]> Joshua Wise's Git repositories - snipe.git/blobdiff - codegen/solidify.sml
Initial import of l4c
[snipe.git] / codegen / solidify.sml
index 8c39017586297295225d1269b9123463244ac240..21b37bceccae003162161409f75a1bfa92fc1646 100644 (file)
@@ -26,12 +26,12 @@ struct
   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
       (* r14d and r15d is reserved for spilling *)
-      val maxreg = X.regtonum X.R14D
+      val maxreg = X.regtonum X.R13D
       fun numtoreg n =
           if (n > maxreg)
           then raise Spilled
           else X.numtoreg n
-      
+
       fun temptonum (t: T.temp) : int =
         (List.hd
           (List.map (fn (_, n) => n)
@@ -42,9 +42,10 @@ struct
         handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
 
       val spillreg1 = X.R15D
+      val spillreg2 = X.R14D
 
       (* Determine which need to be saved. *)
-      val opsused = map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap
+      val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
       val saveregs = X.OperSet.intersection (
         X.OperSet.addList (X.OperSet.empty, opsused),
         X.OperSet.addList (
@@ -58,99 +59,135 @@ struct
       val savelist = X.OperSet.listItems saveregs
       val nsave = length savelist
 
-      val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)     (* Number of registers used. *)
-      val nspilled = Int.max (numreg - maxreg, 0)      (* Number of spilled registers. *)
-      fun isspilled (X.TEMP temp) = (((temptonum temp) > maxreg) handle Empty => false)        (* Whether a register is spilled *)
+      val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)    (* Number of registers used. *)
+      val nspilled = Int.max (numreg - maxreg, 0)    (* Number of spilled registers. *)
+      fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
         | isspilled (X.STACKARG _) = true
         | isspilled (X.REL _) = true
+        | isspilled (X.OSIZE (_, oo)) = isspilled oo
         | isspilled _ = false
       val stacksz = (nspilled + nsave) * 8
-      fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8   (* Stack position of some register number *)
+      fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
 
       val prologue =
-        (X.SIZE (X.Qword, X.SUB (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))) ::
+        (X.SUB (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))) ::
         (ListPair.map
           (fn (num, reg) =>
-            X.SIZE (X.Qword, X.MOV (X.REL (X.RSP, stacksz - 8*(num+1)), reg)))
+            X.MOV (X.OSIZE (X.Qword, X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))), X.OSIZE (X.Qword, reg)))
           (List.tabulate (nsave, fn x => x), savelist))
       val epilogue =
         (ListPair.map
           (fn (num, reg) =>
-            X.SIZE (X.Qword, X.MOV (reg, X.REL (X.RSP, stacksz - 8*(num+1)))))
+            X.MOV (X.OSIZE (X.Qword, reg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))))
           (List.tabulate (nsave, fn x => x), savelist)) @
-        [X.SIZE (X.Qword, X.ADD (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))]
+        [X.ADD (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))]
       val endlbl = Label.new()
 
-      fun spill (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *)
+      fun spill s (X.TEMP temp, xreg: x86.reg) =    (* Spill a register if need be. *)
         if (isspilled (X.TEMP temp))
-          then [X.MOV (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)]
+          then [X.MOV (X.OSIZE(s, X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp)), X.REG xreg)]
           else nil
-        | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
-        | spill (a as X.REL _, xreg) = [X.MOV (a, X.REG xreg)]
-        | spill _ = nil                (* Nothing else can be spilled. *)
-      fun unspill (X.TEMP temp, xreg: x86.reg) =       (* Unspill a register if need be. *)
+        | spill s (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
+        | spill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s,a), X.REG xreg)]
+        | spill s (X.OSIZE (s', oo), xreg) = spill s' (X.stripsize oo, xreg)
+        | spill _ _ = nil        (* Nothing else can be spilled. *)
+      fun unspill s (X.TEMP temp, xreg: x86.reg) =    (* Unspill a register if need be. *)
         if (isspilled (X.TEMP temp))
-          then [X.MOV (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))]
+          then [X.MOV (X.OSIZE(s, X.REG xreg), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))]
           else nil
