From c2b45b3681553192a462bcdd376ee7a9bf83eef3 Mon Sep 17 00:00:00 2001 From: Joshua Wise Date: Thu, 8 Jul 2010 01:08:26 -0400 Subject: [PATCH] Actually generate real code. --- codegen/blarg.sml | 31 +++- codegen/liveness.sml | 8 +- codegen/solidify.sml | 354 ++++++++++++++++++------------------------- sources.cm | 2 +- top/top.sml | 10 +- 5 files changed, 192 insertions(+), 213 deletions(-) diff --git a/codegen/blarg.sml b/codegen/blarg.sml index aacc993..cf3ea4c 100644 --- a/codegen/blarg.sml +++ b/codegen/blarg.sml @@ -8,7 +8,7 @@ signature BLARG = sig (* register type *) datatype reg = - R0 | R1 | R2 | R3 | FR | SP | PC + R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC (* operands to instructions *) datatype oper = REG of reg | TEMP of Temp.temp | @@ -65,7 +65,7 @@ struct (* register type *) datatype reg = - R0 | R1 | R2 | R3 | FR | SP | PC + R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC (* operands to instructions *) datatype oper = REG of reg | TEMP of Temp.temp | @@ -109,6 +109,15 @@ struct (R1, "r1"), (R2, "r2"), (R3, "r3"), + (R4, "r4"), + (R5, "r5"), + (R6, "r6"), + (R7, "r7"), + (R8, "r8"), + (R9, "r9"), + (R10, "r10"), + (R11, "r11"), + (R12, "r12"), (FR, "fr"), (SP, "sp"), (PC, "pc") ]; @@ -134,6 +143,15 @@ struct | regtonum R1 = 1 | regtonum R2 = 2 | regtonum R3 = 3 + | regtonum R4 = 4 + | regtonum R5 = 5 + | regtonum R6 = 6 + | regtonum R7 = 7 + | regtonum R8 = 8 + | regtonum R9 = 9 + | regtonum R10 = 10 + | regtonum R11 = 11 + | regtonum R12 = 12 | regtonum SP = 4 | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register") @@ -142,6 +160,15 @@ struct | numtoreg 1 = R1 | numtoreg 2 = R2 | numtoreg 3 = R3 + | numtoreg 4 = R4 + | numtoreg 5 = R5 + | numtoreg 6 = R6 + | numtoreg 7 = R7 + | numtoreg 8 = R8 + | numtoreg 9 = R9 + | numtoreg 10 = R10 + | numtoreg 11 = R11 + | numtoreg 12 = R12 | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n)) (* register compare *) diff --git a/codegen/liveness.sml b/codegen/liveness.sml index 72df248..97037cb 100644 --- a/codegen/liveness.sml +++ b/codegen/liveness.sml @@ -127,8 +127,12 @@ struct | gendef (n, X.INSN(_, X.POP(X.REG X.SP, X.REG X.PC))) = ([USE (X.REG X.R0), SUCC(n+1)]) | gendef (n, X.INSN(_, X.POP(X.REG X.SP, src))) = (defhit src @ [SUCC (n+1)]) | gendef (n, X.INSN(_, X.POP(_, _))) = raise ErrorMsg.InternalError "POP with sp != SP" - | gendef (n, X.INSN(_, X.CALL(X.REG X.SP, src, a))) = (callhit a @ usehit src @ [DEF(X.REG(X.R0)), DEF(X.REG(X.R1)), DEF(X.REG(X.R2)), - DEF(X.REG(X.R3)), SUCC(n+1)]) + | gendef (n, X.INSN(_, X.CALL(X.REG X.SP, src, a))) = (callhit a @ + usehit src @ + [DEF(X.REG(X.R0)), DEF(X.REG(X.R1)), DEF(X.REG(X.R2)), DEF(X.REG(X.R3)), + DEF(X.REG(X.R4)), DEF(X.REG(X.R5)), + SUCC(n+1)] + ) | gendef (n, X.INSN(_, X.CALL(_, _, _))) = raise ErrorMsg.InternalError "CALL with sp != SP" | gendef (n, X.INSN(_, X.SHR(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)]) | gendef (n, X.INSN(_, X.SHL(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)]) diff --git a/codegen/solidify.sml b/codegen/solidify.sml index 07ae420..a2622e1 100644 --- a/codegen/solidify.sml +++ b/codegen/solidify.sml @@ -8,18 +8,18 @@ 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 @@ -31,8 +31,8 @@ struct 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 @@ -41,244 +41,192 @@ struct 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 diff --git a/sources.cm b/sources.cm index e10115a..edf6e49 100644 --- a/sources.cm +++ b/sources.cm @@ -35,7 +35,7 @@ Group is codegen/liveness.sml codegen/igraph.sml codegen/colororder.sml -(* codegen/solidify.sml*) + codegen/solidify.sml codegen/coloring.sml codegen/stringifier.sml diff --git a/top/top.sml b/top/top.sml index 6a132c6..49e7dc6 100644 --- a/top/top.sml +++ b/top/top.sml @@ -149,19 +149,19 @@ struct ^ "--"^ Int.toString i ^ "\n")) colors) () -(* val _ = Flag.guard Flags.verbose say " Solidifying blargCPU code..." + val _ = Flag.guard Flags.verbose say " Solidifying blargCPU code..." val x86 = Solidify.solidify colors assem val _ = Flag.guard Flags.verbose say " Optimizing final assembly..." val x86p = Optimizer.optimize_final (!enabledopts) x86 val _ = Flag.guard Flags.verbose say " Stringifying..." - val x86d = [x86.DIRECTIVE(".globl " ^ name), - x86.DIRECTIVE(name ^ ":")] + val x86d = [Blarg.DIRECTIVE(".globl " ^ name), + Blarg.DIRECTIVE(name ^ ":")] @ x86p - val code = Stringify.stringify realname x86d*) + val code = Stringify.stringify realname x86d in - "" + code end fun main (name, args) = -- 2.43.0