]> Joshua Wise's Git repositories - snipe.git/blob - codegen/codegen.sml
Initial import of l5c
[snipe.git] / codegen / codegen.sml
1 (* L3 Compiler
2  * Assembly code generator for fake x86 assembly
3  * Author: Joshua Wise <jwise@andrew.cmu.edu>
4  * Author: Chris Lu <czl@andrew.cmu.edu>
5  *)
6
7 signature CODEGEN =
8 sig
9   val codegen : Tree.stm list -> x86.insn list
10 end
11
12 structure Codegen :> CODEGEN = 
13 struct
14   structure T = Tree
15   structure TU = TreeUtils
16   structure X = x86
17   structure Tm = Temp
18
19   (* hasfixed : T.exp -> bool
20    * true iff the given expression has an hasfixed.
21    *)
22   fun hasfixed (T.BINOP(T.DIV, _, _)) = true
23     | hasfixed (T.BINOP(T.MOD, _, _)) = true
24     | hasfixed (T.BINOP(T.LSH, _, _)) = true
25     | hasfixed (T.BINOP(T.RSH, _, _)) = true
26     | hasfixed (T.CALL _) = true
27     | hasfixed (T.BINOP(_, a, b)) = (hasfixed a) orelse (hasfixed b)
28     | hasfixed (T.UNOP (_, a)) = hasfixed a
29     | hasfixed (T.ALLOC(_)) = true
30     | hasfixed (T.MEMORY (m,s)) = hasfixed m
31     | hasfixed (T.STMVAR _) = true
32     | hasfixed _ = false
33
34   fun offshit a b 0w4 d = [X.LEA(d, (X.REL((a, Tm.Quad), (b, Tm.Quad), 0w4), Tm.Quad))]
35     | offshit a b 0w8 d = [X.LEA(d, (X.REL((a, Tm.Quad), (b, Tm.Quad), 0w8), Tm.Quad))]
36     | offshit a b n d   = [X.IMUL((b, Tm.Long), (X.CONST n, Tm.Long)), X.MOV(d, (a, Tm.Quad)), X.ADD(d, (b, Tm.Quad))]
37
38   fun binophit_c d oper e c = let val (i, s) = munch_exp d e in (i @ [oper ((d,s), (X.CONST c, s))], s) end
39   and binophit_t d oper e t =
40     let
41       val (i, s) = munch_exp d e
42       val ts = Tm.size t
43       val rs = if Tm.cmpsize (s, ts) = GREATER then s else ts
44     in
45       (i @ [oper ((d, rs), (X.TEMP t, rs))], rs)
46     end
47   and binophit d oper e1 e2 =
48     let
49       val t = X.TEMP (Tm.new "add" Tm.Long)
50       val (i1, s1) = munch_exp d e1
51       val (i2, s2) = munch_exp t e2
52 (*      val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *)
53       val rs = if Tm.cmpsize (s1, s2) = GREATER then s1 else s2
54 (*      val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *)
55     in
56       (i1 @ i2 @ [oper ((d,rs), (t,rs))], rs)
57     end
58   and cmphit d a = let val (insns, pos, neg) = munch_cond a in (insns @ [X.SETcc (pos, (d, Tm.Byte)), X.MOVZB((d, Tm.Long), (d, Tm.Byte))], Tm.Long) end
59
60   (* munch_exp : prex86oper -> T.exp -> prex86insn list *)
61   (* munch_exp d e
62    * generates instructions to achieve d <- e
63    * d must be TEMP(t) or REG(r)
64    *)
65   and munch_exp d (T.CONST n) = ([X.MOV((d, Tm.Long), (X.CONST n, Tm.Long))], Tm.Long)
66     | munch_exp d (T.NULLPTR) = ([X.MOV((d, Tm.Quad), (X.CONST 0w0, Tm.Quad))], Tm.Quad)
67     | munch_exp d (T.TEMP(t)) = ([X.MOV((d, Tm.size t), (X.TEMP t, Tm.size t))], Tm.size t)
68     | munch_exp d (T.ARG(0, sz)) = ([X.MOV((d, sz), (X.REG X.EDI, sz))], sz)
69     | munch_exp d (T.ARG(1, sz)) = ([X.MOV((d, sz), (X.REG X.ESI, sz))], sz)
70     | munch_exp d (T.ARG(2, sz)) = ([X.MOV((d, sz), (X.REG X.EDX, sz))], sz)
71     | munch_exp d (T.ARG(3, sz)) = ([X.MOV((d, sz), (X.REG X.ECX, sz))], sz)
72     | munch_exp d (T.ARG(4, sz)) = ([X.MOV((d, sz), (X.REG X.R8D, sz))], sz)
73     | munch_exp d (T.ARG(5, sz)) = ([X.MOV((d, sz), (X.REG X.R9D, sz))], sz)
74     | munch_exp d (T.ARG(t, sz)) = ([X.MOV((d, sz), (X.STACKARG (t - 6), sz))], sz)
75     | munch_exp d (T.CALL(name, l, rsz)) = (* Scary demons live here. *)
76         let
77           val nargs = length l
78           val nstack = if (nargs <= 6)
79                        then 0
80                        else nargs - 6
81           val stackb = nstack * 8
82           fun argdest 1 = X.REG X.EDI
83             | argdest 2 = X.REG X.ESI
84             | argdest 3 = X.REG X.EDX
85             | argdest 4 = X.REG X.ECX
86             | argdest 5 = X.REG X.R8D
87             | argdest 6 = X.REG X.R9D
88             | argdest n = X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (~(stackb - 8 * (n - 7)))), Tm.Quad), 0w1)
89
90           val dests = List.tabulate (nargs, fn x => argdest (x+1))
91           val (exps,_) = ListPair.unzip l
92           val hf = List.map hasfixed exps
93           val (d_hf, l_hf) = ListPair.unzip (ListPair.foldr
94             (fn (a,b,c) => if b then a::c else c)
95             nil
96             (ListPair.zip (dests,l), hf)
97           )
98           val (d_nohf, l_nohf) = ListPair.unzip (ListPair.foldr
99             (fn (a,b,c) => if b then c else a::c)
100             nil
101             (ListPair.zip (dests,l), hf)
102           )
103           val temps = List.map (fn (_, sz) => Temp.new ("arg") sz (* xxx? *)) l_hf
104           val (argevals_hf,_) = ListPair.unzip (List.map
105             (fn (t,(exp,_)) => munch_exp (X.TEMP t) exp)
106             (ListPair.zip (temps, l_hf)))
107           val argpushes = List.map
108             (fn (dest, t) => [X.MOV ((dest, Tm.size t), (X.TEMP t, Tm.size t))])
109             (ListPair.zip (d_hf, temps))
110           val (argevals_nohf,_) = ListPair.unzip (List.map
111             (fn (d,(exp,sz)) => munch_exp d exp)
112             (ListPair.zip (d_nohf, l_nohf)))
113         in
114           (List.concat argevals_hf @ 
115            List.concat argpushes @
116            List.concat argevals_nohf @
117            [ X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stackb), Tm.Quad)),
118              X.CALL (name, nargs),
119              X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stackb), Tm.Quad)),
120              X.MOV ((d, rsz), (X.REG X.EAX, rsz))], rsz)      (* Finally! *)
121         end
122     | munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = binophit_c d X.ADD e1 n
123     | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = binophit_c d X.ADD e1 n
124     | munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = binophit_t d X.ADD e1 t
125     | munch_exp d (T.BINOP(T.ADD, T.TEMP t, e1)) = binophit_t d X.ADD e1 t
126     | munch_exp d (T.BINOP(T.ADD, e1, e2)) = binophit d X.ADD e1 e2
127
128     | munch_exp d (T.BINOP(T.SUB, e1, T.CONST n)) = binophit_c d X.SUB e1 n
129     | munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = binophit_t d X.SUB e1 t
130     | munch_exp d (T.BINOP(T.SUB, e1, e2)) = binophit d X.SUB e1 e2
131     | munch_exp d (T.BINOP(T.MUL, T.TEMP t, T.CONST n)) = let val s = Tm.size t in ([X.IMUL3((d,s), (X.TEMP t,s), n)], Tm.size t) end
132     | munch_exp d (T.BINOP(T.MUL, T.CONST n, T.TEMP t)) = let val s = Tm.size t in ([X.IMUL3((d,s), (X.TEMP t,s), n)], Tm.size t) end
133     | munch_exp d (T.BINOP(T.MUL, e1, T.CONST n)) = binophit_c d X.IMUL e1 n
134     | munch_exp d (T.BINOP(T.MUL, T.CONST n, e1)) = binophit_c d X.IMUL e1 n
135     | munch_exp d (T.BINOP(T.MUL, e1, e2)) = binophit d X.IMUL e1 e2
136     | munch_exp d (T.BINOP(T.DIV, e1, e2)) =
137         let
138           val t1 = X.TEMP (Temp.new ("div") Tm.Long)
139           val (i1, s1) = munch_exp t1 e1
140           val (i2, s2) = munch_exp d e2
141         in
142           (i1 @ i2 @ [X.MOV ((X.REG X.EAX, s1), (t1, s1)), X.CLTD, X.IDIV (d, s2), X.MOV ((d, s2), (X.REG X.EAX, s2))], Tm.Long)
143         end
144     | munch_exp d (T.BINOP(T.MOD, e1, e2)) =
145         let
146           val t1 = X.TEMP (Temp.new ("div") Tm.Long)
147           val (i1, s1) = munch_exp t1 e1
148           val (i2, s2) = munch_exp d e2
149         in
150           (i1 @ i2 @ [X.MOV ((X.REG X.EAX, s1), (t1, s1)), X.CLTD, X.IDIV (d, s2), X.MOV ((d, s2), (X.REG X.EDX, s2))], Tm.Long)
151         end
152     | munch_exp d (T.BINOP(T.LSH, e1, T.CONST n)) = let val (i,s) = munch_exp d e1 in (i @ [X.SAL ((d,s), (X.CONST (n mod 0w32),s))],s) end
153     | munch_exp d (T.BINOP(T.LSH, e1, T.TEMP t)) =
154         let
155           val (i,s) = munch_exp d e1
156         in 
157           (i @ [X.MOV ((X.REG X.ECX, s), (X.TEMP t, s)), X.SAL ((d,s), (X.REG X.ECX, Tm.Byte))], s)
158         end
159     | munch_exp d (T.BINOP(T.LSH, e1, e2)) =
160         let
161           val t = X.TEMP (Temp.new ("lsh") Tm.Long)
162           val (i1, s1) = munch_exp d e1
163           val (i2, s2) = munch_exp t e2
164         in
165           (i1 @ i2 @ [X.MOV ((X.REG X.ECX, s1), (t, s1)), X.SAL ((d, s2), (X.REG X.ECX, Tm.Byte))], s2)
166         end
167     | munch_exp d (T.BINOP(T.RSH, e1, T.CONST n)) = let val (i,s) = munch_exp d e1 in (i @ [X.SAR ((d,s), (X.CONST (n mod 0w32),s))],s) end
168     | munch_exp d (T.BINOP(T.RSH, e1, T.TEMP t)) =
169         let
170           val (i,s) = munch_exp d e1
171         in 
172           (i @ [X.MOV ((X.REG X.ECX, s), (X.TEMP t, s)), X.SAR ((d,s), (X.REG X.ECX, Tm.Byte))], s)
173         end
174     | munch_exp d (T.BINOP(T.RSH, e1, e2)) =
175         let
176           val t = X.TEMP (Temp.new ("lsh") Tm.Long)
177           val (i1, s1) = munch_exp d e1
178           val (i2, s2) = munch_exp t e2
179         in
180           (i1 @ i2 @ [X.MOV ((X.REG X.ECX, s1), (t, s1)), X.SAR ((d, s2), (X.REG X.ECX, Tm.Byte))], s2)
181         end
182     | munch_exp d (T.BINOP(T.BITAND, T.CONST n, e1)) = binophit_c d X.AND e1 n
183     | munch_exp d (T.BINOP(T.BITAND, e1, T.CONST n)) = binophit_c d X.AND e1 n
184     | munch_exp d (T.BINOP(T.BITAND, T.TEMP t, e1)) = binophit_t d X.AND e1 t
185     | munch_exp d (T.BINOP(T.BITAND, e1, T.TEMP t)) = binophit_t d X.AND e1 t
186     | munch_exp d (T.BINOP(T.BITAND, e1, e2)) = binophit d X.AND e1 e2
187
188     | munch_exp d (T.BINOP(T.BITOR, T.CONST n, e1)) = binophit_c d X.OR e1 n
189     | munch_exp d (T.BINOP(T.BITOR, e1, T.CONST n)) = binophit_c d X.OR e1 n
190     | munch_exp d (T.BINOP(T.BITOR, T.TEMP t, e1)) = binophit_t d X.OR e1 t
191     | munch_exp d (T.BINOP(T.BITOR, e1, T.TEMP t)) = binophit_t d X.OR e1 t
192     | munch_exp d (T.BINOP(T.BITOR, e1, e2)) = binophit d X.OR e1 e2
193
194     | munch_exp d (T.BINOP(T.BITXOR, T.CONST n, e1)) = binophit_c d X.XOR e1 n
195     | munch_exp d (T.BINOP(T.BITXOR, e1, T.CONST n)) = binophit_c d X.XOR e1 n
196     | munch_exp d (T.BINOP(T.BITXOR, T.TEMP t, e1)) = binophit_t d X.XOR e1 t
197     | munch_exp d (T.BINOP(T.BITXOR, e1, T.TEMP t)) = binophit_t d X.XOR e1 t
198     | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) = binophit d X.XOR e1 e2
199
200     | munch_exp d (a as T.BINOP(T.LOGAND, e1, e2)) =
201         let
202           val (insn1, pos1, neg1) = munch_cond e1
203           val (insn2, pos2, neg2) = munch_cond e2
204           val t1 = (X.TEMP (Tm.new "logand 1" Tm.Byte), Tm.Byte)
205           val t2 = (X.TEMP (Tm.new "logand 2" Tm.Byte), Tm.Byte)
206           val l = Label.new ()
207         in
208           if (TU.effect e2 orelse (length insn2 > 10))
209           then ((insn1) @
210                 [X.SETcc(pos1, t1), X.Jcc (neg1, l)] @
211                 (insn2) @
212                 [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB((d, Tm.Long), t1)], Tm.Long)
213           else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.AND(t1,t2), X.MOVZB((d, Tm.Long), t1)], Tm.Long)
214         end
215     | munch_exp d (a as T.BINOP(T.LOGOR, e1, e2)) =
216         let
217           val (insn1, pos1, neg1) = munch_cond e1
218           val (insn2, pos2, neg2) = munch_cond e2
219           val t1 = (X.TEMP (Tm.new "logand 1" Tm.Byte), Tm.Byte)
220           val t2 = (X.TEMP (Tm.new "logand 2" Tm.Byte), Tm.Byte)
221           val l = Label.new ()
222         in
223           if (TU.effect e2 orelse (length insn2 > 10))
224           then ((insn1) @
225                 [X.SETcc(pos1, t1), X.Jcc (pos1, l)] @
226                 (insn2) @
227                 [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB((d, Tm.Long), t1)], Tm.Long)
228           else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.OR(t1,t2), X.MOVZB((d, Tm.Long), t1)], Tm.Long)
229         end
230     | munch_exp d (a as T.BINOP(T.EQ, _, _)) = cmphit d a
231     | munch_exp d (a as T.BINOP(T.NEQ, _, _)) = cmphit d a
232     | munch_exp d (a as T.BINOP(T.LE, _, _)) = cmphit d a
233     | munch_exp d (a as T.BINOP(T.LT, _, _)) = cmphit d a
234     | munch_exp d (a as T.BINOP(T.GE, _, _)) = cmphit d a
235     | munch_exp d (a as T.BINOP(T.GT, _, _)) = cmphit d a
236     | munch_exp d (a as T.BINOP(T.BE, _, _)) = cmphit d a
237
238     | munch_exp d (T.UNOP(T.NEG, e1)) = let val (i, s) = munch_exp d e1 in (i @ [X.NEG (d, Tm.Long)], s) end
239     | munch_exp d (T.UNOP(T.BITNOT, e1)) = let val (i, s) = munch_exp d e1 in (i @ [X.NOT (d, Tm.Long)], s) end
240     | munch_exp d (T.UNOP(T.BANG, e)) = 
241         let
242           val (insns, pos, neg) = munch_cond e
243         in
244           (insns @ [X.SETcc (neg, (d, Tm.Byte)), X.MOVZB((d, Tm.Long), (d, Tm.Byte))], Tm.Long)
245         end
246     | munch_exp d (T.MEMORY (e1,s)) =
247         let
248           val a = X.TEMP (Temp.new "addr" Tm.Quad)
249           val (i, s') = munch_exp a e1
250           val _ = if s' = Tm.Quad then () else raise ErrorMsg.InternalError "memory fuxed."
251         in
252           (i @ [X.MOV ((d,s), (X.REL ((a, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))], s)
253         end
254     | munch_exp d (T.ALLOC(exp)) =
255         
256         let
257           val t1 = Temp.new "alloc" Tm.Long
258           val l1 = Label.new()
259           val (einsn, _) = munch_exp (X.TEMP t1) exp
260           val (insns, _) = munch_exp d (T.CALL (Symbol.symbol "calloc", [(T.TEMP t1, Tm.Long), (T.CONST 0w1, Tm.Long)], Tm.Quad))
261           val rd = (d, Tm.Quad)
262         in
263           (einsn @ insns, Tm.Quad)
264         end
265 (*    | munch_exp d (T.COND(c, T.CONST n1, T.CONST n2)) = let val (i,p,n) = munch_cond c in ((X.MOV (d, X.CONST n1))::i) @ [X.CMOVcc (p, d, X.CONST n2)] end *)
266     | munch_exp d (T.COND(c,e1,e2)) =
267         let
268           val (insns, pos, neg) = munch_cond c
269           val l1 = Label.new()
270           val l2 = Label.new()
271           val (i1, s1) = munch_exp d e1
272           val (i2, s2) = munch_exp d e2
273 (*          val _ = print ("cond: size " ^ Tm.sfx s1 ^ " from " ^ TU.Print.pp_exp e1 ^ ", " ^ Tm.sfx s2 ^ " from " ^ TU.Print.pp_exp e2 ^ "\n") *)
274         in
275           (insns @ [X.Jcc(neg, l1)] @ i1 @ [X.JMP l2, X.LABEL l1] @ i2 @ [X.LABEL l2], if s1 = s2 then s1 else raise ErrorMsg.InternalError "condfuxed.")
276         end
277     | munch_exp d (T.STMVAR (sl, e)) = let val (i, s) = munch_exp d e in (List.concat (map munch_stm sl) @ i, s) end
278
279   and condhit_tc t c (pos, neg) = ([X.CMP((X.TEMP t, Tm.size t), (X.CONST c, Tm.size t))], pos, neg)
280   and condhit_c e c (pos, neg) =
281     let
282       val t = X.TEMP (Temp.new "consthit" Tm.Long)
283       val (i,s) = munch_exp t e
284     in
285       (i @ [X.CMP ((t,s), (X.CONST c,s))], pos, neg)
286     end
287   and condhit_t e t (pos, neg) =
288     let
289       val t' = X.TEMP (Temp.new "consthit" Tm.Long)
290       val (i,s) = munch_exp t' e
291     in
292       (i @ [X.CMP ((t',s), (X.TEMP t,s))], pos, neg)
293     end
294   and condhit e1 e2 (pos, neg) =
295     let
296       val t1 = X.TEMP (Temp.new ("var neq 1") Tm.Long)
297       val t2 = X.TEMP (Temp.new ("var neq 2") Tm.Long)
298       val (i1, s1) = munch_exp t1 e1
299       val (i2, s2) = munch_exp t2 e2
300     in
301       (i1 @ i2 @ [X.CMP((t1,s1),(t2,s2))], pos, neg)
302     end
303
304   (* munch_cond : T.exp -> X.insn list * X.cond * X.cond
305    * munch_cond stm generates code to set flags, and then returns a conditional
306    * to test if the expression was true and for if it was false.
307    *)
308   and munch_cond (T.UNOP (T.BANG, e)) =
309         let
310           val (insns, pos, neg) = munch_cond e
311         in
312           (insns, neg, pos)
313         end
314     | munch_cond (T.BINOP(T.NEQ, T.TEMP t, T.CONST n)) = condhit_tc t n (X.NE, X.E)
315     | munch_cond (T.BINOP(T.NEQ, T.CONST n, T.TEMP t)) = condhit_tc t n (X.NE, X.E)
316     | munch_cond (T.BINOP(T.NEQ, T.CONST n, e1)) = condhit_c e1 n (X.NE, X.E)
317     | munch_cond (T.BINOP(T.NEQ, e1, T.CONST n)) = condhit_c e1 n (X.NE, X.E)
318     | munch_cond (T.BINOP(T.NEQ, T.TEMP t, e1)) = condhit_t e1 t (X.NE, X.E)
319     | munch_cond (T.BINOP(T.NEQ, e1, T.TEMP t)) = condhit_t e1 t (X.NE, X.E)
320     | munch_cond (T.BINOP(T.NEQ, e1, e2)) = condhit e1 e2 (X.NE, X.E)
321
322     | munch_cond (T.BINOP(T.EQ, T.TEMP t, T.CONST n)) = condhit_tc t n (X.E, X.NE)
323     | munch_cond (T.BINOP(T.EQ, T.CONST n, T.TEMP t)) = condhit_tc t n (X.E, X.NE)
324     | munch_cond (T.BINOP(T.EQ, T.CONST n, e1)) = condhit_c e1 n (X.E, X.NE)
325     | munch_cond (T.BINOP(T.EQ, e1, T.CONST n)) = condhit_c e1 n (X.E, X.NE)
326     | munch_cond (T.BINOP(T.EQ, T.TEMP t, e1)) = condhit_t e1 t (X.E, X.NE)
327     | munch_cond (T.BINOP(T.EQ, e1, T.TEMP t)) = condhit_t e1 t (X.E, X.NE)
328     | munch_cond (T.BINOP(T.EQ, e1, e2)) = condhit e1 e2 (X.E, X.NE)
329
330     | munch_cond (T.BINOP(T.LE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.LE, X.G)
331     | munch_cond (T.BINOP(T.LE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.GE, X.L)
332     | munch_cond (T.BINOP(T.LE, T.CONST n, e1)) = condhit_c e1 n (X.GE, X.L)
333     | munch_cond (T.BINOP(T.LE, e1, T.CONST n)) = condhit_c e1 n (X.LE, X.G)
334     | munch_cond (T.BINOP(T.LE, T.TEMP t, e1)) = condhit_t e1 t (X.GE, X.L)
335     | munch_cond (T.BINOP(T.LE, e1, T.TEMP t)) = condhit_t e1 t (X.LE, X.G)
336     | munch_cond (T.BINOP(T.LE, e1, e2)) = condhit e1 e2 (X.LE, X.G)
337
338     | munch_cond (T.BINOP(T.LT, T.TEMP t, T.CONST n)) = condhit_tc t n (X.L, X.GE)
339     | munch_cond (T.BINOP(T.LT, T.CONST n, T.TEMP t)) = condhit_tc t n (X.G, X.LE)
340     | munch_cond (T.BINOP(T.LT, T.CONST n, e1)) = condhit_c e1 n (X.G, X.LE)
341     | munch_cond (T.BINOP(T.LT, e1, T.CONST n)) = condhit_c e1 n (X.L, X.GE)
342     | munch_cond (T.BINOP(T.LT, T.TEMP t, e1)) = condhit_t e1 t (X.G, X.LE)
343     | munch_cond (T.BINOP(T.LT, e1, T.TEMP t)) = condhit_t e1 t (X.L, X.GE)
344     | munch_cond (T.BINOP(T.LT, e1, e2)) = condhit e1 e2 (X.L, X.GE)
345
346     | munch_cond (T.BINOP(T.GT, T.TEMP t, T.CONST n)) = condhit_tc t n (X.G, X.LE)
347     | munch_cond (T.BINOP(T.GT, T.CONST n, T.TEMP t)) = condhit_tc t n (X.L, X.GE)
348     | munch_cond (T.BINOP(T.GT, T.CONST n, e1)) = condhit_c e1 n (X.L, X.GE)
349     | munch_cond (T.BINOP(T.GT, e1, T.CONST n)) = condhit_c e1 n (X.G, X.LE)
350     | munch_cond (T.BINOP(T.GT, T.TEMP t, e1)) = condhit_t e1 t (X.L, X.GE)
351     | munch_cond (T.BINOP(T.GT, e1, T.TEMP t)) = condhit_t e1 t (X.G, X.LE)
352     | munch_cond (T.BINOP(T.GT, e1, e2)) = condhit e1 e2 (X.G, X.LE)
353
354     | munch_cond (T.BINOP(T.GE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.GE, X.L)
355     | munch_cond (T.BINOP(T.GE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.LE, X.G)
356     | munch_cond (T.BINOP(T.GE, T.CONST n, e1)) = condhit_c e1 n (X.LE, X.G)
357     | munch_cond (T.BINOP(T.GE, e1, T.CONST n)) = condhit_c e1 n (X.GE, X.L)
358     | munch_cond (T.BINOP(T.GE, T.TEMP t, e1)) = condhit_t e1 t (X.LE, X.G)
359     | munch_cond (T.BINOP(T.GE, e1, T.TEMP t)) = condhit_t e1 t (X.GE, X.L)
360     | munch_cond (T.BINOP(T.GE, e1, e2)) = condhit e1 e2 (X.GE, X.L)
361
362     | munch_cond (T.BINOP(T.BE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.BE, X.A)
363     | munch_cond (T.BINOP(T.BE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.AE, X.B)
364     | munch_cond (T.BINOP(T.BE, T.CONST n, e1)) = condhit_c e1 n (X.AE, X.B)
365     | munch_cond (T.BINOP(T.BE, e1, T.CONST n)) = condhit_c e1 n (X.BE, X.A)
366     | munch_cond (T.BINOP(T.BE, T.TEMP t, e1)) = condhit_t e1 t (X.AE, X.B)
367     | munch_cond (T.BINOP(T.BE, e1, T.TEMP t)) = condhit_t e1 t (X.BE, X.A)
368     | munch_cond (T.BINOP(T.BE, e1, e2)) = condhit e1 e2 (X.BE, X.A)
369
370     | munch_cond (T.BINOP(T.LOGOR, e1, e2)) =
371         let
372           val (insn1, pos1, neg1) = munch_cond e1
373           val (insn2, pos2, neg2) = munch_cond e2
374           val t1 = (X.TEMP (Temp.new("logor c 1") Tm.Byte), Tm.Byte)
375           val t2 = (X.TEMP (Temp.new("logor c 2") Tm.Byte), Tm.Byte)
376           val l = Label.new ()
377         in
378           if (TU.effect e2 orelse (length insn2 > 10))
379           then ((insn1) @
380                 [X.SETcc (pos1, t1), X.Jcc (pos1, l)] @
381                 (insn2) @
382                 [X.SETcc (pos2, t1), X.LABEL l, X.TEST(t1, t1)],
383                 X.NE, X.E)
384           else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.OR(t1, t2)], X.NE, X.E)
385         end
386     | munch_cond (T.BINOP(T.LOGAND, e1, e2)) =
387         let
388           val (insn1, pos1, neg1) = munch_cond e1
389           val (insn2, pos2, neg2) = munch_cond e2
390           val t1 = (X.TEMP (Temp.new("logand c 1") Tm.Byte), Tm.Byte)
391           val t2 = (X.TEMP (Temp.new("logand c 2") Tm.Byte), Tm.Byte)
392           val l = Label.new ()
393         in
394           if (TU.effect e2 orelse (length insn2 > 10))
395           then ((insn1) @
396                 [X.SETcc (pos1, t1), X.Jcc (neg1, l)] @
397                 (insn2) @
398                 [X.SETcc (pos2, t1), X.LABEL l, X.TEST(t1, t1)],
399                 X.NE, X.E)
400           else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.AND(t1, t2)], X.NE, X.E)
401         end
402     | munch_cond e =
403       let
404         val t = X.TEMP (Temp.new ("munch c") Tm.Long)
405         val (i, s) = munch_exp t e
406       in
407         (i @ [ X.TEST ((t,s),(t,s)) ], X.NE, X.E)
408       end
409
410   (* munch_lval : T.exp -> (X.insn list * X.operand)
411    * Takes an expression that has been typechecked as being a valid lvalue, and then returns an instruction list and an operand to store your shit in.
412    *)
413   and munch_lval (T.TEMP t) = ([], (X.TEMP t, Tm.size t))
414     | munch_lval (T.MEMORY (m,s)) = 
415       let
416         val t = X.TEMP (Tm.new "lv addr" Tm.Quad)
417         val (i,s') = munch_exp t m
418       in
419         (i, (X.REL ((t, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))
420       end
421     | munch_lval _ = raise ErrorMsg.InternalError "That wasn't really a valid lvalue..."
422
423   (* munch_stm : T.stm -> X.insn list *)
424   (* munch_stm stm generates code to execute stm *)
425   and munch_stm (T.MOVE (T.TEMP t1, T.TEMP t2)) = if Tm.size t1 = Tm.size t2 then [X.MOV((X.TEMP t1, Tm.size t1), (X.TEMP t2, Tm.size t2))]
426                                                                              else raise ErrorMsg.InternalError "temp to temp move fuxed."
427     | munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = if Tm.size t = Tm.Long then [X.MOV((X.TEMP t, Tm.size t), (X.CONST n, Tm.size t))]
428                                                                         else raise ErrorMsg.InternalError "const to temp move fuxed."
429     | munch_stm (T.MOVE (T.TEMP t, a as T.ARG (an, sz))) =
430         let
431           val (i, s) = munch_exp (X.TEMP t) a
432         in
433           if s = Tm.size t
434           then i
435           else raise ErrorMsg.InternalError "arg to tmp fuxed."
436         end
437     | munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = let val (i, _) = munch_exp (X.TEMP t) a in i end
438     | munch_stm (T.MOVE (a, e2)) =
439         let
440           val t = X.TEMP (Temp.new ("assign") Tm.Long)
441           val (m, (r,s1)) = munch_lval a
442           val (i, s2) = munch_exp t e2
443 (*          val _ = print ("move: size " ^ Tm.sfx s2 ^ " from " ^ TU.Print.pp_exp e2 ^ ", " ^ Tm.sfx s1 ^ " from " ^ TU.Print.pp_exp a ^ "\n") *)
444           val _ = if s1 = s2 then () else raise ErrorMsg.InternalError "move generic fuxed."
445         in
446           m @ i @ [X.MOV((r,s1), (t,s2))]
447         end
448     | munch_stm (T.RETURN(e, sz)) =
449         let
450           val t = X.TEMP (Temp.new ("retval") sz)
451           val (i, s) = munch_exp t e
452         in
453           i @ [X.MOV((X.REG X.EAX, sz), (t, if sz = s then sz else raise ErrorMsg.InternalError "retfuxed.")), X.RET]
454         end
455     | munch_stm (T.LABEL l) = [X.LABEL l]
456     | munch_stm (T.JUMP l) = [X.JMP l]
457     | munch_stm (T.JUMPIFN(e, l)) =
458        let
459          val (insns, pos, neg) = munch_cond e 
460        in
461          insns @ [X.Jcc (neg, l)]
462        end
463     | munch_stm (T.EFFECT exp) = let val t = X.TEMP (Temp.new "throwaway" Tm.Quad) val (i, _) = munch_exp t exp in i end
464
465   fun codegen nil = nil
466     | codegen (stm::stms) = munch_stm stm @ codegen stms
467 end
This page took 0.047971 seconds and 4 git commands to generate.