datatype reg =
EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
(* operands to instructions *)
- datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int) | STACKARG of int | STR of string
- datatype cc = E | NE | GE | LE | L | G
- datatype size = Byte | Word | Long | Qword
+ 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 |
- SIZE of size * insn |
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 |
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 |
CLTD |
LIVEIGN of insn |
RET
-
+
structure OperSet : ORD_SET
- where type Key.ord_key = oper;
+ 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 regname : size -> reg -> string
+ 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 prettyprint_oper : size -> oper -> string
- val prettyprint : size -> insn -> string
+ 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
- datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int) | STACKARG of int | STR of string
- datatype cc = E | NE | GE | LE | L | G
- datatype size = Byte | Word | Long | Qword
+ (* 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 |
- SIZE of size * insn |
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 |
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 |
val (n, (b, w, l, q)) = valOf (List.find (fn (r, _) => r = reg) regnames)
in
case sz
- of Byte => b
- | Word => w
- | Long => l
- | Qword => q
+ of Temp.Byte => b
+ | Temp.Word => w
+ | Temp.Long => l
+ | Temp.Quad => q
end
fun ccname E = "e"
| 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 R10D = 7
| regtonum R11D = 8
| regtonum EBX = 9
- | regtonum R12D = 10
- | regtonum R13D = 11
- | regtonum R14D = 12
- | regtonum R15D = 13
- | regtonum EBP = 14 (* Dummy numbers -- not permitted for allocation, but there so that we can compare *)
+ | regtonum EBP = 10
+ | regtonum R12D = 11
+ | regtonum R13D = 12
+ | regtonum R14D = 13
+ | regtonum R15D = 14
| regtonum RSP = 15
(* gives reg associated with number (color) *)
| numtoreg 7 = R10D
| numtoreg 8 = R11D
| numtoreg 9 = EBX
- | numtoreg 10 = R12D
- | numtoreg 11 = R13D
- | numtoreg 12 = R14D
- | numtoreg 13 = R15D
- | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Unknown register "^(Int.toString n))
+ | 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 cmpoper (REG(reg1), REG(reg2)) = regcmp (reg1, reg2)
- | cmpoper (TEMP(temp1), TEMP(temp2)) = Temp.compare (temp1,temp2)
- | cmpoper (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
- | cmpoper (REL (r1, i1), REL (r2, i2)) =
- let
- val regorder = regcmp (r1, r2)
- val intorder = Int.compare (i1, i2)
+ 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 (regorder = EQUAL) then intorder
- else regorder
+ if (o1 = EQUAL) then orderm
+ else o1
end
- | cmpoper (CONST _, _) = LESS
- | cmpoper (REG _, _) = LESS
- | cmpoper (REL _, _) = LESS
- | cmpoper (_, _) = GREATER
+ | 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
- fun opereq (REG a, REG b) = a = b
- | opereq (TEMP a, TEMP b) = Temp.eq (a, b)
- | opereq (CONST a, CONST b) = a = b
- | opereq (REL (ra, ia), REL (rb, ib)) = (ra = rb) andalso (ia = ib)
- | opereq (_, _) = false
-
structure OperSet = ListSetFn (
struct
- type ord_key = oper
- val compare = cmpoper
+ type ord_key = basicop
+ val compare = cmpbasic
end)
structure LiveMap = SplayMapFn(struct
| 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 ((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 ((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 ((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)
- | opsused ((SIZE (_, i))::l) = opsused (i::l)
- (* integer tostring, except with more - and less ~ *)
- fun moreDifferentToString (i) =
- if (i >= 0) then Int.toString i
- else "-" ^ (Int.toString (~i))
- (* pretty prints an operand *)
- fun sfx Byte = "b"
- | sfx Word = "w"
- | sfx Long = "l"
- | sfx Qword = "q"
-
- fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
- | prettyprint_oper s (TEMP t) = (Temp.name t) ^ (sfx s)
- | prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
- | prettyprint_oper _ (REL (r, i)) = (moreDifferentToString i) ^ "(%" ^ (regname Qword r) ^ ")"
- | prettyprint_oper _ (STR s) = s
- | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
+ 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 (no...) *)
- fun prettyprint s (DIRECTIVE(str)) = str ^ "\n"
- | prettyprint s (COMMENT(str)) = "// " ^ str ^ "\n"
- | prettyprint s (LABEL(l)) = Label.name l ^ ":\n"
- | prettyprint s (MOV(dst, src)) = "\tmov" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (SUB(dst, src)) = "\tsub" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (IMUL(dst, src)) = "\timul\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (IMUL3(dst, tmp, const)) = "\timul\t" ^ (prettyprint_oper s (CONST const)) ^ ", " ^ (prettyprint_oper s tmp) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (ADD(dst, src)) = "\tadd" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (IDIV(src)) = "\tidiv" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ "\n"
- | prettyprint s (NEG (dst)) = "\tneg" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (NOT (dst)) = "\tnot" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (SAL (dst, shft)) = "\tsal" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (SAR (dst, shft)) = "\tsar" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (AND (dst, src)) = "\tand" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (OR (dst, src)) = "\tor" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (XOR (dst, src)) = "\txor" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (CMP (dst, src)) = "\tcmp" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (TEST (dst, src)) = "\ttest" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (prettyprint_oper Byte dst) ^ "\n"
- | prettyprint s (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n"
- | prettyprint s (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n"
- | prettyprint s (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n"
- | prettyprint s (MOVZB (dst, src)) = "\tmovzb" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
- | prettyprint s (CLTD) = "\tcltd\n"
- | prettyprint s (RET) = "\tret\n"
- | prettyprint s (LIVEIGN i) = prettyprint s i
- | prettyprint _ (SIZE (s, i)) = prettyprint s i
-(* | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
+ (* 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
git.joshuawise.com / snipe.git / blobdiff