-(* L2 compiler
+(* L3 compiler
* X86 instruction/operand internal representation and manipulation
* Author: Joshua Wise <jwise@andrew.cmu.edu>
* Author: Chris Lu <czl@andrew.cmu.edu>
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)
- (* instructions
- * a better way to do SET would be SET of cc * oper,
- * same with JMP
- *)
+ 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
+ (* instructions *)
datatype insn =
DIRECTIVE of string |
COMMENT of string |
LABEL of Label.label |
- MOVL of oper * oper |
- SUBL of oper * oper |
+ SIZE of size * insn |
+ MOV of oper * oper |
+ SUB of oper * oper |
IMUL of oper * oper |
IMUL3 of oper * oper * Word32.word |
- ADDL of oper * oper |
- IDIVL of oper |
+ ADD of oper * oper |
+ IDIV of oper |
NEG of oper |
- NOTL of oper |
- SALL of oper * oper |
- SARL of oper * oper |
- ANDL of oper * oper |
- ORL of oper * oper |
- XORL of oper * oper |
- CMPL of oper * 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 |
- SETNE of oper |
- SETE of oper |
- SETLE of oper |
- SETL of oper |
- SETGE of oper |
- SETG of oper |
+ SETcc of cc * oper |
JMP of Label.label |
- JE of Label.label |
- JNE of Label.label |
- MOVZBL of oper * oper |
+ 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 = oper;
+ structure LiveMap : ORD_MAP
+ where type Key.ord_key = int;
+
val cmpoper : oper * oper -> order
val opereq : oper * oper -> bool
- val regname : reg -> string
- val regnameb : reg -> string
+ val regname : size -> reg -> string
val regtonum : reg -> int
val numtoreg : int -> reg
- val prettyprint_oper : oper -> string
- val prettyprint_operb : oper -> string
- val prettyprint : insn -> string
+ val ccname : cc -> string
+ val opsused : insn list -> OperSet.set
+ val prettyprint_oper : size -> oper -> string
+ val prettyprint : size -> 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)
+ 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 insn =
DIRECTIVE of string |
COMMENT of string |
LABEL of Label.label |
- MOVL of oper * oper |
- SUBL of oper * oper |
+ SIZE of size * insn |
+ MOV of oper * oper |
+ SUB of oper * oper |
IMUL of oper * oper |
IMUL3 of oper * oper * Word32.word |
- ADDL of oper * oper |
- IDIVL of oper |
+ ADD of oper * oper |
+ IDIV of oper |
NEG of oper |
- NOTL of oper |
- SALL of oper * oper |
- SARL of oper * oper |
- ANDL of oper * oper |
- ORL of oper * oper |
- XORL of oper * oper |
- CMPL of oper * 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 |
- SETNE of oper |
- SETE of oper |
- SETLE of oper |
- SETL of oper |
- SETGE of oper |
- SETG of oper |
+ SETcc of cc * oper |
JMP of Label.label |
- JE of Label.label |
- JNE of Label.label |
- MOVZBL of oper * oper |
+ 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 *)
- fun regname EAX = "eax"
- | regname EBX = "ebx"
- | regname ECX = "ecx"
- | regname EDX = "edx"
- | regname ESI = "esi"
- | regname EDI = "edi"
- | regname EBP = "ebp"
- | regname RSP = "rsp"
- | regname R8D = "r8d"
- | regname R9D = "r9d"
- | regname R10D = "r10d"
- | regname R11D = "r11d"
- | regname R12D = "r12d"
- | regname R13D = "r13d"
- | regname R14D = "r14d"
- | regname R15D = "r15d"
+ 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")) ];
- (* like regname, but for the byte name *)
- fun regnameb EAX = "al"
- | regnameb EBX = "bl"
- | regnameb ECX = "cl"
- | regnameb EDX = "dl"
- | regnameb ESI = "sil"
- | regnameb EDI = "dil"
- | regnameb EBP = "bpl"
- | regnameb RSP = "spl"
- | regnameb R8D = "r8b"
- | regnameb R9D = "r9b"
- | regnameb R10D = "r10b"
- | regnameb R11D = "r11b"
- | regnameb R12D = "r12b"
- | regnameb R13D = "r13b"
- | regnameb R14D = "r14b"
- | regnameb R15D = "r15b"
+ fun regname sz reg =
+ let
+ 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
+ end
+
+ fun ccname E = "e"
+ | ccname NE = "ne"
+ | ccname GE = "ge"
+ | ccname LE = "le"
+ | ccname G = "g"
+ | ccname L = "l"
(* gives number (color) associated with reg *)
fun regtonum EAX = 0
- | regtonum EBX = 1
- | regtonum ECX = 2
- | regtonum EDX = 3
- | regtonum ESI = 4
- | regtonum EDI = 5
- | regtonum R8D = 6
- | regtonum R9D = 7
- | regtonum R10D = 8
- | regtonum R11D = 9
+ | 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 R12D = 10
| regtonum R13D = 11
| regtonum R14D = 12
(* gives reg associated with number (color) *)
fun numtoreg 0 = EAX
- | numtoreg 1 = EBX
- | numtoreg 2 = ECX
- | numtoreg 3 = EDX
- | numtoreg 4 = ESI
- | numtoreg 5 = EDI
- | numtoreg 6 = R8D
- | numtoreg 7 = R9D
- | numtoreg 8 = R10D
- | numtoreg 9 = R11D
+ | 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 = R12D
| numtoreg 11 = R13D
| numtoreg 12 = R14D
| cmpoper (REL _, _) = LESS
| cmpoper (_, _) = GREATER
- fun opereq (a, b) = cmpoper (a, b) = EQUAL
+ 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
+ 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 ((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 ((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)
+ | opsused ((SIZE (_, i))::l) = opsused (i::l)
(* integer tostring, except with more - and less ~ *)
fun moreDifferentToString (i) =
else "-" ^ (Int.toString (~i))
(* pretty prints an operand *)
- fun prettyprint_oper (REG r) = "%" ^ (regname r)
- | prettyprint_oper (TEMP t) = Temp.name t
- | prettyprint_oper (CONST c) = "$0x" ^ (Word32.toString c)
- | prettyprint_oper (REL (r, i)) = (moreDifferentToString i) ^ "(%" ^ (regname r) ^ ")"
-
- (* pretty prints an operand as a byte *)
- fun prettyprint_operb (REG r) = "%" ^ (regnameb r)
- | prettyprint_operb (TEMP t) = Temp.name t ^ "b"
- | prettyprint_operb (CONST c) = "$0x" ^ (Word32.toString (c mod 0w32))
- | prettyprint_operb x = prettyprint_oper x
+ 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
(* pretty prints (no...) *)
- fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
- | prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
- | prettyprint (LABEL(l)) = Label.name l ^ "\n"
- | prettyprint (MOVL(src, dst)) = "\tMOVL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (SUBL(src, dst)) = "\tSUBL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (IMUL(src, dst)) = "\tIMUL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (IMUL3(dst, tmp, const)) = "\tIMUL\t" ^ (prettyprint_oper (CONST const)) ^ ", " ^ (prettyprint_oper tmp) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (ADDL(src, dst)) = "\tADDL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (IDIVL(src)) = "\tIDIVL\t" ^ (prettyprint_oper src) ^ "\n"
- | prettyprint (NEG (src)) = "\tNEG\t" ^ (prettyprint_oper src) ^ "\n"
- | prettyprint (NOTL (src)) = "\tNOTL\t" ^ (prettyprint_oper src) ^ "\n"
- | prettyprint (SALL (dst, shft)) = "\tSALL\t" ^ (prettyprint_oper dst) ^ ", " ^ (prettyprint_operb shft) ^ "\n"
- | prettyprint (SARL (dst, shft)) = "\tSARL\t" ^ (prettyprint_oper dst) ^ ", " ^ (prettyprint_operb shft) ^ "\n"
- | prettyprint (ANDL(src, dst)) = "\tANDL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (ORL(src, dst)) = "\tORL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (XORL(src, dst)) = "\tXORL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (CMPL(src, dst)) = "\tCMPL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (TEST(src, dst)) = "\tTEST\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (SETNE(dst)) = "\tSETNE\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (SETE(dst)) = "\tSETE\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (SETLE(dst)) = "\tSETLE\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (SETL(dst)) = "\tSETL\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (SETGE(dst)) = "\tSETGE\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (SETG(dst)) = "\tSETG\t" ^ (prettyprint_operb dst) ^ "\n"
- | prettyprint (JMP(label)) = "\tJMP\t" ^ (Label.name label) ^ "\n"
- | prettyprint (JE(label)) = "\tJE\t" ^ (Label.name label) ^ "\n"
- | prettyprint (JNE(label)) = "\tJNE\t" ^ (Label.name label) ^ "\n"
- | prettyprint (MOVZBL(src, dst)) = "\tMOVZBL\t" ^ (prettyprint_operb src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
- | prettyprint (CLTD) = "\tCLTD\n"
- | prettyprint (RET) = "\tRET\n"
-(* | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: unknown instruction")*)
+ 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?")*)
end
git.joshuawise.com / snipe.git / blobdiff