First pass spill code.

diff --git a/codegen/blarg.sml b/codegen/blarg.sml
index cdd4a1bfbd4b22d038d6ba2440f4e6b71065ec68..4df4d4851819e5ca998386242556bf209b2705f0 100644 (file)
--- a/codegen/blarg.sml
+++ b/codegen/blarg.sml
@@ -154,8 +154,9 @@ struct
     | regtonum R10 = 10
     | regtonum R11 = 11
     | regtonum R12 = 12
     | regtonum R10 = 10
     | regtonum R11 = 11
     | regtonum R12 = 12

-    | regtonum SP = 4
-    | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register")
+    | regtonum FR = 13
+    | regtonum SP = 14
+    | regtonum PC = 15

 
   (* gives reg associated with number (color) *)
   fun numtoreg 0 = R0
 
   (* gives reg associated with number (color) *)
   fun numtoreg 0 = R0

diff --git a/codegen/codegen.sml b/codegen/codegen.sml
index 804dee55108edf2cfcafea80e66e4880fefce845..a407a2014ec562685de39437787879d1f427c35b 100644 (file)
--- a/codegen/codegen.sml
+++ b/codegen/codegen.sml
@@ -40,7 +40,7 @@ struct
 (*      val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *)
 (*      val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *)
     in
 (*      val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *)
 (*      val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *)
     in

-      [X.COMMENT "binophit" ] @ i1 @ i2 @ [X.INSN (X.AL, oper (d, t)), X.COMMENT "binophit done"]
+      i1 @ i2 @ [X.INSN (X.AL, oper (d, t))]

     end
   
   (* cmphit : X.oper -> X.exp -> X.insn list
     end
   
   (* cmphit : X.oper -> X.exp -> X.insn list


@@ -75,11 +75,20 @@ struct
                        then 0
                        else nargs - 4
           val stackb = nstack * 1
                        then 0
                        else nargs - 4
           val stackb = nstack * 1

-          fun argdest 1 = X.REG X.R0
-            | argdest 2 = X.REG X.R1
-            | argdest 3 = X.REG X.R2
-            | argdest 4 = X.REG X.R3
-            | argdest n = raise ErrorMsg.InternalError "more than 4 args not supported yet" (*X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (~(stackb - 8 * (n - 7)))), Tm.Quad), 0w1)*)
+          fun argdest 1 = (X.REG X.R0, [])
+            | argdest 2 = (X.REG X.R1, [])
+            | argdest 3 = (X.REG X.R2, [])
+            | argdest 4 = (X.REG X.R3, [])
+            | argdest n = 
+              let
+                val t = Temp.new "argdest"
+                val t2 = Temp.new "argptr"
+              in
+                (X.TEMP t, (* Dude, I *love* this shit. *)
+                 [ X.INSN (X.AL, X.MOVLIT (X.TEMP t2, Word.fromInt (0x10000 - (n - 4 + 1)))),
+                   X.INSN (X.AL, X.ADD (X.TEMP t2, X.REG X.SP)),
+                   X.INSN (X.AL, X.STO (X.TEMP t2, X.TEMP t)) ] )
+              end

 
           val dests = List.tabulate (nargs, fn x => argdest (x+1))
           val hf = List.map hasfixed l
 
           val dests = List.tabulate (nargs, fn x => argdest (x+1))
           val hf = List.map hasfixed l


@@ -98,11 +107,12 @@ struct
             (fn (t,exp) => munch_exp (X.TEMP t) exp)
             (ListPair.zip (temps, l_hf))
           val argpushes = List.map
             (fn (t,exp) => munch_exp (X.TEMP t) exp)
             (ListPair.zip (temps, l_hf))
           val argpushes = List.map

-            (fn (dest, t) => [X.INSN (X.AL, X.MOV (dest, X.TEMP t))])
+            (fn ((dest, _), t) => [X.INSN (X.AL, X.MOV (dest, X.TEMP t))])

             (ListPair.zip (d_hf, temps))
           val argevals_nohf = List.map
             (ListPair.zip (d_hf, temps))
           val argevals_nohf = List.map

