Add string pasting support to the gramamr.

[snipe.git] / codegen / codegen.sml

diff --git a/codegen/codegen.sml b/codegen/codegen.sml
index 81819054f033d5a1d2d66fde840e62c8e6942511..a407a2014ec562685de39437787879d1f427c35b 100644 (file)
--- a/codegen/codegen.sml
+++ b/codegen/codegen.sml
@@ -59,7 +59,8 @@ struct
    * generates instructions to achieve d <- e
    * d must be TEMP(t) or REG(r)
    *)
-  and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge n))]
+  and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge (Word32.toLarge n)))]
+    | munch_exp d (T.STRING s) = [X.INSN (X.AL, X.MOVSTR(d, s))]
     | munch_exp d (T.NULLPTR) = [X.INSN (X.AL, X.MOVLIT(d, 0w0))]
     | munch_exp d (T.TEMP(t)) = [X.INSN (X.AL, X.MOV(d, X.TEMP t))]
     | munch_exp d (T.ARG(0)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R0))]
@@ -74,11 +75,20 @@ struct
                        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
@@ -97,11 +107,12 @@ struct
             (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
-            (fn (d,exp) => munch_exp d exp)
+            (fn ((d,_),exp) => munch_exp d exp)
             (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")
@@ -109,12 +120,18 @@ struct
           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
@@ -231,8 +248,8 @@ struct
 
   and condhit e1 e2 (pos, neg) =
     let
-      val t1 = X.TEMP (Temp.new ("var neq 1"))
-      val t2 = X.TEMP (Temp.new ("var neq 2"))
+      val t1 = X.TEMP (Temp.new ("var cond 1"))
+      val t2 = X.TEMP (Temp.new ("var cond 2"))
       val i1 = munch_exp t1 e1
       val i2 = munch_exp t2 e2
     in
@@ -250,11 +267,11 @@ struct
           (insns, neg, pos)
         end
     | munch_cond (T.BINOP(T.NEQ, e1, e2)) = condhit e1 e2 (X.NE, X.EQ)
-    | munch_cond (T.BINOP(T.EQ, e1, e2)) = condhit e1 e2 (X.EQ, X.NE)
-    | munch_cond (T.BINOP(T.LE, e1, e2)) = condhit e1 e2 (X.LE, X.GT)
-    | munch_cond (T.BINOP(T.LT, e1, e2)) = condhit e1 e2 (X.LT, X.GE)
-    | munch_cond (T.BINOP(T.GT, e1, e2)) = condhit e1 e2 (X.GT, X.LE)
-    | munch_cond (T.BINOP(T.GE, e1, e2)) = condhit e1 e2 (X.GE, X.LT)
+    | munch_cond (T.BINOP(T.EQ, e1, e2)) =  condhit e1 e2 (X.EQ, X.NE)
+    | munch_cond (T.BINOP(T.LE, e1, e2)) =  condhit e1 e2 (X.LE, X.GT)
+    | munch_cond (T.BINOP(T.LT, e1, e2)) =  condhit e1 e2 (X.LT, X.GE)
+    | munch_cond (T.BINOP(T.GT, e1, e2)) =  condhit e1 e2 (X.GT, X.LE)
+    | munch_cond (T.BINOP(T.GE, e1, e2)) =  condhit e1 e2 (X.GE, X.LT)
 
     | munch_cond (T.BINOP(T.BE, e1, e2)) = raise ErrorMsg.InternalError "memory safety not supported"
 
@@ -269,7 +286,7 @@ struct
   (* munch_lval : T.exp -> X.operand
    * Takes an expression that has been typechecked as being a valid lvalue and a location of a datum, and then returns an instruction list to store.
    *)
-  and munch_lval (T.TEMP t) oper = [X.INSN (X.AL, X.MOV (oper, X.TEMP t))]
+  and munch_lval (T.TEMP t) oper = [X.INSN (X.AL, X.MOV (X.TEMP t, oper))]
     | munch_lval (T.MEMORY m) oper = 
       let
         val t = X.TEMP (Tm.new "lv addr")
@@ -283,7 +300,7 @@ struct
   (* munch_stm : T.stm -> X.insn list *)
   (* munch_stm stm generates code to execute stm *)
   and munch_stm (T.MOVE (T.TEMP t1, T.TEMP t2)) = [X.INSN (X.AL, X.MOV(X.TEMP t1, X.TEMP t2))]
-    | munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = [X.INSN (X.AL, X.MOVLIT(X.TEMP t, Word.fromLarge n))]
+    | munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = [X.INSN (X.AL, X.MOVLIT(X.TEMP t, Word.fromLarge (Word32.toLarge n)))]
     | munch_stm (T.MOVE (T.TEMP t, a as T.ARG (an))) =
         let
           val i = munch_exp (X.TEMP t) a