[snipe.git] / codegen / codegen.sml

(* 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 -> Blarg.insn list
end

structure Codegen :> CODEGEN = 
struct
  structure T = Tree
  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)
   *)
  and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge n))]
    | munch_exp d (T.STRING s) = [X.INSN (X.AL, X.MOVSTR(d, s))]
    | 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 *)
  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 = X.TEMP (Temp.new ("retval"))
          val i = munch_exp t e
        in
          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
end
Commit	Line	Data
6ade8b0a	1	(* L3 Compiler
0a24e44d JW	2	* Assembly code generator for fake x86 assembly
	3	* Author: Joshua Wise <jwise@andrew.cmu.edu>
	4	* Author: Chris Lu <czl@andrew.cmu.edu>
12aa4087 JW	5	*)
	6
	7	signature CODEGEN =
	8	sig
075222c7	9	val codegen : Tree.stm list -> Blarg.insn list
12aa4087 JW	10	end
	11
	12	structure Codegen :> CODEGEN =
	13	struct
	14	structure T = Tree
5c79bb68	15	structure TU = TreeUtils
075222c7	16	structure X = Blarg
5c79bb68	17	structure Tm = Temp
6ade8b0a JW	18
6ade8b0a JW	19	(* hasfixed : T.exp -> bool
5c79bb68	20	* true iff the given expression has an hasfixed.
6ade8b0a	21	*)
075222c7	22	fun hasfixed (T.CALL _) = true
6ade8b0a JW	23	\| hasfixed (T.BINOP(_, a, b)) = (hasfixed a) orelse (hasfixed b)
6ade8b0a JW	24	\| hasfixed (T.UNOP (_, a)) = hasfixed a
1144856b	25	\| hasfixed (T.ALLOC(_)) = true
075222c7	26	\| hasfixed (T.MEMORY (m)) = hasfixed m
5c79bb68	27	\| hasfixed (T.STMVAR _) = true
6ade8b0a JW	28	\| hasfixed _ = false
6ade8b0a JW	29
075222c7 JW	30	(* binophit : X.oper -> X.opc -> T.exp -> T.exp -> X.insn list *)
	31	(* binophit d oper e1 e2
	32	* generates instructions to achieve d <- e1 oper e2
	33	* oper should be something like X.ADD
	34	*)
	35	fun binophit d oper e1 e2 =
5c79bb68	36	let
075222c7 JW	37	val t = X.TEMP (Tm.new "binop")
	38	val i1 = munch_exp d e1
	39	val i2 = munch_exp t e2
5c79bb68	40	(* val _ = print ("s1 = " ^ Tm.sfx s1 ^ ", s2 = " ^ Tm.sfx s2 ^ ", ") *)
5c79bb68 JW	41	(* val _ = print ("rs = " ^ Tm.sfx rs ^ " from " ^ TU.Print.pp_exp e1 ^ " and " ^ TU.Print.pp_exp e2 ^ "\n") *)
5c79bb68 JW	42	in
4f528370	43	[X.COMMENT "binophit" ] @ i1 @ i2 @ [X.INSN (X.AL, oper (d, t)), X.COMMENT "binophit done"]
075222c7 JW	44	end
	45
	46	(* cmphit : X.oper -> X.exp -> X.insn list
	47	* cmphit d ex
	48	* generates instructions to set d based on the truth value of ex
	49	*)
	50	and cmphit d ex =
	51	let
	52	val (insns, pos, neg) = munch_cond ex
	53	in
	54	insns @ [X.INSN (X.AL, X.MOVLIT (d, 0w0)), X.INSN (pos, X.MOVLIT (d, 0w1))]
5c79bb68	55	end
5c79bb68	56
12aa4087 JW	57	(* munch_exp : prex86oper -> T.exp -> prex86insn list *)
	58	(* munch_exp d e
	59	* generates instructions to achieve d <- e
	60	* d must be TEMP(t) or REG(r)
	61	*)
