summaryrefslogtreecommitdiffstats
path: root/linker.sml
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2023-02-11 09:40:25 -0800
committerRose Hogenson <rhogenson@posteo.net>2023-02-11 09:40:25 -0800
commitddb69212f03a82e980144594d809a072b50e7f19 (patch)
treefeffd8402d40c8ee0c3bb441355db956ef4cc6f9 /linker.sml
parentWrite a first draft of the compiler. (diff)
downloadsml-ddb69212f03a82e980144594d809a072b50e7f19.tar.zst
Finish the compiler.
Just joking. But we did manage to compile a program from SML to bytecode.
Diffstat (limited to 'linker.sml')
-rw-r--r--linker.sml38
1 files changed, 24 insertions, 14 deletions
diff --git a/linker.sml b/linker.sml
index b52e84b..874e145 100644
--- a/linker.sml
+++ b/linker.sml
@@ -18,23 +18,33 @@ struct
BinIO.output1 (w, Word8.fromInt (Word.toInt (Word.andb (n, Word.fromInt 0xff))))
fun writeInt w i =
- let
- val n = Word.fromInt i
- fun go b =
- if b < 8
- then
- (lowByte w (Word.>> (n, Word.fromInt (8 * b))) ;
- go (b + 1))
- else ()
+ let val n = Word.fromInt i
in
- go 0
+ (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 > 7
+ then raise Fail ("var out of range: " ^ Int.toString v)
+ else lowByte w (Word.fromInt v)
+
+ fun writeOffset w i =
+ if ~128 > i orelse i > 127
+ then raise Fail ("offset out of range: " ^ Int.toString i)
+ else lowByte w
+
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) = writeInt w v
+ 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
| writeValue w (Syntax.VString _) = raise Fail "I don't support strings yet"
@@ -42,23 +52,23 @@ struct
case oper of
Syntax.OAlloc (r, v) =>
(makeOpcode w 1 (isConst v) false ;
- writeInt w r ;
+ writeVar w r ;
writeValue w v)
| Syntax.OCall =>
makeOpcode w 2 false false
| Syntax.OPoke (off, p, v) =>
(makeOpcode w 3 (isConst v) false ;
writeInt w off ;
- writeInt w p ;
+ writeVar w p ;
writeValue w v)
| Syntax.OPeek (r, off, v) =>
(makeOpcode w 4 (isConst v) false ;
- writeInt w r ;
+ writeVar w r ;
writeInt w off ;
writeValue w v)
| Syntax.OShuf (r, v) =>
(makeOpcode w 5 (isConst v) false ;
- writeInt w r ;
+ writeVar w r ;
writeValue w v)
| Syntax.OExit v =>
(makeOpcode w 6 (isConst v) false ;