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   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       (* r14d and r15d is reserved for spilling *)
  35       val maxreg = X.regtonum X.R13D
  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) : x86.reg =
  45         numtoreg (temptonum t)
  46         handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
  47
  48       val spillreg1 = X.R15D
  49       val spillreg2 = X.R14D
  50
  51       (* Determine which need to be saved. *)
  52       val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
  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
  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. *)
  68       fun isspilled (X.TEMP temp, _) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
  69         | isspilled (X.STACKARG _, _) = true
  70         | isspilled (X.REL _, _) = true
  71         | isspilled _ = false
  72
  73       val stacksz = (nspilled + nsave) * 8
  74       fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
  75
  76       val prologue =
  77         (X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))) ::
  78         (ListPair.map
  79           (fn (num, reg) =>
  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)))
  81           (List.tabulate (nsave, fn x => x), savelist))
  82       val epilogue =
  83         (ListPair.map
  84           (fn (num, reg) =>
  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)))
  86           (List.tabulate (nsave, fn x => x), savelist)) @
  87         [X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))]
  88       val endlbl = Label.new()
  89
  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
 124         | realoper r = r
 125
 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))
 158             else
 159               ([],
 160                 (X.REL (realoper op1, realoper op2, m), s))
 161         | ophit a = (nil, realoper a handle Spilled => stackoper a)
 162
 163       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
 164         | transform (X.COMMENT s) = [X.COMMENT s]
 165         | transform (X.LIVEIGN a) = transform a
 166         | transform (X.MOV (dest, src)) =
 167             let
 168               val (insns1, realop1 as (_,s1)) = ophit dest
 169               val (insns2, realop2 as (_,s2)) = ophit src
 170             in
 171               if(isspilled dest andalso isspilled src) then
 172                 insns2 @ [X.MOV ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
 173               else
 174                 insns1 @ insns2 @ [X.MOV (realop1, realop2)]
 175             end
 176         | transform (X.LEA (dest, src)) =
 177             let
 178               val (insns1, realop1 as (_,s1)) = ophit dest
 179               val (insns2, realop2 as (_,s2)) = ophit src
 180             in
 181               if(isspilled dest andalso isspilled src) then
 182                 insns2 @ [X.LEA ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
 183               else
 184                 insns1 @ insns2 @ [X.LEA (realop1, realop2)]
 185             end
 186         | transform (X.SUB (dest, src)) =
 187             let
 188               val (insns, realop) = ophit dest
 189             in
 190               unspill (src, spillreg2) @ insns @
 191               [ X.SUB(realop,
 192                   realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
 193             end
 194         | transform (X.IMUL (dest, src)) =
 195             unspill (dest, spillreg1) @
 196             [ X.IMUL(
 197                 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
 198                 realoper src handle Spilled => stackoper src)] @
 199             spill (dest, spillreg1)
 200         | transform (X.IMUL3 (dest, src, const)) =
 201             unspill (src, spillreg2) @
 202             [ X.IMUL3(
 203                 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
 204                 realoper src handle Spilled => (X.REG spillreg2, X.osize src),
 205                 const)] @
 206             spill (dest, spillreg1)
 207         | transform (X.ADD (dest, src)) =
 208             let
 209               val (insns, realop) = ophit dest
 210             in
 211               unspill (src, spillreg2) @ insns @
 212               [ X.ADD(realop,
 213                   realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
 214             end
 215         | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
 216         | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
 217         | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
 218         | transform (X.SAL (dest, shft)) =
 219             [ X.SAL (
 220                 realoper dest handle Spilled => stackoper dest,
 221                 shft)]
 222         | transform (X.SAR (dest, shft)) =
 223             [ X.SAR (
 224                 realoper dest handle Spilled => stackoper dest,
 225                 shft)]
 226         | transform (X.CLTD) = [ X.CLTD ]
 227         | transform (X.AND (dest, src)) =
 228             unspill (src, spillreg1) @
 229             [ X.AND(
 230                 realoper dest handle Spilled => stackoper dest,
 231                 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
 232         | transform (X.OR (dest, src)) =
 233             unspill (src, spillreg1) @
 234             [ X.OR(
 235                 realoper dest handle Spilled => stackoper dest,
 236                 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
 237         | transform (X.XOR (dest, src)) =
 238             unspill (src, spillreg1) @
 239             [ X.XOR(
 240                 realoper dest handle Spilled => stackoper dest,
 241                 realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
 242         | transform (X.CMP (op1, op2)) =
 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
 251         | transform (X.TEST (op1, op2)) =
 252             unspill (op2, spillreg1) @
 253             [ X.TEST(
 254                 realoper op1 handle Spilled => stackoper op1,
 255                 realoper op2 handle Spilled => (X.REG spillreg1, X.osize op2))]
 256         | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
 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
 267         | transform (X.CALL l) = [ X.CALL l ]
 268         | transform (X.MOVZB (dest, src)) =
 269             [ X.MOVZB(
 270                 realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
 271                 realoper src handle Spilled => stackoper src)]
 272             @ spill (dest, spillreg1)
 273         | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
 274         | transform (X.LABEL l) = [ X.LABEL l ]
 275         | transform (X.JMP l) = [ X.JMP l ]
 276         | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
 277         | transform _ = raise ErrorMsg.InternalError "probably movsc: unimplemented"
 278     in
 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]]))
 283     end
 284 end