-        | unspill (X.STACKARG arg, xreg) = [X.MOV (X.REG xreg, X.REL (X.RSP, stacksz + 8 + (arg * 8)))]
-        | unspill (a as X.REL _, xreg) = [X.MOV (X.REG xreg, a)]
-        | unspill _ = nil
+        | unspill s (X.STACKARG arg, xreg) = [X.MOV (X.OSIZE(s, X.REG xreg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8)))))]
+        | unspill s (a as X.REL _, xreg) = [X.MOV (X.OSIZE(s, X.REG xreg), a)]
+        | unspill s (X.OSIZE (s', oo), xreg) = unspill s' (X.stripsize oo, xreg)
+        | unspill _ _ = nil
       
-      fun realoper (X.TEMP temp) = X.REG (temptoreg temp)      (* Makes a operand 'real'. *)
+      fun realoper (X.TEMP temp) = X.OSIZE (X.sts (Temp.size temp), X.REG (temptoreg temp))  (* Makes a operand 'real'. *)
         | realoper (X.STACKARG arg) = raise Spilled
         | realoper (X.REL _) = raise Spilled
+        | realoper (X.OSIZE (s, oo)) = X.OSIZE (s, realoper (X.stripsize oo))
         | realoper r = r
 
       fun stackoper (X.TEMP temp) =
             if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
-            else X.REL (X.RSP, stackpos (temptonum temp))
-        | stackoper (X.STACKARG arg) = X.REL (X.RSP, stacksz + 8 + (arg * 8))
+            else X.OSIZE (X.sts (Temp.size temp), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))
+        | stackoper (X.STACKARG arg) = X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt) (stacksz + 8 + (arg * 8)))
         | stackoper (a as X.REL _) = a
+        | stackoper (X.OSIZE (s, oo)) = X.OSIZE (s, stackoper (X.stripsize oo))
         | stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
-      
+
+      fun ophit (X.OSIZE (s, oo)) = let val (insns, p) = ophit (X.stripsize oo) in (insns, X.OSIZE (s, p)) end
+        | ophit (X.REL(op1, op2)) =
+          let
+            val t1 = X.stripsize op1
+            val (s, t2) = X.sizeoper op2
+          in
+            if (isspilled t1 andalso isspilled t2) then
+              ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2),
+                X.ADD (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
+                X.REL (X.REG spillreg1, X.CONST 0w0))
+            else if(isspilled t1) then
+              ([X.MOV (X.OSIZE (X.Qword, X.REG spillreg1), stackoper t1)],
+                X.REL (X.REG spillreg1, realoper t2))
+            else if(isspilled t2) then
+              ([X.MOV (X.OSIZE (s, X.REG spillreg1), stackoper t2)],
+                X.REL (realoper t1, X.REG spillreg1))
+            else
+              ([],
+                X.REL (realoper t1, realoper t2))
+          end
+        | ophit a = (nil, realoper a handle Spilled => stackoper a)
+
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
         | transform (X.COMMENT s) = [X.COMMENT s]
         | transform (X.LIVEIGN a) = transform a
-        | transform (X.SIZE (s, i)) = map (fn i' => (X.SIZE (s, i'))) (transform i)
         | transform (X.MOV (dest, src)) =
-            if (isspilled dest)
-            then
-              unspill (src, spillreg1) @
-              [X.MOV(
-                  realoper dest handle Spilled => stackoper dest,
-                  realoper src handle Spilled => X.REG spillreg1)]
-            else
-              [X.MOV(
-                  realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
-                  realoper src handle Spilled => stackoper src)]
+            let
+              val (insns1, realop1) = ophit dest
+              val (insns2, realop2) = ophit src
+            in
+              if(isspilled dest andalso isspilled src) then
+                insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.MOV (realop1, X.REG spillreg2)]
+              else
+                insns1 @ insns2 @ [X.MOV (realop1, realop2)]
+            end
+        | transform (X.LEA (dest, src)) =
+            let
+              val (insns1, realop1) = ophit dest
+              val (insns2, realop2) = ophit src
+            in
+              if(isspilled dest andalso isspilled src) then
+                insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.LEA (realop1, X.REG spillreg2)]
+              else
+                insns1 @ insns2 @ [X.LEA (realop1, realop2)]
+            end
         | transform (X.SUB (dest, src)) =