075222c7	62	and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge n))]
5c90fbb8	63	\| munch_exp d (T.STRING s) = [X.INSN (X.AL, X.MOVSTR(d, s))]
075222c7 JW	64	\| munch_exp d (T.NULLPTR) = [X.INSN (X.AL, X.MOVLIT(d, 0w0))]
	65	\| munch_exp d (T.TEMP(t)) = [X.INSN (X.AL, X.MOV(d, X.TEMP t))]
	66	\| munch_exp d (T.ARG(0)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R0))]
	67	\| munch_exp d (T.ARG(1)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R1))]
	68	\| munch_exp d (T.ARG(2)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R2))]
	69	\| munch_exp d (T.ARG(3)) = [X.INSN (X.AL, X.MOV(d, X.REG X.R3))]
	70	\| munch_exp d (T.ARG(t)) = [X.INSN (X.AL, X.MOV(d, X.STACKARG (t - 4)))]
	71	\| munch_exp d (T.CALL(name, l)) = (* Scary demons live here. *)
6ade8b0a JW	72	let
6ade8b0a JW	73	val nargs = length l
075222c7	74	val nstack = if (nargs <= 4)
6ade8b0a	75	then 0
075222c7 JW	76	else nargs - 4
	77	val stackb = nstack * 1
	78	fun argdest 1 = X.REG X.R0
	79	\| argdest 2 = X.REG X.R1
	80	\| argdest 3 = X.REG X.R2
	81	\| argdest 4 = X.REG X.R3
	82	\| 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)*)
6ade8b0a JW	83
6ade8b0a JW	84	val dests = List.tabulate (nargs, fn x => argdest (x+1))
075222c7	85	val hf = List.map hasfixed l
1144856b	86	val (d_hf, l_hf) = ListPair.unzip (ListPair.foldr
6ade8b0a JW	87	(fn (a,b,c) => if b then a::c else c)
	88	nil
	89	(ListPair.zip (dests,l), hf)
	90	)
1144856b	91	val (d_nohf, l_nohf) = ListPair.unzip (ListPair.foldr
6ade8b0a JW	92	(fn (a,b,c) => if b then c else a::c)
	93	nil
	94	(ListPair.zip (dests,l), hf)
	95	)
075222c7 JW	96	val temps = List.map (fn _ => Temp.new ("arg")) l_hf
	97	val argevals_hf = List.map
	98	(fn (t,exp) => munch_exp (X.TEMP t) exp)
	99	(ListPair.zip (temps, l_hf))
6ade8b0a	100	val argpushes = List.map
075222c7	101	(fn (dest, t) => [X.INSN (X.AL, X.MOV (dest, X.TEMP t))])
6ade8b0a	102	(ListPair.zip (d_hf, temps))
075222c7 JW	103	val argevals_nohf = List.map
	104	(fn (d,exp) => munch_exp d exp)
	105	(ListPair.zip (d_nohf, l_nohf))
	106
	107	val t_stackb = Temp.new ("stackb")
	108	val t_target = Temp.new ("target")
