codegen/x86.sml

   1 signature X86 =
   2 sig
   3   datatype reg =
   4     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
   5   datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int)
   6   datatype insn =
   7     DIRECTIVE of string |
   8     COMMENT of string |
   9     MOVL of oper * oper |
  10     SUBL of oper * oper |
  11     IMUL of oper * oper |
  12     IMUL3 of oper * oper * Word32.word |
  13     ADDL of oper * oper |
  14     LEAL of oper * oper * oper |
  15     IDIVL of oper |
  16     NEG of oper |
  17     CLTD |
  18     RET
  19
  20   val cmpoper : oper * oper -> order
  21   val opereq : oper * oper -> bool
  22   val regname : reg -> string
  23   val regtonum : reg -> int
  24   val numtoreg : int -> reg
  25   val prettyprint_oper : oper -> string
  26   val prettyprint : insn -> string
  27 end
  28
  29 structure x86 :> X86 =
  30 struct
  31   datatype reg =
  32     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
  33   datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int)
  34   datatype insn =
  35     DIRECTIVE of string |
  36     COMMENT of string |
  37     MOVL of oper * oper |
  38     SUBL of oper * oper |
  39     IMUL of oper * oper |
  40     IMUL3 of oper * oper * Word32.word |
  41     ADDL of oper * oper |
  42     LEAL of oper * oper * oper |
  43     IDIVL of oper |
  44     NEG of oper |
  45     CLTD |
  46     RET
  47
  48   fun regname EAX = "eax"
  49     | regname EBX = "ebx"
  50     | regname ECX = "ecx"
  51     | regname EDX = "edx"
  52     | regname ESI = "esi"
  53     | regname EDI = "edi"
  54     | regname EBP = "ebp"
  55     | regname RSP = "rsp"
  56     | regname R8D = "r8d"
  57     | regname R9D = "r9d"
  58     | regname R10D = "r10d"
  59     | regname R11D = "r11d"
  60     | regname R12D = "r12d"
  61     | regname R13D = "r13d"
  62     | regname R14D = "r14d"
  63     | regname R15D = "r15d"
  64
  65   fun regtonum EAX = 0
  66     | regtonum EBX = 1
  67     | regtonum ECX = 2
  68     | regtonum EDX = 3
  69     | regtonum ESI = 4
  70     | regtonum EDI = 5
  71     | regtonum R8D = 6
  72     | regtonum R9D = 7
  73     | regtonum R10D = 8
  74     | regtonum R11D = 9
  75     | regtonum R12D = 10
  76     | regtonum R13D = 11
  77     | regtonum R14D = 12
  78     | regtonum R15D = 13
  79     | regtonum EBP = 14         (* Dummy numbers -- not permitted for allocation, but there so that we can compare *)
  80     | regtonum RSP = 15
  81
  82   fun numtoreg 0 = EAX
  83     | numtoreg 1 = EBX
  84     | numtoreg 2 = ECX
  85     | numtoreg 3 = EDX
  86     | numtoreg 4 = ESI
  87     | numtoreg 5 = EDI
  88     | numtoreg 6 = R8D
  89     | numtoreg 7 = R9D
  90     | numtoreg 8 = R10D
  91     | numtoreg 9 = R11D
  92     | numtoreg 10 = R12D
  93     | numtoreg 11 = R13D
  94     | numtoreg 12 = R14D
  95     | numtoreg 13 = R15D
  96     | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Unknown register "^(Int.toString n))
  97
  98   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
  99
 100   fun cmpoper (REG(reg1), REG(reg2)) = regcmp (reg1, reg2)
 101     | cmpoper (TEMP(temp1), TEMP(temp2)) = Temp.compare (temp1,temp2)
 102     | cmpoper (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
 103     | cmpoper (REL (r1, i1), REL (r2, i2)) =
 104         let
 105           val regorder = regcmp (r1, r2)
 106           val intorder = Int.compare (i1, i2)
 107         in
 108           if (regorder = EQUAL) then intorder
 109           else regorder
 110         end
 111     | cmpoper (CONST _, _) = LESS
 112     | cmpoper (REG _, _) = LESS
 113     | cmpoper (REL _, _) = LESS
 114     | cmpoper (_, _) = GREATER
 115
 116   fun opereq (a, b) = cmpoper (a, b) = EQUAL
 117
 118   fun moreDifferentToString (i) =
 119        if (i >= 0) then Int.toString i
 120        else "-" ^ (Int.toString (~i))
 121
 122   fun prettyprint_oper (REG r) = "%" ^ (regname r)
 123     | prettyprint_oper (TEMP t) = Temp.name t
 124     | prettyprint_oper (CONST c) = "$0x" ^ (Word32.toString c)
 125     | prettyprint_oper (REL (r, i)) = (moreDifferentToString i) ^ "(%" ^ (regname r) ^ ")"
 126
 127   fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
 128     | prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
 129     | prettyprint (MOVL(src, dst)) = "\tMOVL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
 130     | prettyprint (SUBL(src, dst)) = "\tSUBL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
 131     | prettyprint (IMUL(src, dst)) = "\tIMUL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
 132     | prettyprint (IMUL3(dst, tmp, const)) = "\tIMUL\t" ^ (prettyprint_oper (CONST const)) ^ ", " ^ (prettyprint_oper tmp) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
 133     | prettyprint (ADDL(src, dst)) = "\tADDL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
 134     | prettyprint (LEAL(src1, src2, dst)) = "\tLEAL\t(" ^ (prettyprint_oper src1) ^ "," ^ (prettyprint_oper src2) ^ ")," ^ (prettyprint_oper dst) ^ "\n"
 135     | prettyprint (IDIVL(src)) = "\tIDIVL\t" ^ (prettyprint_oper src) ^ "\n"
 136     | prettyprint (NEG (src)) = "\tNEG\t" ^ (prettyprint_oper src) ^ "\n"
 137     | prettyprint (CLTD) = "\tCLTD\n"
 138     | prettyprint (RET) = "\tRET\n"
 139 (*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: unknown instruction")*)
 140 end