fun solidify (regmap : colorings) (instrs : asm) : asm =
let
(* r14d and r15d is reserved for spilling *)
- val maxreg = X.regtonum X.R14D
+ val maxreg = X.regtonum X.R13D
fun numtoreg n =
if (n > maxreg)
then raise Spilled
else X.numtoreg n
-
+
fun temptonum (t: T.temp) : int =
(List.hd
(List.map (fn (_, n) => n)
handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
val spillreg1 = X.R15D
+ val spillreg2 = X.R14D
(* Determine which need to be saved. *)
- val opsused = map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap
+ val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
val saveregs = X.OperSet.intersection (
X.OperSet.addList (X.OperSet.empty, opsused),
X.OperSet.addList (
val savelist = X.OperSet.listItems saveregs
val nsave = length savelist
- val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap) (* Number of registers used. *)
- val nspilled = Int.max (numreg - maxreg, 0) (* Number of spilled registers. *)
- fun isspilled (X.TEMP temp) = (((temptonum temp) > maxreg) handle Empty => false) (* Whether a register is spilled *)
+ val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap) (* Number of registers used. *)
+ val nspilled = Int.max (numreg - maxreg, 0) (* Number of spilled registers. *)
+ fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg (* Whether a register is spilled *)
| isspilled (X.STACKARG _) = true
| isspilled (X.REL _) = true
+ | isspilled (X.OSIZE (_, oo)) = isspilled oo
| isspilled _ = false
val stacksz = (nspilled + nsave) * 8
- fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8 (* Stack position of some register number *)
+ fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8 (* Stack position of some register number *)
val prologue =
- (X.SIZE (X.Qword, X.SUB (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))) ::
+ (X.SUB (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))) ::
(ListPair.map
(fn (num, reg) =>
- X.SIZE (X.Qword, X.MOV (X.REL (X.RSP, stacksz - 8*(num+1)), reg)))
+ 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)))
(List.tabulate (nsave, fn x => x), savelist))
val epilogue =
(ListPair.map
(fn (num, reg) =>
- X.SIZE (X.Qword, X.MOV (reg, X.REL (X.RSP, stacksz - 8*(num+1)))))
+ X.MOV (X.OSIZE (X.Qword, reg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))))
(List.tabulate (nsave, fn x => x), savelist)) @
- [X.SIZE (X.Qword, X.ADD (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))]
+ [X.ADD (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))]
val endlbl = Label.new()
- fun spill (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *)
+ fun spill s (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *)
if (isspilled (X.TEMP temp))
- then [X.MOV (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)]
+ 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)]
else nil
- | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
- | spill (a as X.REL _, xreg) = [X.MOV (a, X.REG xreg)]
- | spill _ = nil (* Nothing else can be spilled. *)
- fun unspill (X.TEMP temp, xreg: x86.reg) = (* Unspill a register if need be. *)
+ | spill s (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
+ | spill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s,a), X.REG xreg)]
+ | spill s (X.OSIZE (s', oo), xreg) = spill s' (X.stripsize oo, xreg)
+ | spill _ _ = nil (* Nothing else can be spilled. *)
+ fun unspill s (X.TEMP temp, xreg: x86.reg) = (* Unspill a register if need be. *)
if (isspilled (X.TEMP temp))
- then [X.MOV (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))]
+ 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))]
else nil
- | unspill (X.STACKARG arg, xreg) = [X.MOV (X.REG xreg, X.REL (X.RSP, stacksz + 8 + (arg * 8)))]
- | unspill (a as X.REL _, xreg) = [X.MOV (X.REG xreg, a)]
- | unspill _ = nil
+ | 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)))))]
+ | unspill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s, X.REG xreg), a)]
+ | unspill s (X.OSIZE (s', oo), xreg) = unspill s' (X.stripsize oo, xreg)
+ | unspill _ _ = nil
- fun realoper (X.TEMP temp) = X.REG (temptoreg temp) (* Makes a operand 'real'. *)
+ fun realoper (X.TEMP temp) = X.OSIZE (X.sts (Temp.size temp), X.REG (temptoreg temp)) (* Makes a operand 'real'. *)
| realoper (X.STACKARG arg) = raise Spilled
| realoper (X.REL _) = raise Spilled
+ | realoper (X.OSIZE (s, oo)) = X.OSIZE (s, realoper (X.stripsize oo))
| realoper r = r
fun stackoper (X.TEMP temp) =
if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
- else X.REL (X.RSP, stackpos (temptonum temp))
- | stackoper (X.STACKARG arg) = X.REL (X.RSP, stacksz + 8 + (arg * 8))
+ else X.OSIZE (X.sts (Temp.size temp), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))
+ | stackoper (X.STACKARG arg) = X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt) (stacksz + 8 + (arg * 8)))
| stackoper (a as X.REL _) = a
+ | stackoper (X.OSIZE (s, oo)) = X.OSIZE (s, stackoper (X.stripsize oo))
| stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
-
+
+ fun ophit (X.OSIZE (s, oo)) = let val (insns, p) = ophit (X.stripsize oo) in (insns, X.OSIZE (s, p)) end
+ | ophit (X.REL(op1, op2)) =
+ let
+ val t1 = X.stripsize op1
+ val (s, t2) = X.sizeoper op2
+ in
+ if (isspilled t1 andalso isspilled t2) then
+ ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2),
+ X.ADD (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
+ X.REL (X.REG spillreg1, X.CONST 0w0))
+ else if(isspilled t1) then
+ ([X.MOV (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
+ X.REL (X.REG spillreg1, realoper t2))
+ else if(isspilled t2) then
+ ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2)],
+ X.REL (realoper t1, X.REG spillreg1))
+ else
+ ([],
+ X.REL (realoper t1, realoper t2))
+ end
+ | ophit a = (nil, realoper a handle Spilled => stackoper a)
+
fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
| transform (X.COMMENT s) = [X.COMMENT s]
| transform (X.LIVEIGN a) = transform a
- | transform (X.SIZE (s, i)) = map (fn i' => (X.SIZE (s, i'))) (transform i)
| transform (X.MOV (dest, src)) =
- if (isspilled dest)
- then
- unspill (src, spillreg1) @
- [X.MOV(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => X.REG spillreg1)]
- else
- [X.MOV(
- realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
- realoper src handle Spilled => stackoper src)]
+ let
+ val (insns1, realop1) = ophit dest
+ val (insns2, realop2) = ophit src
+ in
+ if(isspilled dest andalso isspilled src) then
+ insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.MOV (realop1, X.REG spillreg2)]
+ else
+ insns1 @ insns2 @ [X.MOV (realop1, realop2)]
+ end
+ | transform (X.LEA (dest, src)) =
+ let
+ val (insns1, realop1) = ophit dest
+ val (insns2, realop2) = ophit src
+ in
+ if(isspilled dest andalso isspilled src) then
+ insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.LEA (realop1, X.REG spillreg2)]
+ else
+ insns1 @ insns2 @ [X.LEA (realop1, realop2)]
+ end
| transform (X.SUB (dest, src)) =
- unspill (src, spillreg1) @
- [ X.SUB(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => X.REG spillreg1)]
+ let
+ val (insns, realop) = ophit dest
+ in
+ unspill X.Long (src, spillreg2) @ insns @
+ [ X.SUB(realop,
+ realoper src handle Spilled => X.REG spillreg2)]
+ end
| transform (X.IMUL (dest, src)) =
- unspill (dest, spillreg1) @
+ unspill X.Long (dest, spillreg1) @
[ X.IMUL(
realoper dest handle Spilled => X.REG spillreg1,
realoper src handle Spilled => stackoper src)] @
- spill (dest, spillreg1)
+ spill X.Long (dest, spillreg1)
| transform (X.IMUL3 (dest, src, const)) =
+ unspill X.Long ((X.stripsize src), spillreg2) @
[ X.IMUL3(
realoper dest handle Spilled => X.REG spillreg1,
- realoper src handle Spilled => stackoper src,
+ realoper src handle Spilled => X.REG spillreg2,
const)] @
- spill (dest, spillreg1)
- | transform (X.ADD (dest, src)) = (* You can have either operand spilled, but not both. Pick one. *)
- if (isspilled dest)
- then
- unspill (src, spillreg1) @
- [ X.ADD(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => X.REG spillreg1)]
- else
- [ X.ADD(
- realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
- realoper src handle Spilled => stackoper src)]
+ spill X.Long (dest, spillreg1)
+ | transform (X.ADD (dest, src)) =
+ let
+ val (insns, realop) = ophit dest
+ in
+ unspill X.Long (src, spillreg2) @ insns @
+ [ X.ADD(realop,
+ realoper src handle Spilled => X.REG spillreg2)]
+ end
| transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
| transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
| transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
shft)]
| transform (X.CLTD) = [ X.CLTD ]
| transform (X.AND (dest, src)) =
- unspill (src, spillreg1) @
+ unspill X.Long (src, spillreg1) @
[ X.AND(
realoper dest handle Spilled => stackoper dest,
realoper src handle Spilled => X.REG spillreg1)]
| transform (X.OR (dest, src)) =
- unspill (src, spillreg1) @
+ unspill X.Long (src, spillreg1) @
[ X.OR(
realoper dest handle Spilled => stackoper dest,
realoper src handle Spilled => X.REG spillreg1)]
| transform (X.XOR (dest, src)) =
- unspill (src, spillreg1) @
+ unspill X.Long (src, spillreg1) @
[ X.XOR(
realoper dest handle Spilled => stackoper dest,
realoper src handle Spilled => X.REG spillreg1)]
| transform (X.CMP (op1, op2)) =
- unspill (op2, spillreg1) @
+ unspill X.Long (op2, spillreg1) @
[ X.CMP(
realoper op1 handle Spilled => stackoper op1,
realoper op2 handle Spilled => X.REG spillreg1)]
| transform (X.TEST (op1, op2)) =
- unspill (op2, spillreg1) @
+ unspill X.Long (op2, spillreg1) @
[ X.TEST(
realoper op1 handle Spilled => stackoper op1,
realoper op2 handle Spilled => X.REG spillreg1)]
[ X.MOVZB(
realoper dest handle Spilled => X.REG spillreg1,
realoper src handle Spilled => stackoper src)]
- @ spill (dest, spillreg1)
+ @ spill X.Long (dest, spillreg1)
| transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
| transform (X.LABEL l) = [ X.LABEL l ]
| transform (X.JMP l) = [ X.JMP l ]