codegen/blarg.sml

   1 (* L3 compiler
   2  * blargCPU instruction/operand internal representation and manipulation
   3  * Author: Joshua Wise <jwise@andrew.cmu.edu>
   4  * Author: Chris Lu <czl@andrew.cmu.edu>
   5  *)
   6
   7 signature BLARG =
   8 sig
   9   (* register type *)
  10   datatype reg =
  11     R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC
  12   (* operands to instructions *)
  13   datatype oper = REG of reg |
  14                      TEMP of Temp.temp |
  15                      STACKARG of int
  16   datatype pred = NV | NE | EQ | LT | GT | LE | GE | AL
  17   (* instructions *)
  18   datatype opc =
  19     MOVLIT of oper * word |
  20     MOVSYM of oper * Symbol.symbol |
  21     MOVLBL of oper * Label.label |
  22     MOVSTR of oper * Stringref.stringref |
  23     LDR of oper * oper |
  24     STO of oper * oper |
  25     MOV of oper * oper |
  26     MOVS of oper * oper |
  27     ADD of oper * oper |
  28     ADDS of oper * oper |
  29     SUB of oper * oper |
  30     SUBS of oper * oper |
  31     AND of oper * oper |
  32     ANDS of oper * oper |
  33     NOT of oper * oper |
  34     NOTS of oper * oper |
  35     PUSH of oper * oper |
  36     POP of oper * oper |
  37     CALL of oper * oper * int |
  38     SHR of oper * oper |
  39     SHL of oper * oper
  40
  41   datatype insn =
  42     DIRECTIVE of string |
  43     COMMENT of string |
  44     LABEL of Label.label |
  45     INSN of pred * opc |
  46     LIVEIGN of insn
  47
  48   structure OperSet : ORD_SET
  49     where type Key.ord_key = oper;
  50   structure LiveMap : ORD_MAP
  51     where type Key.ord_key = int;
  52
  53   val regcmp : reg * reg -> order
  54   val cmpoper : oper * oper -> order
  55   val opereq : oper * oper -> bool
  56   val regname : reg -> string
  57   val regtonum : reg -> int
  58   val numtoreg : int -> reg
  59   val predname : pred -> string
  60   val pp_oper : oper -> string
  61   val print : insn -> string
  62 end
  63
  64 structure Blarg :> BLARG =
  65 struct
  66
  67 (* register type *)
  68   datatype reg =
  69     R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC
  70   (* operands to instructions *)
  71   datatype oper = REG of reg |
  72                   TEMP of Temp.temp |
  73                   STACKARG of int
  74   datatype pred = NV | NE | EQ | LT | GT | LE | GE | AL
  75   (* instructions *)
  76   datatype opc =
  77     MOVLIT of oper * word |
  78     MOVSYM of oper * Symbol.symbol |
  79     MOVLBL of oper * Label.label |
  80     MOVSTR of oper * Stringref.stringref |
  81     LDR of oper * oper |
  82     STO of oper * oper |
  83     MOV of oper * oper |
  84     MOVS of oper * oper |
  85     ADD of oper * oper |
  86     ADDS of oper * oper |
  87     SUB of oper * oper |
  88     SUBS of oper * oper |
  89     AND of oper * oper |
  90     ANDS of oper * oper |
  91     NOT of oper * oper |
  92     NOTS of oper * oper |
  93     PUSH of oper * oper |
  94     POP of oper * oper |
  95     CALL of oper * oper * int |
  96     SHR of oper * oper |
  97     SHL of oper * oper
  98
  99   datatype insn =
 100     DIRECTIVE of string |
 101     COMMENT of string |
 102     LABEL of Label.label |
 103     INSN of pred * opc |
 104     LIVEIGN of insn
 105
 106   type func = Ast.ident * insn list
 107
 108   (* gives name of reg *)
 109   val regnames =
 110     [ (R0, "r0"),
 111       (R1, "r1"),
 112       (R2, "r2"),
 113       (R3, "r3"),
 114       (R4, "r4"),
 115       (R5, "r5"),
 116       (R6, "r6"),
 117       (R7, "r7"),
 118       (R8, "r8"),
 119       (R9, "r9"),
 120       (R10, "r10"),
 121       (R11, "r11"),
 122       (R12, "r12"),
 123       (FR, "fr"),
 124       (SP, "sp"),
 125       (PC, "pc") ];
 126
 127   fun regname reg =
 128     let
 129       val (r, n) = valOf (List.find (fn (r, _) => r = reg) regnames)
 130     in
 131       n
 132     end
 133
 134   fun predname NV = "nv"
 135     | predname NE = "ne"
 136     | predname EQ = "eq"
 137     | predname LT = "lt"
 138     | predname GT = "gt"
 139     | predname GE = "ge"
 140     | predname LE = "le"
 141     | predname AL = ""
 142
 143   (* gives number (color) associated with reg *)
 144   fun regtonum R0 = 0
 145     | regtonum R1 = 1
 146     | regtonum R2 = 2
 147     | regtonum R3 = 3
 148     | regtonum R4 = 4
 149     | regtonum R5 = 5
 150     | regtonum R6 = 6
 151     | regtonum R7 = 7
 152     | regtonum R8 = 8
 153     | regtonum R9 = 9
 154     | regtonum R10 = 10
 155     | regtonum R11 = 11
 156     | regtonum R12 = 12
 157     | regtonum FR = 13
 158     | regtonum SP = 14
 159     | regtonum PC = 15
 160
 161   (* gives reg associated with number (color) *)
 162   fun numtoreg 0 = R0
 163     | numtoreg 1 = R1
 164     | numtoreg 2 = R2
 165     | numtoreg 3 = R3
 166     | numtoreg 4 = R4
 167     | numtoreg 5 = R5
 168     | numtoreg 6 = R6
 169     | numtoreg 7 = R7
 170     | numtoreg 8 = R8
 171     | numtoreg 9 = R9
 172     | numtoreg 10 = R10
 173     | numtoreg 11 = R11
 174     | numtoreg 12 = R12
 175     | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n))
 176
 177   (* register compare *)
 178   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
 179
 180   (* operand compare; arbitrary order imposed to make
 181    * various things easier (e.g. liveness, for sorting)
 182    *)
 183   fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2)
 184     | cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2)
 185     | cmpoper (REG _, _) = LESS
 186     | cmpoper (_, _) = GREATER
 187
 188   fun opereq (REG a, REG b) = a = b
 189     | opereq (TEMP a, TEMP b) = Temp.eq (a, b)
 190     | opereq (_, _) = false
 191
 192   structure OperSet = ListSetFn (
 193     struct
 194       type ord_key = oper
 195       val compare = cmpoper
 196     end)
 197
 198   structure LiveMap = SplayMapFn(struct
 199                                    type ord_key = int
 200                                    val compare = Int.compare
 201                                  end)
 202
 203   fun pp_oper (REG r) = (regname r)
 204     | pp_oper (TEMP t) = (Temp.name t)
 205     | pp_oper (STACKARG i) = "arg#"^Int.toString i
 206
 207   fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
 208     | pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
 209     | pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
 210     | pp_insn pr (MOVSTR (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Stringref.name s)^"\n"
 211     | pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n"
 212     | pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n"
 213     | pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 214     | pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 215     | pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 216     | pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 217     | pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 218     | pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 219     | pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 220     | pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 221     | pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 222     | pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 223     | pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 224     | pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 225     | pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
 226     | pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 227     | pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 228
 229   (* pretty prints the asm *)
 230   fun print (DIRECTIVE(str)) = str ^ "\n"
 231     | print (COMMENT(str)) = "@ " ^ str ^ "\n"
 232     | print (LABEL(l)) = Label.name l ^ ":\n"
 233     | print (INSN (pred, insn)) = pp_insn (predname pred) insn
 234     | print (LIVEIGN i) = print i
 235 end