Add string pasting support to the gramamr.

[snipe.git] / codegen / solidify.sml

diff --git a/codegen/solidify.sml b/codegen/solidify.sml
index a2622e122b54e21c47638ab8e780f80b7d9b4b0f..bb0eb1c85ce391accd78a1f84339284c975772ce 100644 (file)
--- a/codegen/solidify.sml
+++ b/codegen/solidify.sml
@@ -54,7 +54,8 @@ struct
         X.OperSet.addList (X.OperSet.empty, opsused),
         X.OperSet.addList (
           X.OperSet.empty,
-          [X.REG X.R7,
+          [X.REG X.R6,
+           X.REG X.R7,
            X.REG X.R8,
            X.REG X.R9,
            X.REG X.R10,
@@ -98,15 +99,19 @@ struct
          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))
-                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
+        | 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. *)
@@ -115,16 +120,19 @@ struct
               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
-              val offs = Word.fromInt (stacksz + 8 + (arg * 8))
+              val offs = Word.fromInt (stacksz + 1 + (arg * 1))
             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
 
@@ -176,17 +184,22 @@ struct
         | 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
-             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
+             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
-             then spill (op1, spillreg1)
+             then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
              else [])
         
         (* and here comes the boilerplate *)