X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/6ade8b0a3251e44b34c6bdbbd9403e36d6fd6231..2ab9671fde5297fc59583361f152e812e66c2d17:/codegen/codegen.sml?ds=inline diff --git a/codegen/codegen.sml b/codegen/codegen.sml index 8a5afe2..de8fa1e 100644 --- a/codegen/codegen.sml +++ b/codegen/codegen.sml @@ -6,430 +6,315 @@ signature CODEGEN = sig - val codegen : Tree.stm list -> x86.insn list + val codegen : Tree.stm list -> Blarg.insn list end structure Codegen :> CODEGEN = struct structure T = Tree - structure X = x86 - - (* effect : T.exp -> bool - * true iff the given expression has an effect. - *) - fun effect (T.BINOP(T.DIV, _, _)) = true - | effect (T.BINOP(T.MOD, _, _)) = true - | effect (T.CALL _) = true - | effect (T.BINOP(_, a, b)) = (effect a) orelse (effect b) - | effect (T.UNOP (_, a)) = effect a - | effect _ = false + structure TU = TreeUtils + structure X = Blarg + structure Tm = Temp (* hasfixed : T.exp -> bool - * true iff the given expression has an hasfixed. Somewhat like effect, hmm? + * true iff the given expression has an hasfixed. *) - fun hasfixed (T.BINOP(T.DIV, _, _)) = true - | hasfixed (T.BINOP(T.MOD, _, _)) = true - | hasfixed (T.BINOP(T.LSH, _, _)) = true - | hasfixed (T.BINOP(T.RSH, _, _)) = true - | hasfixed (T.CALL _) = true + fun hasfixed (T.CALL _) = true | hasfixed (T.BINOP(_, a, b)) = (hasfixed a) orelse (hasfixed b) | hasfixed (T.UNOP (_, a)) = hasfixed a + | hasfixed (T.ALLOC(_)) = true + | hasfixed (T.MEMORY (m)) = hasfixed m + | hasfixed (T.STMVAR _) = true | hasfixed _ = false + (* binophit : X.oper -> X.opc -> T.exp -> T.exp -> X.insn list *) + (* binophit d oper e1 e2 + * generates instructions to achieve d <- e1 oper e2 + * oper should be something like X.ADD + *) + fun binophit d oper e1 e2 = + let + val t = X.TEMP (Tm.new "binop") + val i1 = munch_exp d e1 + val i2 = munch_exp t e2 +(* val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *) +(* val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *) + in + [X.COMMENT "binophit" ] @ i1 @ i2 @ [X.INSN (X.AL, oper (d, t)), X.COMMENT "binophit done"] + end + + (* cmphit : X.oper -> X.exp -> X.insn list + * cmphit d ex + * generates instructions to set d based on the truth value of ex + *) + and cmphit d ex = + let + val (insns, pos, neg) = munch_cond ex + in + insns @ [X.INSN (X.AL, X.MOVLIT (d, 0w0)), X.INSN (pos, X.MOVLIT (d, 0w1))] + end + (* munch_exp : prex86oper -> T.exp -> prex86insn list *) (* munch_exp d e * generates instructions to achieve d <- e * d must be TEMP(t) or REG(r) *) - fun munch_exp d (T.CONST(n)) = [X.MOV(d, X.CONST n)] - | munch_exp d (T.TEMP(t)) = [X.MOV(d, X.TEMP t)] - | munch_exp d (T.ARG(0)) = [X.MOV(d, X.REG X.EDI)] - | munch_exp d (T.ARG(1)) = [X.MOV(d, X.REG X.ESI)] - | munch_exp d (T.ARG(2)) = [X.MOV(d, X.REG X.EDX)] - | munch_exp d (T.ARG(3)) = [X.MOV(d, X.REG X.ECX)] - | munch_exp d (T.ARG(4)) = [X.MOV(d, X.REG X.R8D)] - | munch_exp d (T.ARG(5)) = [X.MOV(d, X.REG X.R9D)] - | munch_exp d (T.ARG(t)) = [X.MOV(d, X.STACKARG (t - 6))] - | munch_exp d (T.CALL(name, l)) = (* Scary demons live here. *) + and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge n))] + | 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))] + | munch_exp d (T.ARG(1)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R1))] + | munch_exp d (T.ARG(2)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R2))] + | munch_exp d (T.ARG(3)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R3))] + | munch_exp d (T.ARG(t)) = [X.INSN (X.AL, X.MOV(d, X.STACKARG (t - 4)))] + | munch_exp d (T.CALL(name, l)) = (* Scary demons live here. *) let val nargs = length l - val nstack = if (nargs <= 6) + val nstack = if (nargs <= 4) then 0 - else nargs - 6 - val stackb = nstack * 8 - fun argdest 1 = X.REG X.EDI - | argdest 2 = X.REG X.ESI - | argdest 3 = X.REG X.EDX - | argdest 4 = X.REG X.ECX - | argdest 5 = X.REG X.R8D - | argdest 6 = X.REG X.R9D - | argdest n = X.REL (X.RSP, (~(stackb - 8 * (n - 7)))) + 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)*) val dests = List.tabulate (nargs, fn x => argdest (x+1)) val hf = List.map hasfixed l - val (d_hf, exps_hf) = ListPair.unzip (ListPair.foldr + val (d_hf, l_hf) = ListPair.unzip (ListPair.foldr (fn (a,b,c) => if b then a::c else c) nil (ListPair.zip (dests,l), hf) ) - val (d_nohf, exps_nohf) = ListPair.unzip (ListPair.foldr + val (d_nohf, l_nohf) = ListPair.unzip (ListPair.foldr (fn (a,b,c) => if b then c else a::c) nil (ListPair.zip (dests,l), hf) ) - val temps = List.tabulate (List.length d_hf, fn x => Temp.new(Int.toString x ^ " arg")) + val temps = List.map (fn _ => Temp.new ("arg")) l_hf val argevals_hf = List.map (fn (t,exp) => munch_exp (X.TEMP t) exp) - (ListPair.zip (temps, exps_hf)) + (ListPair.zip (temps, l_hf)) val argpushes = List.map - (fn (dest, t) => [(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) - (ListPair.zip (d_nohf, exps_nohf)) + (ListPair.zip (d_nohf, l_nohf)) + + val t_stackb = Temp.new ("stackb") + val t_target = Temp.new ("target") in List.concat argevals_hf @ List.concat argpushes @ List.concat argevals_nohf @ - [ X.SIZE (X.Qword, X.SUB (X.REG X.RSP, X.CONST (Word32.fromInt stackb))), - X.CALL (name, nargs), - X.SIZE (X.Qword, X.ADD (X.REG X.RSP, X.CONST (Word32.fromInt stackb))), - X.MOV (d, X.REG X.EAX) ] (* Finally! *) - end - | munch_exp d (T.BINOP(T.ADD, e1, T.CONST 0w0)) = munch_exp d e1 - | munch_exp d (T.BINOP(T.ADD, T.CONST 0w0, e1)) = munch_exp d e1 - | munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = (munch_exp d e1) @ [X.ADD(d, X.CONST n)] - | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = (munch_exp d e1) @ [X.ADD(d, X.CONST n)] - | munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = (munch_exp d e1) @ [X.ADD(d, X.TEMP t)] - | munch_exp d (T.BINOP(T.ADD, T.TEMP t, e2)) = (munch_exp d e2) @ [X.ADD(d, X.TEMP t)] - | munch_exp d (T.BINOP(T.ADD, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("add")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.ADD(d, t1)] - end - | munch_exp d (T.BINOP(T.SUB, T.CONST 0w0, e1)) = (munch_exp d e1) @ [X.NEG d] - | munch_exp d (T.BINOP(T.SUB, e1, T.CONST 0w0)) = munch_exp d e1 - | munch_exp d (T.BINOP(T.SUB, e1, T.CONST(n))) = (munch_exp d e1) @ [X.SUB(d, X.CONST n)] - | munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = (munch_exp d e1) @ [X.SUB(d, X.TEMP t)] - | munch_exp d (T.BINOP(T.SUB, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("sub")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.SUB(d, t1)] - end - | munch_exp d (T.BINOP(T.MUL, T.TEMP t, T.CONST n)) = [X.IMUL3(d, X.TEMP t, n)] - | munch_exp d (T.BINOP(T.MUL, T.CONST n, T.TEMP t)) = [X.IMUL3(d, X.TEMP t, n)] - | munch_exp d (T.BINOP(T.MUL, e1, T.CONST 0w1)) = munch_exp d e1 - | munch_exp d (T.BINOP(T.MUL, T.CONST 0w1, e1)) = munch_exp d e1 - | munch_exp d (T.BINOP(T.MUL, e1, T.CONST n)) = (munch_exp d e1) @ [X.IMUL(d, X.CONST n)] - | munch_exp d (T.BINOP(T.MUL, T.CONST n, e1)) = (munch_exp d e1) @ [X.IMUL(d, X.CONST n)] - | munch_exp d (T.BINOP(T.MUL, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("mul")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.IMUL(d, t1)] - end - | munch_exp d (T.BINOP(T.DIV, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("div")) - in - (munch_exp t1 e1) @ (munch_exp d e2) @ - [X.MOV (X.REG X.EAX, t1), X.CLTD, X.IDIV d, X.MOV (d, X.REG X.EAX)] - end - | munch_exp d (T.BINOP(T.MOD, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("mod")) - in - (munch_exp t1 e1) @ (munch_exp d e2) @ - [X.MOV (X.REG X.EAX, t1), X.CLTD, X.IDIV d, X.MOV (d, X.REG X.EDX)] - end - | munch_exp d (T.BINOP(T.LSH, e1, T.CONST n)) = (munch_exp d e1) @ [X.SAL (d, X.CONST (n mod 0w32))] - | munch_exp d (T.BINOP(T.LSH, e1, T.TEMP t)) = (munch_exp d e1) @ [X.MOV (X.REG X.ECX, X.TEMP t), X.SAL (d, X.REG X.ECX)] - | munch_exp d (T.BINOP(T.LSH, e1, e2)) = - let - val t = X.TEMP (Temp.new ("lsh")) - in - (munch_exp d e1) @ (munch_exp t e2) @ [X.MOV (X.REG X.ECX, t), X.SAL (d, X.REG X.ECX)] - end - | munch_exp d (T.BINOP(T.RSH, e1, T.CONST n)) = (munch_exp d e1) @ [X.SAR (d, X.CONST (n mod 0w32))] - | munch_exp d (T.BINOP(T.RSH, e1, T.TEMP t)) = (munch_exp d e1) @ [X.MOV (X.REG X.ECX, X.TEMP t), X.SAR (d, X.REG X.ECX)] - | munch_exp d (T.BINOP(T.RSH, e1, e2)) = - let - val t = X.TEMP (Temp.new ("rsh")) - in - (munch_exp d e1) @ (munch_exp t e2) @ [X.MOV (X.REG X.ECX, t), X.SAR (d, X.REG X.ECX)] - end - | munch_exp d (T.BINOP(T.BITAND, T.CONST n, e1)) = (munch_exp d e1) @ [X.AND (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITAND, e1, T.CONST n)) = (munch_exp d e1) @ [X.AND (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITAND, T.TEMP t, e1)) = (munch_exp d e1) @ [X.AND (d, X.TEMP t)] - | munch_exp d (T.BINOP(T.BITAND, e1, T.TEMP t)) = (munch_exp d e1) @ [X.AND (d, X.TEMP t)] - | munch_exp d (T.BINOP(T.BITAND, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("bitand")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.AND(d, t1)] - end - | munch_exp d (T.BINOP(T.BITOR, T.CONST n, e1)) = (munch_exp d e1) @ [X.OR (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITOR, e1, T.CONST n)) = (munch_exp d e1) @ [X.OR (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITOR, T.TEMP t, e1)) = (munch_exp d e1) @ [X.OR (d, X.TEMP t)] - | munch_exp d (T.BINOP(T.BITOR, e1, T.TEMP t)) = (munch_exp d e1) @ [X.OR (d, X.TEMP t)] - | munch_exp d (T.BINOP(T.BITOR, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("bitor")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.OR(d, t1)] + [ 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))] end - | munch_exp d (T.BINOP(T.BITXOR, T.CONST n, e1)) = (munch_exp d e1) @ [X.XOR (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITXOR, e1, T.CONST n)) = (munch_exp d e1) @ [X.XOR (d, X.CONST n)] - | munch_exp d (T.BINOP(T.BITXOR, T.TEMP t, e1)) = (munch_exp d e1) @ [X.XOR (d, X.TEMP t)] - | munch_exp d (T.BINOP(T.BITXOR, e1, T.TEMP t)) = (munch_exp d e1) @ [X.XOR (d, X.TEMP t)] + (*| 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 + | munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = binophit_t d X.ADD e1 t + | munch_exp d (T.BINOP(T.ADD, T.TEMP t, e1)) = binophit_t d X.ADD e1 t*) + | munch_exp d (T.BINOP(T.ADD, e1, e2)) = binophit d X.ADD e1 e2 + + (*| munch_exp d (T.BINOP(T.SUB, e1, T.CONST n)) = binophit_c d X.SUB e1 n + | munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = binophit_t d X.SUB e1 t*) + | munch_exp d (T.BINOP(T.SUB, e1, e2)) = binophit d X.SUB e1 e2 + | munch_exp d (T.BINOP(T.MUL, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mul", [e1, e2])) + | munch_exp d (T.BINOP(T.DIV, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_div", [e1, e2])) + | munch_exp d (T.BINOP(T.MOD, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mod", [e1, e2])) + | munch_exp d (T.BINOP(T.LSH, e1, e2)) = binophit d X.SHL e1 e2 + | munch_exp d (T.BINOP(T.RSH, e1, e2)) = binophit d X.SHR e1 e2 + | munch_exp d (T.BINOP(T.BITAND, e1, e2)) = binophit d X.AND e1 e2 + | munch_exp d (T.BINOP(T.BITOR, e1, e2)) = munch_exp d (T.UNOP (T.BITNOT, T.BINOP (T.BITAND, T.UNOP (T.BITNOT, e1), T.UNOP (T.BITNOT, e2)))) | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("bitxor")) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.XOR(d, t1)] - end + munch_exp d (T.BINOP(T.BITOR, T.BINOP(T.BITAND, e1, T.UNOP(T.BITNOT, e2)), + T.BINOP(T.BITAND, e2, T.UNOP(T.BITNOT, e1)))) + | munch_exp d (a as T.BINOP(T.LOGAND, e1, e2)) = let val (insn1, pos1, neg1) = munch_cond e1 val (insn2, pos2, neg2) = munch_cond e2 - val t1 = X.TEMP (Temp.new("logand 1")) - val t2 = X.TEMP (Temp.new("logand 2")) val l = Label.new () in - if (effect e2 orelse (length insn2 > 10)) - then (insn1) @ - [X.SETcc(pos1, t1), X.Jcc (neg1, l)] @ - (insn2) @ - [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB(d, t1)] - else insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.AND(t1, t2)), X.MOVZB(d, t1)] + (insn1) @ + [X.INSN (X.AL, X.MOVLIT (d, 0w0)), + X.INSN (neg1, X.MOVLBL (X.REG X.PC, l))] @ + (insn2) @ + [X.INSN (pos2, X.MOVLIT (d, 0w1)), + X.LABEL l] end | munch_exp d (a as T.BINOP(T.LOGOR, e1, e2)) = let val (insn1, pos1, neg1) = munch_cond e1 val (insn2, pos2, neg2) = munch_cond e2 - val t1 = X.TEMP (Temp.new("logor 1")) - val t2 = X.TEMP (Temp.new("logor 2")) + val t1 = X.TEMP (Tm.new "logand 1") + val t2 = X.TEMP (Tm.new "logand 2") val l = Label.new () in - if (effect e2 orelse (length insn2 > 10)) - then (insn1) @ - [X.SETcc(pos1, t1), X.Jcc (pos1, l)] @ - (insn2) @ - [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB(d, t1)] - else insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.OR(t1, t2)), X.MOVZB(d, t1)] + (insn1) @ + [X.INSN (X.AL, X.MOVLIT (d, 0w0)), + X.INSN (pos1, X.MOVLIT (d, 0w1)), + X.INSN (pos1, X.MOVLBL (X.REG X.PC, l))] @ + (insn2) @ + [X.INSN (pos2, X.MOVLIT (d, 0w1)), + X.LABEL l] end - | munch_exp d (a as T.BINOP(T.EQ, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (a as T.BINOP(T.NEQ, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (a as T.BINOP(T.LE, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (a as T.BINOP(T.LT, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (a as T.BINOP(T.GE, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (a as T.BINOP(T.GT, _, _)) = - let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end - | munch_exp d (T.UNOP(T.NEG, T.CONST n)) = [X.MOV (d, X.CONST (~n))] - | munch_exp d (T.UNOP(T.NEG, e1)) = (munch_exp d e1) @ [X.NEG d] - | munch_exp d (T.UNOP(T.BITNOT, T.CONST n)) = [X.MOV (d, X.CONST (Word32.notb n))] - | munch_exp d (T.UNOP(T.BITNOT, e1)) = (munch_exp d e1) @ [X.NOT d] - | munch_exp d (T.UNOP(T.BANG, T.CONST n)) = if (n = 0w0) then [X.MOV (d, X.CONST 0w1)] else [X.MOV (d, X.CONST 0w0)] - | munch_exp d (T.UNOP(T.BANG, e)) = + | munch_exp d (a as T.BINOP(T.EQ, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.NEQ, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.LE, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.LT, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.GE, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.GT, _, _)) = cmphit d a + | munch_exp d (a as T.BINOP(T.BE, _, _)) = cmphit d a + + | munch_exp d (T.UNOP(T.NEG, e1)) = let - val (insns, pos, neg) = munch_cond e + val t = Temp.new "-val" + val i = munch_exp (X.TEMP t) e1 in - insns @ [X.SETcc (neg, d), X.MOVZB(d, d)] + (i) @ + [X.INSN (X.AL, X.MOVLIT (d, 0w0)), + X.INSN (X.AL, X.SUB (d, X.TEMP t))] end - (* munch_cond : T.exp -> X.insn list * X.cond * X.cond - * munch_cond stm generates code to set flags, and then returns a conditional - * to test if the expression was true and for if it was false. - *) - and munch_cond (T.UNOP (T.BANG, e)) = + | munch_exp d (T.UNOP(T.BITNOT, e1)) = let val i = munch_exp d e1 in i @ [X.INSN (X.AL, X.NOT (d, d))] end + | munch_exp d (T.UNOP(T.BANG, e)) = let val (insns, pos, neg) = munch_cond e in - (insns, neg, pos) - end - | munch_cond (T.BINOP(T.NEQ, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.NE, X.E) - | munch_cond (T.BINOP(T.NEQ, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.NE, X.E) - | munch_cond (T.BINOP(T.NEQ, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const neq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.NE, X.E) end - | munch_cond (T.BINOP(T.NEQ, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const neq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.NE, X.E) end - | munch_cond (T.BINOP(T.NEQ, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const neq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.NE, X.E) end - | munch_cond (T.BINOP(T.NEQ, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const neq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.NE, X.E) end - | munch_cond (T.BINOP(T.NEQ, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var neq 1")) - val t2 = X.TEMP (Temp.new ("var neq 2")) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.NE, X.E) - end - | munch_cond (T.BINOP(T.EQ, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.E, X.NE) - | munch_cond (T.BINOP(T.EQ, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.E, X.NE) - | munch_cond (T.BINOP(T.EQ, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const eq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.E, X.NE) end - | munch_cond (T.BINOP(T.EQ, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const eq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.E, X.NE) end - | munch_cond (T.BINOP(T.EQ, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const eq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.E, X.NE) end - | munch_cond (T.BINOP(T.EQ, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const eq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.E, X.NE) end - | munch_cond (T.BINOP(T.EQ, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var eq 1")) - val t2 = X.TEMP (Temp.new ("var eq 2")) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.E, X.NE) + insns @ + [X.INSN (X.AL, X.MOVLIT (d, 0w0)), + X.INSN (neg, X.MOVLIT (d, 0w1))] end - | munch_cond (T.BINOP(T.LE, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.LE, X.G) - | munch_cond (T.BINOP(T.LE, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.GE, X.L) - | munch_cond (T.BINOP(T.LE, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const le")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.GE, X.L) end - | munch_cond (T.BINOP(T.LE, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const le")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.LE, X.G) end - | munch_cond (T.BINOP(T.LE, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const le")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.GE, X.L) end - | munch_cond (T.BINOP(T.LE, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const le")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.LE, X.G) end - | munch_cond (T.BINOP(T.LE, e1, e2)) = + | munch_exp d (T.MEMORY (e1)) = let - val t1 = X.TEMP (Temp.new ("var le 1")) - val t2 = X.TEMP (Temp.new ("var le 2")) + val a = X.TEMP (Temp.new "addr") + val i = munch_exp a e1 in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.LE, X.G) + i @ + [X.INSN (X.AL, X.LDR (d, a))] end - | munch_cond (T.BINOP(T.LT, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.L, X.GE) - | munch_cond (T.BINOP(T.LT, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.G, X.LE) - | munch_cond (T.BINOP(T.LT, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const lt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.G, X.LE) end - | munch_cond (T.BINOP(T.LT, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const lt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.L, X.GE) end - | munch_cond (T.BINOP(T.LT, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const lt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.G, X.LE) end - | munch_cond (T.BINOP(T.LT, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const lt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end - | munch_cond (T.BINOP(T.LT, e1, e2)) = + + | munch_exp d (T.ALLOC(exp)) = let - val t1 = X.TEMP (Temp.new ("var lt 1")) - val t2 = X.TEMP (Temp.new ("var lt 2")) + val t1 = Temp.new "alloc" + val l1 = Label.new() + val einsn = munch_exp (X.TEMP t1) exp + val insns = munch_exp d (T.CALL (Symbol.symbol "calloc", [T.TEMP t1, T.CONST 0w1])) in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.L, X.GE) + einsn @ insns end - | munch_cond (T.BINOP(T.GT, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.G, X.LE) - | munch_cond (T.BINOP(T.GT, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.L, X.GE) - | munch_cond (T.BINOP(T.GT, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const gt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.G, X.LE) end - | munch_cond (T.BINOP(T.GT, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const gt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.L, X.GE) end - | munch_cond (T.BINOP(T.GT, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const gt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.G, X.LE) end - | munch_cond (T.BINOP(T.GT, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const gt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end - | munch_cond (T.BINOP(T.GT, e1, e2)) = +(* | munch_exp d (T.COND(c, T.CONST n1, T.CONST n2)) = let val (i,p,n) = munch_cond c in ((X.MOV (d, X.CONST n1))::i) @ [X.CMOVcc (p, d, X.CONST n2)] end *) + | munch_exp d (T.COND(c,e1,e2)) = let - val t1 = X.TEMP (Temp.new ("var gt 1")) - val t2 = X.TEMP (Temp.new ("var gt 2")) + val (insns, pos, neg) = munch_cond c + val l1 = Label.new() + val l2 = Label.new() + val i1 = munch_exp d e1 + val i2 = munch_exp d e2 +(* val _ = print ("cond: size " ^ Tm.sfx s1 ^ " from " ^ TU.Print.pp_exp e1 ^ ", " ^ Tm.sfx s2 ^ " from " ^ TU.Print.pp_exp e2 ^ "\n") *) in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.G, X.LE) + insns @ + [X.INSN (neg, X.MOVLBL (X.REG X.PC, l1))] @ + i1 @ + [X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l2)), + X.LABEL l1] @ + i2 @ + [X.LABEL l2] end - | munch_cond (T.BINOP(T.GE, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.GE, X.L) - | munch_cond (T.BINOP(T.GE, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.LE, X.G) - | munch_cond (T.BINOP(T.GE, e1, T.CONST n)) = - let val t = X.TEMP (Temp.new ("const ge")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.GE, X.L) end - | munch_cond (T.BINOP(T.GE, T.CONST n, e1)) = - let val t = X.TEMP (Temp.new ("const ge")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.LE, X.G) end - | munch_cond (T.BINOP(T.GE, e1, T.TEMP t)) = - let val t1 = X.TEMP (Temp.new ("const ge")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.GE, X.L) end - | munch_cond (T.BINOP(T.GE, T.TEMP t, e1)) = - let val t1 = X.TEMP (Temp.new ("const ge")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.LE, X.G) end - | munch_cond (T.BINOP(T.GE, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var ge 1")) - val t2 = X.TEMP (Temp.new ("var ge 2")) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.GE, X.L) - end - | munch_cond (T.BINOP(T.LOGOR, e1, e2)) = - let - val (insn1, pos1, neg1) = munch_cond e1 - val (insn2, pos2, neg2) = munch_cond e2 - val t1 = X.TEMP (Temp.new("logor c 1")) - val t2 = X.TEMP (Temp.new("logor c 2")) - val l = Label.new () - in - if (effect e2 orelse (length insn2 > 10)) - then ((insn1) @ - [X.SETcc (pos1, t1), X.Jcc (pos1, l)] @ - (insn2) @ - [X.SETcc (pos2, t1), X.LABEL l, X.SIZE (X.Byte, X.TEST (t1, t1))], - X.NE, X.E) - else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.OR(t1, t2))], X.NE, X.E) - end - | munch_cond (T.BINOP(T.LOGAND, e1, e2)) = + | munch_exp d (T.STMVAR (sl, e)) = let val i = munch_exp d e in List.concat (map munch_stm sl) @ i end + + and condhit e1 e2 (pos, neg) = + let + 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 + (i1 @ i2 @ [X.INSN (X.AL, X.SUBS (t1, t2))], pos, neg) + end + + (* munch_cond : T.exp -> X.insn list * X.cond * X.cond + * munch_cond stm generates code to set flags, and then returns a conditional + * to test if the expression was true and for if it was false. + *) + and munch_cond (T.UNOP (T.BANG, e)) = let - val (insn1, pos1, neg1) = munch_cond e1 - val (insn2, pos2, neg2) = munch_cond e2 - val t1 = X.TEMP (Temp.new("logand c 1")) - val t2 = X.TEMP (Temp.new("logand c 2")) - val l = Label.new () + val (insns, pos, neg) = munch_cond e in - if (effect e2 orelse (length insn2 > 10)) - then ((insn1) @ - [X.SETcc (pos1, t1), X.Jcc (neg1, l)] @ - (insn2) @ - [X.SETcc (pos2, t1), X.LABEL l, X.SIZE (X.Byte, X.TEST (t1, t1))], - X.NE, X.E) - else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.AND(t1, t2))], X.NE, X.E) + (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.BE, e1, e2)) = raise ErrorMsg.InternalError "memory safety not supported" + | munch_cond e = let val t = X.TEMP (Temp.new ("munch c")) + val i = munch_exp t e + in + (i @ [ X.INSN (X.AL, X.MOVS (t,t)) ], X.NE, X.EQ) + end + + (* 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 (X.TEMP t, oper))] + | munch_lval (T.MEMORY m) oper = + let + val t = X.TEMP (Tm.new "lv addr") + val i = munch_exp t m in - (munch_exp t e @ [ X.TEST (t,t) ], X.NE, X.E) + i @ + [X.INSN (X.AL, X.STO (t, oper))] end + | munch_lval _ _ = raise ErrorMsg.InternalError "That wasn't really a valid lvalue..." (* munch_stm : T.stm -> X.insn list *) (* munch_stm stm generates code to execute stm *) - fun munch_stm (T.MOVE (T.TEMP t, a as T.TEMP _)) = munch_exp (X.TEMP t) a - | munch_stm (T.MOVE (T.TEMP t, a as T.CONST _)) = munch_exp (X.TEMP t) a - | munch_stm (T.MOVE (T.TEMP t, a as T.ARG _)) = munch_exp (X.TEMP t) a + 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, a as T.ARG (an))) = + let + val i = munch_exp (X.TEMP t) a + in + i + end | munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = munch_exp (X.TEMP t) a - | munch_stm (T.MOVE(T.TEMP t1, e2)) = + | munch_stm (T.MOVE (a, e2)) = let - val t = Temp.new ("assign") + val t = X.TEMP (Temp.new ("assign")) + val i = munch_exp t e2 + val li = munch_lval a t in - munch_exp (X.TEMP t) e2 - @ [X.MOV(X.TEMP t1, X.TEMP t)] + i @ li end - | munch_stm (T.MOVE(_, _)) = - raise ErrorMsg.InternalError "Incorrect first operand for T.MOVE?" | munch_stm (T.RETURN(e)) = let - val t = Temp.new ("retval") + val t = X.TEMP (Temp.new ("retval")) + val i = munch_exp t e in - munch_exp (X.TEMP t) e - @ [X.MOV(X.REG X.EAX, X.TEMP t), X.RET] + i @ [X.INSN (X.AL, X.MOV(X.REG X.R0, t)), X.INSN (X.AL, X.POP (X.REG X.SP, X.REG X.PC))] end - | munch_stm (T.LABEL(l)) = [X.LABEL l] - | munch_stm (T.JUMP(l)) = [X.JMP l] + | munch_stm (T.LABEL l) = [X.LABEL l] + | munch_stm (T.JUMP l) = [X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l))] | munch_stm (T.JUMPIFN(e, l)) = let val (insns, pos, neg) = munch_cond e in - insns @ [X.Jcc (neg, l)] + insns @ [X.INSN (neg, X.MOVLBL (X.REG X.PC, l))] end + | munch_stm (T.EFFECT exp) = let val t = X.TEMP (Temp.new "throwaway") val i = munch_exp t exp in i end fun codegen nil = nil | codegen (stm::stms) = munch_stm stm @ codegen stms