+++ /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
git.joshuawise.com / snipe.git / blobdiff