]> Joshua Wise's Git repositories - snipe.git/blame - codegen/solidify.sml
Initial import of l5c
[snipe.git] / codegen / solidify.sml
CommitLineData
6ade8b0a 1(* L3 Compiler
12aa4087
JW
2 * Takes a list of mappings of temporaries to colors and a pseudoasm listing,
3 * then produces x86 code.
0a24e44d 4 * Author: Chris Lu <czl@andrew.cmu.edu>
12aa4087
JW
5 * Author: Joshua Wise <jwise@andrew.cmu.edu>
6 *)
7
8signature SOLIDIFY =
9sig
10 type colorings = (Temp.temp * int) list
11 type asm = x86.insn list
12
13 val solidify : colorings -> asm -> asm
14end
15
16structure Solidify :> SOLIDIFY =
17struct
18 structure X = x86
19 structure T = Temp
20
21 type colorings = (Temp.temp * int) list
22 type asm = x86.insn list
23
24 exception Spilled
5c79bb68
JW
25
26 structure TempMap = SplayMapFn(struct
27 type ord_key = Temp.temp
28 val compare = Temp.compare
29 end)
30 structure Tm = Temp
31
12aa4087
JW
32 fun solidify (regmap : colorings) (instrs : asm) : asm =
33 let
34 (* r14d and r15d is reserved for spilling *)
1144856b 35 val maxreg = X.regtonum X.R13D
12aa4087
JW
36 fun numtoreg n =
37 if (n > maxreg)
38 then raise Spilled
39 else X.numtoreg n
1144856b 40
5c79bb68
JW
41 val tempnums = List.foldr (fn ((t,n),b) => TempMap.insert(b,t,n)) (TempMap.empty) regmap
42 fun temptonum (t: T.temp) : int = valOf (TempMap.find (tempnums, t))
43
12aa4087
JW
44 fun temptoreg (t: T.temp) : x86.reg =
45 numtoreg (temptonum t)
6ade8b0a
JW
46 handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
47
48 val spillreg1 = X.R15D
1144856b 49 val spillreg2 = X.R14D
6ade8b0a
JW
50
51 (* Determine which need to be saved. *)
1144856b 52 val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
6ade8b0a
JW
53 val saveregs = X.OperSet.intersection (
54 X.OperSet.addList (X.OperSet.empty, opsused),
55 X.OperSet.addList (
56 X.OperSet.empty,
57 [X.REG X.EBX,
58 X.REG X.EBP,
59 X.REG X.R12D,
60 X.REG X.R13D,
61 X.REG X.R14D,
62 X.REG X.R15D]))
63 val savelist = X.OperSet.listItems saveregs
64 val nsave = length savelist
65
1144856b
JW
66 val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap) (* Number of registers used. *)
67 val nspilled = Int.max (numreg - maxreg, 0) (* Number of spilled registers. *)
5c79bb68
JW
68 fun isspilled (X.TEMP temp, _) = (temptonum temp) > maxreg (* Whether a register is spilled *)
69 | isspilled (X.STACKARG _, _) = true
70 | isspilled (X.REL _, _) = true
12aa4087 71 | isspilled _ = false
5c79bb68 72
6ade8b0a 73 val stacksz = (nspilled + nsave) * 8
1144856b 74 fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8 (* Stack position of some register number *)
6ade8b0a
JW
75
76 val prologue =
5c79bb68 77 (X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))) ::
6ade8b0a
JW
78 (ListPair.map
79 (fn (num, reg) =>
5c79bb68 80 X.MOV ((X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad), (reg, Tm.Quad)))
6ade8b0a
JW
81 (List.tabulate (nsave, fn x => x), savelist))
82 val epilogue =
83 (ListPair.map
84 (fn (num, reg) =>
5c79bb68 85 X.MOV ((reg, Tm.Quad), (X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad)))
6ade8b0a 86 (List.tabulate (nsave, fn x => x), savelist)) @
5c79bb68 87 [X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))]
6ade8b0a
JW
88 val endlbl = Label.new()
89
5c79bb68
JW
90 fun spill ((X.TEMP temp, s), xreg: x86.reg) = (* Spill a register if need be. *)
91 let
92 val base = (X.REG X.RSP, Tm.Quad)
93 val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
94 in
95 if (isspilled (X.TEMP temp, s))
96 then [X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]
97 else nil
98 end
99 | spill ((X.STACKARG _, s), _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
100 | spill ((a as X.REL _, s), xreg) = [X.MOV ((a,s), (X.REG xreg,s))]
101 | spill _ = nil (* Nothing else can be spilled. *)
102 fun unspill ((X.TEMP temp, s), xreg: x86.reg) = (* Unspill a register if need be. *)
103 let
104 val base = (X.REG X.RSP, Tm.Quad)
105 val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
106 in
107 if (isspilled (X.TEMP temp, s))
108 then [X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]
109 else nil
110 end
111 | unspill ((X.STACKARG arg, s), xreg) =
112 let
113 val base = (X.REG X.RSP, Tm.Quad)
114 val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
115 in
116 [X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]
117 end
118 | unspill ((a as X.REL _, s), xreg) = [X.MOV ((X.REG xreg, s), (a,s))]
119 | unspill _ = nil
120
121 fun realoper (X.TEMP temp, s) = (X.REG (temptoreg temp), s) (* makes an operand 'real' *)
122 | realoper (X.STACKARG arg, _) = raise Spilled
123 | realoper (X.REL _, _) = raise Spilled
12aa4087 124 | realoper r = r
6ade8b0a 125
5c79bb68
JW
126 fun stackoper (X.TEMP temp, s) =
127 let
128 val base = (X.REG X.RSP, Tm.Quad)
129 val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
130 in
131 if (isspilled (X.TEMP temp, s))
132 then (X.REL (base, offs, 0w1), s)
133 else raise ErrorMsg.InternalError "stackoper on unspilled temp?"
134 end
135 | stackoper (X.STACKARG arg, s) =
136 let
137 val base = (X.REG X.RSP, Tm.Quad)
138 val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
139 in
140 (X.REL (base, offs, 0w1), s)
141 end
142 | stackoper (a as (X.REL _, s)) = a
143 | stackoper (a as (X.CONST _, s)) = a
144 | stackoper anous = raise ErrorMsg.InternalError ("stackoper on not temp " ^ X.pp_oper anous)
145
146 fun ophit (X.REL(op1, op2, m), s) =
147 if (isspilled op1 andalso isspilled op2) then
148 ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2),
149 X.IMUL((X.REG spillreg1, Tm.Quad), (X.CONST m, Tm.Quad)),
150 X.ADD ((X.REG spillreg1, Tm.Quad), stackoper op1)],
151 (X.REL ((X.REG spillreg1, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))
152 else if(isspilled op1) then
153 ([X.MOV ((X.REG spillreg1, Tm.Quad), stackoper op1)],
154 (X.REL ((X.REG spillreg1, Tm.Quad), realoper op2, m), s))
155 else if(isspilled op2) then
156 ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2)],
157 (X.REL (realoper op1, (X.REG spillreg1, Tm.Quad), m), s))
1144856b
JW
158 else
159 ([],
5c79bb68 160 (X.REL (realoper op1, realoper op2, m), s))
1144856b
JW
161 | ophit a = (nil, realoper a handle Spilled => stackoper a)
162
12aa4087
JW
163 fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
164 | transform (X.COMMENT s) = [X.COMMENT s]
6ade8b0a 165 | transform (X.LIVEIGN a) = transform a
6ade8b0a 166 | transform (X.MOV (dest, src)) =
1144856b 167 let
5c79bb68
JW
168 val (insns1, realop1 as (_,s1)) = ophit dest
169 val (insns2, realop2 as (_,s2)) = ophit src
1144856b
JW
170 in
171 if(isspilled dest andalso isspilled src) then
5c79bb68 172 insns2 @ [X.MOV ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
1144856b
JW
173 else
174 insns1 @ insns2 @ [X.MOV (realop1, realop2)]
175 end
176 | transform (X.LEA (dest, src)) =
177 let
5c79bb68
JW
178 val (insns1, realop1 as (_,s1)) = ophit dest
179 val (insns2, realop2 as (_,s2)) = ophit src
1144856b
JW
180 in
181 if(isspilled dest andalso isspilled src) then
5c79bb68 182 insns2 @ [X.LEA ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
1144856b
JW
183 else
184 insns1 @ insns2 @ [X.LEA (realop1, realop2)]
185 end
6ade8b0a 186 | transform (X.SUB (dest, src)) =
1144856b
JW
187 let
188 val (insns, realop) = ophit dest
189 in
5c79bb68 190 unspill (src, spillreg2) @ insns @
1144856b 191 [ X.SUB(realop,
5c79bb68 192 realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
1144856b 193 end
12aa4087 194 | transform (X.IMUL (dest, src)) =
5c79bb68 195 unspill (dest, spillreg1) @
12aa4087 196 [ X.IMUL(
5c79bb68 197 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
12aa4087 198 realoper src handle Spilled => stackoper src)] @
5c79bb68 199 spill (dest, spillreg1)
12aa4087 200 | transform (X.IMUL3 (dest, src, const)) =
5c79bb68 201 unspill (src, spillreg2) @
12aa4087 202 [ X.IMUL3(
5c79bb68
JW
203 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
204 realoper src handle Spilled => (X.REG spillreg2, X.osize src),
12aa4087 205 const)] @
5c79bb68 206 spill (dest, spillreg1)
1144856b
JW
207 | transform (X.ADD (dest, src)) =
208 let
209 val (insns, realop) = ophit dest
210 in
5c79bb68 211 unspill (src, spillreg2) @ insns @
1144856b 212 [ X.ADD(realop,
5c79bb68 213 realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
1144856b 214 end
6ade8b0a 215 | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
12aa4087 216 | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
6ade8b0a
JW
217 | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
218 | transform (X.SAL (dest, shft)) =
219 [ X.SAL (
0a24e44d
JW
220 realoper dest handle Spilled => stackoper dest,
221 shft)]
6ade8b0a
JW
222 | transform (X.SAR (dest, shft)) =
223 [ X.SAR (
0a24e44d
JW
224 realoper dest handle Spilled => stackoper dest,
225 shft)]
12aa4087 226 | transform (X.CLTD) = [ X.CLTD ]
6ade8b0a 227 | transform (X.AND (dest, src)) =
5c79bb68 228 unspill (src, spillreg1) @
6ade8b0a 229 [ X.AND(
0a24e44d 230 realoper dest handle Spilled => stackoper dest,
5c79bb68 231 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
6ade8b0a 232 | transform (X.OR (dest, src)) =
5c79bb68 233 unspill (src, spillreg1) @
6ade8b0a 234 [ X.OR(
0a24e44d 235 realoper dest handle Spilled => stackoper dest,
5c79bb68 236 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
6ade8b0a 237 | transform (X.XOR (dest, src)) =
5c79bb68 238 unspill (src, spillreg1) @
6ade8b0a 239 [ X.XOR(
0a24e44d 240 realoper dest handle Spilled => stackoper dest,
5c79bb68 241 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
6ade8b0a 242 | transform (X.CMP (op1, op2)) =
5c79bb68
JW
243 let
244 val (insns1, realop1) = ophit op1
245 in
246 if(isspilled realop1 andalso isspilled op2) then
247 unspill (op2, spillreg2) @ insns1 @ [X.CMP (realop1, (X.REG spillreg2, X.osize realop1))]
248 else
249 insns1 @ [X.CMP (realop1, realoper op2 handle Spilled => stackoper op2)]
250 end
0a24e44d 251 | transform (X.TEST (op1, op2)) =
5c79bb68 252 unspill (op2, spillreg1) @
0a24e44d
JW
253 [ X.TEST(
254 realoper op1 handle Spilled => stackoper op1,
5c79bb68 255 realoper op2 handle Spilled => (X.REG spillreg1, X.osize op2))]
6ade8b0a 256 | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
5c79bb68
JW
257 | transform (X.CMOVcc (c, dest, src)) =
258 let
259 val (insns1, realop1) = ophit dest
260 val (insns2, realop2) = ophit src
261 in
262 if(isspilled dest andalso isspilled src) then
263 insns2 @ [X.MOV ((X.REG spillreg2, X.osize src), realop2)] @ insns1 @ [X.CMOVcc (c, realop1, (X.REG spillreg2, X.osize src))]
264 else
265 insns1 @ insns2 @ [X.CMOVcc (c, realop1, realop2)]
266 end
6ade8b0a
JW
267 | transform (X.CALL l) = [ X.CALL l ]
268 | transform (X.MOVZB (dest, src)) =
269 [ X.MOVZB(
5c79bb68 270 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
0a24e44d 271 realoper src handle Spilled => stackoper src)]
5c79bb68 272 @ spill (dest, spillreg1)
6ade8b0a 273 | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
0a24e44d
JW
274 | transform (X.LABEL l) = [ X.LABEL l ]
275 | transform (X.JMP l) = [ X.JMP l ]
6ade8b0a 276 | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
5c79bb68 277 | transform _ = raise ErrorMsg.InternalError "probably movsc: unimplemented"
12aa4087 278 in
6ade8b0a
JW
279 if (nsave < 2) then
280 List.concat (prologue :: (map transform instrs))
281 else
282 List.concat (prologue :: ((map transform instrs) @ [[X.LABEL endlbl], epilogue, [X.RET]]))
12aa4087
JW
283 end
284end
This page took 0.05567 seconds and 4 git commands to generate.