[snipe.git] / codegen / x86.sml

(* 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 size = Byte | Word | Long | Qword
  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (oper * oper) | STACKARG of int | OSIZE of (size * oper)
  datatype cc = E | NE | GE | LE | L | G
  (* instructions *)
  datatype insn =
    DIRECTIVE of string |
    COMMENT of string |
    LABEL of Label.label |
    MOV 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 |
    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 = oper;
  structure LiveMap : ORD_MAP
    where type Key.ord_key = int;
  
  val sts : int -> size
  val sizeoper : oper -> size * oper
  val stripsize : oper -> oper
  val osize : oper -> size
  val cmpoper : oper * oper -> order
  val opereq : oper * oper -> bool
  val regname : 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 : 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 size = Byte | Word | Long | Qword
  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (oper * oper) | STACKARG of int | OSIZE of (size * oper)
  datatype cc = E | NE | GE | LE | L | G
  datatype insn =
    DIRECTIVE of string |
    COMMENT of string |
    LABEL of Label.label |
    MOV 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 |
    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 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 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
    | regtonum R15D = 13
    | regtonum EBP = 14		(* Dummy numbers -- not permitted for allocation, but there so that we can compare *)
    | 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 = R12D
    | numtoreg 11 = R13D
    | numtoreg 12 = R14D
    | numtoreg 13 = R15D
    | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Unknown 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 (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
    | cmpoper (REL (r1, i1), REL (r2, i2)) =
        let 
          val order1 = cmpoper (r1, r2)
          val order2 = cmpoper (i1, i2)
        in
          if (order1 = EQUAL) then order2
          else order1
        end
    | cmpoper (CONST _, _) = LESS
    | cmpoper (REG _, _) = LESS
    | cmpoper (REL _, _) = LESS
    | cmpoper (_, _) = GREATER

  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 (a1, b1), REL (a2, b2)) = opereq (a1,a2) andalso opereq (b1,b2)
(*    | opereq (OSIZE (s1, o1), OSIZE (s2, o2)) = (s1 = s2) andalso opereq (o1, o2)*) (* This breaks the peepholer, shit *)
    | 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 ((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 ((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 sts 8 = Qword
    | sts 4 = Long
    | sts 2 = Word
    | sts 1 = Byte
    | sts _ = raise ErrorMsg.InternalError "invalid size"

  (* pretty prints an operand *)  
  fun sfx Byte = "b"
    | sfx Word = "w"
    | sfx Long = "l"
    | sfx Qword = "q"

  fun osize (OSIZE (s, _)) = s
    | osize _ = Long

  fun stripsize (OSIZE (_, oo)) = stripsize oo
    | stripsize oo = oo

  fun sizeoper (OSIZE (s, oo)) = (s, stripsize oo)
    | sizeoper oo = (Long, oo)

  fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
    | prettyprint_oper _ (TEMP t) = (Temp.name t) ^ (sfx (sts (Temp.size t)))
    | prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
    | prettyprint_oper _ (REL (r, CONST n)) = (Word32Signed.toString n) ^ "(" ^ (prettyprint_oper Qword r) ^ ")"
    | prettyprint_oper s (REL (r1, r2)) = "(" ^ (prettyprint_oper Qword (stripsize r1)) ^ "," ^ (prettyprint_oper Qword (stripsize r2)) ^ ")"
    | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
    | prettyprint_oper _ (OSIZE (s, oo)) = prettyprint_oper s (stripsize oo)

  (* pretty prints (no...) *)
  fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
    | prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
    | prettyprint (LABEL(l)) = Label.name l ^ ":\n"
    | prettyprint (LEA(dst, src)) = "\tlea" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (MOV(dst, src)) = "\tmov" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (SUB(dst, src)) = "\tsub" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (IMUL(dst, src)) = "\timul" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (IMUL3(dst, tmp, const)) = "\timul" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (CONST const)) ^ ", " ^ (prettyprint_oper (osize dst) (stripsize tmp)) ^ ", " ^ (prettyprint_oper (osize dst) dst) ^ "\n"
    | prettyprint (ADD(dst, src)) = "\tadd" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (IDIV(src)) = "\tidiv" ^ (sfx (osize src)) ^ "\t" ^ (prettyprint_oper (osize src) src) ^ "\n"
    | prettyprint (NEG (dst)) = "\tneg" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (NOT (dst)) = "\tnot" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (SAL (dst, shft)) = "\tsal" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (SAR (dst, shft)) = "\tsar" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (AND (dst, src)) = "\tand" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (OR (dst, src)) = "\tor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (XOR (dst, src)) = "\txor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (CMP (dst, src)) = "\tcmp" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (TEST (dst, src)) = "\ttest" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (prettyprint_oper Byte (stripsize dst)) ^ "\n"
    | prettyprint (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n"
    | prettyprint (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n"
    | prettyprint (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n"
    | prettyprint (MOVZB (dst, src)) = "\tmovzb" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
    | prettyprint (CLTD) = "\tcltd\n"
    | prettyprint (RET) = "\tret\n"
    | prettyprint (LIVEIGN i) = prettyprint i
(*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
end
Commit	Line	Data
6ade8b0a	1	(* L3 compiler
0a24e44d JW	2	* X86 instruction/operand internal representation and manipulation
	3	* Author: Joshua Wise <jwise@andrew.cmu.edu>
	4	* Author: Chris Lu <czl@andrew.cmu.edu>
	5	*)
	6
12aa4087 JW	7	signature X86 =
12aa4087 JW	8	sig
0a24e44d	9	(* register type *)
12aa4087 JW	10	datatype reg =
12aa4087 JW	11	EAX \| EBX \| ECX \| EDX \| ESI \| EDI \| EBP \| RSP \| R8D \| R9D \| R10D \| R11D \| R12D \| R13D \| R14D \| R15D
0a24e44d	12	(* operands to instructions *)
6ade8b0a	13	datatype size = Byte \| Word \| Long \| Qword
1144856b JW	14	datatype oper = REG of reg \| TEMP of Temp.temp \| CONST of Word32.word \| REL of (oper * oper) \| STACKARG of int \| OSIZE of (size * oper)
1144856b JW	15	datatype cc = E \| NE \| GE \| LE \| L \| G
6ade8b0a	16	(* instructions *)
12aa4087 JW	17	datatype insn =
	18	DIRECTIVE of string \|
	19	COMMENT of string \|
0a24e44d	20	LABEL of Label.label \|
6ade8b0a	21	MOV of oper * oper \|
1144856b	22	LEA of oper * oper \|
6ade8b0a	23	SUB of oper * oper \|
12aa4087 JW	24	IMUL of oper * oper \|
12aa4087 JW	25	IMUL3 of oper * oper * Word32.word \|
6ade8b0a JW	26	ADD of oper * oper \|
6ade8b0a JW	27	IDIV of oper \|
12aa4087	28	NEG of oper \|
6ade8b0a JW	29	NOT of oper \|
	30	SAL of oper * oper \|
	31	SAR of oper * oper \|
	32	AND of oper * oper \|
	33	OR of oper * oper \|
	34	XOR of oper * oper \|
	35	CMP of oper * oper \|
0a24e44d	36	TEST of oper * oper \|
6ade8b0a	37	SETcc of cc * oper \|
0a24e44d	38	JMP of Label.label \|
6ade8b0a JW	39	Jcc of cc * Label.label \|
	40	CALL of Symbol.symbol * int \|
	41	MOVZB of oper * oper \|
12aa4087	42	CLTD \|
6ade8b0a	43	LIVEIGN of insn \|
12aa4087 JW	44	RET
12aa4087 JW	45
6ade8b0a JW	46	structure OperSet : ORD_SET
	47	where type Key.ord_key = oper;
	48	structure LiveMap : ORD_MAP
	49	where type Key.ord_key = int;
	50
1144856b JW	51	val sts : int -> size
	52	val sizeoper : oper -> size * oper
	53	val stripsize : oper -> oper
	54	val osize : oper -> size
12aa4087 JW	55	val cmpoper : oper * oper -> order
12aa4087 JW	56	val opereq : oper * oper -> bool
6ade8b0a	57	val regname : size -> reg -> string
12aa4087 JW	58	val regtonum : reg -> int
12aa4087 JW	59	val numtoreg : int -> reg
6ade8b0a JW	60	val ccname : cc -> string
	61	val opsused : insn list -> OperSet.set
	62	val prettyprint_oper : size -> oper -> string
1144856b	63	val prettyprint : insn -> string
12aa4087 JW	64	end
	65
	66	structure x86 :> X86 =
	67	struct
6ade8b0a JW	68
6ade8b0a JW	69
12aa4087 JW	70	datatype reg =
12aa4087 JW	71	EAX \| EBX \| ECX \| EDX \| ESI \| EDI \| EBP \| RSP \| R8D \| R9D \| R10D \| R11D \| R12D \| R13D \| R14D \| R15D
6ade8b0a	72	datatype size = Byte \| Word \| Long \| Qword
1144856b JW	73	datatype oper = REG of reg \| TEMP of Temp.temp \| CONST of Word32.word \| REL of (oper * oper) \| STACKARG of int \| OSIZE of (size * oper)
1144856b JW	74	datatype cc = E \| NE \| GE \| LE \| L \| G
12aa4087 JW	75	datatype insn =
	76	DIRECTIVE of string \|
	77	COMMENT of string \|
0a24e44d	78	LABEL of Label.label \|
6ade8b0a	79	MOV of oper * oper \|
1144856b	80	LEA of oper * oper \|
6ade8b0a	81	SUB of oper * oper \|
12aa4087 JW	82	IMUL of oper * oper \|
12aa4087 JW	83	IMUL3 of oper * oper * Word32.word \|
6ade8b0a JW	84	ADD of oper * oper \|
6ade8b0a JW	85	IDIV of oper \|
12aa4087	86	NEG of oper \|
6ade8b0a JW	87	NOT of oper \|
	88	SAL of oper * oper \|
	89	SAR of oper * oper \|
	90	AND of oper * oper \|
	91	OR of oper * oper \|
	92	XOR of oper * oper \|
	93	CMP of oper * oper \|
0a24e44d	94	TEST of oper * oper \|
6ade8b0a	95	SETcc of cc * oper \|
0a24e44d	96	JMP of Label.label \|
6ade8b0a JW	97	Jcc of cc * Label.label \|
	98	CALL of Symbol.symbol * int \|
	99	MOVZB of oper * oper \|
12aa4087	100	CLTD \|
6ade8b0a	101	LIVEIGN of insn \|
12aa4087	102	RET
6ade8b0a JW	103
6ade8b0a JW	104	type func = Ast.ident * insn list
0a24e44d JW	105
0a24e44d JW	106	(* gives name of reg *)
6ade8b0a JW	107	val regnames =
	108	[ (EAX, ("al", "ax", "eax", "rax")),
	109	(EBX, ("bl", "bx", "ebx", "rbx")),
	110	(ECX, ("cl", "cx", "ecx", "rcx")),
	111	(EDX, ("dl", "dx", "edx", "rdx")),
	112	(ESI, ("sil", "si", "esi", "rsi")),
	113	(EDI, ("dil", "di", "edi", "rdi")),
	114	(EBP, ("bpl", "bp", "ebp", "rbp")),
	115	(RSP, ("spl", "sp", "esp", "rsp")),
	116	(R8D, ("r8b", "r8w", "r8d", "r8")),
	117	(R9D, ("r9b", "r9w", "r9d", "r9")),
	118	(R10D, ("r10b", "r10w", "r10d", "r10")),
	119	(R11D, ("r11b", "r11w", "r11d", "r11")),
	120	(R12D, ("r12b", "r12w", "r12d", "r12")),
	121	(R13D, ("r13b", "r13w", "r13d", "r13")),
	122	(R14D, ("r14b", "r14w", "r14d", "r14")),
	123	(R15D, ("r15b", "r15w", "r15d", "r15")) ];
0a24e44d	124
6ade8b0a JW	125	fun regname sz reg =
	126	let
	127	val (n, (b, w, l, q)) = valOf (List.find (fn (r, _) => r = reg) regnames)
	128	in
	129	case sz
	130	of Byte => b
	131	\| Word => w
	132	\| Long => l
	133	\| Qword => q
	134	end
	135
	136	fun ccname E = "e"
	137	\| ccname NE = "ne"
	138	\| ccname GE = "ge"
	139	\| ccname LE = "le"
	140	\| ccname G = "g"
	141	\| ccname L = "l"
0a24e44d JW	142
0a24e44d JW	143	(* gives number (color) associated with reg *)
12aa4087	144	fun regtonum EAX = 0
6ade8b0a JW	145	\| regtonum ESI = 1
	146	\| regtonum EDI = 2
	147	\| regtonum ECX = 3
	148	\| regtonum R8D = 4
	149	\| regtonum R9D = 5
	150	\| regtonum EDX = 6
	151	\| regtonum R10D = 7
	152	\| regtonum R11D = 8
	153	\| regtonum EBX = 9
12aa4087 JW	154	\| regtonum R12D = 10
	155	\| regtonum R13D = 11
	156	\| regtonum R14D = 12
	157	\| regtonum R15D = 13
	158	\| regtonum EBP = 14 (* Dummy numbers -- not permitted for allocation, but there so that we can compare *)
	159	\| regtonum RSP = 15
0a24e44d JW	160
0a24e44d JW	161	(* gives reg associated with number (color) *)
12aa4087	162	fun numtoreg 0 = EAX
6ade8b0a JW	163	\| numtoreg 1 = ESI
	164	\| numtoreg 2 = EDI
	165	\| numtoreg 3 = ECX
	166	\| numtoreg 4 = R8D
	167	\| numtoreg 5 = R9D
	168	\| numtoreg 6 = EDX
	169	\| numtoreg 7 = R10D
	170	\| numtoreg 8 = R11D
	171	\| numtoreg 9 = EBX
12aa4087 JW	172	\| numtoreg 10 = R12D
	173	\| numtoreg 11 = R13D
	174	\| numtoreg 12 = R14D
	175	\| numtoreg 13 = R15D
	176	\| numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Unknown register "^(Int.toString n))
0a24e44d JW	177
0a24e44d JW	178	(* register compare *)
12aa4087 JW	179	fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
12aa4087 JW	180
0a24e44d JW	181	(* operand compare; arbitrary order imposed to make
	182	* various things easier (e.g. liveness, for sorting)
	183	*)
12aa4087 JW	184	fun cmpoper (REG(reg1), REG(reg2)) = regcmp (reg1, reg2)
	185	\| cmpoper (TEMP(temp1), TEMP(temp2)) = Temp.compare (temp1,temp2)
	186	\| cmpoper (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
	187	\| cmpoper (REL (r1, i1), REL (r2, i2)) =
	188	let
1144856b JW	189	val order1 = cmpoper (r1, r2)
1144856b JW	190	val order2 = cmpoper (i1, i2)
12aa4087	191	in
1144856b JW	192	if (order1 = EQUAL) then order2
1144856b JW	193	else order1
12aa4087 JW	194	end
	195	\| cmpoper (CONST _, _) = LESS
	196	\| cmpoper (REG _, _) = LESS
	197	\| cmpoper (REL _, _) = LESS
	198	\| cmpoper (_, _) = GREATER
0a24e44d	199
6ade8b0a JW	200	fun opereq (REG a, REG b) = a = b
	201	\| opereq (TEMP a, TEMP b) = Temp.eq (a, b)
	202	\| opereq (CONST a, CONST b) = a = b
1144856b JW	203	\| opereq (REL (a1, b1), REL (a2, b2)) = opereq (a1,a2) andalso opereq (b1,b2)
1144856b JW	204	(* \| opereq (OSIZE (s1, o1), OSIZE (s2, o2)) = (s1 = s2) andalso opereq (o1, o2)) ( This breaks the peepholer, shit *)
6ade8b0a JW	205	\| opereq (_, _) = false
	206
	207	structure OperSet = ListSetFn (
	208	struct
	209	type ord_key = oper
	210	val compare = cmpoper
	211	end)
	212
	213	structure LiveMap = SplayMapFn(struct
	214	type ord_key = int
	215	val compare = Int.compare
	216	end)
	217
	218	fun opsused nil = OperSet.empty
	219	\| opsused ((DIRECTIVE _)::l) = opsused l
	220	\| opsused ((COMMENT _)::l) = opsused l
	221	\| opsused ((LABEL _)::l) = opsused l
	222	\| opsused ((MOV (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
1144856b	223	\| opsused ((LEA (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
6ade8b0a JW	224	\| opsused ((SUB (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	225	\| opsused ((IMUL (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	226	\| opsused ((IMUL3 (dst, src, _))::l) = OperSet.addList (opsused l, [dst, src])
	227	\| opsused ((ADD (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	228	\| opsused ((IDIV (src))::l) = OperSet.addList (opsused l, [src, REG EDX, REG EAX])
	229	\| opsused ((NEG (dst))::l) = OperSet.addList (opsused l, [dst])
	230	\| opsused ((NOT (dst))::l) = OperSet.addList (opsused l, [dst])
	231	\| opsused ((SAL (dst, shft))::l) = OperSet.addList (opsused l, [dst, shft])
	232	\| opsused ((SAR (dst, shft))::l) = OperSet.addList (opsused l, [dst, shft])
	233	\| opsused ((AND (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	234	\| opsused ((OR (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	235	\| opsused ((XOR (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	236	\| opsused ((CMP (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	237	\| opsused ((TEST (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	238	\| opsused ((SETcc (c, dst))::l) = OperSet.addList (opsused l, [dst])
	239	\| opsused ((JMP _)::l) = opsused l
	240	\| opsused ((Jcc _)::l) = opsused l
	241	\| opsused ((CALL _)::l) = opsused l
	242	\| opsused ((MOVZB (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
	243	\| opsused ((CLTD)::l) = opsused l
	244	\| opsused ((RET)::l) = opsused l
	245	\| opsused ((LIVEIGN i)::l) = opsused (i::l)
0a24e44d	246
1144856b JW	247	fun sts 8 = Qword
	248	\| sts 4 = Long
	249	\| sts 2 = Word
	250	\| sts 1 = Byte
	251	\| sts _ = raise ErrorMsg.InternalError "invalid size"
0a24e44d JW	252
0a24e44d JW	253	(* pretty prints an operand *)
6ade8b0a JW	254	fun sfx Byte = "b"
	255	\| sfx Word = "w"
	256	\| sfx Long = "l"
	257	\| sfx Qword = "q"
1144856b JW	258
	259	fun osize (OSIZE (s, _)) = s
	260	\| osize _ = Long
	261
	262	fun stripsize (OSIZE (_, oo)) = stripsize oo
	263	\| stripsize oo = oo
	264
	265	fun sizeoper (OSIZE (s, oo)) = (s, stripsize oo)
	266	\| sizeoper oo = (Long, oo)
	267
6ade8b0a	268	fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
1144856b	269	\| prettyprint_oper _ (TEMP t) = (Temp.name t) ^ (sfx (sts (Temp.size t)))
6ade8b0a	270	\| prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
1144856b JW	271	\| prettyprint_oper _ (REL (r, CONST n)) = (Word32Signed.toString n) ^ "(" ^ (prettyprint_oper Qword r) ^ ")"
1144856b JW	272	\| prettyprint_oper s (REL (r1, r2)) = "(" ^ (prettyprint_oper Qword (stripsize r1)) ^ "," ^ (prettyprint_oper Qword (stripsize r2)) ^ ")"
6ade8b0a	273	\| prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
1144856b	274	\| prettyprint_oper _ (OSIZE (s, oo)) = prettyprint_oper s (stripsize oo)
0a24e44d JW	275
0a24e44d JW	276	(* pretty prints (no...) *)
1144856b JW	277	fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
	278	\| prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
	279	\| prettyprint (LABEL(l)) = Label.name l ^ ":\n"
	280	\| prettyprint (LEA(dst, src)) = "\tlea" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	281	\| prettyprint (MOV(dst, src)) = "\tmov" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	282	\| prettyprint (SUB(dst, src)) = "\tsub" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	283	\| prettyprint (IMUL(dst, src)) = "\timul" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	284	\| prettyprint (IMUL3(dst, tmp, const)) = "\timul" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (CONST const)) ^ ", " ^ (prettyprint_oper (osize dst) (stripsize tmp)) ^ ", " ^ (prettyprint_oper (osize dst) dst) ^ "\n"
	285	\| prettyprint (ADD(dst, src)) = "\tadd" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	286	\| prettyprint (IDIV(src)) = "\tidiv" ^ (sfx (osize src)) ^ "\t" ^ (prettyprint_oper (osize src) src) ^ "\n"
	287	\| prettyprint (NEG (dst)) = "\tneg" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
	288	\| prettyprint (NOT (dst)) = "\tnot" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
	289	\| prettyprint (SAL (dst, shft)) = "\tsal" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	290	\| prettyprint (SAR (dst, shft)) = "\tsar" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	291	\| prettyprint (AND (dst, src)) = "\tand" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	292	\| prettyprint (OR (dst, src)) = "\tor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	293	\| prettyprint (XOR (dst, src)) = "\txor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	294	\| prettyprint (CMP (dst, src)) = "\tcmp" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	295	\| prettyprint (TEST (dst, src)) = "\ttest" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	296	\| prettyprint (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (prettyprint_oper Byte (stripsize dst)) ^ "\n"
	297	\| prettyprint (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n"
	298	\| prettyprint (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n"
	299	\| prettyprint (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n"
	300	\| prettyprint (MOVZB (dst, src)) = "\tmovzb" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
	301	\| prettyprint (CLTD) = "\tcltd\n"
	302	\| prettyprint (RET) = "\tret\n"
	303	\| prettyprint (LIVEIGN i) = prettyprint i
6ade8b0a	304	(* \| prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
12aa4087	305	end