[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 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 (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
de034162	157	\| regtonum SP = 4
f716a180 JW	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
c2b45b36 JW	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
f716a180 JW	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
4f528370	202	fun pp_oper (REG r) = (regname r)
6c5506c5	203	\| pp_oper (TEMP t) = (Temp.name t)
f716a180 JW	204	\| pp_oper (STACKARG i) = "arg#"^Int.toString i
f716a180 JW	205
4f528370	206	fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
f716a180 JW	207	\| pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
f716a180 JW	208	\| pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
5c90fbb8	209	\| pp_insn pr (MOVSTR (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Stringref.name s)^"\n"
f716a180 JW	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"
4f528370	224	\| pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
f716a180 JW	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"
4f528370	230	\| print (COMMENT(str)) = "@ " ^ str ^ "\n"
f716a180 JW	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