[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 |
    MOVSTR of oper * Stringref.stringref |
    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 |
    MOVSTR of oper * Stringref.stringref |
    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 FR = 13
    | regtonum SP = 14
    | regtonum PC = 15

  (* 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 (MOVSTR (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Stringref.name s)^"\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 \|
5c90fbb8	22	MOVSTR of oper * Stringref.stringref \|
f716a180 JW	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 =
c2b45b36	69	R0 \| R1 \| R2 \| R3 \| R4 \| R5 \| R6 \| R7 \| R8 \| R9 \| R10 \| R11 \| R12 \| FR \| SP \| PC
f716a180 JW	70	(* operands to instructions *)
	71	datatype oper = REG of reg \|
	72	TEMP of Temp.temp \|
	73	STACKARG of int
075222c7	74	datatype pred = NV \| NE \| EQ \| LT \| GT \| LE \| GE \| AL
f716a180 JW	75	(* instructions *)
	76	datatype opc =
	77	MOVLIT of oper * word \|
	78	MOVSYM of oper * Symbol.symbol \|
	79	MOVLBL of oper * Label.label \|
5c90fbb8	80	MOVSTR of oper * Stringref.stringref \|
f716a180 JW	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"),
c2b45b36 JW	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"),
f716a180 JW	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"
075222c7 JW	139	\| predname GE = "ge"
075222c7 JW	140	\| predname LE = "le"
f716a180 JW	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
c2b45b36 JW	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
d4e2479e JW	157	\| regtonum FR = 13
	158	\| regtonum SP = 14
	159	\| regtonum PC = 15
f716a180 JW	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
c2b45b36 JW	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
f716a180 JW	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
4f528370	203	fun pp_oper (REG r) = (regname r)
6c5506c5	204	\| pp_oper (TEMP t) = (Temp.name t)
f716a180 JW	205	\| pp_oper (STACKARG i) = "arg#"^Int.toString i
f716a180 JW	206
4f528370	207	fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
f716a180 JW	208	\| pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
f716a180 JW	209	\| pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
5c90fbb8	210	\| pp_insn pr (MOVSTR (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Stringref.name s)^"\n"
f716a180 JW	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"
4f528370	225	\| pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
f716a180 JW	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"
4f528370	231	\| print (COMMENT(str)) = "@ " ^ str ^ "\n"
f716a180 JW	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