(* 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"]
+ i1 @ i2 @ [X.INSN (X.AL, oper (d, t))]
end
(* cmphit : X.oper -> X.exp -> X.insn list
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
X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
val endlbl = Label.new()
- fun spill (X.TEMP temp, xreg: Blarg.reg) = (* Spill a register if need be. *)
+ fun spill (X.TEMP temp, X.R12: Blarg.reg) = (* Spill a register if need be. *)
let
val base = X.REG X.SP
val offs = Word.fromInt (stackpos (temptonum temp))
in
if (isspilled (X.TEMP temp))
- then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]*)
+ then [ X.MOVLIT (X.REG X.R11, offs),
+ X.ADD (X.REG X.R11, X.REG X.SP),
+ X.STO (X.REG X.R11, X.REG X.R12) ]
else nil
end
+ | spill (X.TEMP temp, _) = if (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "Cannot spill from non-R11"
+ else nil
| spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
| spill _ = nil (* Nothing else can be spilled. *)
fun unspill (X.TEMP temp, xreg: Blarg.reg) = (* Unspill a register if need be. *)
val offs = Word.fromInt (stackpos (temptonum temp))
in
if (isspilled (X.TEMP temp))
- then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]*)
+ then [ X.MOVLIT (X.REG xreg, offs),
+ X.ADD (X.REG xreg, X.REG X.SP),
+ X.LDR (X.REG xreg, X.REG xreg) ]
else nil
end
| unspill (X.STACKARG arg, xreg) =
let
val base = X.REG X.SP
- val offs = Word.fromInt (stacksz + 8 + (arg * 8))
+ val offs = Word.fromInt (stacksz + 1 + (arg * 1))
in
- (*[X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]*)
- raise ErrorMsg.InternalError "unspill from stack not supported"
+ [ X.MOVLIT (X.REG xreg, offs),
+ X.ADD (X.REG xreg, X.REG X.SP),
+ X.LDR (X.REG xreg, X.REG xreg) ]
end
| unspill _ = nil
| transform (X.INSN (pred, X.MOVLIT (op1, w))) =
[ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
(if isspilled op1
- then spill (op1, spillreg1)
+ then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
else [])
| transform (X.INSN (pred, X.MOVSYM (op1, w))) =
[ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
(if isspilled op1
- then spill (op1, spillreg1)
+ then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
else [])
| transform (X.INSN (pred, X.MOVSTR (op1, w))) =
[ X.INSN (pred, X.MOVSTR (real_op1 op1, w)) ] @
(if isspilled op1
- then spill (op1, spillreg1)
+ then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
else [])
| transform (X.INSN (pred, X.MOVLBL (op1, w))) =
[ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
(if isspilled op1
- then spill (op1, spillreg1)
+ then map (fn i => X.INSN (pred, i)) (spill (op1, spillreg1))
else [])
(* and here comes the boilerplate *)