codegen/solidify.sml

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