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