]> Joshua Wise's Git repositories - snipe.git/blame - codegen/solidify.sml
Propagate strings through the blarg backend.
[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
c2b45b36 11 type asm = Blarg.insn list
12aa4087
JW
12
13 val solidify : colorings -> asm -> asm
14end
15
16structure Solidify :> SOLIDIFY =
17struct
c2b45b36 18 structure X = Blarg
12aa4087
JW
19 structure T = Temp
20
21 type colorings = (Temp.temp * int) list
c2b45b36 22 type asm = Blarg.insn list
12aa4087
JW
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
c2b45b36
JW
34 (* r11 and r12 is reserved for spilling *)
35 val maxreg = X.regtonum X.R10
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
c2b45b36 44 fun temptoreg (t: T.temp) : Blarg.reg =
12aa4087 45 numtoreg (temptonum t)
c2b45b36 46 handle Option => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
6ade8b0a 47
c2b45b36
JW
48 val spillreg1 = X.R12
49 val spillreg2 = X.R11
6ade8b0a
JW
50
51 (* Determine which need to be saved. *)
c2b45b36 52 val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R12)) regmap) @ [X.REG X.R11]
6ade8b0a
JW
53 val saveregs = X.OperSet.intersection (
54 X.OperSet.addList (X.OperSet.empty, opsused),
55 X.OperSet.addList (
56 X.OperSet.empty,
c2b45b36
JW
57 [X.REG X.R7,
58 X.REG X.R8,
59 X.REG X.R9,
60 X.REG X.R10,
61 X.REG X.R11,
62 X.REG X.R12]))
6ade8b0a
JW
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. *)
c2b45b36
JW
68 fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg (* Whether a register is spilled *)
69 | isspilled (X.STACKARG _) = true
12aa4087 70 | isspilled _ = false
5c79bb68 71
c2b45b36
JW
72 val stacksz = (nspilled + nsave) * 1
73 fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 1 (* Stack position of some register number *)
6ade8b0a
JW
74
75 val prologue =
c2b45b36
JW
76 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
77 X.INSN (X.AL, X.SUB (X.REG X.SP, X.REG X.R4))] @
78 (List.concat
79 (ListPair.map
80 (fn (num, reg) =>
81 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
82 X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
83 X.INSN (X.AL, X.STO (X.REG X.R4, reg))])
84 (List.tabulate (nsave, fn x => x), savelist)
85 )
86 )
6ade8b0a 87 val epilogue =
c2b45b36
JW
88 (List.concat
89 (ListPair.map
90 (fn (num, reg) =>
91 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
92 X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
93 X.INSN (X.AL, X.LDR (reg, X.REG X.R4))])
94 (List.tabulate (nsave, fn x => x), savelist)
95 )
96 ) @
97 [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
98 X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
6ade8b0a
JW
99 val endlbl = Label.new()
100
c2b45b36 101 fun spill (X.TEMP temp, xreg: Blarg.reg) = (* Spill a register if need be. *)
5c79bb68 102 let
c2b45b36
JW
103 val base = X.REG X.SP
104 val offs = Word.fromInt (stackpos (temptonum temp))
5c79bb68 105 in
c2b45b36
JW
106 if (isspilled (X.TEMP temp))
107 then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]*)
5c79bb68
JW
108 else nil
109 end
c2b45b36 110 | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
5c79bb68 111 | spill _ = nil (* Nothing else can be spilled. *)
c2b45b36 112 fun unspill (X.TEMP temp, xreg: Blarg.reg) = (* Unspill a register if need be. *)
5c79bb68 113 let
c2b45b36
JW
114 val base = X.REG X.SP
115 val offs = Word.fromInt (stackpos (temptonum temp))
5c79bb68 116 in
c2b45b36
JW
117 if (isspilled (X.TEMP temp))
118 then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]*)
5c79bb68
JW
119 else nil
120 end
c2b45b36 121 | unspill (X.STACKARG arg, xreg) =
5c79bb68 122 let
c2b45b36
JW
123 val base = X.REG X.SP
124 val offs = Word.fromInt (stacksz + 8 + (arg * 8))
5c79bb68 125 in
c2b45b36
JW
126 (*[X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]*)
127 raise ErrorMsg.InternalError "unspill from stack not supported"
5c79bb68 128 end
5c79bb68
JW
129 | unspill _ = nil
130
c2b45b36
JW
131 fun unspill_ops (op1, op2) =
132 case (isspilled op1, isspilled op2)
133 of (false, false) => []
134 | (true, false) => unspill (op1, spillreg1)
135 | (false, true) => unspill (op2, spillreg2)
136 | (true, true) => unspill (op1, spillreg1) @ unspill (op2, spillreg2)
137
138 fun respill_ops (op1, op2) =
139 case (isspilled op1, isspilled op2) (* no instruction writes back to op2 *)
140 of (false, _) => []
141 | (true, _) => spill (op1, spillreg1)
142
143 fun real_op1 op1 =
144 case op1
145 of (X.TEMP temp) => if isspilled op1
146 then (X.REG spillreg1)
147 else X.REG (temptoreg temp)
148 | (X.STACKARG arg) => X.REG spillreg1
149 | r => r
150
151 fun real_ops (op1, op2) =
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 case op2
159 of (X.TEMP temp) => if isspilled op2
160 then (X.REG spillreg2)
161 else X.REG (temptoreg temp)
162 | (X.STACKARG arg) => X.REG spillreg2
163 | r => r)
164
165 fun whack_insn (pred, insn, op1, op2) =
166 (map (fn i => X.INSN (pred, i)) (unspill_ops (op1, op2))) @
167 [ X.INSN (pred, insn (real_ops (op1, op2))) ] @
168 (map (fn i => X.INSN (pred, i)) (respill_ops (op1, op2)))
1144856b 169
12aa4087
JW
170 fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
171 | transform (X.COMMENT s) = [X.COMMENT s]
c2b45b36 172 | transform (X.LABEL l) = [X.LABEL l]
6ade8b0a 173 | transform (X.LIVEIGN a) = transform a
c2b45b36
JW
174
175 (* god the special cases are going to suck *)
176 | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
177 [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
178 (if isspilled op1
179 then spill (op1, spillreg1)
180 else [])
181 | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
182 [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
183 (if isspilled op1
184 then spill (op1, spillreg1)
185 else [])
5c90fbb8
JW
186 | transform (X.INSN (pred, X.MOVSTR (op1, w))) =
187 [ X.INSN (pred, X.MOVSTR (real_op1 op1, w)) ] @
188 (if isspilled op1
189 then spill (op1, spillreg1)
190 else [])
c2b45b36
JW
191 | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
192 [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
193 (if isspilled op1
194 then spill (op1, spillreg1)
195 else [])
196
197 (* and here comes the boilerplate *)
198 | transform (X.INSN (pred, X.LDR (op1, op2))) = whack_insn (pred, X.LDR, op1, op2)
199 | transform (X.INSN (pred, X.STO (op1, op2))) = whack_insn (pred, X.STO, op1, op2)
200 | transform (X.INSN (pred, X.MOV (op1, op2))) = whack_insn (pred, X.MOV, op1, op2)
201 | transform (X.INSN (pred, X.MOVS (op1, op2))) = whack_insn (pred, X.MOVS, op1, op2)
202 | transform (X.INSN (pred, X.ADD (op1, op2))) = whack_insn (pred, X.ADD, op1, op2)
203 | transform (X.INSN (pred, X.ADDS (op1, op2))) = whack_insn (pred, X.ADDS, op1, op2)
204 | transform (X.INSN (pred, X.SUB (op1, op2))) = whack_insn (pred, X.SUB, op1, op2)
205 | transform (X.INSN (pred, X.SUBS (op1, op2))) = whack_insn (pred, X.SUBS, op1, op2)
206 | transform (X.INSN (pred, X.AND (op1, op2))) = whack_insn (pred, X.AND, op1, op2)
207 | transform (X.INSN (pred, X.ANDS (op1, op2))) = whack_insn (pred, X.ANDS, op1, op2)
208 | transform (X.INSN (pred, X.NOT (op1, op2))) = whack_insn (pred, X.NOT, op1, op2)
209 | transform (X.INSN (pred, X.NOTS (op1, op2))) = whack_insn (pred, X.NOTS, op1, op2)
210 | transform (X.INSN (pred, X.PUSH (op1, op2))) = if isspilled op2
211 then raise ErrorMsg.InternalError "PUSH on spilled op2 is not possible"
212 else [ X.INSN (pred, X.PUSH (real_ops (op1, op2))) ]
213 | 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? *)
214 | transform (X.INSN (pred, X.POP (op1, op2))) = if isspilled op2
215 then raise ErrorMsg.InternalError "POP on spilled op2 is not possible"
216 else [ X.INSN (pred, X.POP (real_ops (op1, op2))) ]
217 | transform (X.INSN (pred, X.CALL (op1, op2, i))) = if isspilled op2
218 then raise ErrorMsg.InternalError "CALL on spilled op2 is not possible"
219 else [ X.INSN (pred, X.CALL ((fn (x, y) => (x, y, i)) (real_ops (op1, op2)))) ]
220 | transform (X.INSN (pred, X.SHR (op1, op2))) = whack_insn (pred, X.SHR, op1, op2)
221 | transform (X.INSN (pred, X.SHL (op1, op2))) = whack_insn (pred, X.SHL, op1, op2)
222 (*| transform _ = raise ErrorMsg.InternalError "unimplemented"*)
12aa4087 223 in
c2b45b36 224 (*if (nsave < 2) then
6ade8b0a
JW
225 List.concat (prologue :: (map transform instrs))
226 else
c2b45b36
JW
227 *)
228 List.concat (prologue ::
229 ((map transform instrs) @
230 [[X.LABEL endlbl],
231 epilogue,
232 [X.INSN (X.AL, X.POP (X.REG X.SP, X.REG X.PC))]
233 ]
234 )
235 )
12aa4087
JW
236 end
237end
This page took 0.094009 seconds and 4 git commands to generate.