Remove sizes from temps.

[snipe.git] / codegen / solidify.sml

diff --git a/codegen/solidify.sml b/codegen/solidify.sml
index 21b37bceccae003162161409f75a1bfa92fc1646..07ae420b950703bc33226a307bcc46a6f09ff9f4 100644 (file)
--- a/codegen/solidify.sml
+++ b/codegen/solidify.sml
@@ -22,7 +22,13 @@ struct
   type asm = x86.insn list
   
   exception Spilled
   type asm = x86.insn list
   
   exception Spilled

-  
+
+  structure TempMap = SplayMapFn(struct
+                                   type ord_key = Temp.temp
+                                   val compare = Temp.compare
+                                 end)
+  structure Tm = Temp
+

   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
       (* r14d and r15d is reserved for spilling *)
   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
       (* r14d and r15d is reserved for spilling *)


@@ -32,11 +38,9 @@ struct
           then raise Spilled
           else X.numtoreg n
 
           then raise Spilled
           else X.numtoreg n
 

-      fun temptonum (t: T.temp) : int =
-        (List.hd
-          (List.map (fn (_, n) => n)
-            (List.filter (fn (a, _) => (Temp.eq (a, t))) regmap)))
-      
+      val tempnums = List.foldr (fn ((t,n),b) => TempMap.insert(b,t,n)) (TempMap.empty) regmap
+      fun temptonum (t: T.temp) : int = valOf (TempMap.find (tempnums, t))
+

       fun temptoreg (t: T.temp) : x86.reg =
         numtoreg (temptonum t)          
         handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
       fun temptoreg (t: T.temp) : x86.reg =
         numtoreg (temptonum t)          
         handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")


@@ -61,79 +65,99 @@ struct
 
       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. *)
 
       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
+      fun isspilled (X.TEMP temp, _) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
+        | isspilled (X.STACKARG _, _) = true
+        | isspilled (X.REL _, _) = true

         | isspilled _ = false
         | isspilled _ = false

+

       val stacksz = (nspilled + nsave) * 8
       fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
 
       val prologue =
       val stacksz = (nspilled + nsave) * 8
       fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
 
       val prologue =

-        (X.SUB (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))) ::
+        (X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))) ::

         (ListPair.map
           (fn (num, reg) =>
         (ListPair.map
           (fn (num, 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)))
+            X.MOV ((X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad), (reg, Tm.Quad)))

           (List.tabulate (nsave, fn x => x), savelist))
       val epilogue =
         (ListPair.map
           (fn (num, reg) =>
           (List.tabulate (nsave, fn x => x), savelist))
       val epilogue =
         (ListPair.map
           (fn (num, reg) =>

-            X.MOV (X.OSIZE (X.Qword, reg), X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (stacksz - 8*(num+1))))))
+            X.MOV ((reg, Tm.Quad), (X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad)))

           (List.tabulate (nsave, fn x => x), savelist)) @
           (List.tabulate (nsave, fn x => x), savelist)) @

-        [X.ADD (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stacksz))]
+        [X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))]

       val endlbl = Label.new()
 
       val endlbl = Label.new()
 

