X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/459e54ac227128d4980ee40293b4b9fdd7b8ef26..f716a180ca5458e19643c902d4fb97785b9fd88e:/codegen/blarg.sml diff --git a/codegen/blarg.sml b/codegen/blarg.sml new file mode 100644 index 0000000..e482813 --- /dev/null +++ b/codegen/blarg.sml @@ -0,0 +1,201 @@ +(* L3 compiler + * blargCPU instruction/operand internal representation and manipulation + * Author: Joshua Wise + * Author: Chris Lu + *) + +signature BLARG = +sig + (* register type *) + datatype reg = + R0 | R1 | R2 | R3 | FR | SP | PC + (* operands to instructions *) + datatype oper = REG of reg | + TEMP of Temp.temp | + STACKARG of int + datatype pred = NV | NE | EQ | LT | GT | AL + (* instructions *) + datatype opc = + MOVLIT of oper * word | + MOVSYM of oper * Symbol.symbol | + MOVLBL of oper * Label.label | + LDR of oper * oper | + STO of oper * oper | + MOV of oper * oper | + MOVS of oper * oper | + ADD of oper * oper | + ADDS of oper * oper | + SUB of oper * oper | + SUBS of oper * oper | + AND of oper * oper | + ANDS of oper * oper | + NOT of oper * oper | + NOTS of oper * oper | + PUSH of oper * oper | + POP of oper * oper | + CALL of oper * oper * int | + SHR of oper * oper | + SHL of oper * oper + + datatype insn = + DIRECTIVE of string | + COMMENT of string | + LABEL of Label.label | + INSN of pred * opc | + LIVEIGN of insn + + structure OperSet : ORD_SET + where type Key.ord_key = oper; + structure LiveMap : ORD_MAP + where type Key.ord_key = int; + + val regcmp : reg * reg -> order + val cmpoper : oper * oper -> order + val opereq : oper * oper -> bool + val regname : reg -> string + val regtonum : reg -> int + val numtoreg : int -> reg + val predname : pred -> string + val pp_oper : oper -> string + val print : insn -> string +end + +structure Blarg :> BLARG = +struct + +(* register type *) + datatype reg = + R0 | R1 | R2 | R3 | FR | SP | PC + (* operands to instructions *) + datatype oper = REG of reg | + TEMP of Temp.temp | + STACKARG of int + datatype pred = NV | NE | EQ | LT | GT | AL + (* instructions *) + datatype opc = + MOVLIT of oper * word | + MOVSYM of oper * Symbol.symbol | + MOVLBL of oper * Label.label | + LDR of oper * oper | + STO of oper * oper | + MOV of oper * oper | + MOVS of oper * oper | + ADD of oper * oper | + ADDS of oper * oper | + SUB of oper * oper | + SUBS of oper * oper | + AND of oper * oper | + ANDS of oper * oper | + NOT of oper * oper | + NOTS of oper * oper | + PUSH of oper * oper | + POP of oper * oper | + CALL of oper * oper * int | + SHR of oper * oper | + SHL of oper * oper + + datatype insn = + DIRECTIVE of string | + COMMENT of string | + LABEL of Label.label | + INSN of pred * opc | + LIVEIGN of insn + + type func = Ast.ident * insn list + + (* gives name of reg *) + val regnames = + [ (R0, "r0"), + (R1, "r1"), + (R2, "r2"), + (R3, "r3"), + (FR, "fr"), + (SP, "sp"), + (PC, "pc") ]; + + fun regname reg = + let + val (r, n) = valOf (List.find (fn (r, _) => r = reg) regnames) + in + n + end + + fun predname NV = "nv" + | predname NE = "ne" + | predname EQ = "eq" + | predname LT = "lt" + | predname GT = "gt" + | predname AL = "" + + (* gives number (color) associated with reg *) + fun regtonum R0 = 0 + | regtonum R1 = 1 + | regtonum R2 = 2 + | regtonum R3 = 3 + | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register") + + (* gives reg associated with number (color) *) + fun numtoreg 0 = R0 + | numtoreg 1 = R1 + | numtoreg 2 = R2 + | numtoreg 3 = R3 + | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n)) + + (* register compare *) + fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2) + + (* operand compare; arbitrary order imposed to make + * various things easier (e.g. liveness, for sorting) + *) + fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2) + | cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2) + | cmpoper (REG _, _) = LESS + | cmpoper (_, _) = GREATER + + fun opereq (REG a, REG b) = a = b + | opereq (TEMP a, TEMP b) = Temp.eq (a, b) + | opereq (_, _) = false + + structure OperSet = ListSetFn ( + struct + type ord_key = oper + val compare = cmpoper + end) + + structure LiveMap = SplayMapFn(struct + type ord_key = int + val compare = Int.compare + end) + + fun pp_oper (REG r) = "%" ^ (regname r) + | pp_oper (TEMP t) = (Temp.name t) ^ (Temp.sfx (Temp.size t)) + | pp_oper (STACKARG i) = "arg#"^Int.toString i + + fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Word.toString w)^"\n" + | pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n" + | pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n" + | pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n" + | pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n" + | pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" # ("^(Int.toString n)^" args)\n" + | pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + | pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n" + + (* pretty prints the asm *) + fun print (DIRECTIVE(str)) = str ^ "\n" + | print (COMMENT(str)) = "// " ^ str ^ "\n" + | print (LABEL(l)) = Label.name l ^ ":\n" + | print (INSN (pred, insn)) = pp_insn (predname pred) insn + | print (LIVEIGN i) = print i +end