Emit strings at the end.

[snipe.git] / trans / trans.sml

diff --git a/trans/trans.sml b/trans/trans.sml
index 7c70af19d941e14c304d3073ac0a437818225fa6..0ec657403bf018b7f01007fc62bf87719ed52518 100644 (file)
--- a/trans/trans.sml
+++ b/trans/trans.sml
@@ -98,6 +98,7 @@ struct
         (* after type-checking, id must be declared; do not guard lookup *)
             T.TEMP (Symbol.look' env id)
         | trans_exp env vartypes (A.ConstExp c) = T.CONST(c)
         (* after type-checking, id must be declared; do not guard lookup *)
             T.TEMP (Symbol.look' env id)
         | trans_exp env vartypes (A.ConstExp c) = T.CONST(c)

+        | trans_exp env vartypes (A.StringExp s) = T.STRING(Stringref.new s)

         | trans_exp env vartypes (A.OpExp(oper, [e1, e2])) =
             T.BINOP(trans_oper oper, trans_exp env vartypes e1, trans_exp env vartypes e2)
         | trans_exp env vartypes (A.OpExp(oper, [e])) =
         | trans_exp env vartypes (A.OpExp(oper, [e1, e2])) =
             T.BINOP(trans_oper oper, trans_exp env vartypes e1, trans_exp env vartypes e2)
         | trans_exp env vartypes (A.OpExp(oper, [e])) =


@@ -109,29 +110,32 @@ struct
         | trans_exp env vartypes (A.FuncCall(func, stms)) =
             T.CALL(func,
               List.map
         | trans_exp env vartypes (A.FuncCall(func, stms)) =
             T.CALL(func,
               List.map

-                (fn exp => (trans_exp env vartypes exp, Temp.sts (Type.size (typeof' vartypes exp))))
-                stms,
-              Temp.sts (Type.size (AstUtils.Function.returntype (Symbol.look' funcs func))))
+                (fn exp => (trans_exp env vartypes exp))
+                stms)

         | trans_exp env vartypes (A.Member (exp, id)) =
             let
               val apk = T.BINOP (T.ADD, trans_exp env vartypes exp, T.CONST (Word32.fromInt (offset_s id (typeof' vartypes exp))))
               val tipo = type_s id (typeof' vartypes exp)
             in
              if Type.issmall tipo
         | trans_exp env vartypes (A.Member (exp, id)) =
             let
               val apk = T.BINOP (T.ADD, trans_exp env vartypes exp, T.CONST (Word32.fromInt (offset_s id (typeof' vartypes exp))))
               val tipo = type_s id (typeof' vartypes exp)
             in
              if Type.issmall tipo

-             then T.MEMORY(apk, Temp.sts (Type.size tipo))
+             then T.MEMORY(apk)

              else apk
            end
         | trans_exp env vartypes (A.DerefMember (exp, id)) =
             trans_exp env vartypes (A.Member (A.Dereference (exp), id))
         | trans_exp env vartypes (A.Dereference(exp)) =
             if (Type.issmall (deref (typeof' vartypes exp)))
              else apk
            end
         | trans_exp env vartypes (A.DerefMember (exp, id)) =
             trans_exp env vartypes (A.Member (A.Dereference (exp), id))
         | trans_exp env vartypes (A.Dereference(exp)) =
             if (Type.issmall (deref (typeof' vartypes exp)))

-            then T.MEMORY(trans_exp env vartypes exp, Temp.sts (Type.size (deref (typeof' vartypes exp))))
+            then T.MEMORY(trans_exp env vartypes exp)

             else trans_exp env vartypes exp
         | trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
             let
               val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1, 
             else trans_exp env vartypes exp
         | trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
             let
               val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1, 

-                                  T.BINOP(T.MUL, trans_exp env vartypes exp2,
-                                          T.CONST(Word32.fromInt(sizeof (deref (typeof' vartypes exp1))))))
+                                  if sizeof (deref (typeof' vartypes exp1)) = 1
+                                  then trans_exp env vartypes exp2
+                                  else T.BINOP(T.MUL, trans_exp env vartypes exp2,
+                                               T.CONST(Word32.fromInt(sizeof (deref (typeof' vartypes exp1))))
+                                              )
+                                 )

               val tipo = deref (typeof' vartypes exp1)
               val d =
                 if not (Flag.isset Flags.safe)
               val tipo = deref (typeof' vartypes exp1)
               val d =
                 if not (Flag.isset Flags.safe)


@@ -141,33 +145,35 @@ struct
                                T.MEMORY (T.BINOP (
                                  T.SUB,
                                  trans_exp env vartypes exp1, 
                                T.MEMORY (T.BINOP (
                                  T.SUB,
                                  trans_exp env vartypes exp1, 

-                                 T.CONST 0w8), Temp.Long),
+                                 T.CONST 0w8)),

                                trans_exp env vartypes exp2),
                              T.NULLPTR,
                              asubk)
             in
               if Type.issmall tipo
                                trans_exp env vartypes exp2),
                              T.NULLPTR,
                              asubk)
             in
               if Type.issmall tipo

-              then T.MEMORY(d, Temp.sts (Type.size tipo))
+              then T.MEMORY(d)

               else d
             end
         | trans_exp env vartypes (A.New(tipo)) =
             let
               else d
             end
         | trans_exp env vartypes (A.New(tipo)) =
             let

-              val t1 = T.TEMP (Temp.new "result" Temp.Quad)
+              val t1 = T.TEMP (Temp.new "result")

             in
               T.STMVAR (
                 [T.MOVE (t1, T.ALLOC (T.CONST (Word32.fromInt(sizeof tipo)))),
             in
               T.STMVAR (
                 [T.MOVE (t1, T.ALLOC (T.CONST (Word32.fromInt(sizeof tipo)))),

-                 T.EFFECT (T.MEMORY (t1, Temp.Long))],
+                 T.EFFECT (T.MEMORY (t1))],

                 t1)
             end
         | trans_exp env vartypes (A.NewArr(tipo, exp)) =
             let
                 t1)
             end
         | trans_exp env vartypes (A.NewArr(tipo, exp)) =
             let

-              val size = T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof tipo)))
-              val t1 = T.TEMP (Temp.new "allocated address" Temp.Quad)
-              val ts = T.TEMP (Temp.new "size" Temp.Long)
+              val size = if (sizeof tipo) = 1
+                         then trans_exp env vartypes exp
+                         else T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof tipo)))
+              val t1 = T.TEMP (Temp.new "allocated address")
+              val ts = T.TEMP (Temp.new "size")

             in
               if not (Flag.isset Flags.safe)
               then T.STMVAR ([T.MOVE (t1, T.ALLOC size),
             in
               if not (Flag.isset Flags.safe)
               then T.STMVAR ([T.MOVE (t1, T.ALLOC size),

-                              T.EFFECT (T.COND (T.BINOP (T.EQ, trans_exp env vartypes exp, T.CONST 0w0), T.CONST 0w0, T.MEMORY (t1, Temp.Long)))],
+                              T.EFFECT (T.COND (T.BINOP (T.EQ, trans_exp env vartypes exp, T.CONST 0w0), T.CONST 0w0, T.MEMORY (t1)))],

                              t1)
               else T.COND (T.BINOP(T.EQ, size, T.CONST 0w0),
                            T.NULLPTR,
                              t1)
               else T.COND (T.BINOP(T.EQ, size, T.CONST 0w0),
                            T.NULLPTR,


@@ -178,7 +184,7 @@ struct
                                   T.NULLPTR,
                                   T.ALLOC (T.BINOP (T.ADD, size, T.CONST 0w8)))
                                 ),
                                   T.NULLPTR,
                                   T.ALLOC (T.BINOP (T.ADD, size, T.CONST 0w8)))
                                 ),

-                              T.MOVE(T.MEMORY (t1, Temp.Long), trans_exp env vartypes exp)],
+                              T.MOVE(T.MEMORY (t1), trans_exp env vartypes exp)],

                              T.BINOP(T.ADD, t1, T.CONST 0w8)))
             end
         | trans_exp env vartypes (A.Null) = T.NULLPTR
                              T.BINOP(T.ADD, t1, T.CONST 0w8)))
             end
         | trans_exp env vartypes (A.Null) = T.NULLPTR


@@ -196,17 +202,17 @@ struct
           let
             val te1 = trans_exp vars vartypes e1
             val te2 = trans_exp vars vartypes e2
           let
             val te1 = trans_exp vars vartypes e1
             val te2 = trans_exp vars vartypes e2

-            val t1 = T.TEMP (Temp.new "memory deref cache" Temp.Quad)
+            val t1 = T.TEMP (Temp.new "memory deref cache")

           in
             case te1
           in
             case te1

-            of T.MEMORY(m,s) => T.MOVE(t1, m) :: T.MOVE (T.MEMORY(t1,s), T.BINOP(trans_oper oop, T.MEMORY(t1,s), te2)) :: (trans_stms vars vartypes ls stms)
+            of T.MEMORY(m) => T.MOVE(t1, m) :: T.MOVE (T.MEMORY(t1), T.BINOP(trans_oper oop, T.MEMORY(t1), te2)) :: (trans_stms vars vartypes ls stms)

              | _ => T.MOVE(te1, T.BINOP(trans_oper oop, te1, te2)) :: (trans_stms vars vartypes ls stms)
           end
         | trans_stms vars vartypes ls (A.Return e::stms) =
           let
             val remainder = trans_stms vars vartypes ls stms
           in 
              | _ => T.MOVE(te1, T.BINOP(trans_oper oop, te1, te2)) :: (trans_stms vars vartypes ls stms)
           end
         | trans_stms vars vartypes ls (A.Return e::stms) =
           let
             val remainder = trans_stms vars vartypes ls stms
           in 

-            T.RETURN (trans_exp vars vartypes e, Temp.sts (Type.size (typeof' vartypes e)))
+            T.RETURN (trans_exp vars vartypes e)

             :: remainder
           end
         | trans_stms vars vartypes ls (A.If(e, s, NONE)::stms) =
             :: remainder
           end
         | trans_stms vars vartypes ls (A.If(e, s, NONE)::stms) =


@@ -291,7 +297,7 @@ struct
             let
               val allvars = foldr
                               (fn ((name, t),b) =>
             let
               val allvars = foldr
                               (fn ((name, t),b) =>

-                                Symbol.bind b (name, Temp.new (Symbol.name(name)) (Temp.sts (Type.size t))))
+                                Symbol.bind b (name, Temp.new (Symbol.name(name))))

                               Symbol.empty
                               (args @ vars)
               val vartypes = foldr (fn ((i, t), b) => Symbol.bind b (i, t)) Symbol.empty (args @ vars)
                               Symbol.empty
                               (args @ vars)
               val vartypes = foldr (fn ((i, t), b) => Symbol.bind b (i, t)) Symbol.empty (args @ vars)


@@ -299,7 +305,7 @@ struct
               val (argn,_) = ListPair.unzip args
               val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
               val argmv = map
               val (argn,_) = ListPair.unzip args
               val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
               val argmv = map

-                (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG (n, Temp.size (Symbol.look' allvars argname))))
+                (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG (n)))

                 numberedargs
             in
               (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)
                 numberedargs
             in
               (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)