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 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 *)
  17   datatype insn =
  18     DIRECTIVE of string |
  19     COMMENT of string |
  20     LABEL of Label.label |
  21     SIZE of size * insn |
  22     MOV 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 cmpoper : oper * oper -> order
  52   val opereq : oper * oper -> bool
  53   val regname : size -> reg -> string
  54   val regtonum : reg -> int
  55   val numtoreg : int -> reg
  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
  60 end
  61
  62 structure x86 :> X86 =
  63 struct
  64
  65
  66   datatype reg =
  67     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
  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
  71   datatype insn =
  72     DIRECTIVE of string |
  73     COMMENT of string |
  74     LABEL of Label.label |
  75     SIZE of size * insn |
  76     MOV of oper * oper |
  77     SUB of oper * oper |
  78     IMUL of oper * oper |
  79     IMUL3 of oper * oper * Word32.word |
  80     ADD of oper * oper |
  81     IDIV of oper |
  82     NEG of oper |
  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 |
  90     TEST of oper * oper |
  91     SETcc of cc * oper |
  92     JMP of Label.label |
  93     Jcc of cc * Label.label |
  94     CALL of Symbol.symbol * int |
  95     MOVZB of oper * oper |
  96     CLTD |
  97     LIVEIGN of insn |
  98     RET
  99
 100   type func = Ast.ident * insn list
 101
 102   (* gives name of reg *)
 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")) ];
 120
 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"
 138
 139   (* gives number (color) associated with reg *)
 140   fun regtonum EAX = 0
 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
 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
 156
 157   (* gives reg associated with number (color) *)
 158   fun numtoreg 0 = EAX
 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
 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))
 173
 174   (* register compare *)
 175   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
 176
 177   (* operand compare; arbitrary order imposed to make
 178    * various things easier (e.g. liveness, for sorting)
 179    *)
 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
 195
 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)
 241
 242   (* integer tostring, except with more - and less ~ *)
 243   fun moreDifferentToString (i) =
 244        if (i >= 0) then Int.toString i
 245        else "-" ^ (Int.toString (~i))
 246
 247   (* pretty prints an operand *)
 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
 259
 260   (* pretty prints (no...) *)
 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?")*)
 289 end