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 SP = 4
 158     | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register")
 159
 160   (* gives reg associated with number (color) *)
 161   fun numtoreg 0 = R0
 162     | numtoreg 1 = R1
 163     | numtoreg 2 = R2
 164     | numtoreg 3 = R3
 165     | numtoreg 4 = R4
 166     | numtoreg 5 = R5
 167     | numtoreg 6 = R6
 168     | numtoreg 7 = R7
 169     | numtoreg 8 = R8
 170     | numtoreg 9 = R9
 171     | numtoreg 10 = R10
 172     | numtoreg 11 = R11
 173     | numtoreg 12 = R12
 174     | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n))
 175
 176   (* register compare *)
 177   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
 178
 179   (* operand compare; arbitrary order imposed to make
 180    * various things easier (e.g. liveness, for sorting)
 181    *)
 182   fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2)
 183     | cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2)
 184     | cmpoper (REG _, _) = LESS
 185     | cmpoper (_, _) = GREATER
 186
 187   fun opereq (REG a, REG b) = a = b
 188     | opereq (TEMP a, TEMP b) = Temp.eq (a, b)
 189     | opereq (_, _) = false
 190
 191   structure OperSet = ListSetFn (
 192     struct
 193       type ord_key = oper
 194       val compare = cmpoper
 195     end)
 196
 197   structure LiveMap = SplayMapFn(struct
 198                                    type ord_key = int
 199                                    val compare = Int.compare
 200                                  end)
 201
 202   fun pp_oper (REG r) = (regname r)
 203     | pp_oper (TEMP t) = (Temp.name t)
 204     | pp_oper (STACKARG i) = "arg#"^Int.toString i
 205
 206   fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
 207     | pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
 208     | pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
 209     | pp_insn pr (MOVSTR (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Stringref.name s)^"\n"
 210     | pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n"
 211     | pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n"
 212     | pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 213     | pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 214     | pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 215     | pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 216     | pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 217     | pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 218     | pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 219     | pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 220     | pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 221     | pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 222     | pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 223     | pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 224     | pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
 225     | pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 226     | pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
 227
 228   (* pretty prints the asm *)
 229   fun print (DIRECTIVE(str)) = str ^ "\n"
 230     | print (COMMENT(str)) = "@ " ^ str ^ "\n"
 231     | print (LABEL(l)) = Label.name l ^ ":\n"
 232     | print (INSN (pred, insn)) = pp_insn (predname pred) insn
 233     | print (LIVEIGN i) = print i
 234 end