codegen/x86.sml

   1 (* L3 compiler
   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
   7 signature X86 =
   8 sig
   9   (* register type *)
  10   datatype reg =
  11     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
  12   (* operands to instructions *)
  13   datatype size = Byte | Word | Long | Qword
  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)
  15   datatype cc = E | NE | GE | LE | L | G
  16   (* instructions *)
  17   datatype insn =
  18     DIRECTIVE of string |
  19     COMMENT of string |
  20     LABEL of Label.label |
  21     MOV of oper * oper |
  22     LEA of oper * oper |
  23     SUB of oper * oper |
  24     IMUL of oper * oper |
  25     IMUL3 of oper * oper * Word32.word |
  26     ADD of oper * oper |
  27     IDIV of oper |
  28     NEG of oper |
  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 |
  36     TEST of oper * oper |
  37     SETcc of cc * oper |
  38     JMP of Label.label |
  39     Jcc of cc * Label.label |
  40     CALL of Symbol.symbol * int |
  41     MOVZB of oper * oper |
  42     CLTD |
  43     LIVEIGN of insn |
  44     RET
  45
  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
  51   val sts : int -> size
  52   val sizeoper : oper -> size * oper
  53   val stripsize : oper -> oper
  54   val osize : oper -> size
  55   val cmpoper : oper * oper -> order
  56   val opereq : oper * oper -> bool
  57   val regname : size -> reg -> string
  58   val regtonum : reg -> int
  59   val numtoreg : int -> reg
  60   val ccname : cc -> string
  61   val opsused : insn list -> OperSet.set
  62   val prettyprint_oper : size -> oper -> string
  63   val prettyprint : insn -> string
  64 end
  65
  66 structure x86 :> X86 =
  67 struct
  68
  69
  70   datatype reg =
  71     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
  72   datatype size = Byte | Word | Long | Qword
  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)
  74   datatype cc = E | NE | GE | LE | L | G
  75   datatype insn =
  76     DIRECTIVE of string |
  77     COMMENT of string |
  78     LABEL of Label.label |
  79     MOV of oper * oper |
  80     LEA of oper * oper |
  81     SUB of oper * oper |
  82     IMUL of oper * oper |
  83     IMUL3 of oper * oper * Word32.word |
  84     ADD of oper * oper |
  85     IDIV of oper |
  86     NEG of oper |
  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 |
  94     TEST of oper * oper |
  95     SETcc of cc * oper |
  96     JMP of Label.label |
  97     Jcc of cc * Label.label |
  98     CALL of Symbol.symbol * int |
  99     MOVZB of oper * oper |
 100     CLTD |
 101     LIVEIGN of insn |
 102     RET
 103
 104   type func = Ast.ident * insn list
 105
 106   (* gives name of reg *)
 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")) ];
 124
 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"
 142
 143   (* gives number (color) associated with reg *)
 144   fun regtonum EAX = 0
 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
 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
 160
 161   (* gives reg associated with number (color) *)
 162   fun numtoreg 0 = EAX
 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
 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))
 177
 178   (* register compare *)
 179   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
 180
 181   (* operand compare; arbitrary order imposed to make
 182    * various things easier (e.g. liveness, for sorting)
 183    *)
 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
 189           val order1 = cmpoper (r1, r2)
 190           val order2 = cmpoper (i1, i2)
 191         in
 192           if (order1 = EQUAL) then order2
 193           else order1
 194         end
 195     | cmpoper (CONST _, _) = LESS
 196     | cmpoper (REG _, _) = LESS
 197     | cmpoper (REL _, _) = LESS
 198     | cmpoper (_, _) = GREATER
 199
 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
 203     | opereq (REL (a1, b1), REL (a2, b2)) = opereq (a1,a2) andalso opereq (b1,b2)
 204 (*    | opereq (OSIZE (s1, o1), OSIZE (s2, o2)) = (s1 = s2) andalso opereq (o1, o2)*) (* This breaks the peepholer, shit *)
 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])
 223     | opsused ((LEA (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
 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)
 246
 247   fun sts 8 = Qword
 248     | sts 4 = Long
 249     | sts 2 = Word
 250     | sts 1 = Byte
 251     | sts _ = raise ErrorMsg.InternalError "invalid size"
 252
 253   (* pretty prints an operand *)
 254   fun sfx Byte = "b"
 255     | sfx Word = "w"
 256     | sfx Long = "l"
 257     | sfx Qword = "q"
 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
 268   fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
 269     | prettyprint_oper _ (TEMP t) = (Temp.name t) ^ (sfx (sts (Temp.size t)))
 270     | prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
 271     | prettyprint_oper _ (REL (r, CONST n)) = (Word32Signed.toString n) ^ "(" ^ (prettyprint_oper Qword r) ^ ")"
 272     | prettyprint_oper s (REL (r1, r2)) = "(" ^ (prettyprint_oper Qword (stripsize r1)) ^ "," ^ (prettyprint_oper Qword (stripsize r2)) ^ ")"
 273     | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
 274     | prettyprint_oper _ (OSIZE (s, oo)) = prettyprint_oper s (stripsize oo)
 275
 276   (* pretty prints (no...) *)
 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
 304 (*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
 305 end