6ade8b0a	109	in
075222c7 JW	110	List.concat argevals_hf @
	111	List.concat argpushes @
	112	List.concat argevals_nohf @
	113	[ X.INSN (X.AL, X.MOVLIT (X.TEMP t_stackb, Word.fromInt stackb)),
	114	X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
	115	X.INSN (X.AL, X.SUB (X.REG X.SP, X.TEMP t_stackb)),
	116	X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
	117	X.INSN (X.AL, X.ADD (X.REG X.SP, X.TEMP t_stackb)),
	118	X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
0a24e44d	119	end
075222c7	120	(*\| munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = binophit_c d X.ADD e1 n
5c79bb68 JW	121	\| munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = binophit_c d X.ADD e1 n
5c79bb68 JW	122	\| munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = binophit_t d X.ADD e1 t
075222c7	123	\| munch_exp d (T.BINOP(T.ADD, T.TEMP t, e1)) = binophit_t d X.ADD e1 t*)
5c79bb68 JW	124	\| munch_exp d (T.BINOP(T.ADD, e1, e2)) = binophit d X.ADD e1 e2
5c79bb68 JW	125
075222c7 JW	126	(*\| munch_exp d (T.BINOP(T.SUB, e1, T.CONST n)) = binophit_c d X.SUB e1 n
075222c7 JW	127	\| munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = binophit_t d X.SUB e1 t*)
5c79bb68	128	\| munch_exp d (T.BINOP(T.SUB, e1, e2)) = binophit d X.SUB e1 e2
de034162 JW	129	\| munch_exp d (T.BINOP(T.MUL, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mul", [e1, e2]))
	130	\| munch_exp d (T.BINOP(T.DIV, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_div", [e1, e2]))
	131	\| munch_exp d (T.BINOP(T.MOD, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mod", [e1, e2]))
075222c7 JW	132	\| munch_exp d (T.BINOP(T.LSH, e1, e2)) = binophit d X.SHL e1 e2
075222c7 JW	133	\| munch_exp d (T.BINOP(T.RSH, e1, e2)) = binophit d X.SHR e1 e2
5c79bb68	134	\| munch_exp d (T.BINOP(T.BITAND, e1, e2)) = binophit d X.AND e1 e2
075222c7 JW	135	\| 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))))
	136	\| munch_exp d (T.BINOP(T.BITXOR, e1, e2)) =
	137	munch_exp d (T.BINOP(T.BITOR, T.BINOP(T.BITAND, e1, T.UNOP(T.BITNOT, e2)),
	138	T.BINOP(T.BITAND, e2, T.UNOP(T.BITNOT, e1))))
5c79bb68	139
6ade8b0a	140	\| munch_exp d (a as T.BINOP(T.LOGAND, e1, e2)) =
0a24e44d	141	let
6ade8b0a JW	142	val (insn1, pos1, neg1) = munch_cond e1
6ade8b0a JW	143	val (insn2, pos2, neg2) = munch_cond e2
6ade8b0a	144	val l = Label.new ()
0a24e44d	145	in
075222c7 JW	146	(insn1) @
	147	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	148	X.INSN (neg1, X.MOVLBL (X.REG X.PC, l))] @
	149	(insn2) @
	150	[X.INSN (pos2, X.MOVLIT (d, 0w1)),
	151	X.LABEL l]
0a24e44d	152	end
6ade8b0a	153	\| munch_exp d (a as T.BINOP(T.LOGOR, e1, e2)) =
0a24e44d	154	let
6ade8b0a JW	155	val (insn1, pos1, neg1) = munch_cond e1
6ade8b0a JW	156	val (insn2, pos2, neg2) = munch_cond e2
075222c7 JW	157	val t1 = X.TEMP (Tm.new "logand 1")
075222c7 JW	158	val t2 = X.TEMP (Tm.new "logand 2")
6ade8b0a	159	val l = Label.new ()
0a24e44d	160	in
075222c7 JW	161	(insn1) @
	162	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	163	X.INSN (pos1, X.MOVLIT (d, 0w1)),
	164	X.INSN (pos1, X.MOVLBL (X.REG X.PC, l))] @
	165	(insn2) @
	166	[X.INSN (pos2, X.MOVLIT (d, 0w1)),
	167	X.LABEL l]
0a24e44d	168	end
5c79bb68 JW	169	\| munch_exp d (a as T.BINOP(T.EQ, _, _)) = cmphit d a
	170	\| munch_exp d (a as T.BINOP(T.NEQ, _, _)) = cmphit d a
	171	\| munch_exp d (a as T.BINOP(T.LE, _, _)) = cmphit d a
	172	\| munch_exp d (a as T.BINOP(T.LT, _, _)) = cmphit d a
	173	\| munch_exp d (a as T.BINOP(T.GE, _, _)) = cmphit d a
	174	\| munch_exp d (a as T.BINOP(T.GT, _, _)) = cmphit d a
	175	\| munch_exp d (a as T.BINOP(T.BE, _, _)) = cmphit d a
	176
075222c7 JW	177	\| munch_exp d (T.UNOP(T.NEG, e1)) =
	178	let
	179	val t = Temp.new "-val"
	180	val i = munch_exp (X.TEMP t) e1
	181	in
	182	(i) @
	183	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	184	X.INSN (X.AL, X.SUB (d, X.TEMP t))]
	185	end
	186	\| 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