-            unspill (src, spillreg1) @
-            [ X.SUB(
-                realoper dest handle Spilled => stackoper dest,
-                realoper src handle Spilled => X.REG spillreg1)]
+            let
+              val (insns, realop) = ophit dest
+            in
+              unspill X.Long (src, spillreg2) @ insns @
+              [ X.SUB(realop,
+                  realoper src handle Spilled => X.REG spillreg2)]
+            end
         | transform (X.IMUL (dest, src)) =
-            unspill (dest, spillreg1) @
+            unspill X.Long (dest, spillreg1) @
             [ X.IMUL(
                 realoper dest handle Spilled => X.REG spillreg1,
                 realoper src handle Spilled => stackoper src)] @
-            spill (dest, spillreg1)
+            spill X.Long (dest, spillreg1)
         | transform (X.IMUL3 (dest, src, const)) =
+            unspill X.Long ((X.stripsize src), spillreg2) @
             [ X.IMUL3(
                 realoper dest handle Spilled => X.REG spillreg1,
-                realoper src handle Spilled => stackoper src,
+                realoper src handle Spilled => X.REG spillreg2,
                 const)] @
-            spill (dest, spillreg1)
-        | transform (X.ADD (dest, src)) =      (* You can have either operand spilled, but not both. Pick one. *)
-            if (isspilled dest)
-            then
-              unspill (src, spillreg1) @
-              [ X.ADD(
-                  realoper dest handle Spilled => stackoper dest,
-                  realoper src handle Spilled => X.REG spillreg1)]
-            else
-              [ X.ADD(
-                  realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
-                  realoper src handle Spilled => stackoper src)]
+            spill X.Long (dest, spillreg1)
+        | transform (X.ADD (dest, src)) =
+            let
+              val (insns, realop) = ophit dest
+            in
+              unspill X.Long (src, spillreg2) @ insns @
+              [ X.ADD(realop,
+                  realoper src handle Spilled => X.REG spillreg2)]
+            end
         | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
         | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
         | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
@@ -164,27 +201,27 @@ struct
                 shft)]
         | transform (X.CLTD) = [ X.CLTD ]
         | transform (X.AND (dest, src)) =
-            unspill (src, spillreg1) @
+            unspill X.Long (src, spillreg1) @
             [ X.AND(
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.OR (dest, src)) =
-            unspill (src, spillreg1) @
+            unspill X.Long (src, spillreg1) @
             [ X.OR(
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.XOR (dest, src)) =
-            unspill (src, spillreg1) @
+            unspill X.Long (src, spillreg1) @
             [ X.XOR(
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.CMP (op1, op2)) =
-            unspill (op2, spillreg1) @
+            unspill X.Long (op2, spillreg1) @
             [ X.CMP(
                 realoper op1 handle Spilled => stackoper op1,
                 realoper op2 handle Spilled => X.REG spillreg1)]
         | transform (X.TEST (op1, op2)) =
-            unspill (op2, spillreg1) @
+            unspill X.Long (op2, spillreg1) @
             [ X.TEST(
                 realoper op1 handle Spilled => stackoper op1,
                 realoper op2 handle Spilled => X.REG spillreg1)]
@@ -194,7 +231,7 @@ struct
             [ X.MOVZB(
                 realoper dest handle Spilled => X.REG spillreg1,
                 realoper src handle Spilled => stackoper src)]
-            @ spill (dest, spillreg1)
+            @ spill X.Long (dest, spillreg1)
         | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
         | transform (X.LABEL l) = [ X.LABEL l ]
         | transform (X.JMP l) = [ X.JMP l ]
This page took 0.030116 seconds and 4 git commands to generate.