]> Joshua Wise's Git repositories - snipe.git/blobdiff - codegen/x86.sml
git.joshuawise.com / snipe.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Initial import of l4c
[snipe.git] / codegen / x86.sml
diff --git a/codegen/x86.sml b/codegen/x86.sml
index 6ec426375fccc37b37c302cbdc1f84674085a742..e54d4beb2b0ec77085398cf5368e31670df14413 100644 (file)
--- a/codegen/x86.sml
+++ b/codegen/x86.sml
@@ -10,16 +10,16 @@ sig
   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
   (* operands to instructions *)
   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
   datatype size = Byte | Word | Long | Qword
+  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (oper * oper) | STACKARG of int | OSIZE of (size * oper)
+  datatype cc = E | NE | GE | LE | L | G
   (* instructions *)
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
   (* instructions *)
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
-    SIZE of size * insn |
     MOV of oper * oper |
     MOV of oper * oper |
+    LEA of oper * oper |
     SUB of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     SUB of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
@@ -48,6 +48,10 @@ sig
   structure LiveMap : ORD_MAP
     where type Key.ord_key = int;
   
   structure LiveMap : ORD_MAP
     where type Key.ord_key = int;
   
+  val sts : int -> size
+  val sizeoper : oper -> size * oper
+  val stripsize : oper -> oper
+  val osize : oper -> size
   val cmpoper : oper * oper -> order
   val opereq : oper * oper -> bool
   val regname : size -> reg -> string
   val cmpoper : oper * oper -> order
   val opereq : oper * oper -> bool
   val regname : size -> reg -> string
@@ -56,7 +60,7 @@ sig
   val ccname : cc -> string
   val opsused : insn list -> OperSet.set
   val prettyprint_oper : size -> oper -> string
   val ccname : cc -> string
   val opsused : insn list -> OperSet.set
   val prettyprint_oper : size -> oper -> string
-  val prettyprint : size -> insn -> string
+  val prettyprint : insn -> string
 end
 
 structure x86 :> X86 =
 end
 
 structure x86 :> X86 =
@@ -65,15 +69,15 @@ struct
 
   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
 
   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 size = Byte | Word | Long | Qword
+  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (oper * oper) | STACKARG of int | OSIZE of (size * oper)
+  datatype cc = E | NE | GE | LE | L | G
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
-    SIZE of size * insn |
     MOV of oper * oper |
     MOV of oper * oper |
+    LEA of oper * oper |
     SUB of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     SUB of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
@@ -182,11 +186,11 @@ struct
     | cmpoper (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
     | cmpoper (REL (r1, i1), REL (r2, i2)) =
         let 
     | 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)
+          val order1 = cmpoper (r1, r2)
+          val order2 = cmpoper (i1, i2)
         in
         in
-          if (regorder = EQUAL) then intorder
-          else regorder
+          if (order1 = EQUAL) then order2
+          else order1
         end
     | cmpoper (CONST _, _) = LESS
     | cmpoper (REG _, _) = LESS
         end
     | cmpoper (CONST _, _) = LESS
     | cmpoper (REG _, _) = LESS
@@ -196,7 +200,8 @@ struct
   fun opereq (REG a, REG b) = a = b
     | opereq (TEMP a, TEMP b) = Temp.eq (a, b)
     | opereq (CONST a, CONST b) = a = b
   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 (REL (a1, b1), REL (a2, b2)) = opereq (a1,a2) andalso opereq (b1,b2)