-      fun spill s (X.TEMP temp, xreg: x86.reg) =    (* Spill a register if need be. *)
-        if (isspilled (X.TEMP temp))
-          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 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.OSIZE(s, X.REG xreg), X.REL (X.REG X.RSP, (X.CONST o Word32.fromInt o stackpos o temptonum) temp))]
-          else 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.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))
+      fun spill ((X.TEMP temp, s), xreg: x86.reg) =    (* Spill a register if need be. *)
+            let
+              val base = (X.REG X.RSP, Tm.Quad)
+              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+            in
+              if (isspilled (X.TEMP temp, s))
+                then [X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]
+                else nil
+            end
+        | spill ((X.STACKARG _, s), _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
+        | spill ((a as X.REL _, s), xreg) = [X.MOV ((a,s), (X.REG xreg,s))]
+        | spill _ = nil        (* Nothing else can be spilled. *)
+      fun unspill ((X.TEMP temp, s), xreg: x86.reg) =    (* Unspill a register if need be. *)
+            let
+              val base = (X.REG X.RSP, Tm.Quad)
+              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+            in
+              if (isspilled (X.TEMP temp, s))
+                then [X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]
+                else nil
+            end
+        | unspill ((X.STACKARG arg, s), xreg) =
+            let
+              val base = (X.REG X.RSP, Tm.Quad)
+              val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
+            in
+              [X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]
+            end
+        | unspill ((a as X.REL _, s), xreg) = [X.MOV ((X.REG xreg, s), (a,s))]
+        | unspill _ = nil
+
+      fun realoper (X.TEMP temp, s) = (X.REG (temptoreg temp), s) (* makes an operand 'real' *)
+        | realoper (X.STACKARG arg, _) = raise Spilled
+        | realoper (X.REL _, _) = raise Spilled

         | realoper r = r
 
         | realoper r = r
 

-      fun stackoper (X.TEMP temp) =
-            if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
-            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))
+      fun stackoper (X.TEMP temp, s) =
+            let
+              val base = (X.REG X.RSP, Tm.Quad)
+              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+            in
+              if (isspilled (X.TEMP temp, s)) 
+                then (X.REL (base, offs, 0w1), s)
+                else raise ErrorMsg.InternalError "stackoper on unspilled temp?"
+            end
+        | stackoper (X.STACKARG arg, s) =
+            let
+              val base = (X.REG X.RSP, Tm.Quad)
+              val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
+            in
+              (X.REL (base, offs, 0w1), s)
+            end
+        | stackoper (a as (X.REL _, s)) = a
+        | stackoper (a as (X.CONST _, s)) = a
+        | stackoper anous = raise ErrorMsg.InternalError ("stackoper on not temp " ^ X.pp_oper anous)
+
+      fun ophit (X.REL(op1, op2, m), s) =
+            if (isspilled op1 andalso isspilled op2) then
+              ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2),
+                X.IMUL((X.REG spillreg1, Tm.Quad), (X.CONST m, Tm.Quad)), 
+                X.ADD ((X.REG spillreg1, Tm.Quad), stackoper op1)],
+                (X.REL ((X.REG spillreg1, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))
+            else if(isspilled op1) then
+              ([X.MOV ((X.REG spillreg1, Tm.Quad), stackoper op1)],
+                (X.REL ((X.REG spillreg1, Tm.Quad), realoper op2, m), s))
+            else if(isspilled op2) then
+              ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2)],
+                (X.REL (realoper op1, (X.REG spillreg1, Tm.Quad), m), s))

             else
               ([],
             else
               ([],

-                X.REL (realoper t1, realoper t2))
-          end
+                (X.REL (realoper op1, realoper op2, m), s))

         | ophit a = (nil, realoper a handle Spilled => stackoper a)
 
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
         | ophit a = (nil, realoper a handle Spilled => stackoper a)
 
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]


@@ -141,21 +165,21 @@ struct
         | transform (X.LIVEIGN a) = transform a
         | transform (X.MOV (dest, src)) =
             let
         | transform (X.LIVEIGN a) = transform a
         | transform (X.MOV (dest, src)) =
             let

-              val (insns1, realop1) = ophit dest
-              val (insns2, realop2) = ophit src
+              val (insns1, realop1 as (_,s1)) = ophit dest
+              val (insns2, realop2 as (_,s2)) = ophit src

             in
               if(isspilled dest andalso isspilled src) then
             in
               if(isspilled dest andalso isspilled src) then

-                insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.MOV (realop1, X.REG spillreg2)]
+                insns2 @ [X.MOV ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]

               else
                 insns1 @ insns2 @ [X.MOV (realop1, realop2)]
             end
         | transform (X.LEA (dest, src)) =
             let
               else
                 insns1 @ insns2 @ [X.MOV (realop1, realop2)]
             end
         | transform (X.LEA (dest, src)) =
             let

-              val (insns1, realop1) = ophit dest
-              val (insns2, realop2) = ophit src
+              val (insns1, realop1 as (_,s1)) = ophit dest
+              val (insns2, realop2 as (_,s2)) = ophit src

             in
               if(isspilled dest andalso isspilled src) then
             in
               if(isspilled dest andalso isspilled src) then

-                insns2 @ [X.MOV (X.REG spillreg2, realop2)] @ insns1 @ [X.LEA (realop1, X.REG spillreg2)]
+                insns2 @ [X.LEA ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]

               else
                 insns1 @ insns2 @ [X.LEA (realop1, realop2)]
             end
               else
                 insns1 @ insns2 @ [X.LEA (realop1, realop2)]
             end


@@ -163,30 +187,30 @@ struct
             let
               val (insns, realop) = ophit dest
             in
             let
               val (insns, realop) = ophit dest
             in

-              unspill X.Long (src, spillreg2) @ insns @
+              unspill (src, spillreg2) @ insns @

               [ X.SUB(realop,
               [ X.SUB(realop,

-                  realoper src handle Spilled => X.REG spillreg2)]
+                  realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]

             end
         | transform (X.IMUL (dest, src)) =
             end
         | transform (X.IMUL (dest, src)) =

-            unspill X.Long (dest, spillreg1) @
+            unspill (dest, spillreg1) @

             [ X.IMUL(
             [ X.IMUL(

-                realoper dest handle Spilled => X.REG spillreg1,
+                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),

                 realoper src handle Spilled => stackoper src)] @
                 realoper src handle Spilled => stackoper src)] @

-            spill X.Long (dest, spillreg1)
+            spill (dest, spillreg1)

         | transform (X.IMUL3 (dest, src, const)) =
         | transform (X.IMUL3 (dest, src, const)) =

