X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/0a24e44d4e9f82f8d3d83de8e58c83c8cf2868b6..2ab9671fde5297fc59583361f152e812e66c2d17:/codegen/solidify.sml?ds=inline diff --git a/codegen/solidify.sml b/codegen/solidify.sml index 48fad39..a2622e1 100644 --- a/codegen/solidify.sml +++ b/codegen/solidify.sml @@ -1,4 +1,4 @@ -(* L2 Compiler +(* L3 Compiler * Takes a list of mappings of temporaries to colors and a pseudoasm listing, * then produces x86 code. * Author: Chris Lu @@ -8,167 +8,225 @@ 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 - + + structure TempMap = SplayMapFn(struct + type ord_key = Temp.temp + val compare = Temp.compare + end) + structure Tm = Temp + 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 else X.numtoreg n - - fun temptonum (t: T.temp) : int = - (List.hd - (List.map (fn (_, n) => n) - (List.filter (fn (a, _) => (Temp.compare (a, t) = EQUAL)) regmap))) - - fun temptoreg (t: T.temp) : x86.reg = + + 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) : Blarg.reg = numtoreg (temptonum t) - handle Empty => - (ErrorMsg.warn NONE ("Uncolored temp "^(Temp.name t)^" -- dead code?") ; - X.R15D) (*If we don't care about the output, then it is cool to explode this; R15D is guaranteed not to be used across builtin blocks.*) - - val spillreg1 = X.R14D - - val prologue = [X.DIRECTIVE "\tpush %rbx\n\tpush %r12\n\tpush %r13\n\tpush %r14\n\tpush %r15"] (* Could be done better. *) - val epilogue = [X.DIRECTIVE "\tpop %r15\n\tpop %r14\n\tpop %r13\n\tpop %r12\n\tpop %rbx"] - - 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 *) + handle Option => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!") + + 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.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.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 _ = false - fun stackpos (reg: int) = (reg - maxreg) * ~4 (* Stack position of some register number *) - - fun spill (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *) - if (isspilled (X.TEMP temp)) - then [X.MOVL (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)] - else nil - | spill _ = nil (* Nothing else can be spilled. *) - fun unspill (X.TEMP temp, xreg: x86.reg) = (* Unspill a register if need be. *) - if (isspilled (X.TEMP temp)) - then [X.MOVL (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))] - else nil + + val stacksz = (nspilled + nsave) * 1 + fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 1 (* Stack position of some register number *) + + val prologue = + [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 = + (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, xreg: Blarg.reg) = (* Spill a register if need be. *) + let + val base = X.REG X.SP + val offs = Word.fromInt (stackpos (temptonum temp)) + in + 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 _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg" + | spill _ = nil (* Nothing else can be spilled. *) + fun unspill (X.TEMP temp, xreg: Blarg.reg) = (* Unspill a register if need be. *) + let + val base = X.REG X.SP + val offs = Word.fromInt (stackpos (temptonum temp)) + in + 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, xreg) = + let + 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))]*) + raise ErrorMsg.InternalError "unspill from stack not supported" + end | unspill _ = nil + + 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 realoper (X.TEMP temp) = X.REG (temptoreg temp) (* Makes a operand 'real'. *) - | 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 _ = raise ErrorMsg.InternalError "stackoper on not temp?" + 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.MOVL (dest, src)) = - if (isspilled dest) - then - unspill (src, spillreg1) @ - [ X.MOVL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - else - [ X.MOVL( - realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?", - realoper src handle Spilled => stackoper src)] - | transform (X.SUBL (dest, src)) = - unspill (src, spillreg1) @ - [ X.SUBL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - | transform (X.IMUL (dest, src)) = - unspill (dest, spillreg1) @ - [ X.IMUL( - realoper dest handle Spilled => X.REG spillreg1, - realoper src handle Spilled => stackoper src)] @ - spill (dest, spillreg1) - | transform (X.IMUL3 (dest, src, const)) = - [ X.IMUL3( - realoper dest handle Spilled => X.REG spillreg1, - realoper src handle Spilled => stackoper src, - const)] @ - spill (dest, spillreg1) - | transform (X.ADDL (dest, src)) = (* You can have either operand spilled, but not both. Pick one. *) - if (isspilled dest) - then - unspill (src, spillreg1) @ - [ X.ADDL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - else - [ X.ADDL( - realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?", - realoper src handle Spilled => stackoper src)] - | transform (X.IDIVL (src)) = [ X.IDIVL(realoper src handle Spilled => stackoper src)] - | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)] - | transform (X.NOTL (src)) = [ X.NOTL(realoper src handle Spilled => stackoper src)] - | transform (X.SALL (dest, shft)) = - [ X.SALL ( - realoper dest handle Spilled => stackoper dest, - shft)] - | transform (X.SARL (dest, shft)) = - [ X.SARL ( - realoper dest handle Spilled => stackoper dest, - shft)] - | transform (X.CLTD) = [ X.CLTD ] - | transform (X.ANDL (dest, src)) = - unspill (src, spillreg1) @ - [ X.ANDL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - | transform (X.ORL (dest, src)) = - unspill (src, spillreg1) @ - [ X.ORL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - | transform (X.XORL (dest, src)) = - unspill (src, spillreg1) @ - [ X.XORL( - realoper dest handle Spilled => stackoper dest, - realoper src handle Spilled => X.REG spillreg1)] - | transform (X.CMPL (op1, op2)) = - unspill (op2, spillreg1) @ - [ X.CMPL( - realoper op1 handle Spilled => stackoper op1, - realoper op2 handle Spilled => X.REG spillreg1)] - | transform (X.TEST (op1, op2)) = - unspill (op2, spillreg1) @ - [ X.TEST( - realoper op1 handle Spilled => stackoper op1, - realoper op2 handle Spilled => X.REG spillreg1)] - | transform (X.SETNE (src)) = [ X.SETNE(realoper src handle Spilled => stackoper src)] - | transform (X.SETE (src)) = [ X.SETE(realoper src handle Spilled => stackoper src)] - | transform (X.SETLE (src)) = [ X.SETLE(realoper src handle Spilled => stackoper src)] - | transform (X.SETL (src)) = [ X.SETL(realoper src handle Spilled => stackoper src)] - | transform (X.SETGE (src)) = [ X.SETGE(realoper src handle Spilled => stackoper src)] - | transform (X.SETG (src)) = [ X.SETG(realoper src handle Spilled => stackoper src)] - | transform (X.MOVZBL (dest, src)) = - [ X.MOVZBL( - realoper dest handle Spilled => X.REG spillreg1, - realoper src handle Spilled => stackoper src)] - @ spill (dest, spillreg1) - | transform (X.RET) = epilogue @ [X.RET] - | transform (X.LABEL l) = [ X.LABEL l ] - | transform (X.JMP l) = [ X.JMP l ] - | transform (X.JE l) = [ X.JE l] - | transform (X.JNE l) = [ X.JNE l] -(* | transform _ = raise ErrorMsg.InternalError ("Unimplemented transform")*) + | transform (X.LABEL l) = [X.LABEL l] + | transform (X.LIVEIGN a) = transform a + + (* 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 - List.concat (prologue :: (map transform instrs)) - + (*if (nsave < 2) then + List.concat (prologue :: (map transform instrs)) + else + *) + 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