[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
      i1 @ i2 @ [X.INSN (X.AL, oper (d, t))]
    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 (Word32.toLarge 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 = 
              let
                val t = Temp.new "argdest"
                val t2 = Temp.new "argptr"
              in
                (X.TEMP t, (* Dude, I *love* this shit. *)
                 [ X.INSN (X.AL, X.MOVLIT (X.TEMP t2, Word.fromInt (0x10000 - (n - 4 + 1)))),
                   X.INSN (X.AL, X.ADD (X.TEMP t2, X.REG X.SP)),
                   X.INSN (X.AL, X.STO (X.TEMP t2, X.TEMP t)) ] )
              end

          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 shittodo = List.concat (List.map (fn (_, shit) => shit) (d_hf @ d_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 @
          shittodo @
          (if stackb > 0
           then [ 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))]
           else [ X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
                  X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
                  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 (Word32.toLarge 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
d4e2479e	43	i1 @ i2 @ [X.INSN (X.AL, oper (d, t))]
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	*)
0328a46e	62	and munch_exp d (T.CONST n) = [X.INSN (X.AL, X.MOVLIT(d, Word.fromLarge (Word32.toLarge 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
075222c7 JW	77	val stackb = nstack * 1
d4e2479e JW	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 =
	83	let
	84	val t = Temp.new "argdest"
	85	val t2 = Temp.new "argptr"
	86	in
	87	(X.TEMP t, (* Dude, I love this shit. *)
	88	[ X.INSN (X.AL, X.MOVLIT (X.TEMP t2, Word.fromInt (0x10000 - (n - 4 + 1)))),
	89	X.INSN (X.AL, X.ADD (X.TEMP t2, X.REG X.SP)),
	90	X.INSN (X.AL, X.STO (X.TEMP t2, X.TEMP t)) ] )
	91	end
6ade8b0a JW	92
6ade8b0a JW	93	val dests = List.tabulate (nargs, fn x => argdest (x+1))
075222c7	94	val hf = List.map hasfixed l
1144856b	95	val (d_hf, l_hf) = ListPair.unzip (ListPair.foldr
6ade8b0a JW	96	(fn (a,b,c) => if b then a::c else c)
	97	nil
	98	(ListPair.zip (dests,l), hf)
	99	)
1144856b	100	val (d_nohf, l_nohf) = ListPair.unzip (ListPair.foldr
6ade8b0a JW	101	(fn (a,b,c) => if b then c else a::c)
	102	nil
	103	(ListPair.zip (dests,l), hf)
	104	)
075222c7 JW	105	val temps = List.map (fn _ => Temp.new ("arg")) l_hf
	106	val argevals_hf = List.map
	107	(fn (t,exp) => munch_exp (X.TEMP t) exp)
	108	(ListPair.zip (temps, l_hf))
6ade8b0a	109	val argpushes = List.map
d4e2479e	110	(fn ((dest, _), t) => [X.INSN (X.AL, X.MOV (dest, X.TEMP t))])
6ade8b0a	111	(ListPair.zip (d_hf, temps))
075222c7	112	val argevals_nohf = List.map
d4e2479e	113	(fn ((d,_),exp) => munch_exp d exp)
075222c7	114	(ListPair.zip (d_nohf, l_nohf))
d4e2479e	115	val shittodo = List.concat (List.map (fn (_, shit) => shit) (d_hf @ d_nohf))
075222c7 JW	116
	117	val t_stackb = Temp.new ("stackb")
	118	val t_target = Temp.new ("target")
6ade8b0a	119	in
075222c7 JW	120	List.concat argevals_hf @
	121	List.concat argpushes @
	122	List.concat argevals_nohf @
d4e2479e JW	123	shittodo @
	124	(if stackb > 0
	125	then [ X.INSN (X.AL, X.MOVLIT (X.TEMP t_stackb, Word.fromInt stackb)),
	126	X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
	127	X.INSN (X.AL, X.SUB (X.REG X.SP, X.TEMP t_stackb)),
	128	X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
	129	X.INSN (X.AL, X.ADD (X.REG X.SP, X.TEMP t_stackb)),
	130	X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
	131	else [ X.INSN (X.AL, X.MOVSYM (X.TEMP t_target, name)),
	132	X.INSN (X.AL, X.CALL (X.REG X.SP, X.TEMP t_target, nargs)),
	133	X.INSN (X.AL, X.MOV (d, X.REG X.R0))]
	134	)
0a24e44d	135	end
075222c7	136	(*\| munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = binophit_c d X.ADD e1 n
5c79bb68 JW	137	\| munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = binophit_c d X.ADD e1 n
5c79bb68 JW	138	\| munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = binophit_t d X.ADD e1 t
075222c7	139	\| munch_exp d (T.BINOP(T.ADD, T.TEMP t, e1)) = binophit_t d X.ADD e1 t*)
5c79bb68 JW	140	\| munch_exp d (T.BINOP(T.ADD, e1, e2)) = binophit d X.ADD e1 e2
5c79bb68 JW	141
075222c7 JW	142	(*\| munch_exp d (T.BINOP(T.SUB, e1, T.CONST n)) = binophit_c d X.SUB e1 n
075222c7 JW	143	\| munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = binophit_t d X.SUB e1 t*)
5c79bb68	144	\| munch_exp d (T.BINOP(T.SUB, e1, e2)) = binophit d X.SUB e1 e2
de034162 JW	145	\| munch_exp d (T.BINOP(T.MUL, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mul", [e1, e2]))
	146	\| munch_exp d (T.BINOP(T.DIV, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_div", [e1, e2]))
	147	\| munch_exp d (T.BINOP(T.MOD, e1, e2)) = munch_exp d (T.CALL (Symbol.symbol "__blarg_mod", [e1, e2]))
075222c7 JW	148	\| munch_exp d (T.BINOP(T.LSH, e1, e2)) = binophit d X.SHL e1 e2
075222c7 JW	149	\| munch_exp d (T.BINOP(T.RSH, e1, e2)) = binophit d X.SHR e1 e2
5c79bb68	150	\| munch_exp d (T.BINOP(T.BITAND, e1, e2)) = binophit d X.AND e1 e2
075222c7 JW	151	\| 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))))
	152	\| munch_exp d (T.BINOP(T.BITXOR, e1, e2)) =
	153	munch_exp d (T.BINOP(T.BITOR, T.BINOP(T.BITAND, e1, T.UNOP(T.BITNOT, e2)),
	154	T.BINOP(T.BITAND, e2, T.UNOP(T.BITNOT, e1))))
5c79bb68	155
6ade8b0a	156	\| munch_exp d (a as T.BINOP(T.LOGAND, e1, e2)) =
0a24e44d	157	let
6ade8b0a JW	158	val (insn1, pos1, neg1) = munch_cond e1
6ade8b0a JW	159	val (insn2, pos2, neg2) = munch_cond e2
6ade8b0a	160	val l = Label.new ()
0a24e44d	161	in
075222c7 JW	162	(insn1) @
	163	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	164	X.INSN (neg1, X.MOVLBL (X.REG X.PC, l))] @
	165	(insn2) @
	166	[X.INSN (pos2, X.MOVLIT (d, 0w1)),
	167	X.LABEL l]
0a24e44d	168	end
6ade8b0a	169	\| munch_exp d (a as T.BINOP(T.LOGOR, e1, e2)) =
0a24e44d	170	let
6ade8b0a JW	171	val (insn1, pos1, neg1) = munch_cond e1
6ade8b0a JW	172	val (insn2, pos2, neg2) = munch_cond e2
075222c7 JW	173	val t1 = X.TEMP (Tm.new "logand 1")
075222c7 JW	174	val t2 = X.TEMP (Tm.new "logand 2")
6ade8b0a	175	val l = Label.new ()
0a24e44d	176	in
075222c7 JW	177	(insn1) @
	178	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	179	X.INSN (pos1, X.MOVLIT (d, 0w1)),
	180	X.INSN (pos1, X.MOVLBL (X.REG X.PC, l))] @
	181	(insn2) @
	182	[X.INSN (pos2, X.MOVLIT (d, 0w1)),
	183	X.LABEL l]
0a24e44d	184	end
5c79bb68 JW	185	\| munch_exp d (a as T.BINOP(T.EQ, _, _)) = cmphit d a
	186	\| munch_exp d (a as T.BINOP(T.NEQ, _, _)) = cmphit d a
	187	\| munch_exp d (a as T.BINOP(T.LE, _, _)) = cmphit d a
	188	\| munch_exp d (a as T.BINOP(T.LT, _, _)) = cmphit d a
	189	\| munch_exp d (a as T.BINOP(T.GE, _, _)) = cmphit d a
	190	\| munch_exp d (a as T.BINOP(T.GT, _, _)) = cmphit d a
	191	\| munch_exp d (a as T.BINOP(T.BE, _, _)) = cmphit d a
	192
075222c7 JW	193	\| munch_exp d (T.UNOP(T.NEG, e1)) =
	194	let
	195	val t = Temp.new "-val"
	196	val i = munch_exp (X.TEMP t) e1
	197	in
	198	(i) @
	199	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	200	X.INSN (X.AL, X.SUB (d, X.TEMP t))]
	201	end
	202	\| 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	203	\| munch_exp d (T.UNOP(T.BANG, e)) =
0a24e44d	204	let
6ade8b0a	205	val (insns, pos, neg) = munch_cond e
0a24e44d	206	in
075222c7 JW	207	insns @
	208	[X.INSN (X.AL, X.MOVLIT (d, 0w0)),
	209	X.INSN (neg, X.MOVLIT (d, 0w1))]
5c79bb68	210	end
075222c7	211	\| munch_exp d (T.MEMORY (e1)) =
5c79bb68	212	let
075222c7 JW	213	val a = X.TEMP (Temp.new "addr")
075222c7 JW	214	val i = munch_exp a e1
5c79bb68	215	in
075222c7 JW	216	i @
075222c7 JW	217	[X.INSN (X.AL, X.LDR (d, a))]
0a24e44d	218	end
075222c7	219
5c79bb68	220	\| munch_exp d (T.ALLOC(exp)) =
1144856b	221	let
075222c7	222	val t1 = Temp.new "alloc"
5c79bb68	223	val l1 = Label.new()
075222c7 JW	224	val einsn = munch_exp (X.TEMP t1) exp
075222c7 JW	225	val insns = munch_exp d (T.CALL (Symbol.symbol "calloc", [T.TEMP t1, T.CONST 0w1]))
1144856b	226	in
075222c7	227	einsn @ insns
1144856b	228	end
5c79bb68 JW	229	(* \| 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 *)
	230	\| munch_exp d (T.COND(c,e1,e2)) =
	231	let
	232	val (insns, pos, neg) = munch_cond c
	233	val l1 = Label.new()
	234	val l2 = Label.new()
075222c7 JW	235	val i1 = munch_exp d e1
075222c7 JW	236	val i2 = munch_exp d e2
5c79bb68 JW	237	(* 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	238	in
075222c7 JW	239	insns @
	240	[X.INSN (neg, X.MOVLBL (X.REG X.PC, l1))] @
	241	i1 @
	242	[X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l2)),
	243	X.LABEL l1] @
	244	i2 @
	245	[X.LABEL l2]
5c79bb68	246	end
075222c7	247	\| munch_exp d (T.STMVAR (sl, e)) = let val i = munch_exp d e in List.concat (map munch_stm sl) @ i end
5c79bb68	248
5c79bb68 JW	249	and condhit e1 e2 (pos, neg) =
5c79bb68 JW	250	let
4f528370 JW	251	val t1 = X.TEMP (Temp.new ("var cond 1"))
4f528370 JW	252	val t2 = X.TEMP (Temp.new ("var cond 2"))
075222c7 JW	253	val i1 = munch_exp t1 e1
075222c7 JW	254	val i2 = munch_exp t2 e2
5c79bb68	255	in
075222c7	256	(i1 @ i2 @ [X.INSN (X.AL, X.SUBS (t1, t2))], pos, neg)
5c79bb68	257	end
1144856b	258
6ade8b0a JW	259	(* munch_cond : T.exp -> X.insn list * X.cond * X.cond
	260	* munch_cond stm generates code to set flags, and then returns a conditional
	261	* to test if the expression was true and for if it was false.
	262	*)
	263	and munch_cond (T.UNOP (T.BANG, e)) =
0a24e44d	264	let
6ade8b0a	265	val (insns, pos, neg) = munch_cond e
0a24e44d	266	in
6ade8b0a	267	(insns, neg, pos)
0a24e44d	268	end
075222c7	269	\| munch_cond (T.BINOP(T.NEQ, e1, e2)) = condhit e1 e2 (X.NE, X.EQ)
4f528370 JW	270	\| munch_cond (T.BINOP(T.EQ, e1, e2)) = condhit e1 e2 (X.EQ, X.NE)
	271	\| munch_cond (T.BINOP(T.LE, e1, e2)) = condhit e1 e2 (X.LE, X.GT)
	272	\| munch_cond (T.BINOP(T.LT, e1, e2)) = condhit e1 e2 (X.LT, X.GE)
	273	\| munch_cond (T.BINOP(T.GT, e1, e2)) = condhit e1 e2 (X.GT, X.LE)
	274	\| munch_cond (T.BINOP(T.GE, e1, e2)) = condhit e1 e2 (X.GE, X.LT)
5c79bb68	275
075222c7	276	\| munch_cond (T.BINOP(T.BE, e1, e2)) = raise ErrorMsg.InternalError "memory safety not supported"
5c79bb68	277
6ade8b0a JW	278	\| munch_cond e =
6ade8b0a JW	279	let
075222c7 JW	280	val t = X.TEMP (Temp.new ("munch c"))
075222c7 JW	281	val i = munch_exp t e
6ade8b0a	282	in
075222c7	283	(i @ [ X.INSN (X.AL, X.MOVS (t,t)) ], X.NE, X.EQ)
6ade8b0a	284	end
12aa4087	285
075222c7 JW	286	(* munch_lval : T.exp -> X.operand
075222c7 JW	287	* 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	288	*)
4f528370	289	and munch_lval (T.TEMP t) oper = [X.INSN (X.AL, X.MOV (X.TEMP t, oper))]
075222c7	290	\| munch_lval (T.MEMORY m) oper =
1144856b	291	let
075222c7 JW	292	val t = X.TEMP (Tm.new "lv addr")
075222c7 JW	293	val i = munch_exp t m
1144856b	294	in
075222c7 JW	295	i @
075222c7 JW	296	[X.INSN (X.AL, X.STO (t, oper))]
1144856b	297	end
075222c7	298	\| munch_lval _ _ = raise ErrorMsg.InternalError "That wasn't really a valid lvalue..."
1144856b	299
0a24e44d	300	(* munch_stm : T.stm -> X.insn list *)
12aa4087	301	(* munch_stm stm generates code to execute stm *)
075222c7	302	and munch_stm (T.MOVE (T.TEMP t1, T.TEMP t2)) = [X.INSN (X.AL, X.MOV(X.TEMP t1, X.TEMP t2))]
0328a46e	303	\| munch_stm (T.MOVE (T.TEMP t, T.CONST n)) = [X.INSN (X.AL, X.MOVLIT(X.TEMP t, Word.fromLarge (Word32.toLarge n)))]
075222c7	304	\| munch_stm (T.MOVE (T.TEMP t, a as T.ARG (an))) =
5c79bb68	305	let
075222c7	306	val i = munch_exp (X.TEMP t) a
5c79bb68	307	in
075222c7	308	i
5c79bb68	309	end
075222c7	310	\| munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = munch_exp (X.TEMP t) a
5c79bb68	311	\| munch_stm (T.MOVE (a, e2)) =
0a24e44d	312	let
075222c7 JW	313	val t = X.TEMP (Temp.new ("assign"))
	314	val i = munch_exp t e2
	315	val li = munch_lval a t
0a24e44d	316	in
075222c7	317	i @ li
0a24e44d	318	end
075222c7	319	\| munch_stm (T.RETURN(e)) =
12aa4087	320	let
075222c7 JW	321	val t = X.TEMP (Temp.new ("retval"))
075222c7 JW	322	val i = munch_exp t e
12aa4087	323	in
075222c7	324	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	325	end
5c79bb68	326	\| munch_stm (T.LABEL l) = [X.LABEL l]
075222c7	327	\| munch_stm (T.JUMP l) = [X.INSN (X.AL, X.MOVLBL (X.REG X.PC, l))]
0a24e44d JW	328	\| munch_stm (T.JUMPIFN(e, l)) =
0a24e44d JW	329	let
6ade8b0a	330	val (insns, pos, neg) = munch_cond e
0a24e44d	331	in
075222c7	332	insns @ [X.INSN (neg, X.MOVLBL (X.REG X.PC, l))]
0a24e44d	333	end
075222c7	334	\| munch_stm (T.EFFECT exp) = let val t = X.TEMP (Temp.new "throwaway") val i = munch_exp t exp in i end
12aa4087 JW	335
	336	fun codegen nil = nil
	337	\| codegen (stm::stms) = munch_stm stm @ codegen stms
	338	end