-            unspill X.Long ((X.stripsize src), spillreg2) @
+            unspill (src, spillreg2) @

             [ X.IMUL3(
             [ X.IMUL3(

-                realoper dest handle Spilled => X.REG spillreg1,
-                realoper src handle Spilled => X.REG spillreg2,
+                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
+                realoper src handle Spilled => (X.REG spillreg2, X.osize src),

                 const)] @
                 const)] @

-            spill X.Long (dest, spillreg1)
+            spill (dest, spillreg1)

         | transform (X.ADD (dest, src)) =
             let
               val (insns, realop) = ophit dest
             in
         | transform (X.ADD (dest, src)) =
             let
               val (insns, realop) = ophit dest
             in

-              unspill X.Long (src, spillreg2) @ insns @
+              unspill (src, spillreg2) @ insns @

               [ X.ADD(realop,
               [ X.ADD(realop,

-                  realoper src handle Spilled => X.REG spillreg2)]
+                  realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]

             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)]
             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)]


@@ -201,41 +225,56 @@ struct
                 shft)]
         | transform (X.CLTD) = [ X.CLTD ]
         | transform (X.AND (dest, src)) =
                 shft)]
         | transform (X.CLTD) = [ X.CLTD ]
         | transform (X.AND (dest, src)) =

-            unspill X.Long (src, spillreg1) @
+            unspill (src, spillreg1) @

             [ X.AND(
                 realoper dest handle Spilled => stackoper dest,
             [ X.AND(
                 realoper dest handle Spilled => stackoper dest,

-                realoper src handle Spilled => X.REG spillreg1)]
+                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]

         | transform (X.OR (dest, src)) =
         | transform (X.OR (dest, src)) =

-            unspill X.Long (src, spillreg1) @
+            unspill (src, spillreg1) @

             [ X.OR(
                 realoper dest handle Spilled => stackoper dest,
             [ X.OR(
                 realoper dest handle Spilled => stackoper dest,

-                realoper src handle Spilled => X.REG spillreg1)]
+                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]

         | transform (X.XOR (dest, src)) =
         | transform (X.XOR (dest, src)) =

-            unspill X.Long (src, spillreg1) @
+            unspill (src, spillreg1) @

             [ X.XOR(
                 realoper dest handle Spilled => stackoper dest,
             [ X.XOR(
                 realoper dest handle Spilled => stackoper dest,

-                realoper src handle Spilled => X.REG spillreg1)]
+                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]

         | transform (X.CMP (op1, op2)) =
         | transform (X.CMP (op1, op2)) =

-            unspill X.Long (op2, spillreg1) @
-            [ X.CMP(
-                realoper op1 handle Spilled => stackoper op1,
-                realoper op2 handle Spilled => X.REG spillreg1)]
+            let
+              val (insns1, realop1) = ophit op1
+            in
+              if(isspilled realop1 andalso isspilled op2) then
+                unspill (op2, spillreg2) @ insns1 @ [X.CMP (realop1, (X.REG spillreg2, X.osize realop1))]
+              else
+                insns1 @ [X.CMP (realop1, realoper op2 handle Spilled => stackoper op2)]
+            end

         | transform (X.TEST (op1, op2)) =
         | transform (X.TEST (op1, op2)) =

-            unspill X.Long (op2, spillreg1) @
+            unspill (op2, spillreg1) @

             [ X.TEST(
                 realoper op1 handle Spilled => stackoper op1,
             [ X.TEST(
                 realoper op1 handle Spilled => stackoper op1,

-                realoper op2 handle Spilled => X.REG spillreg1)]
+                realoper op2 handle Spilled => (X.REG spillreg1, X.osize op2))]

         | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
         | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]

+        | transform (X.CMOVcc (c, 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, X.osize src), realop2)] @ insns1 @ [X.CMOVcc (c, realop1, (X.REG spillreg2, X.osize src))]
+              else
+                insns1 @ insns2 @ [X.CMOVcc (c, realop1, realop2)]
+            end

         | transform (X.CALL l) = [ X.CALL l ]
         | transform (X.MOVZB (dest, src)) =
             [ X.MOVZB(
         | transform (X.CALL l) = [ X.CALL l ]
         | transform (X.MOVZB (dest, src)) =
             [ X.MOVZB(

-                realoper dest handle Spilled => X.REG spillreg1,
+                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),

                 realoper src handle Spilled => stackoper src)]
                 realoper src handle Spilled => stackoper src)]

-            @ spill X.Long (dest, spillreg1)
+            @ spill (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 ]
         | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
         | 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 ]
         | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]

+        | transform _ = raise ErrorMsg.InternalError "probably movsc: unimplemented"

     in
       if (nsave < 2) then
         List.concat (prologue :: (map transform instrs))
     in
       if (nsave < 2) then
         List.concat (prologue :: (map transform instrs))