-            (fn (d,exp) => munch_exp d exp)
+            (fn ((d,_),exp) => munch_exp d exp)

             (ListPair.zip (d_nohf, l_nohf))
             (ListPair.zip (d_nohf, l_nohf))

+          val shittodo = List.concat (List.map (fn (_, shit) => shit) (d_hf @ d_nohf))

           
           val t_stackb = Temp.new ("stackb")
           val t_target = Temp.new ("target")
           
           val t_stackb = Temp.new ("stackb")
           val t_target = Temp.new ("target")


@@ -110,12 +120,18 @@ struct
           List.concat argevals_hf @ 
           List.concat argpushes @
           List.concat argevals_nohf @
           List.concat argevals_hf @ 
           List.concat argpushes @
           List.concat argevals_nohf @

-          [ X.INSN (X.AL, X.MOVLIT (X.TEMP t_stackb, Word.fromInt stackb)),
-            X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
-            X.INSN (X.AL, X.SUB (X.REG X.SP, X.TEMP t_stackb)),
-            X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
-            X.INSN (X.AL, X.ADD (X.REG X.SP, X.TEMP t_stackb)),
-            X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
+          shittodo @
+          (if stackb > 0
+           then [ X.INSN (X.AL, X.MOVLIT (X.TEMP t_stackb, Word.fromInt stackb)),
+                  X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
+                  X.INSN (X.AL, X.SUB (X.REG X.SP, X.TEMP t_stackb)),
+                  X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
+                  X.INSN (X.AL, X.ADD (X.REG X.SP, X.TEMP t_stackb)),
+                  X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
+           else [ X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
+                  X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
+                  X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
+          )

         end
     (*| munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = binophit_c d X.ADD e1 n
     | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = binophit_c d X.ADD e1 n
         end
     (*| munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = binophit_c d X.ADD e1 n
     | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = binophit_c d X.ADD e1 n

diff --git a/codegen/solidify.sml b/codegen/solidify.sml
index ba3fa897a89afe4d4af422b8771ecdcce79486d9..bb0eb1c85ce391accd78a1f84339284c975772ce 100644 (file)
--- a/codegen/solidify.sml
+++ b/codegen/solidify.sml
@@ -99,15 +99,19 @@ struct
          X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
       val endlbl = Label.new()
 
          X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
       val endlbl = Label.new()
 

-      fun spill (X.TEMP temp, xreg: Blarg.reg) =    (* Spill a register if need be. *)
+      fun spill (X.TEMP temp, X.R12: Blarg.reg) =    (* Spill a register if need be. *)

             let
               val base = X.REG X.SP
               val offs = Word.fromInt (stackpos (temptonum temp))
             in
               if (isspilled (X.TEMP temp))
             let
               val base = X.REG X.SP
               val offs = Word.fromInt (stackpos (temptonum temp))
             in
               if (isspilled (X.TEMP temp))

-                then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]*)
+                then [ X.MOVLIT (X.REG X.R11, offs),
+                       X.ADD (X.REG X.R11, X.REG X.SP),
+                       X.STO (X.REG X.R11, X.REG X.R12) ]

                 else nil
             end
                 else nil
             end

+        | spill (X.TEMP temp, _) = if (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "Cannot spill from non-R11"
+                                   else nil

         | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
         | spill _ = nil        (* Nothing else can be spilled. *)
       fun unspill (X.TEMP temp, xreg: Blarg.reg) =    (* Unspill a register if need be. *)
         | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
         | spill _ = nil        (* Nothing else can be spilled. *)
       fun unspill (X.TEMP temp, xreg: Blarg.reg) =    (* Unspill a register if need be. *)


@@ -116,16 +120,19 @@ struct
               val offs = Word.fromInt (stackpos (temptonum temp))
             in
               if (isspilled (X.TEMP temp))
               val offs = Word.fromInt (stackpos (temptonum temp))
             in
               if (isspilled (X.TEMP temp))

-                then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]*)
+                then [ X.MOVLIT (X.REG xreg, offs),
+                       X.ADD (X.REG xreg, X.REG X.SP),
+                       X.LDR (X.REG xreg, X.REG xreg) ]

                 else nil
             end
         | unspill (X.STACKARG arg, xreg) =
             let
               val base = X.REG X.SP
                 else nil
             end
         | unspill (X.STACKARG arg, xreg) =
             let
               val base = X.REG X.SP

-              val offs = Word.fromInt (stacksz + 8 + (arg * 8))
+              val offs = Word.fromInt (stacksz + 1 + (arg * 1))

             in
             in

-              (*[X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]*)
-              raise ErrorMsg.InternalError "unspill from stack not supported"
+              [ X.MOVLIT (X.REG xreg, offs),
+                X.ADD (X.REG xreg, X.REG X.SP),
+                X.LDR (X.REG xreg, X.REG xreg) ]

             end
         | unspill _ = nil
 
             end
         | unspill _ = nil
 


@@ -177,22 +184,22 @@ struct
         | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
             [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
             (if isspilled op1
         | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
             [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
             (if isspilled op1

-             then spill (op1, spillreg1)
+             then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))

              else [])
         | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
             [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
             (if isspilled op1
              else [])
         | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
             [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
             (if isspilled op1

-             then spill (op1, spillreg1)
+             then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))

              else [])
         | transform (X.INSN (pred, X.MOVSTR (op1, w))) =
             [ X.INSN (pred, X.MOVSTR (real_op1 op1, w)) ] @
             (if isspilled op1
              else [])
         | transform (X.INSN (pred, X.MOVSTR (op1, w))) =
             [ X.INSN (pred, X.MOVSTR (real_op1 op1, w)) ] @
             (if isspilled op1

-             then spill (op1, spillreg1)
+             then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))

              else [])
         | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
             [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
             (if isspilled op1
              else [])
         | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
             [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
             (if isspilled op1

-             then spill (op1, spillreg1)
+             then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))

              else [])
         
         (* and here comes the boilerplate *)
              else [])
         
         (* and here comes the boilerplate *)

