]> Joshua Wise's Git repositories - snipe.git/blame_incremental - codegen/blarg.sml
git.joshuawise.com / snipe.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
Fix some stupid bugs in code generation.
[snipe.git] / codegen / blarg.sml
... / ...
CommitLineData
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
7signature BLARG =
8sig
9 (* register type *)
10 datatype reg =
11 R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | 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 | LE | GE | 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
61end
62
63structure Blarg :> BLARG =
64struct
65
66(* register type *)
67 datatype reg =
68 R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | 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 | LE | GE | 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 (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"),
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"
137 | predname GE = "ge"
138 | predname LE = "le"
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
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
155 | regtonum SP = 4
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
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
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
200 fun pp_oper (REG r) = (regname r)
201 | pp_oper (TEMP t) = (Temp.name t)
202 | pp_oper (STACKARG i) = "arg#"^Int.toString i
203
204 fun pp_insn pr (MOVLIT (d, w)) = "\tmov"^pr^" "^(pp_oper d)^", #0x"^(Word.toString w)^"\n"
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"
221 | pp_insn pr (CALL (d, s, n)) = "\tcall"^pr^" "^(pp_oper d)^", "^(pp_oper s)^" @ ("^(Int.toString n)^" args)\n"
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"
227 | print (COMMENT(str)) = "@ " ^ str ^ "\n"
228 | print (LABEL(l)) = Label.name l ^ ":\n"
229 | print (INSN (pred, insn)) = pp_insn (predname pred) insn
230 | print (LIVEIGN i) = print i
231end
Compiler for a C-like language written in SML
This page took 0.024161 seconds and 4 git commands to generate.