X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/de034162d9af50e6bfb454f4de67213d856137c4..a644da892dbd55a7be1aed029dafebe28d26d27e:/codegen/codegen.sml diff --git a/codegen/codegen.sml b/codegen/codegen.sml index 8181905..a407a20 100644 --- a/codegen/codegen.sml +++ b/codegen/codegen.sml @@ -59,7 +59,8 @@ struct * 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))] @@ -74,11 +75,20 @@ struct 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 @@ -97,11 +107,12 @@ struct (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") @@ -109,12 +120,18 @@ struct 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 @@ -231,8 +248,8 @@ struct 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 @@ -250,11 +267,11 @@ struct (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" @@ -269,7 +286,7 @@ struct (* 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") @@ -283,7 +300,7 @@ struct (* 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