]>
Commit | Line | Data |
---|---|---|
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 | ||
8 | signature SOLIDIFY = | |
9 | sig | |
10 | type colorings = (Temp.temp * int) list | |
11 | type asm = x86.insn list | |
12 | ||
13 | val solidify : colorings -> asm -> asm | |
14 | end | |
15 | ||
16 | structure Solidify :> SOLIDIFY = | |
17 | struct | |
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 |
284 | end |