-sml @SMLcmdname=$0 @SMLload=bin/l5c.heap.x86-linux $*
+sml @SMLcmdname=$0 @SMLload=bin/snipe.heap.x86-darwin $*
--- /dev/null
+(* L3 compiler
+ * blargCPU instruction/operand internal representation and manipulation
+ * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
+ *)
+
+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
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
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
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
(* 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
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
(* 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
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"
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
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)
+++ /dev/null
-(* L3 compiler
- * X86 instruction/operand internal representation and manipulation
- * Author: Joshua Wise <jwise@andrew.cmu.edu>
- * Author: Chris Lu <czl@andrew.cmu.edu>
- *)
-
-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
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,
}
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 =
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,
trans/treeutils.sml
trans/trans.sml
- codegen/x86.sml
+ codegen/blarg.sml
codegen/codegen.sml
codegen/liveness.sml
codegen/igraph.sml
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
exception EXIT
val alloptimizations =
- [ConstantFold.optimizer,
+ [(*ConstantFold.optimizer,
StupidFunctionElim.optimizer,
FeckfulnessAnalysis.optimizer,
ConstantFold.optimizer,
LabelCoalescing.optimizer,
- Peephole.optimizer]
+ Peephole.optimizer*)]
val uniqopts =
foldr
git.joshuawise.com / snipe.git / commitdiff