]> Joshua Wise's Git repositories - snipe.git/blame_incremental - codegen/solidify.sml
git.joshuawise.com / snipe.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
First pass spill code.
[snipe.git] / codegen / solidify.sml
... / ...
CommitLineData
1(* L3 Compiler
2 * Takes a list of mappings of temporaries to colors and a pseudoasm listing,
3 * then produces x86 code.
4 * Author: Chris Lu <czl@andrew.cmu.edu>
5 * Author: Joshua Wise <jwise@andrew.cmu.edu>
6 *)
7
8signature SOLIDIFY =
9sig
10 type colorings = (Temp.temp * int) list
11 type asm = Blarg.insn list
12
13 val solidify : colorings -> asm -> asm
14end
15
16structure Solidify :> SOLIDIFY =
17struct
18 structure X = Blarg
19 structure T = Temp
20
21 type colorings = (Temp.temp * int) list
22 type asm = Blarg.insn list
23
24 exception Spilled
25
26 structure TempMap = SplayMapFn(struct
27 type ord_key = Temp.temp
28 val compare = Temp.compare
29 end)
30 structure Tm = Temp
31
32 fun solidify (regmap : colorings) (instrs : asm) : asm =
33 let
34 (* r11 and r12 is reserved for spilling *)
35 val maxreg = X.regtonum X.R10
36 fun numtoreg n =
37 if (n > maxreg)
38 then raise Spilled
39 else X.numtoreg n
40
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
44 fun temptoreg (t: T.temp) : Blarg.reg =
45 numtoreg (temptonum t)
46 handle Option => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
47
48 val spillreg1 = X.R12
49 val spillreg2 = X.R11
50
51 (* Determine which need to be saved. *)
52 val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R12)) regmap) @ [X.REG X.R11]
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.R6,
58 X.REG X.R7,
59 X.REG X.R8,
60 X.REG X.R9,
61 X.REG X.R10,
62 X.REG X.R11,
63 X.REG X.R12]))
64 val savelist = X.OperSet.listItems saveregs
65 val nsave = length savelist
66
67 val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap) (* Number of registers used. *)
68 val nspilled = Int.max (numreg - maxreg, 0) (* Number of spilled registers. *)
69 fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg (* Whether a register is spilled *)
70 | isspilled (X.STACKARG _) = true
71 | isspilled _ = false
72
73 val stacksz = (nspilled + nsave) * 1
74 fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 1 (* Stack position of some register number *)
75
76 val prologue =
77 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
78 X.INSN (X.AL, X.SUB (X.REG X.SP, X.REG X.R4))] @
79 (List.concat
80 (ListPair.map
81 (fn (num, reg) =>
82 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
83 X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
84 X.INSN (X.AL, X.STO (X.REG X.R4, reg))])
85 (List.tabulate (nsave, fn x => x), savelist)
86 )
87 )
88 val epilogue =
89 (List.concat
90 (ListPair.map
91 (fn (num, reg) =>
92 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
93 X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
94 X.INSN (X.AL, X.LDR (reg, X.REG X.R4))])
95 (List.tabulate (nsave, fn x => x), savelist)
96 )
97 ) @
98 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
99 X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
100 val endlbl = Label.new()
101
102 fun spill (X.TEMP temp, X.R12: Blarg.reg) = (* Spill a register if need be. *)
103 let
104 val base = X.REG X.SP
105 val offs = Word.fromInt (stackpos (temptonum temp))
106 in
107 if (isspilled (X.TEMP temp))
108 then [ X.MOVLIT (X.REG X.R11, offs),
109 X.ADD (X.REG X.R11, X.REG X.SP),
110 X.STO (X.REG X.R11, X.REG X.R12) ]
111 else nil
112 end
113 | spill (X.TEMP temp, _) = if (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "Cannot spill from non-R11"
114 else nil
115 | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
116 | spill _ = nil (* Nothing else can be spilled. *)
117 fun unspill (X.TEMP temp, xreg: Blarg.reg) = (* Unspill a register if need be. *)
118 let
119 val base = X.REG X.SP
120 val offs = Word.fromInt (stackpos (temptonum temp))
121 in
122 if (isspilled (X.TEMP temp))
123 then [ X.MOVLIT (X.REG xreg, offs),
124 X.ADD (X.REG xreg, X.REG X.SP),
125 X.LDR (X.REG xreg, X.REG xreg) ]
126 else nil
127 end
128 | unspill (X.STACKARG arg, xreg) =
129 let
130 val base = X.REG X.SP
131 val offs = Word.fromInt (stacksz + 1 + (arg * 1))
132 in
133 [ X.MOVLIT (X.REG xreg, offs),
134 X.ADD (X.REG xreg, X.REG X.SP),
135 X.LDR (X.REG xreg, X.REG xreg) ]
136 end
137 | unspill _ = nil
138
139 fun unspill_ops (op1, op2) =
140 case (isspilled op1, isspilled op2)
141 of (false, false) => []
142 | (true, false) => unspill (op1, spillreg1)
143 | (false, true) => unspill (op2, spillreg2)
144 | (true, true) => unspill (op1, spillreg1) @ unspill (op2, spillreg2)
145
146 fun respill_ops (op1, op2) =
147 case (isspilled op1, isspilled op2) (* no instruction writes back to op2 *)
148 of (false, _) => []
149 | (true, _) => spill (op1, spillreg1)
150
151 fun real_op1 op1 =
152 case op1
153 of (X.TEMP temp) => if isspilled op1
154 then (X.REG spillreg1)
155 else X.REG (temptoreg temp)
156 | (X.STACKARG arg) => X.REG spillreg1
157 | r => r
158
159 fun real_ops (op1, op2) =
160 (case op1
161 of (X.TEMP temp) => if isspilled op1
162 then (X.REG spillreg1)
163 else X.REG (temptoreg temp)
164 | (X.STACKARG arg) => X.REG spillreg1
165 | r => r,
166 case op2
167 of (X.TEMP temp) => if isspilled op2
168 then (X.REG spillreg2)
169 else X.REG (temptoreg temp)
170 | (X.STACKARG arg) => X.REG spillreg2
171 | r => r)
172
173 fun whack_insn (pred, insn, op1, op2) =
174 (map (fn i => X.INSN (pred, i)) (unspill_ops (op1, op2))) @
175 [ X.INSN (pred, insn (real_ops (op1, op2))) ] @
176 (map (fn i => X.INSN (pred, i)) (respill_ops (op1, op2)))
177
178 fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
179 | transform (X.COMMENT s) = [X.COMMENT s]
180 | transform (X.LABEL l) = [X.LABEL l]
181 | transform (X.LIVEIGN a) = transform a
182
183 (* god the special cases are going to suck *)
184 | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
185 [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
186 (if isspilled op1
187 then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
188 else [])
189 | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
190 [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
191 (if isspilled op1
192 then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
193 else [])
194 | transform (X.INSN (pred, X.MOVSTR (op1, w))) =
195 [ X.INSN (pred, X.MOVSTR (real_op1 op1, w)) ] @
196 (if isspilled op1
197 then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
198 else [])
199 | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
200 [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
201 (if isspilled op1
202 then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
203 else [])
204
205 (* and here comes the boilerplate *)
206 | transform (X.INSN (pred, X.LDR (op1, op2))) = whack_insn (pred, X.LDR, op1, op2)
207 | transform (X.INSN (pred, X.STO (op1, op2))) = whack_insn (pred, X.STO, op1, op2)
208 | transform (X.INSN (pred, X.MOV (op1, op2))) = whack_insn (pred, X.MOV, op1, op2)
209 | transform (X.INSN (pred, X.MOVS (op1, op2))) = whack_insn (pred, X.MOVS, op1, op2)
210 | transform (X.INSN (pred, X.ADD (op1, op2))) = whack_insn (pred, X.ADD, op1, op2)
211 | transform (X.INSN (pred, X.ADDS (op1, op2))) = whack_insn (pred, X.ADDS, op1, op2)
212 | transform (X.INSN (pred, X.SUB (op1, op2))) = whack_insn (pred, X.SUB, op1, op2)
213 | transform (X.INSN (pred, X.SUBS (op1, op2))) = whack_insn (pred, X.SUBS, op1, op2)
214 | transform (X.INSN (pred, X.AND (op1, op2))) = whack_insn (pred, X.AND, op1, op2)
215 | transform (X.INSN (pred, X.ANDS (op1, op2))) = whack_insn (pred, X.ANDS, op1, op2)
216 | transform (X.INSN (pred, X.NOT (op1, op2))) = whack_insn (pred, X.NOT, op1, op2)
217 | transform (X.INSN (pred, X.NOTS (op1, op2))) = whack_insn (pred, X.NOTS, op1, op2)
218 | transform (X.INSN (pred, X.PUSH (op1, op2))) = if isspilled op2
219 then raise ErrorMsg.InternalError "PUSH on spilled op2 is not possible"
220 else [ X.INSN (pred, X.PUSH (real_ops (op1, op2))) ]
221 | transform (X.INSN (pred, X.POP (X.REG X.SP, X.REG X.PC))) = [ X.INSN (pred, X.MOVLBL (X.REG X.PC, endlbl)) ] (* optimize epilogue? *)
222 | transform (X.INSN (pred, X.POP (op1, op2))) = if isspilled op2
223 then raise ErrorMsg.InternalError "POP on spilled op2 is not possible"
224 else [ X.INSN (pred, X.POP (real_ops (op1, op2))) ]
225 | transform (X.INSN (pred, X.CALL (op1, op2, i))) = if isspilled op2
226 then raise ErrorMsg.InternalError "CALL on spilled op2 is not possible"
227 else [ X.INSN (pred, X.CALL ((fn (x, y) => (x, y, i)) (real_ops (op1, op2)))) ]
228 | transform (X.INSN (pred, X.SHR (op1, op2))) = whack_insn (pred, X.SHR, op1, op2)
229 | transform (X.INSN (pred, X.SHL (op1, op2))) = whack_insn (pred, X.SHL, op1, op2)
230 (*| transform _ = raise ErrorMsg.InternalError "unimplemented"*)
231 in
232 (*if (nsave < 2) then
233 List.concat (prologue :: (map transform instrs))
234 else
235 *)
236 List.concat (prologue ::
237 ((map transform instrs) @
238 [[X.LABEL endlbl],
239 epilogue,
240 [X.INSN (X.AL, X.POP (X.REG X.SP, X.REG X.PC))]
241 ]
242 )
243 )
244 end
245end
Compiler for a C-like language written in SML
This page took 0.023652 seconds and 4 git commands to generate.