[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 | 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 | 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"),
      (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 _ = 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 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)^", #"^(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 =
	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
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 =
	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
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"),
	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"
075222c7 JW	128	\| predname GE = "ge"
075222c7 JW	129	\| predname LE = "le"
f716a180 JW	130	\| predname AL = ""
	131
	132	(* gives number (color) associated with reg *)
	133	fun regtonum R0 = 0
	134	\| regtonum R1 = 1
	135	\| regtonum R2 = 2
	136	\| regtonum R3 = 3
	137	\| regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register")
	138
	139	(* gives reg associated with number (color) *)
	140	fun numtoreg 0 = R0
	141	\| numtoreg 1 = R1
	142	\| numtoreg 2 = R2
	143	\| numtoreg 3 = R3
	144	\| numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n))
	145
	146	(* register compare *)
	147	fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
	148
	149	(* operand compare; arbitrary order imposed to make
	150	* various things easier (e.g. liveness, for sorting)
	151	*)
	152	fun cmpoper (REG reg1, REG reg2) = regcmp (reg1, reg2)
	153	\| cmpoper (TEMP temp1, TEMP temp2) = Temp.compare (temp1,temp2)
	154	\| cmpoper (REG _, _) = LESS
	155	\| cmpoper (_, _) = GREATER
	156
	157	fun opereq (REG a, REG b) = a = b
	158	\| opereq (TEMP a, TEMP b) = Temp.eq (a, b)
	159	\| opereq (_, _) = false
	160
	161	structure OperSet = ListSetFn (
	162	struct
	163	type ord_key = oper
	164	val compare = cmpoper
	165	end)
	166
	167	structure LiveMap = SplayMapFn(struct
	168	type ord_key = int
	169	val compare = Int.compare
	170	end)
	171
	172	fun pp_oper (REG r) = "%" ^ (regname r)
6c5506c5	173	\| pp_oper (TEMP t) = (Temp.name t)
f716a180 JW	174	\| pp_oper (STACKARG i) = "arg#"^Int.toString i
	175
	176	fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Word.toString w)^"\n"
	177	\| pp_insn pr (MOVSYM (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Symbol.name s)^"\n"
	178	\| pp_insn pr (MOVLBL (d, l)) = "\tmov"^pr^" "^(pp_oper d)^", #"^(Label.name l)^"\n"
	179	\| pp_insn pr (LDR (d, s)) = "\tldr"^pr^" "^(pp_oper d)^", ["^(pp_oper s)^"]\n"
	180	\| pp_insn pr (STO (d, s)) = "\tsto"^pr^" ["^(pp_oper d)^"], "^(pp_oper s)^"\n"
	181	\| pp_insn pr (MOV (d, s)) = "\tmov"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	182	\| pp_insn pr (MOVS (d, s)) = "\tmovs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	183	\| pp_insn pr (ADD (d, s)) = "\tadd"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	184	\| pp_insn pr (ADDS (d, s)) = "\tadds"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	185	\| pp_insn pr (SUB (d, s)) = "\tsub"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	186	\| pp_insn pr (SUBS (d, s)) = "\tsubs"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	187	\| pp_insn pr (AND (d, s)) = "\tand"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	188	\| pp_insn pr (ANDS (d, s)) = "\tands"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	189	\| pp_insn pr (NOT (d, s)) = "\tnot"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	190	\| pp_insn pr (NOTS (d, s)) = "\tnots"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	191	\| pp_insn pr (PUSH (d, s)) = "\tpush"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	192	\| pp_insn pr (POP (d, s)) = "\tpop"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	193	\| pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" # ("^(Int.toString n)^" args)\n"
	194	\| pp_insn pr (SHR (d, s)) = "\tshr"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	195	\| pp_insn pr (SHL (d, s)) = "\tshl"^pr^" "^(pp_oper d)^", "^(pp_oper s)^"\n"
	196
	197	(* pretty prints the asm *)
	198	fun print (DIRECTIVE(str)) = str ^ "\n"
	199	\| print (COMMENT(str)) = "// " ^ str ^ "\n"
	200	\| print (LABEL(l)) = Label.name l ^ ":\n"
	201	\| print (INSN (pred, insn)) = pp_insn (predname pred) insn
	202	\| print (LIVEIGN i) = print i
	203	end