+(*    | opereq (OSIZE (s1, o1), OSIZE (s2, o2)) = (s1 = s2) andalso opereq (o1, o2)*) (* This breaks the peepholer, shit *)
     | opereq (_, _) = false
     
   structure OperSet = ListSetFn (
     | opereq (_, _) = false
     
   structure OperSet = ListSetFn (
@@ -215,6 +220,7 @@ struct
     | opsused ((COMMENT _)::l) = opsused l
     | opsused ((LABEL _)::l) = opsused l
     | opsused ((MOV (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
     | opsused ((COMMENT _)::l) = opsused l
     | opsused ((LABEL _)::l) = opsused l
     | opsused ((MOV (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 ((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])
@@ -237,53 +243,63 @@ struct
     | opsused ((CLTD)::l) = opsused l
     | opsused ((RET)::l) = opsused l
     | opsused ((LIVEIGN i)::l) = opsused (i::l)
     | 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))
+  fun sts 8 = Qword
+    | sts 4 = Long
+    | sts 2 = Word
+    | sts 1 = Byte
+    | sts _ = raise ErrorMsg.InternalError "invalid size"
 
   (* pretty prints an operand *)  
   fun sfx Byte = "b"
     | sfx Word = "w"
     | sfx Long = "l"
     | sfx Qword = "q"
 
   (* pretty prints an operand *)  
   fun sfx Byte = "b"
     | sfx Word = "w"
     | sfx Long = "l"
     | sfx Qword = "q"
-  
+
+  fun osize (OSIZE (s, _)) = s
+    | osize _ = Long
+
+  fun stripsize (OSIZE (_, oo)) = stripsize oo
+    | stripsize oo = oo
+
+  fun sizeoper (OSIZE (s, oo)) = (s, stripsize oo)
+    | sizeoper oo = (Long, oo)
+
   fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
   fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
-    | prettyprint_oper s (TEMP t) = (Temp.name t) ^ (sfx s)
+    | prettyprint_oper _ (TEMP t) = (Temp.name t) ^ (sfx (sts (Temp.size t)))
     | prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
     | 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 _ (REL (r, CONST n)) = (Word32Signed.toString n) ^ "(" ^ (prettyprint_oper Qword r) ^ ")"
+    | prettyprint_oper s (REL (r1, r2)) = "(" ^ (prettyprint_oper Qword (stripsize r1)) ^ "," ^ (prettyprint_oper Qword (stripsize r2)) ^ ")"
     | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
     | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i
+    | prettyprint_oper _ (OSIZE (s, oo)) = prettyprint_oper s (stripsize oo)
 
   (* pretty prints (no...) *)
 
   (* 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
+  fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
+    | prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
+    | prettyprint (LABEL(l)) = Label.name l ^ ":\n"
+    | prettyprint (LEA(dst, src)) = "\tlea" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (MOV(dst, src)) = "\tmov" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (SUB(dst, src)) = "\tsub" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (IMUL(dst, src)) = "\timul" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | 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"
+    | prettyprint (ADD(dst, src)) = "\tadd" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (IDIV(src)) = "\tidiv" ^ (sfx (osize src)) ^ "\t" ^ (prettyprint_oper (osize src) src) ^ "\n"
+    | prettyprint (NEG (dst)) = "\tneg" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (NOT (dst)) = "\tnot" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (SAL (dst, shft)) = "\tsal" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (SAR (dst, shft)) = "\tsar" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (AND (dst, src)) = "\tand" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (OR (dst, src)) = "\tor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (XOR (dst, src)) = "\txor" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (CMP (dst, src)) = "\tcmp" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (TEST (dst, src)) = "\ttest" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper (osize dst) (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (prettyprint_oper Byte (stripsize dst)) ^ "\n"
+    | prettyprint (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n"
+    | prettyprint (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n"
+    | prettyprint (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n"
+    | prettyprint (MOVZB (dst, src)) = "\tmovzb" ^ (sfx (osize dst)) ^ "\t" ^ (prettyprint_oper Byte (stripsize src)) ^ ", " ^ (prettyprint_oper Long dst) ^ "\n"
+    | prettyprint (CLTD) = "\tcltd\n"
+    | prettyprint (RET) = "\tret\n"
+    | prettyprint (LIVEIGN i) = prettyprint i
 (*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
 end
 (*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)
 end
Compiler for a C-like language written in SML
This page took 0.03215 seconds and 4 git commands to generate.