1 files changed, 149 insertions, 0 deletions
diff --git a/Linker.sml b/Linker.sml
new file mode 100644
index 0000000..684451d
--- /dev/null
+++ b/Linker.sml
@@ -0,0 +1,149 @@
+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