6ade8b0a	187	\| munch_exp d (T.UNOP(T.BANG, e)) =
0a24e44d	188	let
6ade8b0a	189	val (insns, pos, neg) = munch_cond e
0a24e44d	190	in
075222c7 JW	191	insns @
	192	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	193	X.INSN (neg, X.MOVLIT (d, 0w1))]
5c79bb68	194	end
075222c7	195	\| munch_exp d (T.MEMORY (e1)) =
5c79bb68	196	let
075222c7 JW	197	val a = X.TEMP (Temp.new "addr")
075222c7 JW	198	val i = munch_exp a e1
5c79bb68	199	in
075222c7 JW	200	i @
075222c7 JW	201	[X.INSN (X.AL, X.LDR (d, a))]
0a24e44d	202	end
075222c7	203
5c79bb68	204	\| munch_exp d (T.ALLOC(exp)) =
1144856b	205	let
075222c7	206	val t1 = Temp.new "alloc"
5c79bb68	207	val l1 = Label.new()
075222c7 JW	208	val einsn = munch_exp (X.TEMP t1) exp
075222c7 JW	209	val insns = munch_exp d (T.CALL (Symbol.symbol "calloc", [T.TEMP t1, T.CONST 0w1]))
1144856b	210	in
075222c7	211	einsn @ insns
1144856b	212	end
5c79bb68 JW	213	(* \| 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 *)
	214	\| munch_exp d (T.COND(c,e1,e2)) =
	215	let
	216	val (insns, pos, neg) = munch_cond c
	217	val l1 = Label.new()
	218	val l2 = Label.new()
075222c7 JW	219	val i1 = munch_exp d e1
075222c7 JW	220	val i2 = munch_exp d e2
5c79bb68 JW	221	(* val _ = print ("cond: size " ^ Tm.sfx s1 ^ " from " ^ TU.Print.pp_exp e1 ^ ", " ^ Tm.sfx s2 ^ " from " ^ TU.Print.pp_exp e2 ^ "\n") *)
5c79bb68 JW	222	in
075222c7 JW	223	insns @
	224	[X.INSN (neg, X.MOVLBL (X.REG X.PC, l1))] @
	225	i1 @
	226	[X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l2)),
	227	X.LABEL l1] @
	228	i2 @
	229	[X.LABEL l2]
5c79bb68	230	end
075222c7	231	\| munch_exp d (T.STMVAR (sl, e)) = let val i = munch_exp d e in List.concat (map munch_stm sl) @ i end
5c79bb68	232
5c79bb68 JW	233	and condhit e1 e2 (pos, neg) =
5c79bb68 JW	234	let
4f528370 JW	235	val t1 = X.TEMP (Temp.new ("var cond 1"))
4f528370 JW	236	val t2 = X.TEMP (Temp.new ("var cond 2"))
075222c7 JW	237	val i1 = munch_exp t1 e1
075222c7 JW	238	val i2 = munch_exp t2 e2
5c79bb68	239	in
075222c7	240	(i1 @ i2 @ [X.INSN (X.AL, X.SUBS (t1, t2))], pos, neg)
5c79bb68	241	end
1144856b	242
6ade8b0a JW	243	(* munch_cond : T.exp -> X.insn list * X.cond * X.cond
	244	* munch_cond stm generates code to set flags, and then returns a conditional
	245	* to test if the expression was true and for if it was false.
	246	*)
	247	and munch_cond (T.UNOP (T.BANG, e)) =
0a24e44d	248	let
6ade8b0a	249	val (insns, pos, neg) = munch_cond e
0a24e44d	250	in
6ade8b0a	251	(insns, neg, pos)
0a24e44d	252	end
075222c7	253	\| munch_cond (T.BINOP(T.NEQ, e1, e2)) = condhit e1 e2 (X.NE, X.EQ)
4f528370 JW	254	\| munch_cond (T.BINOP(T.EQ, e1, e2)) = condhit e1 e2 (X.EQ, X.NE)
	255	\| munch_cond (T.BINOP(T.LE, e1, e2)) = condhit e1 e2 (X.LE, X.GT)
	256	\| munch_cond (T.BINOP(T.LT, e1, e2)) = condhit e1 e2 (X.LT, X.GE)
	257	\| munch_cond (T.BINOP(T.GT, e1, e2)) = condhit e1 e2 (X.GT, X.LE)
	258	\| munch_cond (T.BINOP(T.GE, e1, e2)) = condhit e1 e2 (X.GE, X.LT)
