-(* L1 Compiler
- * Assembly Code Generator for FAKE assembly
- * Author: Alex Vaynberg <alv@andrew.cmu.edu>
- * Based on code by: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
- * Modified: Frank Pfenning <fp@cs.cmu.edu>
- *
- * Implements a "convenient munch" algorithm
+(* L3 Compiler
+ * Assembly code generator for fake x86 assembly
+ * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
*)
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
+ structure TU = TreeUtils
+ structure X = Blarg
+ structure Tm = Temp
+
+ (* hasfixed : T.exp -> bool
+ * true iff the given expression has an hasfixed.
+ *)
+ 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.MOVL(d, X.CONST n)]
- | munch_exp d (T.TEMP(t)) = [X.MOVL(d, X.TEMP t)]
- | munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = (munch_exp d e1) @ [X.ADDL(d, X.CONST n)]
- | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = (munch_exp d e1) @ [X.ADDL(d, X.CONST n)]
- | munch_exp d (T.BINOP(T.ADD, e1, e2)) = let val t1 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ADDL(d, X.TEMP 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(n))) = (munch_exp d e1) @ [X.SUBL(d, X.CONST n)]
- | munch_exp d (T.BINOP(T.SUB, e1, e2)) = let val t1 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.SUBL(d, X.TEMP 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 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 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.IMUL(d, X.TEMP t1)] end
- | munch_exp d (T.BINOP(T.DIV, e1, e2)) = let val t1 = Temp.new () in (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @ [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EAX)] end
- | munch_exp d (T.BINOP(T.MOD, e1, e2)) = let val t1 = Temp.new () in (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @ [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EDX)] end
-
- (* munch_stm : T.stm -> AS.instr list *)
+ 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 <= 4)
+ then 0
+ 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, 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, 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.map (fn _ => Temp.new ("arg")) l_hf
+ val argevals_hf = List.map
+ (fn (t,exp) => munch_exp (X.TEMP t) exp)
+ (ListPair.zip (temps, l_hf))
+ val argpushes = List.map
+ (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, 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.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.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)) =
+ 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 l = Label.new ()
+ in
+ (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 (Tm.new "logand 1")
+ val t2 = X.TEMP (Tm.new "logand 2")
+ val l = Label.new ()
+ in
+ (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, _, _)) = 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 t = Temp.new "-val"
+ val i = munch_exp (X.TEMP t) e1
+ in
+ (i) @
+ [X.INSN (X.AL, X.MOVLIT (d, 0w0)),
+ X.INSN (X.AL, X.SUB (d, X.TEMP t))]
+ end
+ | 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 @
+ [X.INSN (X.AL, X.MOVLIT (d, 0w0)),
+ X.INSN (neg, X.MOVLIT (d, 0w1))]
+ end
+ | munch_exp d (T.MEMORY (e1)) =
+ let
+ val a = X.TEMP (Temp.new "addr")
+ val i = munch_exp a e1
+ in
+ i @
+ [X.INSN (X.AL, X.LDR (d, a))]
+ end
+
+ | munch_exp d (T.ALLOC(exp)) =
+ let
+ 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
+ einsn @ insns
+ end
+(* | 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 = 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
+ 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_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 (insns, pos, neg) = munch_cond e
+ in
+ (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
+ 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(t1), e2)) =
- munch_exp (X.TEMP t1) e2
- | munch_stm (T.MOVE(_, _)) =
- raise ErrorMsg.InternalError "Incorrect first operand for T.MOVE?"
+ 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 (a, e2)) =
+ let
+ val t = X.TEMP (Temp.new ("assign"))
+ val i = munch_exp t e2
+ val li = munch_lval a t
+ in
+ i @ li
+ end
| munch_stm (T.RETURN(e)) =
let
- val t = Temp.new ()
+ val t = X.TEMP (Temp.new ("retval"))
+ val i = munch_exp t e
in
- munch_exp (X.TEMP t) e
- @ [X.MOVL(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.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.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
git.joshuawise.com / snipe.git / blobdiff