* 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))]
+ 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))]
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)*)
+ 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
(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))])
+ (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)
+ (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")
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))]
+ 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.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, _, _)) = raise ErrorMsg.InternalError "MUL does not exist on blargcpu"
- | munch_exp d (T.BINOP(T.DIV, _, _)) = raise ErrorMsg.InternalError "DIV does not exist on blargcpu"
- | munch_exp d (T.BINOP(T.MOD, _, _)) = raise ErrorMsg.InternalError "MOD does not exist on blargcpu"
+ | 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
and condhit e1 e2 (pos, neg) =
let
- val t1 = X.TEMP (Temp.new ("var neq 1"))
- val t2 = X.TEMP (Temp.new ("var neq 2"))
+ 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
(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.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_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 (oper, X.TEMP t))]
+ 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")
(* 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, 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
git.joshuawise.com / snipe.git / blobdiff