X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/6ade8b0a3251e44b34c6bdbbd9403e36d6fd6231..a644da892dbd55a7be1aed029dafebe28d26d27e:/trans/trans.sml?ds=inline diff --git a/trans/trans.sml b/trans/trans.sml index 80802be..ec66fd5 100644 --- a/trans/trans.sml +++ b/trans/trans.sml @@ -10,7 +10,7 @@ signature TRANS = sig (* translate abstract syntax tree to IR tree *) - val translate : Ast.program -> Tree.func list + val translate : Ast.program -> Tree.program end structure Trans :> TRANS = @@ -39,31 +39,157 @@ struct | trans_oper A.GT = T.GT | trans_oper _ = raise ErrorMsg.InternalError "expected AST binop, got AST unop" - fun translate p = + fun translate (defs, funcs) = let - val allfuncs = foldr (fn (A.Extern(_),b) => b - | (A.Function(_, id, _, _, _), b) => Symbol.bind b (id, () )) - Symbol.empty p + val funclist = Symbol.elemsi funcs + val _ = Type.alignment_reset() + val _ = Type.sizeof_reset() + fun sizeof a = Type.sizeof defs a + fun alignment a = Type.alignment defs a + fun align t curpos = Type.align defs t curpos + + fun offset_s id (Type.Typedef(id')) = + let + val shit = Symbol.look' defs id' + fun eat (Type.Struct(l)) = l + | eat (Type.MarkedTypedef(a)) = eat (Mark.data a) + fun offset_s' ((id1,t)::l') curofs = + let + val a = align t curofs + in + if Symbol.compare(id,id1) = EQUAL + then a + else offset_s' l' (a + sizeof t) + end + | offset_s' nil _ = raise ErrorMsg.InternalError "looking for offset of something that isn't in the structure" + in + offset_s' (eat shit) 0 + end + | offset_s _ _ = raise ErrorMsg.InternalError "cannot find offset into non-typedef" + + fun type_s id (Type.Typedef id') = + let + val td = + case Type.defdata (Symbol.look' defs id') + of Type.Struct d => d + | _ => raise ErrorMsg.InternalError "data didn't return struct" + fun type_s' ((id',t)::l) = + if (Symbol.compare (id, id') = EQUAL) + then t + else type_s' l + | type_s' nil = raise ErrorMsg.InternalError "struct member not found in type_s" + in + type_s' td + end + | type_s id _ = raise ErrorMsg.InternalError "cannot find internal type non-typedef" + + fun deref (Type.Pointer i) = i + | deref (Type.Array i) = i + | deref _ = raise ErrorMsg.InternalError "cannot deref non-pointer" fun trans_unop A.NEGATIVE = T.NEG | trans_unop A.BITNOT = T.BITNOT | trans_unop A.BANG = T.BANG | trans_unop _ = raise ErrorMsg.InternalError "expected AST unop, got AST binop" + + fun typeof' vartypes exp = TypeChecker.typeof (defs, funcs) vartypes NONE exp - fun trans_exp env (A.Var(id)) = + fun trans_exp env vartypes (A.Var(id)) = (* after type-checking, id must be declared; do not guard lookup *) T.TEMP (Symbol.look' env id) - | trans_exp env (A.ConstExp c) = T.CONST(c) - | trans_exp env (A.OpExp(oper, [e1, e2])) = - T.BINOP(trans_oper oper, trans_exp env e1, trans_exp env e2) - | trans_exp env (A.OpExp(oper, [e])) = - T.UNOP(trans_unop oper, trans_exp env e) - | trans_exp env (A.OpExp(oper, _)) = + | trans_exp env vartypes (A.Cast (ty, e)) = trans_exp env vartypes e (* lurrr *) + | 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])) = + T.UNOP(trans_unop oper, trans_exp env vartypes e) + | trans_exp env vartypes (A.OpExp(oper, _)) = raise ErrorMsg.InternalError "expected one or two operands, got it in the oven" - | trans_exp env (A.Marked(marked_exp)) = - trans_exp env (Mark.data marked_exp) - | trans_exp env (A.FuncCall(func, stms)) = - T.CALL(func, List.map (trans_exp env) stms) + | trans_exp env vartypes (A.Marked(marked_exp)) = + trans_exp env vartypes (Mark.data marked_exp) + | trans_exp env vartypes (A.FuncCall(func, stms)) = + T.CALL(func, + List.map + (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) + 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) + 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, + 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) + then asubk + else T.COND (T.BINOP + (T.BE, + T.MEMORY (T.BINOP ( + T.SUB, + trans_exp env vartypes exp1, + T.CONST 0w8)), + trans_exp env vartypes exp2), + T.NULLPTR, + asubk) + in + if Type.issmall tipo + then T.MEMORY(d) + else d + end + | trans_exp env vartypes (A.New(tipo)) = + let + 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))], + t1) + end + | trans_exp env vartypes (A.NewArr(tipo, exp)) = + let + 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)))], + t1) + else T.COND (T.BINOP(T.EQ, size, T.CONST 0w0), + T.NULLPTR, + T.STMVAR ( + [T.MOVE(t1, + T.COND( + T.BINOP(T.LT, size, T.CONST 0w0), + T.NULLPTR, + T.ALLOC (T.BINOP (T.ADD, size, T.CONST 0w8))) + ), + 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 + | trans_exp env vartypes (A.Conditional(c,e1,e2)) = T.COND(trans_exp env vartypes c, trans_exp env vartypes e1, trans_exp env vartypes e2) (* anything else should be impossible *) @@ -72,115 +198,122 @@ struct * we pass around the environment and the current loop context, if any * (usually called ls, which contains a continue label and a break label) *) - fun trans_stms vars ls (A.Assign(id,e)::stms) = + fun trans_stms vars vartypes ls (A.Assign(e1,e2)::stms) = T.MOVE(trans_exp vars vartypes e1, trans_exp vars vartypes e2)::(trans_stms vars vartypes ls stms) + | trans_stms vars vartypes ls (A.AsnOp(oop,e1,e2)::stms) = let - val t = Symbol.look' vars id handle Option => raise ErrorMsg.InternalError "Undeclared variable, should have been caught in typechecker..." - val remainder = trans_stms vars ls stms + val te1 = trans_exp vars vartypes e1 + val te2 = trans_exp vars vartypes e2 + val t1 = T.TEMP (Temp.new "memory deref cache") in - T.MOVE(T.TEMP(t), trans_exp vars e) - :: remainder + case te1 + 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 ls (A.Return e::stms) = + | trans_stms vars vartypes ls (A.Return e::stms) = let - val remainder = trans_stms vars ls stms + val remainder = trans_stms vars vartypes ls stms in - T.RETURN (trans_exp vars e) + T.RETURN (trans_exp vars vartypes e) :: remainder end - - | trans_stms vars ls (A.If(e, s, NONE)::stms) = + | trans_stms vars vartypes ls (A.If(e, s, NONE)::stms) = let val l = Label.new () - val strans = trans_stms vars ls s - val remainder = trans_stms vars ls stms + val strans = trans_stms vars vartypes ls s + val remainder = trans_stms vars vartypes ls stms in - (T.JUMPIFN(trans_exp vars e, l) + (T.JUMPIFN(trans_exp vars vartypes e, l) :: strans @ [T.LABEL (l)] @ remainder) end - | trans_stms vars ls (A.If(e, s, SOME s2)::stms) = + | trans_stms vars vartypes ls (A.If(e, s, SOME s2)::stms) = let val l = Label.new () val l2 = Label.new () - val s1trans = trans_stms vars ls s - val s2trans = trans_stms vars ls s2 - val remainder = trans_stms vars ls stms + val s1trans = trans_stms vars vartypes ls s + val s2trans = trans_stms vars vartypes ls s2 + val remainder = trans_stms vars vartypes ls stms in - (T.JUMPIFN(trans_exp vars e, l) + (T.JUMPIFN(trans_exp vars vartypes e, l) :: s1trans @ [T.JUMP (l2), T.LABEL (l)] @ s2trans @ [T.LABEL (l2)] @ remainder) end - | trans_stms vars ls (A.For(s1, e, s2, s)::stms) = + | trans_stms vars vartypes ls (A.For(s1, e, s2, s)::stms) = let val head = Label.new () val tail = Label.new () val loop = Label.new () - val stm1 = if isSome s1 then trans_stms vars NONE [valOf s1] else nil - val strans = trans_stms vars (SOME(loop,tail)) s - val stm2 = if isSome s2 then trans_stms vars NONE [valOf s2] else nil - val remainder = trans_stms vars ls stms + val stm1 = if isSome s1 then trans_stms vars vartypes NONE [valOf s1] else nil + val strans = trans_stms vars vartypes (SOME(loop,tail)) s + val stm2 = if isSome s2 then trans_stms vars vartypes NONE [valOf s2] else nil + val remainder = trans_stms vars vartypes ls stms in (stm1 - @ [T.LABEL head, T.JUMPIFN(trans_exp vars e, tail)] + @ [T.LABEL head, T.JUMPIFN(trans_exp vars vartypes e, tail)] @ strans @ [T.LABEL loop] @ stm2 @ [T.JUMP head, T.LABEL tail] @ remainder) end - | trans_stms vars ls (A.While(e, s)::stms) = + | trans_stms vars vartypes ls (A.While(e, s)::stms) = let val head = Label.new () val tail = Label.new () - val strans = trans_stms vars (SOME(head,tail)) s - val remainder = trans_stms vars ls stms + val strans = trans_stms vars vartypes (SOME(head,tail)) s + val remainder = trans_stms vars vartypes ls stms in (T.LABEL head - :: T.JUMPIFN(trans_exp vars e, tail) + :: T.JUMPIFN(trans_exp vars vartypes e, tail) :: strans @ [T.JUMP head, T.LABEL tail] @ remainder) end - - | trans_stms vars (SOME(b,e)) (A.Break::stms) = + | trans_stms vars vartypes ls (A.Effect(e)::stms) = (T.EFFECT (trans_exp vars vartypes e)) :: (trans_stms vars vartypes ls stms) + | trans_stms vars vartypes (SOME(b,e)) (A.Break::stms) = let - val remainder = trans_stms vars (SOME(b,e)) stms + val remainder = trans_stms vars vartypes (SOME(b,e)) stms in ((T.JUMP e) :: remainder) end - | trans_stms vars NONE (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker" - | trans_stms vars (SOME(b,e)) (A.Continue::stms) = + | trans_stms vars vartypes NONE (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker" + | trans_stms vars vartypes (SOME(b,e)) (A.Continue::stms) = let - val remainder = trans_stms vars (SOME(b,e)) stms + val remainder = trans_stms vars vartypes (SOME(b,e)) stms in ((T.JUMP b) :: remainder) end - | trans_stms vars NONE (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker" - | trans_stms vars ls (A.Nop::stms) = trans_stms vars ls stms - | trans_stms vars ls (A.MarkedStm m :: stms) = trans_stms vars ls ((Mark.data m) :: stms) - | trans_stms vars _ nil = nil + | trans_stms vars vartypes NONE (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker" + | trans_stms vars vartypes ls (A.Nop::stms) = trans_stms vars vartypes ls stms + | trans_stms vars vartypes ls (A.MarkedStm m :: stms) = trans_stms vars vartypes ls ((Mark.data m) :: stms) + | trans_stms vars vartypes _ nil = nil - fun trans_funcs (A.Extern(t, id, varl)::l) = trans_funcs l - | trans_funcs (A.Function(t, id, args, vars, body)::l) = + fun trans_funcs ((id, A.Extern(_, _))::l) = trans_funcs l + | trans_funcs ((id, A.MarkedFunction a)::l) = trans_funcs ((id, Mark.data a)::l) + | trans_funcs ((id, A.Function(t, args, vars, body))::l) = let - val (a,_) = ListPair.unzip (args @ vars) - val allvars = foldr (fn (a,b) => Symbol.bind b (a, Temp.new(Symbol.name(a)))) Symbol.empty a - val b = trans_stms allvars NONE body + val allvars = foldr + (fn ((name, t),b) => + 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) + val b = trans_stms allvars vartypes NONE body 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)) + (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG (n))) numberedargs in (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l) end | trans_funcs nil = nil + in - trans_funcs p + trans_funcs funclist end - end