[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 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 |
    SIZE of size * insn |
    MOV 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 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 : 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) | 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 |
    SIZE of size * insn |
    MOV 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 regorder = regcmp (r1, r2)
          val intorder = Int.compare (i1, i2)
        in
          if (regorder = EQUAL) then intorder
          else regorder
        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 (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) =
       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

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