X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/1144856ba9d6018d9922c6ede7e97779a0fe6373..5c79bb689ab446551bc7ec4497e6c9b75582837e:/codegen/codegen.sml diff --git a/codegen/codegen.sml b/codegen/codegen.sml index 6ee8c2f..18ac4af 100644 --- a/codegen/codegen.sml +++ b/codegen/codegen.sml @@ -12,22 +12,12 @@ end structure Codegen :> CODEGEN = struct structure T = Tree + structure TU = TreeUtils 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 (T.MEMORY m) = true - | effect (T.ALLOC(_)) = true - | effect _ = false + 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 @@ -37,24 +27,52 @@ struct | 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.MEMORY (m,s)) = hasfixed m + | hasfixed (T.STMVAR _) = true | hasfixed _ = false + fun offshit a b 0w4 d = [X.LEA(d, (X.REL((a, Tm.Quad), (b, Tm.Quad), 0w4), Tm.Quad))] + | offshit a b 0w8 d = [X.LEA(d, (X.REL((a, Tm.Quad), (b, Tm.Quad), 0w8), Tm.Quad))] + | offshit a b n d = [X.IMUL((b, Tm.Long), (X.CONST n, Tm.Long)), X.MOV(d, (a, Tm.Quad)), X.ADD(d, (b, Tm.Quad))] + + fun binophit_c d oper e c = let val (i, s) = munch_exp d e in (i @ [oper ((d,s), (X.CONST c, s))], s) end + and binophit_t d oper e t = + let + val (i, s) = munch_exp d e + val ts = Tm.size t + val rs = if Tm.cmpsize (s, ts) = GREATER then s else ts + in + (i @ [oper ((d, rs), (X.TEMP t, rs))], rs) + end + and binophit d oper e1 e2 = + let + val t = X.TEMP (Tm.new "add" Tm.Long) + val (i1, s1) = munch_exp d e1 + val (i2, s2) = munch_exp t e2 +(* val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *) + val rs = if Tm.cmpsize (s1, s2) = GREATER then s1 else s2 +(* val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *) + in + (i1 @ i2 @ [oper ((d,rs), (t,rs))], rs) + end + and cmphit d a = let val (insns, pos, neg) = munch_cond a in (insns @ [X.SETcc (pos, (d, Tm.Byte)), X.MOVZB((d, Tm.Long), (d, Tm.Byte))], Tm.Long) 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) *) - and 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, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.EDI))] - | munch_exp d (T.ARG(1, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.ESI))] - | munch_exp d (T.ARG(2, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.EDX))] - | munch_exp d (T.ARG(3, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.ECX))] - | munch_exp d (T.ARG(4, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.R8D))] - | munch_exp d (T.ARG(5, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.REG X.R9D))] - | munch_exp d (T.ARG(t, sz)) = [X.MOV(d, X.OSIZE (X.sts sz, X.STACKARG (t - 6)))] - | munch_exp d (T.CALL(name, l, rsz)) = (* Scary demons live here. *) + and munch_exp d (T.CONST n) = ([X.MOV((d, Tm.Long), (X.CONST n, Tm.Long))], Tm.Long) + | munch_exp d (T.NULLPTR) = ([X.MOV((d, Tm.Quad), (X.CONST 0w0, Tm.Quad))], Tm.Quad) + | munch_exp d (T.TEMP(t)) = ([X.MOV((d, Tm.size t), (X.TEMP t, Tm.size t))], Tm.size t) + | munch_exp d (T.ARG(0, sz)) = ([X.MOV((d, sz), (X.REG X.EDI, sz))], sz) + | munch_exp d (T.ARG(1, sz)) = ([X.MOV((d, sz), (X.REG X.ESI, sz))], sz) + | munch_exp d (T.ARG(2, sz)) = ([X.MOV((d, sz), (X.REG X.EDX, sz))], sz) + | munch_exp d (T.ARG(3, sz)) = ([X.MOV((d, sz), (X.REG X.ECX, sz))], sz) + | munch_exp d (T.ARG(4, sz)) = ([X.MOV((d, sz), (X.REG X.R8D, sz))], sz) + | munch_exp d (T.ARG(5, sz)) = ([X.MOV((d, sz), (X.REG X.R9D, sz))], sz) + | munch_exp d (T.ARG(t, sz)) = ([X.MOV((d, sz), (X.STACKARG (t - 6), sz))], sz) + | munch_exp d (T.CALL(name, l, rsz)) = (* Scary demons live here. *) let val nargs = length l val nstack = if (nargs <= 6) @@ -67,7 +85,7 @@ struct | argdest 4 = X.REG X.ECX | argdest 5 = X.REG X.R8D | argdest 6 = X.REG X.R9D - | argdest n = X.REL (X.REG X.RSP, X.CONST (Word32.fromInt (~(stackb - 8 * (n - 7)))) ) + | argdest n = 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 (exps,_) = ListPair.unzip l @@ -83,180 +101,205 @@ struct (ListPair.zip (dests,l), hf) ) val temps = List.map (fn (_, sz) => Temp.new ("arg") sz (* xxx? *)) l_hf - val argevals_hf = List.map + val (argevals_hf,_) = ListPair.unzip (List.map (fn (t,(exp,_)) => munch_exp (X.TEMP t) exp) - (ListPair.zip (temps, l_hf)) + (ListPair.zip (temps, l_hf))) val argpushes = List.map - (fn (dest, t) => [(X.MOV (X.OSIZE(X.sts (Temp.size t), dest), X.TEMP t))]) + (fn (dest, t) => [X.MOV ((dest, Tm.size t), (X.TEMP t, Tm.size t))]) (ListPair.zip (d_hf, temps)) - val argevals_nohf = List.map - (fn (d,(exp,sz)) => munch_exp (X.OSIZE (X.sts sz, d)) exp) - (ListPair.zip (d_nohf, l_nohf)) + val (argevals_nohf,_) = ListPair.unzip (List.map + (fn (d,(exp,sz)) => munch_exp d exp) + (ListPair.zip (d_nohf, l_nohf))) in - List.concat argevals_hf @ - List.concat argpushes @ - List.concat argevals_nohf @ - [ X.SUB (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stackb)), - X.CALL (name, nargs), - X.ADD (X.OSIZE (X.Qword, X.REG X.RSP), X.CONST (Word32.fromInt stackb)), - X.MOV (d, X.OSIZE (X.sts rsz, 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") 4) - 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") 4) - 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") 4) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.IMUL(d, t1)] + (List.concat argevals_hf @ + List.concat argpushes @ + List.concat argevals_nohf @ + [ X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stackb), Tm.Quad)), + X.CALL (name, nargs), + X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stackb), Tm.Quad)), + X.MOV ((d, rsz), (X.REG X.EAX, rsz))], rsz) (* Finally! *) 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 + | 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, T.TEMP t, T.CONST n)) = let val s = Tm.size t in ([X.IMUL3((d,s), (X.TEMP t,s), n)], Tm.size t) end + | munch_exp d (T.BINOP(T.MUL, T.CONST n, T.TEMP t)) = let val s = Tm.size t in ([X.IMUL3((d,s), (X.TEMP t,s), n)], Tm.size t) end + | munch_exp d (T.BINOP(T.MUL, e1, T.CONST n)) = binophit_c d X.IMUL e1 n + | munch_exp d (T.BINOP(T.MUL, T.CONST n, e1)) = binophit_c d X.IMUL e1 n + | munch_exp d (T.BINOP(T.MUL, e1, e2)) = binophit d X.IMUL e1 e2 | munch_exp d (T.BINOP(T.DIV, e1, e2)) = let - val t1 = X.TEMP (Temp.new ("div") 4) + val t1 = X.TEMP (Temp.new ("div") Tm.Long) + val (i1, s1) = munch_exp t1 e1 + val (i2, s2) = munch_exp d e2 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)] + (i1 @ i2 @ [X.MOV ((X.REG X.EAX, s1), (t1, s1)), X.CLTD, X.IDIV (d, s2), X.MOV ((d, s2), (X.REG X.EAX, s2))], Tm.Long) end | munch_exp d (T.BINOP(T.MOD, e1, e2)) = let - val t1 = X.TEMP (Temp.new ("mod") 4) + val t1 = X.TEMP (Temp.new ("div") Tm.Long) + val (i1, s1) = munch_exp t1 e1 + val (i2, s2) = munch_exp d e2 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)] + (i1 @ i2 @ [X.MOV ((X.REG X.EAX, s1), (t1, s1)), X.CLTD, X.IDIV (d, s2), X.MOV ((d, s2), (X.REG X.EDX, s2))], Tm.Long) 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)) = + | munch_exp d (T.BINOP(T.LSH, e1, T.CONST n)) = let val (i,s) = munch_exp d e1 in (i @ [X.SAL ((d,s), (X.CONST (n mod 0w32),s))],s) end + | munch_exp d (T.BINOP(T.LSH, e1, T.TEMP t)) = let - val t = X.TEMP (Temp.new ("lsh") 4) - in - (munch_exp d e1) @ (munch_exp t e2) @ [X.MOV (X.REG X.ECX, t), X.SAL (d, X.REG X.ECX)] + val (i,s) = munch_exp d e1 + in + (i @ [X.MOV ((X.REG X.ECX, s), (X.TEMP t, s)), X.SAL ((d,s), (X.REG X.ECX, Tm.Byte))], s) 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") 4) - 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)) = + | munch_exp d (T.BINOP(T.LSH, e1, e2)) = let - val t1 = X.TEMP (Temp.new ("bitand") 4) + val t = X.TEMP (Temp.new ("lsh") Tm.Long) + val (i1, s1) = munch_exp d e1 + val (i2, s2) = munch_exp t e2 in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.AND(d, t1)] + (i1 @ i2 @ [X.MOV ((X.REG X.ECX, s1), (t, s1)), X.SAL ((d, s2), (X.REG X.ECX, Tm.Byte))], s2) 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)) = + | munch_exp d (T.BINOP(T.RSH, e1, T.CONST n)) = let val (i,s) = munch_exp d e1 in (i @ [X.SAR ((d,s), (X.CONST (n mod 0w32),s))],s) end + | munch_exp d (T.BINOP(T.RSH, e1, T.TEMP t)) = let - val t1 = X.TEMP (Temp.new ("bitor") 4) - in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.OR(d, t1)] + val (i,s) = munch_exp d e1 + in + (i @ [X.MOV ((X.REG X.ECX, s), (X.TEMP t, s)), X.SAR ((d,s), (X.REG X.ECX, Tm.Byte))], s) 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.BITXOR, e1, e2)) = + | munch_exp d (T.BINOP(T.RSH, e1, e2)) = let - val t1 = X.TEMP (Temp.new ("bitxor") 4) + val t = X.TEMP (Temp.new ("lsh") Tm.Long) + val (i1, s1) = munch_exp d e1 + val (i2, s2) = munch_exp t e2 in - (munch_exp d e1) @ (munch_exp t1 e2) @ [X.XOR(d, t1)] + (i1 @ i2 @ [X.MOV ((X.REG X.ECX, s1), (t, s1)), X.SAR ((d, s2), (X.REG X.ECX, Tm.Byte))], s2) end + | munch_exp d (T.BINOP(T.BITAND, T.CONST n, e1)) = binophit_c d X.AND e1 n + | munch_exp d (T.BINOP(T.BITAND, e1, T.CONST n)) = binophit_c d X.AND e1 n + | munch_exp d (T.BINOP(T.BITAND, T.TEMP t, e1)) = binophit_t d X.AND e1 t + | munch_exp d (T.BINOP(T.BITAND, e1, T.TEMP t)) = binophit_t d X.AND e1 t + | munch_exp d (T.BINOP(T.BITAND, e1, e2)) = binophit d X.AND e1 e2 + + | munch_exp d (T.BINOP(T.BITOR, T.CONST n, e1)) = binophit_c d X.OR e1 n + | munch_exp d (T.BINOP(T.BITOR, e1, T.CONST n)) = binophit_c d X.OR e1 n + | munch_exp d (T.BINOP(T.BITOR, T.TEMP t, e1)) = binophit_t d X.OR e1 t + | munch_exp d (T.BINOP(T.BITOR, e1, T.TEMP t)) = binophit_t d X.OR e1 t + | munch_exp d (T.BINOP(T.BITOR, e1, e2)) = binophit d X.OR e1 e2 + + | munch_exp d (T.BINOP(T.BITXOR, T.CONST n, e1)) = binophit_c d X.XOR e1 n + | munch_exp d (T.BINOP(T.BITXOR, e1, T.CONST n)) = binophit_c d X.XOR e1 n + | munch_exp d (T.BINOP(T.BITXOR, T.TEMP t, e1)) = binophit_t d X.XOR e1 t + | munch_exp d (T.BINOP(T.BITXOR, e1, T.TEMP t)) = binophit_t d X.XOR e1 t + | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) = binophit d X.XOR e1 e2 + | 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") 4) - val t2 = X.TEMP (Temp.new("logand 2") 4) + val t1 = (X.TEMP (Tm.new "logand 1" Tm.Byte), Tm.Byte) + val t2 = (X.TEMP (Tm.new "logand 2" Tm.Byte), Tm.Byte) 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.AND(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t2)), X.MOVZB(d, t1)] + if (TU.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, Tm.Long), t1)], Tm.Long) + else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.AND(t1,t2), X.MOVZB((d, Tm.Long), t1)], Tm.Long) 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") 4) - val t2 = X.TEMP (Temp.new("logor 2") 4) + val t1 = (X.TEMP (Tm.new "logand 1" Tm.Byte), Tm.Byte) + val t2 = (X.TEMP (Tm.new "logand 2" Tm.Byte), Tm.Byte) 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.OR(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t2)), X.MOVZB(d, t1)] + if (TU.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, Tm.Long), t1)], Tm.Long) + else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.OR(t1,t2), X.MOVZB((d, Tm.Long), t1)], Tm.Long) 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 (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 (i, s) = munch_exp d e1 in (i @ [X.NEG (d, Tm.Long)], s) end + | munch_exp d (T.UNOP(T.BITNOT, e1)) = let val (i, s) = munch_exp d e1 in (i @ [X.NOT (d, Tm.Long)], s) end | munch_exp d (T.UNOP(T.BANG, e)) = let val (insns, pos, neg) = munch_cond e in - insns @ [X.SETcc (neg, d), X.MOVZB(d, d)] + (insns @ [X.SETcc (neg, (d, Tm.Byte)), X.MOVZB((d, Tm.Long), (d, Tm.Byte))], Tm.Long) + end + | munch_exp d (T.MEMORY (e1,s)) = + let + val a = X.TEMP (Temp.new "addr" Tm.Quad) + val (i, s') = munch_exp a e1 + val _ = if s' = Tm.Quad then () else raise ErrorMsg.InternalError "memory fuxed." + in + (i @ [X.MOV ((d,s), (X.REL ((a, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))], s) end - | munch_exp d (T.MEMORY e1) = + | munch_exp d (T.ALLOC(exp)) = + let - val a = X.TEMP (Temp.new "addr" 8) + val t1 = Temp.new "alloc" Tm.Long + 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, Tm.Long), (T.CONST 0w1, Tm.Long)], Tm.Quad)) + val rd = (d, Tm.Quad) in - munch_exp a e1 @ [X.MOV (d, X.REL (a, X.CONST 0w0))] + (einsn @ insns, Tm.Quad) end - | munch_exp d (T.ALLOC(exp)) = (munch_exp d (T.CALL (Symbol.symbol "calloc", [(exp, 4), (T.CONST 0w1, 4)], 8))) - @ [X.MOV (X.REL (d, X.CONST 0w0), X.CONST 0w0)] +(* | 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 (insns, pos, neg) = munch_cond c + val l1 = Label.new() + val l2 = Label.new() + val (i1, s1) = munch_exp d e1 + val (i2, s2) = 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 + (insns @ [X.Jcc(neg, l1)] @ i1 @ [X.JMP l2, X.LABEL l1] @ i2 @ [X.LABEL l2], if s1 = s2 then s1 else raise ErrorMsg.InternalError "condfuxed.") + end + | munch_exp d (T.STMVAR (sl, e)) = let val (i, s) = munch_exp d e in (List.concat (map munch_stm sl) @ i, s) end + + and condhit_tc t c (pos, neg) = ([X.CMP((X.TEMP t, Tm.size t), (X.CONST c, Tm.size t))], pos, neg) + and condhit_c e c (pos, neg) = + let + val t = X.TEMP (Temp.new "consthit" Tm.Long) + val (i,s) = munch_exp t e + in + (i @ [X.CMP ((t,s), (X.CONST c,s))], pos, neg) + end + and condhit_t e t (pos, neg) = + let + val t' = X.TEMP (Temp.new "consthit" Tm.Long) + val (i,s) = munch_exp t' e + in + (i @ [X.CMP ((t',s), (X.TEMP t,s))], pos, neg) + end + and condhit e1 e2 (pos, neg) = + let + val t1 = X.TEMP (Temp.new ("var neq 1") Tm.Long) + val t2 = X.TEMP (Temp.new ("var neq 2") Tm.Long) + val (i1, s1) = munch_exp t1 e1 + val (i2, s2) = munch_exp t2 e2 + in + (i1 @ i2 @ [X.CMP((t1,s1),(t2,s2))], 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 @@ -268,195 +311,156 @@ struct 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") 4) 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") 4) 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") 4) 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") 4) 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") 4) - val t2 = X.TEMP (Temp.new ("var neq 2") 4) - 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") 4) 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") 4) 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") 4) 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") 4) 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") 4) - val t2 = X.TEMP (Temp.new ("var eq 2") 4) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.E, X.NE) - 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") 4) 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") 4) 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") 4) 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") 4) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.LE, X.G) end - | munch_cond (T.BINOP(T.LE, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var le 1") 4) - val t2 = X.TEMP (Temp.new ("var le 2") 4) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.LE, X.G) - 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") 4) 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") 4) 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") 4) 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") 4) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end - | munch_cond (T.BINOP(T.LT, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var lt 1") 4) - val t2 = X.TEMP (Temp.new ("var lt 2") 4) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.L, X.GE) - 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") 4) 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") 4) 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") 4) 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") 4) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end - | munch_cond (T.BINOP(T.GT, e1, e2)) = - let - val t1 = X.TEMP (Temp.new ("var gt 1") 4) - val t2 = X.TEMP (Temp.new ("var gt 2") 4) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.G, X.LE) - 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") 4) 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") 4) 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") 4) 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") 4) 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") 4) - val t2 = X.TEMP (Temp.new ("var ge 2") 4) - in - (munch_exp t1 e1 @ munch_exp t2 e2 @ - [X.CMP(t1, t2)], X.GE, X.L) - end + | munch_cond (T.BINOP(T.NEQ, T.TEMP t, T.CONST n)) = condhit_tc t n (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, T.CONST n, T.TEMP t)) = condhit_tc t n (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, T.CONST n, e1)) = condhit_c e1 n (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, e1, T.CONST n)) = condhit_c e1 n (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, T.TEMP t, e1)) = condhit_t e1 t (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, e1, T.TEMP t)) = condhit_t e1 t (X.NE, X.E) + | munch_cond (T.BINOP(T.NEQ, e1, e2)) = condhit e1 e2 (X.NE, X.E) + + | munch_cond (T.BINOP(T.EQ, T.TEMP t, T.CONST n)) = condhit_tc t n (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, T.CONST n, T.TEMP t)) = condhit_tc t n (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, T.CONST n, e1)) = condhit_c e1 n (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, e1, T.CONST n)) = condhit_c e1 n (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, T.TEMP t, e1)) = condhit_t e1 t (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, e1, T.TEMP t)) = condhit_t e1 t (X.E, X.NE) + | munch_cond (T.BINOP(T.EQ, e1, e2)) = condhit e1 e2 (X.E, X.NE) + + | munch_cond (T.BINOP(T.LE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.LE, X.G) + | munch_cond (T.BINOP(T.LE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.GE, X.L) + | munch_cond (T.BINOP(T.LE, T.CONST n, e1)) = condhit_c e1 n (X.GE, X.L) + | munch_cond (T.BINOP(T.LE, e1, T.CONST n)) = condhit_c e1 n (X.LE, X.G) + | munch_cond (T.BINOP(T.LE, T.TEMP t, e1)) = condhit_t e1 t (X.GE, X.L) + | munch_cond (T.BINOP(T.LE, e1, T.TEMP t)) = condhit_t e1 t (X.LE, X.G) + | munch_cond (T.BINOP(T.LE, e1, e2)) = condhit e1 e2 (X.LE, X.G) + + | munch_cond (T.BINOP(T.LT, T.TEMP t, T.CONST n)) = condhit_tc t n (X.L, X.GE) + | munch_cond (T.BINOP(T.LT, T.CONST n, T.TEMP t)) = condhit_tc t n (X.G, X.LE) + | munch_cond (T.BINOP(T.LT, T.CONST n, e1)) = condhit_c e1 n (X.G, X.LE) + | munch_cond (T.BINOP(T.LT, e1, T.CONST n)) = condhit_c e1 n (X.L, X.GE) + | munch_cond (T.BINOP(T.LT, T.TEMP t, e1)) = condhit_t e1 t (X.G, X.LE) + | munch_cond (T.BINOP(T.LT, e1, T.TEMP t)) = condhit_t e1 t (X.L, X.GE) + | munch_cond (T.BINOP(T.LT, e1, e2)) = condhit e1 e2 (X.L, X.GE) + + | munch_cond (T.BINOP(T.GT, T.TEMP t, T.CONST n)) = condhit_tc t n (X.G, X.LE) + | munch_cond (T.BINOP(T.GT, T.CONST n, T.TEMP t)) = condhit_tc t n (X.L, X.GE) + | munch_cond (T.BINOP(T.GT, T.CONST n, e1)) = condhit_c e1 n (X.L, X.GE) + | munch_cond (T.BINOP(T.GT, e1, T.CONST n)) = condhit_c e1 n (X.G, X.LE) + | munch_cond (T.BINOP(T.GT, T.TEMP t, e1)) = condhit_t e1 t (X.L, X.GE) + | munch_cond (T.BINOP(T.GT, e1, T.TEMP t)) = condhit_t e1 t (X.G, X.LE) + | munch_cond (T.BINOP(T.GT, e1, e2)) = condhit e1 e2 (X.G, X.LE) + + | munch_cond (T.BINOP(T.GE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.GE, X.L) + | munch_cond (T.BINOP(T.GE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.LE, X.G) + | munch_cond (T.BINOP(T.GE, T.CONST n, e1)) = condhit_c e1 n (X.LE, X.G) + | munch_cond (T.BINOP(T.GE, e1, T.CONST n)) = condhit_c e1 n (X.GE, X.L) + | munch_cond (T.BINOP(T.GE, T.TEMP t, e1)) = condhit_t e1 t (X.LE, X.G) + | munch_cond (T.BINOP(T.GE, e1, T.TEMP t)) = condhit_t e1 t (X.GE, X.L) + | munch_cond (T.BINOP(T.GE, e1, e2)) = condhit e1 e2 (X.GE, X.L) + + | munch_cond (T.BINOP(T.BE, T.TEMP t, T.CONST n)) = condhit_tc t n (X.BE, X.A) + | munch_cond (T.BINOP(T.BE, T.CONST n, T.TEMP t)) = condhit_tc t n (X.AE, X.B) + | munch_cond (T.BINOP(T.BE, T.CONST n, e1)) = condhit_c e1 n (X.AE, X.B) + | munch_cond (T.BINOP(T.BE, e1, T.CONST n)) = condhit_c e1 n (X.BE, X.A) + | munch_cond (T.BINOP(T.BE, T.TEMP t, e1)) = condhit_t e1 t (X.AE, X.B) + | munch_cond (T.BINOP(T.BE, e1, T.TEMP t)) = condhit_t e1 t (X.BE, X.A) + | munch_cond (T.BINOP(T.BE, e1, e2)) = condhit e1 e2 (X.BE, X.A) + | 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") 4) - val t2 = X.TEMP (Temp.new("logor c 2") 4) + val t1 = (X.TEMP (Temp.new("logor c 1") Tm.Byte), Tm.Byte) + val t2 = (X.TEMP (Temp.new("logor c 2") Tm.Byte), Tm.Byte) val l = Label.new () in - if (effect e2 orelse (length insn2 > 10)) + if (TU.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.TEST(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t1))], + [X.SETcc (pos2, t1), X.LABEL l, X.TEST(t1, t1)], X.NE, X.E) - else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.OR(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t2))], X.NE, X.E) + else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.OR(t1, t2)], X.NE, X.E) end | munch_cond (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 c 1") 4) - val t2 = X.TEMP (Temp.new("logand c 2") 4) + val t1 = (X.TEMP (Temp.new("logand c 1") Tm.Byte), Tm.Byte) + val t2 = (X.TEMP (Temp.new("logand c 2") Tm.Byte), Tm.Byte) val l = Label.new () in - if (effect e2 orelse (length insn2 > 10)) + if (TU.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.TEST(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t1))], + [X.SETcc (pos2, t1), X.LABEL l, X.TEST(t1, t1)], X.NE, X.E) - else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.AND(X.OSIZE (X.Byte, t1), X.OSIZE (X.Byte, t2))], X.NE, X.E) + else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.AND(t1, t2)], X.NE, X.E) end | munch_cond e = let - val t = X.TEMP (Temp.new ("munch c") 4) + val t = X.TEMP (Temp.new ("munch c") Tm.Long) + val (i, s) = munch_exp t e in - (munch_exp t e @ [ X.TEST (t,t) ], X.NE, X.E) + (i @ [ X.TEST ((t,s),(t,s)) ], X.NE, X.E) end (* munch_lval : T.exp -> (X.insn list * X.operand) * Takes an expression that has been typechecked as being a valid lvalue, and then returns an instruction list and an operand to store your shit in. *) - fun munch_lval (T.TEMP t) = ([], X.TEMP t) - | munch_lval (T.MEMORY m) = + and munch_lval (T.TEMP t) = ([], (X.TEMP t, Tm.size t)) + | munch_lval (T.MEMORY (m,s)) = let - val t = Temp.new "lv addr" 8 + val t = X.TEMP (Tm.new "lv addr" Tm.Quad) + val (i,s') = munch_exp t m in - (munch_exp (X.TEMP t) m, X.REL (X.TEMP t, X.CONST 0w0)) + (i, (X.REL ((t, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s)) 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 (an, sz), _)) = munch_exp (X.TEMP t) a - | munch_stm (T.MOVE (T.TEMP t, a as T.CALL _, _)) = munch_exp (X.TEMP t) a - | munch_stm (T.MOVE (a, e2, sz)) = + and munch_stm (T.MOVE (T.TEMP t1, T.TEMP t2)) = if Tm.size t1 = Tm.size t2 then [X.MOV((X.TEMP t1, Tm.size t1), (X.TEMP t2, Tm.size t2))] + else raise ErrorMsg.InternalError "temp to temp move fuxed." + | munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = if Tm.size t = Tm.Long then [X.MOV((X.TEMP t, Tm.size t), (X.CONST n, Tm.size t))] + else raise ErrorMsg.InternalError "const to temp move fuxed." + | munch_stm (T.MOVE (T.TEMP t, a as T.ARG (an, sz))) = + let + val (i, s) = munch_exp (X.TEMP t) a + in + if s = Tm.size t + then i + else raise ErrorMsg.InternalError "arg to tmp fuxed." + end + | munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = let val (i, _) = munch_exp (X.TEMP t) a in i end + | munch_stm (T.MOVE (a, e2)) = let - val t = Temp.new ("assign") sz - val (m, r) = munch_lval a + val t = X.TEMP (Temp.new ("assign") Tm.Long) + val (m, (r,s1)) = munch_lval a + val (i, s2) = munch_exp t e2 +(* val _ = print ("move: size " ^ Tm.sfx s2 ^ " from " ^ TU.Print.pp_exp e2 ^ ", " ^ Tm.sfx s1 ^ " from " ^ TU.Print.pp_exp a ^ "\n") *) + val _ = if s1 = s2 then () else raise ErrorMsg.InternalError "move generic fuxed." in - m @ munch_exp (X.TEMP t) e2 - @ [X.MOV(X.OSIZE (X.sts sz, r), X.TEMP t)] + m @ i @ [X.MOV((r,s1), (t,s2))] end | munch_stm (T.RETURN(e, sz)) = let - val t = Temp.new ("retval") sz + val t = X.TEMP (Temp.new ("retval") sz) + val (i, s) = munch_exp t e in - munch_exp (X.TEMP t) e - @ [X.MOV(X.OSIZE (X.sts sz, X.REG X.EAX), X.TEMP t), X.RET] + i @ [X.MOV((X.REG X.EAX, sz), (t, if sz = s then sz else raise ErrorMsg.InternalError "retfuxed.")), X.RET] 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.JMP l] | munch_stm (T.JUMPIFN(e, l)) = let val (insns, pos, neg) = munch_cond e in insns @ [X.Jcc (neg, l)] end - | munch_stm (T.EFFECT(exp, sz)) = let val t = X.TEMP (Temp.new "throwaway" sz) in munch_exp t exp end + | munch_stm (T.EFFECT exp) = let val t = X.TEMP (Temp.new "throwaway" Tm.Quad) val (i, _) = munch_exp t exp in i end fun codegen nil = nil | codegen (stm::stms) = munch_stm stm @ codegen stms