From: Joshua Wise Date: Sun, 4 Jul 2010 08:07:17 +0000 (-0400) Subject: blargCPU liveness X-Git-Url: http://git.joshuawise.com/snipe.git/commitdiff_plain/f716a180ca5458e19643c902d4fb97785b9fd88e?ds=sidebyside;hp=459e54ac227128d4980ee40293b4b9fdd7b8ef26 blargCPU liveness --- diff --git a/bin/snipe b/bin/snipe index d883d20..7f7417c 100755 --- a/bin/snipe +++ b/bin/snipe @@ -1 +1 @@ -sml @SMLcmdname=$0 @SMLload=bin/l5c.heap.x86-linux $* +sml @SMLcmdname=$0 @SMLload=bin/snipe.heap.x86-darwin $* diff --git a/codegen/blarg.sml b/codegen/blarg.sml new file mode 100644 index 0000000..e482813 --- /dev/null +++ b/codegen/blarg.sml @@ -0,0 +1,201 @@ +(* L3 compiler + * blargCPU instruction/operand internal representation and manipulation + * Author: Joshua Wise + * Author: Chris Lu + *) + +signature BLARG = +sig + (* register type *) + datatype reg = + R0 | R1 | R2 | R3 | FR | SP | PC + (* operands to instructions *) + datatype oper = REG of reg | + TEMP of Temp.temp | + STACKARG of int + datatype pred = NV | NE | EQ | LT | GT | AL + (* instructions *) + datatype opc = + MOVLIT of oper * word | + MOVSYM of oper * Symbol.symbol | + MOVLBL of oper * Label.label | + LDR of oper * oper | + STO of oper * oper | + MOV of oper * oper | + MOVS of oper * oper | + ADD of oper * oper | + ADDS of oper * oper | + SUB of oper * oper | + SUBS of oper * oper | + AND of oper * oper | + ANDS of oper * oper | + NOT of oper * oper | + NOTS of oper * oper | + PUSH of oper * oper | + POP of oper * oper | + CALL of oper * oper * int | + SHR of oper * oper | + SHL of oper * oper + + datatype insn = + DIRECTIVE of string | + COMMENT of string | + LABEL of Label.label | + INSN of pred * opc | + LIVEIGN of insn + + structure OperSet : ORD_SET + where type Key.ord_key = oper; + structure LiveMap : ORD_MAP + where type Key.ord_key = int; + + val regcmp : reg * reg -> order + val cmpoper : oper * oper -> order + val opereq : oper * oper -> bool + val regname : reg -> string + val regtonum : reg -> int + val numtoreg : int -> reg + val predname : pred -> string + val pp_oper : oper -> string + val print : insn -> string +end + +structure Blarg :> BLARG = +struct + +(* register type *) + datatype reg = + R0 | R1 | R2 | R3 | FR | SP | PC + (* operands to instructions *) + datatype oper = REG of reg | + TEMP of Temp.temp | + STACKARG of int + datatype pred = NV | NE | EQ | LT | GT | AL + (* instructions *) + datatype opc = + MOVLIT of oper * word | + MOVSYM of oper * Symbol.symbol | + MOVLBL of oper * Label.label | + LDR of oper * oper | + STO of oper * oper | + MOV of oper * oper | + MOVS of oper * oper | + ADD of oper * oper | + ADDS of oper * oper | + SUB of oper * oper | + SUBS of oper * oper | + AND of oper * oper | + ANDS of oper * oper | + NOT of oper * oper | + NOTS of oper * oper | + PUSH of oper * oper | + POP of oper * oper | + CALL of oper * oper * int | + SHR of oper * oper | + SHL of oper * oper + + datatype insn = + DIRECTIVE of string | + COMMENT of string | + LABEL of Label.label | + INSN of pred * opc | + LIVEIGN of insn + + type func = Ast.ident * insn list + + (* gives name of reg *) + val regnames = + [ (R0, "r0"), + (R1, "r1"), + (R2, "r2"), + (R3, "r3"), + (FR, "fr"), + (SP, "sp"), + (PC, "pc") ]; + + fun regname reg = + let + val (r, n) = valOf (List.find (fn (r, _) => r = reg) regnames) + in + n + end + + fun predname NV = "nv" + | predname NE = "ne" + | predname EQ = "eq" + | predname LT = "lt" + | predname GT = "gt" + | predname AL = "" + + (* gives number (color) associated with reg *) + fun regtonum R0 = 0 + | regtonum R1 = 1 + | regtonum R2 = 2 + | regtonum R3 = 3 + | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register") + + (* gives reg associated with number (color) *) + fun numtoreg 0 = R0 + | numtoreg 1 = R1 + | numtoreg 2 = R2 + | numtoreg 3 = R3 + | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n)) + + (* register compare *) + fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2) + + (* operand compare; arbitrary order imposed to make + * various things easier (e.g. liveness, for sorting) + *) + fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2) + | cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2) + | cmpoper (REG _, _) = LESS + | cmpoper (_, _) = GREATER + + fun opereq (REG a, REG b) = a = b + | opereq (TEMP a, TEMP b) = Temp.eq (a, b) + | opereq (_, _) = false + + structure OperSet = ListSetFn ( + struct + type ord_key = oper + val compare = cmpoper + end) + + structure LiveMap = SplayMapFn(struct + type ord_key = int + val compare = Int.compare + end) + + fun pp_oper (REG r) = "%" ^ (regname r) + | pp_oper (TEMP t) = (Temp.name t) ^ (Temp.sfx (Temp.size t)) + | pp_oper (STACKARG i) = "arg#"^Int.toString i + + fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Word.toString w)^"\n" + | pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n" + | pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n" + | pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n" + | pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n" + | pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" # ("^(Int.toString n)^" args)\n" + | pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + + (* pretty prints the asm *) + fun print (DIRECTIVE(str)) = str ^ "\n" + | print (COMMENT(str)) = "// " ^ str ^ "\n" + | print (LABEL(l)) = Label.name l ^ ":\n" + | print (INSN (pred, insn)) = pp_insn (predname pred) insn + | print (LIVEIGN i) = print i +end diff --git a/codegen/liveness.sml b/codegen/liveness.sml index b030f94..72df248 100644 --- a/codegen/liveness.sml +++ b/codegen/liveness.sml @@ -7,22 +7,22 @@ signature LIVENESS = sig structure OperSet : ORD_SET - where type Key.ord_key = x86.basicop; + where type Key.ord_key = Blarg.oper; structure LiveMap : ORD_MAP where type Key.ord_key = int; type live = int * OperSet.set - type pseudoasm = x86.insn list + type pseudoasm = Blarg.insn list type livenesses = OperSet.set LiveMap.map type ident = int - datatype pred = DEF of x86.basicop | USE of x86.basicop | SUCC of ident | ISMOVE + datatype pred = DEF of Blarg.oper | USE of Blarg.oper | SUCC of ident | ISMOVE type predicates = pred list LiveMap.map - val uses : pred list -> x86.basicop list + val uses : pred list -> Blarg.oper list val succs : pred list -> ident list - val defs : pred list -> x86.basicop list + val defs : pred list -> Blarg.oper list val ismove : pred list -> bool val liveness : pseudoasm -> predicates * livenesses @@ -33,10 +33,10 @@ end structure Liveness :> LIVENESS = struct structure T = Temp - structure X = x86 + structure X = Blarg - structure OperSet = x86.OperSet - structure LiveMap = x86.LiveMap + structure OperSet = Blarg.OperSet + structure LiveMap = Blarg.LiveMap structure LabelMap = SplayMapFn(struct type ord_key = Label.label val compare = Label.compare @@ -48,7 +48,7 @@ struct type livenesses = OperSet.set LiveMap.map type ident = int - datatype pred = DEF of X.basicop | USE of X.basicop | SUCC of ident | ISMOVE + datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident | ISMOVE type predicates = pred list LiveMap.map @@ -80,24 +80,21 @@ struct (* val defhit/usehit : X.oper -> pred list * helper functions to discard constant operands *) - fun defhit (X.REG a,_) = [DEF(X.REG a)] - | defhit (X.TEMP a,_) = [DEF(X.TEMP a)] - | defhit (X.REL(o1, o2, _),_) = usehit o1 @ usehit o2 + fun defhit (X.REG X.PC) = raise ErrorMsg.InternalError "cannot define PC" + | defhit (X.REG a) = [DEF(X.REG a)] + | defhit (X.TEMP a) = [DEF(X.TEMP a)] | defhit (_) = nil - and usehit (X.REG a,_) = [USE(X.REG a)] - | usehit (X.TEMP a,_) = [USE(X.TEMP a)] - | usehit (X.REL(o1, o2, _),_) = usehit o1 @ usehit o2 + and usehit (X.REG a) = [USE(X.REG a)] + | usehit (X.TEMP a) = [USE(X.TEMP a)] | usehit (_) = nil fun callhit 0 = nil - | callhit 1 = USE(X.REG(X.EDI))::(callhit 0) - | callhit 2 = USE(X.REG(X.ESI))::(callhit 1) - | callhit 3 = USE(X.REG(X.EDX))::(callhit 2) - | callhit 4 = USE(X.REG(X.ECX))::(callhit 3) - | callhit 5 = USE(X.REG(X.R8D))::(callhit 4) - | callhit 6 = USE(X.REG(X.R9D))::(callhit 5) - | callhit _ = callhit 6 + | callhit 1 = USE(X.REG(X.R0))::(callhit 0) + | callhit 2 = USE(X.REG(X.R1))::(callhit 1) + | callhit 3 = USE(X.REG(X.R2))::(callhit 2) + | callhit 4 = USE(X.REG(X.R3))::(callhit 3) + | callhit _ = callhit 4 (* val gendef : ident * X.insn -> ident * pred list * generates the def/use/succ predicates for a single insn @@ -105,36 +102,36 @@ struct fun gendef (n, X.DIRECTIVE(_)) = (nil) | gendef (n, X.COMMENT(_)) = (nil) | gendef (n, X.LIVEIGN (_)) = ([SUCC (n+1)]) - | gendef (n, X.MOV(dest, src)) = (defhit dest @ usehit src @ [SUCC(n+1), ISMOVE]) - | gendef (n, X.MOVSC(dest, src)) = (defhit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.LEA(dest, src)) = (defhit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.SUB(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.IMUL(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.IMUL3(dest, src, _)) = (defhit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.ADD(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.IDIV(src)) = (usehit src @ [DEF(X.REG(X.EAX)), DEF(X.REG(X.EDX)), - USE(X.REG(X.EAX)), USE(X.REG(X.EDX)), - SUCC(n+1)]) - | gendef (n, X.CLTD) = ([USE(X.REG(X.EAX)), DEF(X.REG(X.EDX)), SUCC(n+1)]) - | gendef (n, X.SAL(dest, shft)) = (defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)]) - | gendef (n, X.SAR(dest, shft)) = (defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)]) - | gendef (n, X.NEG(src)) = (defhit src @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.NOT(src)) = (defhit src @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.AND(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.OR(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.XOR(dest, src)) = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.CMP(dest, src)) = (usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.TEST(dest, src)) = (usehit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.SETcc(_,dest)) = (defhit dest @ [SUCC(n+1)]) - | gendef (n, X.CMOVcc(_,src, dest)) = (defhit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.CALL(_, a)) = (callhit a @ [DEF(X.REG(X.EAX)), DEF(X.REG(X.ECX)), DEF(X.REG(X.EDX)), - DEF(X.REG(X.EDI)), DEF(X.REG(X.ESI)), DEF(X.REG(X.R8D)), - DEF(X.REG(X.R9D)), DEF(X.REG(X.R10D)), DEF(X.REG(X.R11D)), SUCC(n+1)]) - | gendef (n, X.MOVZB(dest, src)) = (defhit dest @ usehit src @ [SUCC(n+1)]) - | gendef (n, X.RET) = ([USE (X.REG X.EAX)]) | gendef (n, X.LABEL l) = ([SUCC (n+1)]) - | gendef (n, X.JMP l) = ([SUCC (findlabel l)]) - | gendef (n, X.Jcc (_,l)) = ([SUCC (n+1), SUCC (findlabel l)]) + | gendef (n, X.INSN(X.NV, _)) = ([SUCC (n+1)]) + | gendef (n, X.INSN(_, X.MOVLIT(dest, _))) = (defhit dest @ [SUCC(n+1), ISMOVE]) + | gendef (n, X.INSN(_, X.MOVSYM(dest, sym))) = (defhit dest @ [SUCC(n+1), ISMOVE]) + | gendef (n, X.INSN(X.AL, X.MOVLBL(X.REG X.PC, l))) = ([SUCC (findlabel l)]) + | gendef (n, X.INSN(_, X.MOVLBL(X.REG X.PC, l))) = ([SUCC (n+1), SUCC (findlabel l)]) + | gendef (n, X.INSN(_, X.MOVLBL(_, _))) = raise ErrorMsg.InternalError "MOVLBL with target neq PC" + | gendef (n, X.INSN(_, X.LDR(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1), ISMOVE]) + | gendef (n, X.INSN(_, X.STO(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.MOV(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1), ISMOVE]) + | gendef (n, X.INSN(_, X.MOVS(dest, src))) = (usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.ADD(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.ADDS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.SUB(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.SUBS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.AND(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.ANDS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.NOT(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.NOTS(dest, src))) = (usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.PUSH(X.REG X.SP, src))) = (usehit src @ [SUCC (n+1)]) + | gendef (n, X.INSN(_, X.PUSH(_, _))) = raise ErrorMsg.InternalError "PUSH with sp != SP" + | gendef (n, X.INSN(X.AL, X.POP(X.REG X.SP, X.REG X.PC))) = ([USE (X.REG X.R0)]) (* kind of like 'ret' *) + | 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(_, _, _))) = 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)]) in LiveMap.mapi gendef l end @@ -216,7 +213,7 @@ struct (* val isndef : X.oper -> pred list -> bool * checks to see if x is defined in a predicate list *) fun isndef (X.STACKARG(_)) _ = false - | isndef x (DEF(y)::l') = not (X.basiceq (x,y)) andalso isndef x l' + | isndef x (DEF(y)::l') = not (X.opereq (x,y)) andalso isndef x l' | isndef x (a::l') = isndef x l' | isndef x nil = true @@ -246,8 +243,8 @@ struct else liveiter newl preds end - fun dustostring (DEF(a)) = "DEF(" ^ X.pp_oper (a,Temp.Quad) ^ ")" - | dustostring (USE(a)) = "USE(" ^ X.pp_oper (a,Temp.Quad) ^ ")" + fun dustostring (DEF(a)) = "DEF(" ^ X.pp_oper a ^ ")" + | dustostring (USE(a)) = "USE(" ^ X.pp_oper a ^ ")" | dustostring (SUCC(a)) = "SUCC(" ^ Int.toString a ^ ")" | dustostring ISMOVE = "ISMOVE" @@ -274,7 +271,7 @@ struct fun prettyprint (set) = OperSet.foldr - (fn (oper, s) => (X.pp_oper (oper,Temp.Quad)) ^ ", " ^ s) + (fn (oper, s) => (X.pp_oper oper) ^ ", " ^ s) "-\n" set diff --git a/codegen/stringifier.sml b/codegen/stringifier.sml index 7ab1e89..6124a55 100644 --- a/codegen/stringifier.sml +++ b/codegen/stringifier.sml @@ -6,20 +6,20 @@ signature STRINGIFY = sig - type asm = x86.insn list + type asm = Blarg.insn list val stringify : (string -> string) -> asm -> string end structure Stringify :> STRINGIFY = struct - type asm = x86.insn list - structure X = x86 + type asm = Blarg.insn list + structure X = Blarg (* val stringify : asm -> string * turns a x86 instruction list into a string of assembly code for these instructions *) - fun stringify' rn (X.CALL (l, n)) = X.print (X.CALL ((Symbol.symbol (rn (Symbol.name l))), n)) - | stringify' rn x = X.print x + fun (*stringify' rn (X.CALL (l, n)) = X.print (X.CALL ((Symbol.symbol (rn (Symbol.name l))), n)) + | *)stringify' rn x = X.print x (* val stringify : asm -> string *) fun stringify realname l = String.concat (List.map (stringify' realname) l) diff --git a/codegen/x86.sml b/codegen/x86.sml deleted file mode 100644 index c0ff0b8..0000000 --- a/codegen/x86.sml +++ /dev/null @@ -1,318 +0,0 @@ -(* L3 compiler - * X86 instruction/operand internal representation and manipulation - * Author: Joshua Wise - * Author: Chris Lu - *) - -signature X86 = -sig - (* register type *) - datatype reg = - EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D - (* operands to instructions *) - datatype basicop = REG of reg | - TEMP of Temp.temp | - CONST of Word32.word | - REL of ((basicop * Temp.size) * (basicop * Temp.size) * Word32.word) | - STACKARG of int - type oper = basicop * Temp.size - datatype cc = E | NE | GE | LE | L | G | B | BE | A | AE - (* instructions *) - datatype insn = - DIRECTIVE of string | - COMMENT of string | - LABEL of Label.label | - MOV of oper * oper | - MOVSC of oper * oper | - LEA of oper * oper | - SUB of oper * oper | - IMUL of oper * oper | - IMUL3 of oper * oper * Word32.word | - ADD of oper * oper | - IDIV of oper | - NEG of oper | - NOT of oper | - SAL of oper * oper | - SAR of oper * oper | - AND of oper * oper | - OR of oper * oper | - XOR of oper * oper | - CMP of oper * oper | - TEST of oper * oper | - SETcc of cc * oper | - CMOVcc of cc * oper * oper | - JMP of Label.label | - Jcc of cc * Label.label | - CALL of Symbol.symbol * int | - MOVZB of oper * oper | - CLTD | - LIVEIGN of insn | - RET - - structure OperSet : ORD_SET - where type Key.ord_key = basicop; - structure LiveMap : ORD_MAP - where type Key.ord_key = int; - - val resize : Temp.size -> oper -> oper - val regcmp : reg * reg -> order - val getop : oper -> basicop - val osize : oper -> Temp.size - val cmpoper : oper * oper -> order - val cmpbasic : basicop * basicop -> order - val opereq : oper * oper -> bool - val basiceq : basicop * basicop -> bool - val regname : Temp.size -> reg -> string - val regtonum : reg -> int - val numtoreg : int -> reg - val ccname : cc -> string - val opsused : insn list -> OperSet.set - val pp_oper : oper -> string - val print : insn -> string -end - -structure x86 :> X86 = -struct - - datatype reg = - EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D - (* operands to instructions *) - datatype basicop = REG of reg | - TEMP of Temp.temp | - CONST of Word32.word | - REL of ((basicop * Temp.size) * (basicop * Temp.size) * Word32.word) | - STACKARG of int - datatype cc = E | NE | GE | LE | L | G | B | BE | A | AE - type oper = basicop * Temp.size - datatype insn = - DIRECTIVE of string | - COMMENT of string | - LABEL of Label.label | - MOV of oper * oper | - MOVSC of oper * oper | - LEA of oper * oper | - SUB of oper * oper | - IMUL of oper * oper | - IMUL3 of oper * oper * Word32.word | - ADD of oper * oper | - IDIV of oper | - NEG of oper | - NOT of oper | - SAL of oper * oper | - SAR of oper * oper | - AND of oper * oper | - OR of oper * oper | - XOR of oper * oper | - CMP of oper * oper | - TEST of oper * oper | - SETcc of cc * oper | - CMOVcc of cc * oper * oper | - JMP of Label.label | - Jcc of cc * Label.label | - CALL of Symbol.symbol * int | - MOVZB of oper * oper | - CLTD | - LIVEIGN of insn | - RET - - type func = Ast.ident * insn list - - (* gives name of reg *) - val regnames = - [ (EAX, ("al", "ax", "eax", "rax")), - (EBX, ("bl", "bx", "ebx", "rbx")), - (ECX, ("cl", "cx", "ecx", "rcx")), - (EDX, ("dl", "dx", "edx", "rdx")), - (ESI, ("sil", "si", "esi", "rsi")), - (EDI, ("dil", "di", "edi", "rdi")), - (EBP, ("bpl", "bp", "ebp", "rbp")), - (RSP, ("spl", "sp", "esp", "rsp")), - (R8D, ("r8b", "r8w", "r8d", "r8")), - (R9D, ("r9b", "r9w", "r9d", "r9")), - (R10D, ("r10b", "r10w", "r10d", "r10")), - (R11D, ("r11b", "r11w", "r11d", "r11")), - (R12D, ("r12b", "r12w", "r12d", "r12")), - (R13D, ("r13b", "r13w", "r13d", "r13")), - (R14D, ("r14b", "r14w", "r14d", "r14")), - (R15D, ("r15b", "r15w", "r15d", "r15")) ]; - - fun regname sz reg = - let - val (n, (b, w, l, q)) = valOf (List.find (fn (r, _) => r = reg) regnames) - in - case sz - of Temp.Byte => b - | Temp.Word => w - | Temp.Long => l - | Temp.Quad => q - end - - fun ccname E = "e" - | ccname NE = "ne" - | ccname GE = "ge" - | ccname LE = "le" - | ccname G = "g" - | ccname L = "l" - | ccname B = "b" - | ccname A = "a" - | ccname AE = "ae" - | ccname BE = "be" - - (* gives number (color) associated with reg *) - fun regtonum EAX = 0 - | regtonum ESI = 1 - | regtonum EDI = 2 - | regtonum ECX = 3 - | regtonum R8D = 4 - | regtonum R9D = 5 - | regtonum EDX = 6 - | regtonum R10D = 7 - | regtonum R11D = 8 - | regtonum EBX = 9 - | regtonum EBP = 10 - | regtonum R12D = 11 - | regtonum R13D = 12 - | regtonum R14D = 13 - | regtonum R15D = 14 - | regtonum RSP = 15 - - (* gives reg associated with number (color) *) - fun numtoreg 0 = EAX - | numtoreg 1 = ESI - | numtoreg 2 = EDI - | numtoreg 3 = ECX - | numtoreg 4 = R8D - | numtoreg 5 = R9D - | numtoreg 6 = EDX - | numtoreg 7 = R10D - | numtoreg 8 = R11D - | numtoreg 9 = EBX - | numtoreg 10 = EBP - | numtoreg 11 = R12D - | numtoreg 12 = R13D - | numtoreg 13 = R14D - | numtoreg 14 = R15D - | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n)) - - (* register compare *) - fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2) - fun osize (_,s) = s - fun resize ss (a,_) = (a,ss) - fun getop (a,_) = a - - (* operand compare; arbitrary order imposed to make - * various things easier (e.g. liveness, for sorting) - *) - fun cmpbasic (REG reg1, REG reg2) = regcmp (reg1, reg2) - | cmpbasic (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2) - | cmpbasic (CONST(const1), CONST(const2)) = Word32.compare (const1, const2) - | cmpbasic (REL (r1, i1, m1), REL (r2, i2, m2)) = - let - val orderm = Word32.compare (m1,m2) - val order1 = cmpbasic (getop r1, getop r2) - val order2 = cmpbasic (getop i1, getop i2) - val o1 = if(order1 = EQUAL) then order2 else order1 - in - if (o1 = EQUAL) then orderm - else o1 - end - | cmpbasic (CONST _, _) = LESS - | cmpbasic (REG _, _) = LESS - | cmpbasic (REL _, _) = LESS - | cmpbasic (_, _) = GREATER - - fun cmpoper ((o1,s1),(o2,s2)) = (case (cmpbasic (o1,o2)) of EQUAL => Temp.cmpsize (s1,s2) | a => a) - - fun basiceq (REG a, REG b) = a = b - | basiceq (TEMP a, TEMP b) = Temp.eq (a, b) - | basiceq (CONST a, CONST b) = a = b - | basiceq (REL (a1, b1, m1), REL (a2, b2, m2)) = m1 = m2 andalso basiceq (getop a1, getop a2) andalso basiceq (getop b1, getop b2) - | basiceq (_, _) = false - - fun opereq ((o1,s1),(o2,s2)) = basiceq (o1,o2) andalso s1 = s2 - - structure OperSet = ListSetFn ( - struct - type ord_key = basicop - val compare = cmpbasic - end) - - structure LiveMap = SplayMapFn(struct - type ord_key = int - val compare = Int.compare - end) - - fun opsused nil = OperSet.empty - | opsused ((DIRECTIVE _)::l) = opsused l - | opsused ((COMMENT _)::l) = opsused l - | opsused ((LABEL _)::l) = opsused l - | opsused ((MOV ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((MOVSC((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((LEA ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((SUB ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((IMUL ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((IMUL3 ((dst,_), (src,_), _))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((ADD ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((IDIV (src,_))::l) = OperSet.addList (opsused l, [src, REG EDX, REG EAX]) - | opsused ((NEG (dst,_))::l) = OperSet.addList (opsused l, [dst]) - | opsused ((NOT (dst,_))::l) = OperSet.addList (opsused l, [dst]) - | opsused ((SAL ((dst,_), (shft,_)))::l) = OperSet.addList (opsused l, [dst, shft]) - | opsused ((SAR ((dst,_), (shft,_)))::l) = OperSet.addList (opsused l, [dst, shft]) - | opsused ((AND ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((OR ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((XOR ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((CMP ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((TEST ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((SETcc (c, (dst,_)))::l) = OperSet.addList (opsused l, [dst]) - | opsused ((CMOVcc (c, (dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((JMP _)::l) = opsused l - | opsused ((Jcc _)::l) = opsused l - | opsused ((CALL _)::l) = opsused l - | opsused ((MOVZB ((dst,_), (src,_)))::l) = OperSet.addList (opsused l, [dst, src]) - | opsused ((CLTD)::l) = opsused l - | opsused ((RET)::l) = opsused l - | opsused ((LIVEIGN i)::l) = opsused (i::l) - - - fun pp_oper (REG r, s) = "%" ^ (regname s r) - | pp_oper (TEMP t, _) = (Temp.name t) ^ (Temp.sfx (Temp.size t)) - | pp_oper (CONST c, _) = "$" ^ Word32Signed.toString c - | pp_oper (REL ((CONST n, _), _, _), _) = Word32Signed.toString n - | pp_oper (REL (r, (CONST n, _), _), _) = (Word32Signed.toString n) ^ "(" ^ (pp_oper r) ^ ")" - | pp_oper (REL (r1, r2, m), _) = "(" ^ (pp_oper r1) ^ "," ^ (pp_oper r2) ^ "," ^ - (Word32.toString m) ^ ")" - | pp_oper (STACKARG i, _) = "arg#"^Int.toString i - - (* pretty prints the asm *) - fun print (DIRECTIVE(str)) = str ^ "\n" - | print (COMMENT(str)) = "// " ^ str ^ "\n" - | print (LABEL(l)) = Label.name l ^ ":\n" - | print (LEA(dst, src)) = "\tlea" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (MOV(dst, src)) = "\tmov" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (MOVSC((d,Temp.Long), (s,Temp.Quad))) = "\tmov" ^ (Temp.sfx Temp.Long) ^ "\t" ^ (pp_oper (s,Temp.Long)) ^ ", " ^ (pp_oper (d,Temp.Long)) ^ " // sex change\n" - | print (MOVSC((d,Temp.Quad), (s,Temp.Long))) = "\tmov" ^ (Temp.sfx Temp.Long) ^ "\t" ^ (pp_oper (s,Temp.Long)) ^ ", " ^ (pp_oper (d,Temp.Long)) ^ " // sex change\n" - | print (MOVSC(_,_)) = raise ErrorMsg.InternalError "invalid size change" - | print (SUB(dst, src)) = "\tsub" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (IMUL(dst, src)) = "\timul" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (IMUL3(dst, tmp, const)) = "\timul" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper (CONST const, Temp.Long)) ^ ", " ^ (pp_oper tmp) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (ADD(dst, src)) = "\tadd" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (IDIV(src)) = "\tidiv" ^ (Temp.sfx (osize src)) ^ "\t" ^ (pp_oper src) ^ "\n" - | print (NEG (dst)) = "\tneg" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper dst) ^ "\n" - | print (NOT (dst)) = "\tnot" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper dst) ^ "\n" - | print (SAL (dst, shft)) = "\tsal" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper shft) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (SAR (dst, shft)) = "\tsar" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper shft) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (AND (dst, src)) = "\tand" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (OR (dst, src)) = "\tor" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (XOR (dst, src)) = "\txor" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (CMP (dst, src)) = "\tcmp" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (TEST (dst, src)) = "\ttest" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (pp_oper dst) ^ "\n" - | print (CMOVcc (c, dst, src)) = "\tcmov" ^ (ccname c) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n" - | print (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n" - | print (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n" - | print (MOVZB (dst, src)) = "\tmovzb" ^ (Temp.sfx (osize dst)) ^ "\t" ^ (pp_oper src) ^ ", " ^ (pp_oper dst) ^ "\n" - | print (CLTD) = "\tcltd\n" - | print (RET) = "\tret\n" - | print (LIVEIGN i) = print i -end diff --git a/optimize/optimizer.sml b/optimize/optimizer.sml index fba6485..290bd05 100644 --- a/optimize/optimizer.sml +++ b/optimize/optimizer.sml @@ -5,8 +5,8 @@ sig IRFUNC of (Tree.func -> Tree.func) | IRSTM of (Tree.stm -> Tree.stm list) | IREXP of (Tree.exp -> Tree.exp) | - PRELIVENESS of (x86.insn list -> x86.insn list) | - FINAL of (x86.insn list -> x86.insn list) + PRELIVENESS of (Blarg.insn list -> Blarg.insn list) | + FINAL of (Blarg.insn list -> Blarg.insn list) type optimization = { shortname : string, @@ -15,8 +15,8 @@ sig } val optimize_ir : optimization list -> Tree.program -> Tree.program - val optimize_preliveness : optimization list -> x86.insn list -> x86.insn list - val optimize_final : optimization list -> x86.insn list -> x86.insn list + val optimize_preliveness : optimization list -> Blarg.insn list -> Blarg.insn list + val optimize_final : optimization list -> Blarg.insn list -> Blarg.insn list end structure Optimizer :> OPTIMIZER = @@ -28,8 +28,8 @@ struct IRFUNC of (Tree.func -> Tree.func) | IRSTM of (Tree.stm -> Tree.stm list) | IREXP of (Tree.exp -> Tree.exp) | - PRELIVENESS of (x86.insn list -> x86.insn list) | - FINAL of (x86.insn list -> x86.insn list) + PRELIVENESS of (Blarg.insn list -> Blarg.insn list) | + FINAL of (Blarg.insn list -> Blarg.insn list) type optimization = { shortname : string, diff --git a/sources.cm b/sources.cm index 5fdb4c7..edf6e49 100644 --- a/sources.cm +++ b/sources.cm @@ -30,7 +30,7 @@ Group is trans/treeutils.sml trans/trans.sml - codegen/x86.sml + codegen/blarg.sml codegen/codegen.sml codegen/liveness.sml codegen/igraph.sml @@ -40,10 +40,10 @@ Group is codegen/stringifier.sml optimize/optimizer.sml - optimize/constfold.sml +(* optimize/constfold.sml optimize/feckful.sml optimize/labelcoalescing.sml optimize/peephole.sml - optimize/stupidfunc.sml + optimize/stupidfunc.sml*) top/top.sml diff --git a/top/top.sml b/top/top.sml index 4b58d00..5263317 100644 --- a/top/top.sml +++ b/top/top.sml @@ -29,12 +29,12 @@ struct exception EXIT val alloptimizations = - [ConstantFold.optimizer, + [(*ConstantFold.optimizer, StupidFunctionElim.optimizer, FeckfulnessAnalysis.optimizer, ConstantFold.optimizer, LabelCoalescing.optimizer, - Peephole.optimizer] + Peephole.optimizer*)] val uniqopts = foldr