1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
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
fun go b =
if b < 8
then
(lowByte w (Word.>> (n, Word.fromInt (8 * b))) ;
go (b + 1))
else ()
in
go 0
end
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
| 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"
in
case oper of
Syntax.OAlloc (r, v) =>
(makeOpcode w 1 (isConst v) false ;
writeInt 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 ;
writeValue w v)
| Syntax.OPeek (r, off, v) =>
(makeOpcode w 4 (isConst v) false ;
writeInt w r ;
writeInt w off ;
writeValue w v)
| Syntax.OShuf (r, v) =>
(makeOpcode w 5 (isConst v) false ;
writeInt w r ;
writeValue w v)
| Syntax.OExit v =>
(makeOpcode w 6 (isConst v) false ;
writeValue w v)
| Syntax.OLabel _ => ()
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
|
