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