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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
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
|
