Joshua Wise's Git repositories - snipe.git/blob

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