Mercurial > repos > tabletprog
comparison modules/llcompile.tp @ 315:f987bb2a1911
WIP native compiler work
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sat, 14 Mar 2015 12:10:51 -0700 |
parents | 2308336790d4 |
children | f74ce841fd1e |
comparison
equal
deleted
inserted
replaced
314:d4df33596e7d | 315:f987bb2a1911 |
---|---|
6 line <- { _line } | 6 line <- { _line } |
7 } | 7 } |
8 } | 8 } |
9 | 9 |
10 _notError <- :vals ifnoterr { | 10 _notError <- :vals ifnoterr { |
11 maybeErr <- vals find: :val { | 11 if: (object does: vals understand?: "find") { |
12 (object does: val understand?: "isError?") && val isError? | 12 maybeErr <- vals find: :val { |
13 } | 13 (object does: val understand?: "isError?") && val isError? |
14 maybErr value: :err { | 14 } |
15 err | 15 maybeErr value: :err { |
16 } none: ifnoterr | 16 err |
17 } none: ifnoterr | |
18 } else: ifnoterr | |
17 } | 19 } |
18 | 20 |
19 _ilFun <- :_name { | 21 _ilFun <- :_name { |
20 _buff <- #[] | 22 _buff <- #[] |
23 _blockStack <- [] | |
21 _nextReg <- 0 | 24 _nextReg <- 0 |
22 #{ | 25 #{ |
23 name <- { _name } | 26 name <- { _name } |
24 add <- :inst { _buff append: inst } | 27 add <- :inst { _buff append: inst } |
25 getReg <- { | 28 getReg <- { |
26 r <- il reg: _nextReg | 29 r <- il reg: _nextReg |
27 _nextReg <- _nextReg + 1 | 30 _nextReg <- _nextReg + 1 |
28 r | 31 r |
29 } | 32 } |
30 } | 33 startBlock <- { |
31 } | 34 _blockStack <- _buff | _blockStack |
32 | 35 _buff <- #[] |
33 _exprHandlers <- dict hash | 36 } |
37 popBlock <- { | |
38 res <- _buff | |
39 _buff <- _blockStack value | |
40 _blockStack <- _blockStack tail | |
41 res | |
42 } | |
43 buffer <- { _buff } | |
44 } | |
45 } | |
46 | |
47 _exprHandlers <- false | |
34 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { | 48 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { |
35 _exprHandlers ifget: (expr nodeType) :handler { | 49 _exprHandlers ifget: (expr nodeType) :handler { |
36 handler: expr syms ilf dst | 50 handler: expr syms ilf dst |
37 } else: { | 51 } else: { |
38 _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet" | 52 _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet" |
39 } | 53 } |
40 } | 54 } |
41 _opMap <- dict hash | 55 _opMap <- false |
42 mapOp <- macro: :op ilfun { | 56 |
43 quote: (opMap set: op :ina inb out size { | 57 _compOps <- false |
44 il ilfun: ina inb out size | |
45 }) | |
46 } | |
47 mapOp: "+" add | |
48 mapOp: "-" sub | |
49 mapOp: "*" mul | |
50 mapOp: "/" div | |
51 mapOp: "and" and | |
52 mapOp: "or" or | |
53 mapOp: "xor" xor | |
54 | |
55 _compOps <- dict hash | |
56 _compOps set: "=" :signed? { il eq } | |
57 _compOps set: "!=" :signed? { il ne } | |
58 _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } } | |
59 _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } } | |
60 _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } } | |
61 _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } } | |
62 | 58 |
63 _compileBinary <- :expr syms ilf assignTo { | 59 _compileBinary <- :expr syms ilf assignTo { |
64 _assignSize? <- false | 60 _assignSize? <- false |
65 _asize <- 0 | 61 _asize <- 0 |
66 dest <- option value: assignTo :asn { | 62 dest <- option value: assignTo :asn { |
111 def | 107 def |
112 } else: { | 108 } else: { |
113 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) | 109 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) |
114 } | 110 } |
115 } | 111 } |
116 | 112 _compileIf <- :expr syms ilf assignTo { |
117 _exprHandlers set: binary _compileBinary | 113 if: ((expr args) length) != 2 { |
118 _exprHandlers set: stringlit _compileString | 114 _compileError: "if takes exactly 2 arguments" 0 |
115 } else: { | |
116 condArg <- (expr args) value | |
117 blockArg <- ((expr args) tail) value | |
118 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) | |
119 _notError: [cond] { | |
120 if: (blockArg nodeType) != (ast lambda) { | |
121 _compileError: "second argument to if must be a lambda" | |
122 } else: { | |
123 ilf add: (il cmp: condArg 0 (condArg size)) | |
124 //TODO: Deal with if in return position | |
125 ilf startBlock | |
126 foreach: (blockArg expressions) :idx expr{ | |
127 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | |
128 } | |
129 block <- ilf popBlock | |
130 ilf add: (il skipIf: (il neq) block) | |
131 } | |
132 } | |
133 } | |
134 } | |
135 _compileIfElse <- :expr syms ilf assignTo { | |
136 if: ((expr args) length) != 2 { | |
137 _compileError: "if takes exactly 2 arguments" 0 | |
138 } else: { | |
139 condArg <- (expr args) value | |
140 blockArg <- ((expr args) tail) value | |
141 elseArg <- (((expr args) tail) tail) value | |
142 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) | |
143 _notError: [cond] { | |
144 if: (blockArg nodeType) != (ast lambda) { | |
145 _compileError: "second argument to if:else must be a lambda" | |
146 } else: { | |
147 if: (elseArg nodeType) != (ast lambda) { | |
148 _compileError: "third argument to if:else must be a lambda" | |
149 } else: { | |
150 ilf add: (il cmp: condArg 0 (condArg size)) | |
151 //TODO: Deal with if:else in return position | |
152 ilf startBlock | |
153 foreach: (blockArg expressions) :idx expr { | |
154 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | |
155 } | |
156 block <- ilf popBlock | |
157 ilf startBlock | |
158 foreach: (elseArg expressions) :idx expr { | |
159 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | |
160 } | |
161 elseblock <- ilf popBlock | |
162 ilf add: (il skipIf: (il neq) block else: elseblock) | |
163 } | |
164 } | |
165 } | |
166 } | |
167 } | |
168 _funMap <- false | |
169 _compileCall <- :expr syms ilf assignTo { | |
170 if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) { | |
171 handler <- _funMap get: ((expr tocall) name) else: { false } | |
172 handler: expr syms ilf assignTo | |
173 } else: { | |
174 ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none) | |
175 cargs <- (expr args) map: :arg { | |
176 _compileExpr: arg syms: syms ilfun: ilf dest: (option none) | |
177 } | |
178 _notError: ctocall | cargs { | |
179 ilf add: (il call: ctocall withArgs: cargs) | |
180 il retr | |
181 } | |
182 } | |
183 } | |
184 | |
185 _compileAssign <- :expr syms ilf assignTo { | |
186 dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none) | |
187 _notError: [dest] { | |
188 value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest | |
189 _notError: [value] { | |
190 //TODO: adjust size of value if necessary | |
191 ilf add: (il mov: (value val) (dest val) (dest size)) | |
192 value | |
193 } | |
194 } | |
195 } | |
196 | |
197 _initDone? <- false | |
119 #{ | 198 #{ |
120 import: [ | 199 import: [ |
121 binary | 200 binary |
122 stringlit | 201 stringlit |
123 intlit | 202 intlit |
126 obj | 205 obj |
127 sequence | 206 sequence |
128 assignment | 207 assignment |
129 lambda | 208 lambda |
130 ] from: ast | 209 ] from: ast |
131 llFun <- :{ | 210 _initHandlers <- { |
132 | 211 if: (not: _initDone?) { |
212 _exprHandlers <- dict hash | |
213 _exprHandlers set: binary _compileBinary | |
214 _exprHandlers set: stringlit _compileString | |
215 _exprHandlers set: intlit _compileInt | |
216 _exprHandlers set: sym _compileSym | |
217 _exprHandlers set: assignment _compileAssign | |
218 _exprHandlers set: call _compileCall | |
219 | |
220 _opMap <- dict hash | |
221 mapOp <- macro: :op ilfun { | |
222 quote: (_opMap set: op :ina inb out size { | |
223 il ilfun: ina inb out size | |
224 }) | |
225 } | |
226 mapOp: "+" add | |
227 mapOp: "-" sub | |
228 mapOp: "*" mul | |
229 mapOp: "/" div | |
230 mapOp: "and" band | |
231 mapOp: "or" bor | |
232 mapOp: "xor" bxor | |
233 | |
234 _compOps <- dict hash | |
235 _compOps set: "=" :signed? { il eq } | |
236 _compOps set: "!=" :signed? { il ne } | |
237 _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } } | |
238 _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } } | |
239 _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } } | |
240 _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } } | |
241 | |
242 _funMap <- dict hash | |
243 _funMap set: "if" _compileIf | |
244 _funMap set: "if:else" _compileIfElse | |
245 //_funMap set: "while:do" _compileWhileDo | |
246 } | |
247 } | |
248 | |
249 llFun:syms:vars:code <- :name :syms :vars :code{ | |
250 _initHandlers: | |
251 syms <- symbols tableWithParent: syms | |
252 argnames <- dict hash | |
253 foreach: (code args) :idx arg { | |
254 if: (arg startsWith?: ":") { | |
255 arg <- arg from: 1 | |
256 } | |
257 argnames set: arg true | |
258 } | |
259 ilf <- _ilFun: name | |
260 _nextReg <- 0 | |
261 foreach: vars :idx var { | |
262 type <- _parseType: (var assign) | |
263 varname <- ((var to) name) | |
264 v <- argnames ifget: varname :argnum { | |
265 il arg: argnum | |
266 } else: { | |
267 ilf getReg | |
268 } | |
269 syms define: varname #{ | |
270 val <- v | |
271 size <- (type size) | |
272 } | |
273 } | |
274 last <- option none | |
275 numexprs <- code length | |
276 foreach: code :idx expr { | |
277 asn <- option none | |
278 if: idx = numexprs - 1 { | |
279 option value: (il retr) | |
280 } | |
281 last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn) | |
282 } | |
283 last value: :v { | |
284 ilf add: (il return: (v val) (v size)) | |
285 } none: { | |
286 ilf add: (il return: 0 (il l)) | |
287 } | |
288 ilf | |
289 } | |
290 | |
291 compileText <- :text { | |
292 res <- parser top: text | |
293 if: res { | |
294 tree <- res yield | |
295 if: (tree nodeType) = obj { | |
296 errors <- [] | |
297 syms <- symbols table | |
298 functions <- tree messages fold: [] :curfuncs msg { | |
299 if: (msg nodeType) = call { | |
300 if: ((msg tocall) name) = "llFun:withVars:andCode" { | |
301 if: ((msg args) length) = 3 { | |
302 fname <- ((msg args) get: 0) name | |
303 syms define: fname #{ | |
304 type <- "topfun" | |
305 } | |
306 #{ | |
307 name <- fname | |
308 vars <- (msg args) get: 1 | |
309 body <- (msg args) get: 2 | |
310 } | curfuncs | |
311 } else: { | |
312 errors <- ( | |
313 _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0 | |
314 ) | errors | |
315 curfuncs | |
316 } | |
317 } else: { | |
318 errors <- ( | |
319 _compileError: "Only llFun:withVars:andCode expressions are allowed in top level object" 0 | |
320 ) | errors | |
321 curfuncs | |
322 } | |
323 } else: { | |
324 errors <- ( | |
325 _compileError: "Only call expresions are allowed in top level object" 0 | |
326 ) | errors | |
327 curfuncs | |
328 } | |
329 } | |
330 if: (errors empty?) { | |
331 fmap <- functions fold: (dict hash) with: :acc func { | |
332 _notError: acc { | |
333 ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body) | |
334 _notError: ilf { | |
335 acc set: (func name) (ilf buffer) | |
336 } | |
337 } | |
338 } | |
339 fmap toBackend: x86 | |
340 } else: { | |
341 errors | |
342 } | |
343 } else: { | |
344 [(_compileError: "Top level must be an object in llcompile dialect" 1)] | |
345 } | |
346 } else: { | |
347 [(_compileError: "Failed to parse file" 0)] | |
348 } | |
349 } | |
350 | |
351 main <- :args { | |
352 if: (length: args) > 1 { | |
353 text <- (file open: (args get: 1)) readAll | |
354 mcode <- compileText: text | |
355 _notError: mcode { | |
356 ba <- bytearray executableFromBytes: mcode | |
357 arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0} | |
358 ba runWithArg: (arg i64) | |
359 } | |
360 } else: { | |
361 (file stderr) write: "Usage: llcompile FILE\n" | |
362 1 | |
363 } | |
133 } | 364 } |
134 } | 365 } |
135 } | 366 } |