diff options
| author | Rose Hogenson <rosehogenson@posteo.net> | 2025-05-16 16:54:17 -0700 |
|---|---|---|
| committer | Rose Hogenson <rosehogenson@posteo.net> | 2025-05-16 16:54:17 -0700 |
| commit | 5582235bd300f8de997192f9109d596d12df4bbe (patch) | |
| tree | d219a6c0a3d96052eec422527cd05775354abf76 /linker.sml | |
| parent | Fix spelling in GenSym (diff) | |
| download | sml-5582235bd300f8de997192f9109d596d12df4bbe.tar.zst | |
Fix spelling of file names
Diffstat (limited to 'linker.sml')
| -rw-r--r-- | linker.sml | 149 |
1 files changed, 0 insertions, 149 deletions
diff --git a/linker.sml b/linker.sml deleted file mode 100644 index 684451d..0000000 --- a/linker.sml +++ /dev/null @@ -1,149 +0,0 @@ -structure Linker = -struct - fun makeOpcode w code arg1Const arg2Const = - if code >= 0x40 - then raise Fail "code is more than 6 bits" - else - let - val arg1Bit = if arg1Const then 2 else 0 - val arg2Bit = if arg2Const then 1 else 0 - in - BinIO.output1 (w, Word8.fromInt (code * 4 + arg1Bit + arg2Bit)) - end - - fun isConst (Syntax.VVar _) = false - | isConst _ = true - - fun lowByte w n = - BinIO.output1 (w, Word8.fromInt (Word.toInt (Word.andb (n, Word.fromInt 0xff)))) - - fun writeInt w i = - let val n = Word.fromInt i - in - (lowByte w (Word.orb (Word.<< (n, Word.fromInt 1), Word.fromInt 0x1)) ; - lowByte w (Word.>> (n, Word.fromInt 7)) ; - lowByte w (Word.>> (n, Word.fromInt 15)) ; - lowByte w (Word.>> (n, Word.fromInt 23)) ; - lowByte w (Word.>> (n, Word.fromInt 31)) ; - lowByte w (Word.>> (n, Word.fromInt 39)) ; - lowByte w (Word.>> (n, Word.fromInt 47)) ; - lowByte w (Word.>> (n, Word.fromInt 55))) - end - - fun writeVar w v = - if v > CodeGen.tempReg - then raise Fail ("var out of range: " ^ Int.toString v) - else lowByte w (Word.fromInt v) - - fun writeOffset w i = - if i < 0 - then raise Fail ("negative offset: " ^ Int.toString i) - else writeInt w i - - structure IntMap = Map(type k = int val cmp = Int.compare) - - fun encode (m : int IntMap.map) (w : BinIO.outstream) (oper : Syntax.opcode) : unit = - let - fun writeValue w (Syntax.VVar v) = writeVar w v - | writeValue w (Syntax.VLabel l) = writeInt w (getOpt (IntMap.lookup l m, 0)) - | writeValue w (Syntax.VInt i) = writeInt w i - in - case oper of - Syntax.OAlloc (r, v) => - (makeOpcode w 1 (isConst v) false ; - writeVar w r ; - writeValue w v) - | Syntax.OCall => - makeOpcode w 2 false false - | Syntax.OPoke (off, p, v) => - (makeOpcode w 3 (isConst v) false ; - writeOffset w off ; - writeVar w p ; - writeValue w v) - | Syntax.OPeek (r, off, v) => - (makeOpcode w 4 (isConst v) false ; - writeVar w r ; - writeOffset w off ; - writeValue w v) - | Syntax.OShuf (r, v) => - (makeOpcode w 5 (isConst v) false ; - writeVar w r ; - writeValue w v) - | Syntax.OExit v => - (makeOpcode w 6 (isConst v) false ; - writeValue w v) - | Syntax.OAdd (r, v1, v2) => - (makeOpcode w 7 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.OSub (r, v1, v2) => - (makeOpcode w 8 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.OMul (r, v1, v2) => - (makeOpcode w 9 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.ODiv (r, v1, v2) => - (makeOpcode w 10 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.OLess (r, v1, v2) => - (makeOpcode w 11 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.OEq (r, v1, v2) => - (makeOpcode w 12 (isConst v1) (isConst v2) ; - writeVar w r ; - writeValue w v1 ; - writeValue w v2) - | Syntax.OIf (condition, label) => - (makeOpcode w 13 (isConst condition) false ; - writeValue w condition ; - writeValue w (Syntax.VLabel label)) - | Syntax.OLabel _ => () - | Syntax.ORead (r, ptr, off, len) => - (makeOpcode w 14 (isConst off) (isConst len) ; - writeVar w r ; - writeVar w ptr ; - writeValue w off ; - writeValue w len) - | Syntax.OWrite (ptr, off, len) => - (makeOpcode w 15 (isConst off) (isConst len) ; - writeVar w ptr ; - writeValue w off ; - writeValue w len) - | Syntax.OWriteErr (ptr, off, len) => - (makeOpcode w 16 (isConst off) (isConst len) ; - writeVar w ptr ; - writeValue w off ; - writeValue w len) - end - - fun link (program : Syntax.opcode list) : Word8Vector.vector = - let - val (w1, b1) = Buffer.buf () - val labels = - foldl - (fn (x, acc) => - (encode IntMap.empty w1 x ; - case x of - Syntax.OLabel l => IntMap.insert l (Word8ArraySlice.length (!b1)) acc - | _ => acc)) - IntMap.empty - program - val (w, b) = Buffer.buf () - fun go [] = () - | go (oper :: program) = - (encode labels w oper ; - go program) - in - go program ; - Word8ArraySlice.vector (!b) - end -end |
