X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/5c79bb689ab446551bc7ec4497e6c9b75582837e..5c90fbb8681e975ccd0a1bc407b31daa1daef38a:/trans/trans.sml?ds=sidebyside diff --git a/trans/trans.sml b/trans/trans.sml index 7c70af1..0ec6574 100644 --- 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) + | 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])) = @@ -109,29 +110,32 @@ struct | 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 - 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))) - 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, - 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) @@ -141,33 +145,35 @@ struct 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 - then T.MEMORY(d, Temp.sts (Type.size tipo)) + then T.MEMORY(d) 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)))), - T.EFFECT (T.MEMORY (t1, Temp.Long))], + T.EFFECT (T.MEMORY (t1))], 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), - 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, @@ -178,7 +184,7 @@ struct 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 @@ -196,17 +202,17 @@ struct 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 - 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.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) = @@ -291,7 +297,7 @@ struct 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) @@ -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 - (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)