5c79bb68	259
075222c7	260	\| munch_cond (T.BINOP(T.BE, e1, e2)) = raise ErrorMsg.InternalError "memory safety not supported"
5c79bb68	261
6ade8b0a JW	262	\| munch_cond e =
6ade8b0a JW	263	let
075222c7 JW	264	val t = X.TEMP (Temp.new ("munch c"))
075222c7 JW	265	val i = munch_exp t e
6ade8b0a	266	in
075222c7	267	(i @ [ X.INSN (X.AL, X.MOVS (t,t)) ], X.NE, X.EQ)
6ade8b0a	268	end
12aa4087	269
075222c7 JW	270	(* munch_lval : T.exp -> X.operand
075222c7 JW	271	* 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.
1144856b	272	*)
4f528370	273	and munch_lval (T.TEMP t) oper = [X.INSN (X.AL, X.MOV (X.TEMP t, oper))]
075222c7	274	\| munch_lval (T.MEMORY m) oper =
1144856b	275	let
075222c7 JW	276	val t = X.TEMP (Tm.new "lv addr")
075222c7 JW	277	val i = munch_exp t m
1144856b	278	in
075222c7 JW	279	i @
075222c7 JW	280	[X.INSN (X.AL, X.STO (t, oper))]
1144856b	281	end
075222c7	282	\| munch_lval _ _ = raise ErrorMsg.InternalError "That wasn't really a valid lvalue..."
1144856b	283
0a24e44d	284	(* munch_stm : T.stm -> X.insn list *)
12aa4087	285	(* munch_stm stm generates code to execute stm *)
075222c7 JW	286	and munch_stm (T.MOVE (T.TEMP t1, T.TEMP t2)) = [X.INSN (X.AL, X.MOV(X.TEMP t1, X.TEMP t2))]
	287	\| munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = [X.INSN (X.AL, X.MOVLIT(X.TEMP t, Word.fromLarge n))]
	288	\| munch_stm (T.MOVE (T.TEMP t, a as T.ARG (an))) =
5c79bb68	289	let
075222c7	290	val i = munch_exp (X.TEMP t) a
5c79bb68	291	in
075222c7	292	i
5c79bb68	293	end
075222c7	294	\| munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = munch_exp (X.TEMP t) a
5c79bb68	295	\| munch_stm (T.MOVE (a, e2)) =
0a24e44d	296	let
075222c7 JW	297	val t = X.TEMP (Temp.new ("assign"))
	298	val i = munch_exp t e2
	299	val li = munch_lval a t
0a24e44d	300	in
075222c7	301	i @ li
0a24e44d	302	end
075222c7	303	\| munch_stm (T.RETURN(e)) =
12aa4087	304	let
075222c7 JW	305	val t = X.TEMP (Temp.new ("retval"))
075222c7 JW	306	val i = munch_exp t e
12aa4087	307	in
075222c7	308	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))]
12aa4087	309	end
5c79bb68	310	\| munch_stm (T.LABEL l) = [X.LABEL l]
075222c7	311	\| munch_stm (T.JUMP l) = [X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l))]
0a24e44d JW	312	\| munch_stm (T.JUMPIFN(e, l)) =
0a24e44d JW	313	let
6ade8b0a	314	val (insns, pos, neg) = munch_cond e
0a24e44d	315	in
075222c7	316	insns @ [X.INSN (neg, X.MOVLBL (X.REG X.PC, l))]
0a24e44d	317	end
075222c7	318	\| munch_stm (T.EFFECT exp) = let val t = X.TEMP (Temp.new "throwaway") val i = munch_exp t exp in i end
12aa4087 JW	319
	320	fun codegen nil = nil
	321	\| codegen (stm::stms) = munch_stm stm @ codegen stms
	322	end