[snipe.git] / codegen / blarg.sml

(* L3 compiler
 * blargCPU instruction/operand internal representation and manipulation
 * Author: Joshua Wise <jwise@andrew.cmu.edu>
 * Author: Chris Lu <czl@andrew.cmu.edu>
 *)

signature BLARG =
sig
  (* register type *)
  datatype reg =
    R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | 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 | LE | GE | 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 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | 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 | LE | GE | 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"),
      (R4, "r4"),
      (R5, "r5"),
      (R6, "r6"),
      (R7, "r7"),
      (R8, "r8"),
      (R9, "r9"),
      (R10, "r10"),
      (R11, "r11"),
      (R12, "r12"),
      (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 GE = "ge"
    | predname LE = "le"
    | predname AL = ""

  (* gives number (color) associated with reg *)
  fun regtonum R0 = 0
    | regtonum R1 = 1
    | regtonum R2 = 2
    | regtonum R3 = 3
    | regtonum R4 = 4
    | regtonum R5 = 5
    | regtonum R6 = 6
    | regtonum R7 = 7
    | regtonum R8 = 8
    | regtonum R9 = 9
    | regtonum R10 = 10
    | regtonum R11 = 11
    | regtonum R12 = 12
    | regtonum SP = 4
    | 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 4 = R4
    | numtoreg 5 = R5
    | numtoreg 6 = R6
    | numtoreg 7 = R7
    | numtoreg 8 = R8
    | numtoreg 9 = R9
    | numtoreg 10 = R10
    | numtoreg 11 = R11
    | numtoreg 12 = R12
    | 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)
    | pp_oper (STACKARG i) = "arg#"^Int.toString i
  
  fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(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
Commit	Line	Data
f716a180 JW	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 =
c2b45b36	11	R0 \| R1 \| R2 \| R3 \| R4 \| R5 \| R6 \| R7 \| R8 \| R9 \| R10 \| R11 \| R12 \| FR \| SP \| PC
f716a180 JW	12	(* operands to instructions *)
	13	datatype oper = REG of reg \|
	14	TEMP of Temp.temp \|
	15	STACKARG of int
075222c7	16	datatype pred = NV \| NE \| EQ \| LT \| GT \| LE \| GE \| AL
f716a180 JW	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 =
c2b45b36	68	R0 \| R1 \| R2 \| R3 \| R4 \| R5 \| R6 \| R7 \| R8 \| R9 \| R10 \| R11 \| R12 \| FR \| SP \| PC
f716a180 JW	69	(* operands to instructions *)
	70	datatype oper = REG of reg \|
	71	TEMP of Temp.temp \|
	72	STACKARG of int
075222c7	73	datatype pred = NV \| NE \| EQ \| LT \| GT \| LE \| GE \| AL
f716a180 JW	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"),
c2b45b36 JW	112	(R4, "r4"),
	113	(R5, "r5"),
	114	(R6, "r6"),
	115	(R7, "r7"),
	116	(R8, "r8"),
	117	(R9, "r9"),
	118	(R10, "r10"),
	119	(R11, "r11"),
	120	(R12, "r12"),
f716a180 JW	121	(FR, "fr"),
	122	(SP, "sp"),
	123	(PC, "pc") ];
	124
	125	fun regname reg =
	126	let
	127	val (r, n) = valOf (List.find (fn (r, _) => r = reg) regnames)
	128	in
	129	n
	130	end
	131
	132	fun predname NV = "nv"
	133	\| predname NE = "ne"
	134	\| predname EQ = "eq"
	135	\| predname LT = "lt"
	136	\| predname GT = "gt"
075222c7 JW	137	\| predname GE = "ge"
075222c7 JW	138	\| predname LE = "le"
f716a180 JW	139	\| predname AL = ""
	140
	141	(* gives number (color) associated with reg *)
	142	fun regtonum R0 = 0
	143	\| regtonum R1 = 1
	144	\| regtonum R2 = 2
	145	\| regtonum R3 = 3
c2b45b36 JW	146	\| regtonum R4 = 4
	147	\| regtonum R5 = 5
	148	\| regtonum R6 = 6
	149	\| regtonum R7 = 7
	150	\| regtonum R8 = 8
	151	\| regtonum R9 = 9
	152	\| regtonum R10 = 10
	153	\| regtonum R11 = 11
	154	\| regtonum R12 = 12
de034162	155	\| regtonum SP = 4
f716a180 JW	156	\| regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register")
	157
	158	(* gives reg associated with number (color) *)
	159	fun numtoreg 0 = R0
	160	\| numtoreg 1 = R1
	161	\| numtoreg 2 = R2
	162	\| numtoreg 3 = R3
c2b45b36 JW	163	\| numtoreg 4 = R4
	164	\| numtoreg 5 = R5
	165	\| numtoreg 6 = R6
	166	\| numtoreg 7 = R7
	167	\| numtoreg 8 = R8
	168	\| numtoreg 9 = R9
	169	\| numtoreg 10 = R10
	170	\| numtoreg 11 = R11
	171	\| numtoreg 12 = R12
f716a180 JW	172	\| numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n))
	173
	174	(* register compare *)
	175	fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
	176
	177	(* operand compare; arbitrary order imposed to make
	178	* various things easier (e.g. liveness, for sorting)
	179	*)
	180	fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2)
	181	\| cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2)
	182	\| cmpoper (REG _, _) = LESS
	183	\| cmpoper (_, _) = GREATER
	184
	185	fun opereq (REG a, REG b) = a = b
	186	\| opereq (TEMP a, TEMP b) = Temp.eq (a, b)
	187	\| opereq (_, _) = false
	188
	189	structure OperSet = ListSetFn (
	190	struct
	191	type ord_key = oper
	192	val compare = cmpoper
	193	end)
	194
	195	structure LiveMap = SplayMapFn(struct
	196	type ord_key = int
	197	val compare = Int.compare
	198	end)
	199
4f528370	200	fun pp_oper (REG r) = (regname r)
6c5506c5	201	\| pp_oper (TEMP t) = (Temp.name t)
f716a180 JW	202	\| pp_oper (STACKARG i) = "arg#"^Int.toString i
f716a180 JW	203
4f528370	204	fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
f716a180 JW	205	\| pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
	206	\| pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
	207	\| pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n"
	208	\| pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n"
	209	\| pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	210	\| pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	211	\| pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	212	\| pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	213	\| pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	214	\| pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	215	\| pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	216	\| pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	217	\| pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	218	\| pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	219	\| pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	220	\| pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
4f528370	221	\| pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
f716a180 JW	222	\| pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	223	\| pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	224
	225	(* pretty prints the asm *)
	226	fun print (DIRECTIVE(str)) = str ^ "\n"
4f528370	227	\| print (COMMENT(str)) = "@ " ^ str ^ "\n"
f716a180 JW	228	\| print (LABEL(l)) = Label.name l ^ ":\n"
	229	\| print (INSN (pred, insn)) = pp_insn (predname pred) insn
	230	\| print (LIVEIGN i) = print i
	231	end