diff --git a/top/top.sml b/top/top.sml
index 6c9f0a2039353686e4bc72c8ef8465ea6ce523bc..c03263fcf40bb5e33c8553fcc7e60523c85f8091 100644 (file)
--- a/top/top.sml
+++ b/top/top.sml
@@ -104,7 +104,7 @@ struct
       
         val _ = Flag.guard Flags.verbose say ("Processing function: " ^ name)
 
       
         val _ = Flag.guard Flags.verbose say ("Processing function: " ^ name)
 

-        val _ = Flag.guard Flags.verbose say "  Generating proto-x86_64 code..."
+        val _ = Flag.guard Flags.verbose say "  Generating proto-blargCPU code..."

         val assem = Codegen.codegen ir
         val _ = Flag.guard Flags.assem
                   (fn () => List.app (TextIO.print o (Blarg.print)) assem) ()
         val assem = Codegen.codegen ir
         val _ = Flag.guard Flags.assem
                   (fn () => List.app (TextIO.print o (Blarg.print)) assem) ()


@@ -142,10 +142,10 @@ struct
                   (fn () => List.app (TextIO.print o
                     (fn (t, i) =>
                       (Temp.name t) ^ " => " ^ (
                   (fn () => List.app (TextIO.print o
                     (fn (t, i) =>
                       (Temp.name t) ^ " => " ^ (

-                        if (i <= 15)
+                        if (i <= 10)

                           then (Blarg.pp_oper (Blarg.REG (Blarg.numtoreg i)))
                         else
                           then (Blarg.pp_oper (Blarg.REG (Blarg.numtoreg i)))
                         else

-                          "spill[" ^ Int.toString (i - Blarg.regtonum Blarg.PC) ^ "]")
+                          "spill[" ^ Int.toString (i - 11) ^ "]")

                         ^ "--"^ Int.toString i ^ "\n"))
                     colors) ()
 
                         ^ "--"^ Int.toString i ^ "\n"))
                     colors) ()