diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2023-02-11 09:40:25 -0800 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2023-02-11 09:40:25 -0800 |
| commit | ddb69212f03a82e980144594d809a072b50e7f19 (patch) | |
| tree | feffd8402d40c8ee0c3bb441355db956ef4cc6f9 /linker.sml | |
| parent | Write a first draft of the compiler. (diff) | |
| download | sml-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.sml | 38 |
1 files changed, 24 insertions, 14 deletions
@@ -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 ; |
