signature SOLIDIFY =
sig
type colorings = (Temp.temp * int) list
- type asm = x86.insn list
+ type asm = Blarg.insn list
val solidify : colorings -> asm -> asm
end
structure Solidify :> SOLIDIFY =
struct
- structure X = x86
+ structure X = Blarg
structure T = Temp
type colorings = (Temp.temp * int) list
- type asm = x86.insn list
+ type asm = Blarg.insn list
exception Spilled
fun solidify (regmap : colorings) (instrs : asm) : asm =
let
- (* r14d and r15d is reserved for spilling *)
- val maxreg = X.regtonum X.R13D
+ (* r11 and r12 is reserved for spilling *)
+ val maxreg = X.regtonum X.R10
fun numtoreg n =
if (n > maxreg)
then raise Spilled
val tempnums = List.foldr (fn ((t,n),b) => TempMap.insert(b,t,n)) (TempMap.empty) regmap
fun temptonum (t: T.temp) : int = valOf (TempMap.find (tempnums, t))
- fun temptoreg (t: T.temp) : x86.reg =
+ fun temptoreg (t: T.temp) : Blarg.reg =
numtoreg (temptonum t)
- handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
+ handle Option => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
- val spillreg1 = X.R15D
- val spillreg2 = X.R14D
+ val spillreg1 = X.R12
+ val spillreg2 = X.R11
(* Determine which need to be saved. *)
- val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
+ val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R12)) regmap) @ [X.REG X.R11]
val saveregs = X.OperSet.intersection (
X.OperSet.addList (X.OperSet.empty, opsused),
X.OperSet.addList (
X.OperSet.empty,
- [X.REG X.EBX,
- X.REG X.EBP,
- X.REG X.R12D,
- X.REG X.R13D,
- X.REG X.R14D,
- X.REG X.R15D]))
+ [X.REG X.R7,
+ X.REG X.R8,
+ X.REG X.R9,
+ X.REG X.R10,
+ X.REG X.R11,
+ X.REG X.R12]))
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 (* Whether a register is spilled *)
- | isspilled (X.STACKARG _, _) = true
- | isspilled (X.REL _, _) = true
+ fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg (* Whether a register is spilled *)
+ | isspilled (X.STACKARG _) = true
| isspilled _ = false
- val stacksz = (nspilled + nsave) * 8
- fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8 (* Stack position of some register number *)
+ val stacksz = (nspilled + nsave) * 1
+ fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 1 (* Stack position of some register number *)
val prologue =
- (X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))) ::
- (ListPair.map
- (fn (num, reg) =>
- 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)))
- (List.tabulate (nsave, fn x => x), savelist))
+ [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
+ X.INSN (X.AL, X.SUB (X.REG X.SP, X.REG X.R4))] @
+ (List.concat
+ (ListPair.map
+ (fn (num, reg) =>
+ [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
+ X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
+ X.INSN (X.AL, X.STO (X.REG X.R4, reg))])
+ (List.tabulate (nsave, fn x => x), savelist)
+ )
+ )
val epilogue =
- (ListPair.map
- (fn (num, reg) =>
- 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)))
- (List.tabulate (nsave, fn x => x), savelist)) @
- [X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))]
+ (List.concat
+ (ListPair.map
+ (fn (num, reg) =>
+ [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
+ X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
+ X.INSN (X.AL, X.LDR (reg, X.REG X.R4))])
+ (List.tabulate (nsave, fn x => x), savelist)
+ )
+ ) @
+ [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
+ X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
val endlbl = Label.new()
- fun spill ((X.TEMP temp, s), xreg: x86.reg) = (* Spill a register if need be. *)
+ fun spill (X.TEMP temp, xreg: Blarg.reg) = (* Spill a register if need be. *)
let
- val base = (X.REG X.RSP, Tm.Quad)
- val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+ val base = X.REG X.SP
+ val offs = Word.fromInt (stackpos (temptonum temp))
in
- if (isspilled (X.TEMP temp, s))
- then [X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]
+ if (isspilled (X.TEMP temp))
+ then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]*)
else nil
end
- | spill ((X.STACKARG _, s), _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
- | spill ((a as X.REL _, s), xreg) = [X.MOV ((a,s), (X.REG xreg,s))]
+ | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
| spill _ = nil (* Nothing else can be spilled. *)
- fun unspill ((X.TEMP temp, s), xreg: x86.reg) = (* Unspill a register if need be. *)
+ fun unspill (X.TEMP temp, xreg: Blarg.reg) = (* Unspill a register if need be. *)
let
- val base = (X.REG X.RSP, Tm.Quad)
- val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+ val base = X.REG X.SP
+ val offs = Word.fromInt (stackpos (temptonum temp))
in
- if (isspilled (X.TEMP temp, s))
- then [X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]
+ if (isspilled (X.TEMP temp))
+ then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]*)
else nil
end
- | unspill ((X.STACKARG arg, s), xreg) =
+ | unspill (X.STACKARG arg, xreg) =
let
- val base = (X.REG X.RSP, Tm.Quad)
- val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
+ val base = X.REG X.SP
+ val offs = Word.fromInt (stacksz + 8 + (arg * 8))
in
- [X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]
+ (*[X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]*)
+ raise ErrorMsg.InternalError "unspill from stack not supported"
end
- | unspill ((a as X.REL _, s), xreg) = [X.MOV ((X.REG xreg, s), (a,s))]
| unspill _ = nil
- fun realoper (X.TEMP temp, s) = (X.REG (temptoreg temp), s) (* makes an operand 'real' *)
- | realoper (X.STACKARG arg, _) = raise Spilled
- | realoper (X.REL _, _) = raise Spilled
- | realoper r = r
-
- fun stackoper (X.TEMP temp, s) =
- let
- val base = (X.REG X.RSP, Tm.Quad)
- val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
- in
- if (isspilled (X.TEMP temp, s))
- then (X.REL (base, offs, 0w1), s)
- else raise ErrorMsg.InternalError "stackoper on unspilled temp?"
- end
- | stackoper (X.STACKARG arg, s) =
- let
- val base = (X.REG X.RSP, Tm.Quad)
- val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
- in
- (X.REL (base, offs, 0w1), s)
- end
- | stackoper (a as (X.REL _, s)) = a
- | stackoper (a as (X.CONST _, s)) = a
- | stackoper anous = raise ErrorMsg.InternalError ("stackoper on not temp " ^ X.pp_oper anous)
-
- fun ophit (X.REL(op1, op2, m), s) =
- if (isspilled op1 andalso isspilled op2) then
- ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2),
- X.IMUL((X.REG spillreg1, Tm.Quad), (X.CONST m, Tm.Quad)),
- X.ADD ((X.REG spillreg1, Tm.Quad), stackoper op1)],
- (X.REL ((X.REG spillreg1, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))
- else if(isspilled op1) then
- ([X.MOV ((X.REG spillreg1, Tm.Quad), stackoper op1)],
- (X.REL ((X.REG spillreg1, Tm.Quad), realoper op2, m), s))
- else if(isspilled op2) then
- ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2)],
- (X.REL (realoper op1, (X.REG spillreg1, Tm.Quad), m), s))
- else
- ([],
- (X.REL (realoper op1, realoper op2, m), s))
- | ophit a = (nil, realoper a handle Spilled => stackoper a)
+ fun unspill_ops (op1, op2) =
+ case (isspilled op1, isspilled op2)
+ of (false, false) => []
+ | (true, false) => unspill (op1, spillreg1)
+ | (false, true) => unspill (op2, spillreg2)
+ | (true, true) => unspill (op1, spillreg1) @ unspill (op2, spillreg2)
+
+ fun respill_ops (op1, op2) =
+ case (isspilled op1, isspilled op2) (* no instruction writes back to op2 *)
+ of (false, _) => []
+ | (true, _) => spill (op1, spillreg1)
+
+ fun real_op1 op1 =
+ case op1
+ of (X.TEMP temp) => if isspilled op1
+ then (X.REG spillreg1)
+ else X.REG (temptoreg temp)
+ | (X.STACKARG arg) => X.REG spillreg1
+ | r => r
+
+ fun real_ops (op1, op2) =
+ (case op1
+ of (X.TEMP temp) => if isspilled op1
+ then (X.REG spillreg1)
+ else X.REG (temptoreg temp)
+ | (X.STACKARG arg) => X.REG spillreg1
+ | r => r,
+ case op2
+ of (X.TEMP temp) => if isspilled op2
+ then (X.REG spillreg2)
+ else X.REG (temptoreg temp)
+ | (X.STACKARG arg) => X.REG spillreg2
+ | r => r)
+
+ fun whack_insn (pred, insn, op1, op2) =
+ (map (fn i => X.INSN (pred, i)) (unspill_ops (op1, op2))) @
+ [ X.INSN (pred, insn (real_ops (op1, op2))) ] @
+ (map (fn i => X.INSN (pred, i)) (respill_ops (op1, op2)))
fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
| transform (X.COMMENT s) = [X.COMMENT s]
+ | transform (X.LABEL l) = [X.LABEL l]
| transform (X.LIVEIGN a) = transform a
- | transform (X.MOV (dest, src)) =
- let
- val (insns1, realop1 as (_,s1)) = ophit dest
- val (insns2, realop2 as (_,s2)) = ophit src
- in
- if(isspilled dest andalso isspilled src) then
- insns2 @ [X.MOV ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
- else
- insns1 @ insns2 @ [X.MOV (realop1, realop2)]
- end
- | transform (X.LEA (dest, src)) =
- let
- val (insns1, realop1 as (_,s1)) = ophit dest
- val (insns2, realop2 as (_,s2)) = ophit src
- in
- if(isspilled dest andalso isspilled src) then
- insns2 @ [X.LEA ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
- else
- insns1 @ insns2 @ [X.LEA (realop1, realop2)]
- end
- | transform (X.SUB (dest, src)) =
- let
- val (insns, realop) = ophit dest
- in
- unspill (src, spillreg2) @ insns @
- [ X.SUB(realop,
- realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
- end
- | transform (X.IMUL (dest, src)) =
- unspill (dest, spillreg1) @
- [ X.IMUL(
- realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
- realoper src handle Spilled => stackoper src)] @
- spill (dest, spillreg1)
- | transform (X.IMUL3 (dest, src, const)) =
- unspill (src, spillreg2) @
- [ X.IMUL3(
- realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
- realoper src handle Spilled => (X.REG spillreg2, X.osize src),
- const)] @
- spill (dest, spillreg1)
- | transform (X.ADD (dest, src)) =
- let
- val (insns, realop) = ophit dest
- in
- unspill (src, spillreg2) @ insns @
- [ X.ADD(realop,
- realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
- 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)]
- | transform (X.SAL (dest, shft)) =
- [ X.SAL (
- realoper dest handle Spilled => stackoper dest,
- shft)]
- | transform (X.SAR (dest, shft)) =
- [ X.SAR (
- realoper dest handle Spilled => stackoper dest,
- shft)]
- | transform (X.CLTD) = [ X.CLTD ]
- | transform (X.AND (dest, src)) =
- unspill (src, spillreg1) @
- [ X.AND(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
- | transform (X.OR (dest, src)) =
- unspill (src, spillreg1) @
- [ X.OR(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
- | transform (X.XOR (dest, src)) =
- unspill (src, spillreg1) @
- [ X.XOR(
- realoper dest handle Spilled => stackoper dest,
- realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
- | transform (X.CMP (op1, op2)) =
- let
- val (insns1, realop1) = ophit op1
- in
- if(isspilled realop1 andalso isspilled op2) then
- unspill (op2, spillreg2) @ insns1 @ [X.CMP (realop1, (X.REG spillreg2, X.osize realop1))]
- else
- insns1 @ [X.CMP (realop1, realoper op2 handle Spilled => stackoper op2)]
- end
- | transform (X.TEST (op1, op2)) =
- unspill (op2, spillreg1) @
- [ X.TEST(
- realoper op1 handle Spilled => stackoper op1,
- realoper op2 handle Spilled => (X.REG spillreg1, X.osize op2))]
- | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
- | transform (X.CMOVcc (c, 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, X.osize src), realop2)] @ insns1 @ [X.CMOVcc (c, realop1, (X.REG spillreg2, X.osize src))]
- else
- insns1 @ insns2 @ [X.CMOVcc (c, realop1, realop2)]
- end
- | transform (X.CALL l) = [ X.CALL l ]
- | transform (X.MOVZB (dest, src)) =
- [ X.MOVZB(
- realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
- realoper src handle Spilled => stackoper src)]
- @ spill (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 ]
- | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
- | transform _ = raise ErrorMsg.InternalError "probably movsc: unimplemented"
+
+ (* god the special cases are going to suck *)
+ | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
+ [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
+ (if isspilled op1
+ then spill (op1, spillreg1)
+ else [])
+ | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
+ [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
+ (if isspilled op1
+ then spill (op1, spillreg1)
+ else [])
+ | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
+ [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
+ (if isspilled op1
+ then spill (op1, spillreg1)
+ else [])
+
+ (* and here comes the boilerplate *)
+ | transform (X.INSN (pred, X.LDR (op1, op2))) = whack_insn (pred, X.LDR, op1, op2)
+ | transform (X.INSN (pred, X.STO (op1, op2))) = whack_insn (pred, X.STO, op1, op2)
+ | transform (X.INSN (pred, X.MOV (op1, op2))) = whack_insn (pred, X.MOV, op1, op2)
+ | transform (X.INSN (pred, X.MOVS (op1, op2))) = whack_insn (pred, X.MOVS, op1, op2)
+ | transform (X.INSN (pred, X.ADD (op1, op2))) = whack_insn (pred, X.ADD, op1, op2)
+ | transform (X.INSN (pred, X.ADDS (op1, op2))) = whack_insn (pred, X.ADDS, op1, op2)
+ | transform (X.INSN (pred, X.SUB (op1, op2))) = whack_insn (pred, X.SUB, op1, op2)
+ | transform (X.INSN (pred, X.SUBS (op1, op2))) = whack_insn (pred, X.SUBS, op1, op2)
+ | transform (X.INSN (pred, X.AND (op1, op2))) = whack_insn (pred, X.AND, op1, op2)
+ | transform (X.INSN (pred, X.ANDS (op1, op2))) = whack_insn (pred, X.ANDS, op1, op2)
+ | transform (X.INSN (pred, X.NOT (op1, op2))) = whack_insn (pred, X.NOT, op1, op2)
+ | transform (X.INSN (pred, X.NOTS (op1, op2))) = whack_insn (pred, X.NOTS, op1, op2)
+ | transform (X.INSN (pred, X.PUSH (op1, op2))) = if isspilled op2
+ then raise ErrorMsg.InternalError "PUSH on spilled op2 is not possible"
+ else [ X.INSN (pred, X.PUSH (real_ops (op1, op2))) ]
+ | 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? *)
+ | transform (X.INSN (pred, X.POP (op1, op2))) = if isspilled op2
+ then raise ErrorMsg.InternalError "POP on spilled op2 is not possible"
+ else [ X.INSN (pred, X.POP (real_ops (op1, op2))) ]
+ | transform (X.INSN (pred, X.CALL (op1, op2, i))) = if isspilled op2
+ then raise ErrorMsg.InternalError "CALL on spilled op2 is not possible"
+ else [ X.INSN (pred, X.CALL ((fn (x, y) => (x, y, i)) (real_ops (op1, op2)))) ]
+ | transform (X.INSN (pred, X.SHR (op1, op2))) = whack_insn (pred, X.SHR, op1, op2)
+ | transform (X.INSN (pred, X.SHL (op1, op2))) = whack_insn (pred, X.SHL, op1, op2)
+ (*| transform _ = raise ErrorMsg.InternalError "unimplemented"*)
in
- if (nsave < 2) then
+ (*if (nsave < 2) then
List.concat (prologue :: (map transform instrs))
else
- List.concat (prologue :: ((map transform instrs) @ [[X.LABEL endlbl], epilogue, [X.RET]]))
+ *)
+ List.concat (prologue ::
+ ((map transform instrs) @
+ [[X.LABEL endlbl],
+ epilogue,
+ [X.INSN (X.AL, X.POP (X.REG X.SP, X.REG X.PC))]
+ ]
+ )
+ )
end
end
git.joshuawise.com / snipe.git / blobdiff