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 = 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
  25
  26   fun solidify (regmap : colorings) (instrs : asm) : asm =
  27     let
  28       (* r14d and r15d is reserved for spilling *)
  29       val maxreg = X.regtonum X.R13D
  30       fun numtoreg n =
  31           if (n > maxreg)
  32           then raise Spilled
  33           else X.numtoreg n
  34
  35       fun temptonum (t: T.temp) : int =
  36         (List.hd
  37           (List.map (fn (_, n) => n)
  38             (List.filter (fn (a, _) => (Temp.eq (a, t))) regmap)))
  39
  40       fun temptoreg (t: T.temp) : x86.reg =
  41         numtoreg (temptonum t)
  42         handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
  43
  44       val spillreg1 = X.R15D
  45       val spillreg2 = X.R14D
  46
  47       (* Determine which need to be saved. *)
  48       val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
  49       val saveregs = X.OperSet.intersection (
  50         X.OperSet.addList (X.OperSet.empty, opsused),
  51         X.OperSet.addList (
  52           X.OperSet.empty,
  53           [X.REG X.EBX,
  54            X.REG X.EBP,
  55            X.REG X.R12D,
  56            X.REG X.R13D,
  57            X.REG X.R14D,
  58            X.REG X.R15D]))
  59       val savelist = X.OperSet.listItems saveregs
  60       val nsave = length savelist
  61
  62       val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)    (* Number of registers used. *)
  63       val nspilled = Int.max (numreg - maxreg, 0)    (* Number of spilled registers. *)
  64       fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
  65         | isspilled (X.STACKARG _) = true
  66         | isspilled (X.REL _) = true
  67         | isspilled (X.OSIZE (_, oo)) = isspilled oo
  68         | isspilled _ = false
  69       val stacksz = (nspilled + nsave) * 8
  70       fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
  71
  72       val prologue =
  73         (X.SUB (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))) ::
  74         (ListPair.map
  75           (fn (num, reg) =>
  76             X.MOV (X.OSIZE (X.Qword, X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))), X.OSIZE (X.Qword, reg)))
  77           (List.tabulate (nsave, fn x => x), savelist))
  78       val epilogue =
  79         (ListPair.map
  80           (fn (num, reg) =>
  81             X.MOV (X.OSIZE (X.Qword, reg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))))
  82           (List.tabulate (nsave, fn x => x), savelist)) @
  83         [X.ADD (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))]
  84       val endlbl = Label.new()
  85
  86       fun spill s (X.TEMP temp, xreg: x86.reg) =    (* Spill a register if need be. *)
  87         if (isspilled (X.TEMP temp))
  88           then [X.MOV (X.OSIZE(s, X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp)), X.REG xreg)]
  89           else nil
  90         | spill s (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
  91         | spill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s,a), X.REG xreg)]
  92         | spill s (X.OSIZE (s', oo), xreg) = spill s' (X.stripsize oo, xreg)
  93         | spill _ _ = nil        (* Nothing else can be spilled. *)
  94       fun unspill s (X.TEMP temp, xreg: x86.reg) =    (* Unspill a register if need be. *)
  95         if (isspilled (X.TEMP temp))
  96           then [X.MOV (X.OSIZE(s, X.REG xreg), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))]
  97           else nil
  98         | unspill s (X.STACKARG arg, xreg) = [X.MOV (X.OSIZE(s, X.REG xreg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8)))))]
  99         | unspill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s, X.REG xreg), a)]
 100         | unspill s (X.OSIZE (s', oo), xreg) = unspill s' (X.stripsize oo, xreg)
 101         | unspill _ _ = nil
 102
 103       fun realoper (X.TEMP temp) = X.OSIZE (X.sts (Temp.size temp), X.REG (temptoreg temp))  (* Makes a operand 'real'. *)
 104         | realoper (X.STACKARG arg) = raise Spilled
 105         | realoper (X.REL _) = raise Spilled
 106         | realoper (X.OSIZE (s, oo)) = X.OSIZE (s, realoper (X.stripsize oo))
 107         | realoper r = r
 108
 109       fun stackoper (X.TEMP temp) =
 110             if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
 111             else X.OSIZE (X.sts (Temp.size temp), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))
 112         | stackoper (X.STACKARG arg) = X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt) (stacksz + 8 + (arg * 8)))
 113         | stackoper (a as X.REL _) = a
 114         | stackoper (X.OSIZE (s, oo)) = X.OSIZE (s, stackoper (X.stripsize oo))
 115         | stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
 116
 117       fun ophit (X.OSIZE (s, oo)) = let val (insns, p) = ophit (X.stripsize oo) in (insns, X.OSIZE (s, p)) end
 118         | ophit (X.REL(op1, op2)) =
 119           let
 120             val t1 = X.stripsize op1
 121             val (s, t2) = X.sizeoper op2
 122           in
 123             if (isspilled t1 andalso isspilled t2) then
 124               ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2),
 125                 X.ADD (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
 126                 X.REL (X.REG spillreg1, X.CONST 0w0))
 127             else if(isspilled t1) then
 128               ([X.MOV (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
 129                 X.REL (X.REG spillreg1, realoper t2))
 130             else if(isspilled t2) then
 131               ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2)],
 132                 X.REL (realoper t1, X.REG spillreg1))
 133             else
 134               ([],
 135                 X.REL (realoper t1, realoper t2))
 136           end
 137         | ophit a = (nil, realoper a handle Spilled => stackoper a)
 138
 139       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
 140         | transform (X.COMMENT s) = [X.COMMENT s]
 141         | transform (X.LIVEIGN a) = transform a
 142         | transform (X.MOV (dest, src)) =
 143             let
 144               val (insns1, realop1) = ophit dest
 145               val (insns2, realop2) = ophit src
 146             in
 147               if(isspilled dest andalso isspilled src) then
 148                 insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.MOV (realop1, X.REG spillreg2)]
 149               else
 150                 insns1 @ insns2 @ [X.MOV (realop1, realop2)]
 151             end
 152         | transform (X.LEA (dest, src)) =
 153             let
 154               val (insns1, realop1) = ophit dest
 155               val (insns2, realop2) = ophit src
 156             in
 157               if(isspilled dest andalso isspilled src) then
 158                 insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.LEA (realop1, X.REG spillreg2)]
 159               else
 160                 insns1 @ insns2 @ [X.LEA (realop1, realop2)]
 161             end
 162         | transform (X.SUB (dest, src)) =
 163             let
 164               val (insns, realop) = ophit dest
 165             in
 166               unspill X.Long (src, spillreg2) @ insns @
 167               [ X.SUB(realop,
 168                   realoper src handle Spilled => X.REG spillreg2)]
 169             end
 170         | transform (X.IMUL (dest, src)) =
 171             unspill X.Long (dest, spillreg1) @
 172             [ X.IMUL(
 173                 realoper dest handle Spilled => X.REG spillreg1,
 174                 realoper src handle Spilled => stackoper src)] @
 175             spill X.Long (dest, spillreg1)
 176         | transform (X.IMUL3 (dest, src, const)) =
 177             unspill X.Long ((X.stripsize src), spillreg2) @
 178             [ X.IMUL3(
 179                 realoper dest handle Spilled => X.REG spillreg1,
 180                 realoper src handle Spilled => X.REG spillreg2,
 181                 const)] @
 182             spill X.Long (dest, spillreg1)
 183         | transform (X.ADD (dest, src)) =
 184             let
 185               val (insns, realop) = ophit dest
 186             in
 187               unspill X.Long (src, spillreg2) @ insns @
 188               [ X.ADD(realop,
 189                   realoper src handle Spilled => X.REG spillreg2)]
 190             end
 191         | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
 192         | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
 193         | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
 194         | transform (X.SAL (dest, shft)) =
 195             [ X.SAL (
 196                 realoper dest handle Spilled => stackoper dest,
 197                 shft)]
 198         | transform (X.SAR (dest, shft)) =
 199             [ X.SAR (
 200                 realoper dest handle Spilled => stackoper dest,
 201                 shft)]
 202         | transform (X.CLTD) = [ X.CLTD ]
 203         | transform (X.AND (dest, src)) =
 204             unspill X.Long (src, spillreg1) @
 205             [ X.AND(
 206                 realoper dest handle Spilled => stackoper dest,
 207                 realoper src handle Spilled => X.REG spillreg1)]
 208         | transform (X.OR (dest, src)) =
 209             unspill X.Long (src, spillreg1) @
 210             [ X.OR(
 211                 realoper dest handle Spilled => stackoper dest,
 212                 realoper src handle Spilled => X.REG spillreg1)]
 213         | transform (X.XOR (dest, src)) =
 214             unspill X.Long (src, spillreg1) @
 215             [ X.XOR(
 216                 realoper dest handle Spilled => stackoper dest,
 217                 realoper src handle Spilled => X.REG spillreg1)]
 218         | transform (X.CMP (op1, op2)) =
 219             unspill X.Long (op2, spillreg1) @
 220             [ X.CMP(
 221                 realoper op1 handle Spilled => stackoper op1,
 222                 realoper op2 handle Spilled => X.REG spillreg1)]
 223         | transform (X.TEST (op1, op2)) =
 224             unspill X.Long (op2, spillreg1) @
 225             [ X.TEST(
 226                 realoper op1 handle Spilled => stackoper op1,
 227                 realoper op2 handle Spilled => X.REG spillreg1)]
 228         | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
 229         | transform (X.CALL l) = [ X.CALL l ]
 230         | transform (X.MOVZB (dest, src)) =
 231             [ X.MOVZB(
 232                 realoper dest handle Spilled => X.REG spillreg1,
 233                 realoper src handle Spilled => stackoper src)]
 234             @ spill X.Long (dest, spillreg1)
 235         | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
 236         | transform (X.LABEL l) = [ X.LABEL l ]
 237         | transform (X.JMP l) = [ X.JMP l ]
 238         | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
 239     in
 240       if (nsave < 2) then
 241         List.concat (prologue :: (map transform instrs))
 242       else
 243         List.concat (prologue :: ((map transform instrs) @ [[X.LABEL endlbl], epilogue, [X.RET]]))
 244     end
 245 end