Mercurial > repos > tabletprog
comparison modules/llcompile.tp @ 352:f74ce841fd1e
Produce something resembling correct il from low level dialect
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 13 Apr 2015 22:42:27 -0700 |
parents | f987bb2a1911 |
children | 95bc24c729e6 |
comparison
equal
deleted
inserted
replaced
351:04ba2118c5fe | 352:f74ce841fd1e |
---|---|
5 msg <- { _msg } | 5 msg <- { _msg } |
6 line <- { _line } | 6 line <- { _line } |
7 } | 7 } |
8 } | 8 } |
9 | 9 |
10 _notError <- :vals ifnoterr { | 10 _notError:else <- :vals ifnoterr iferror { |
11 if: (object does: vals understand?: "find") { | 11 if: (object does: vals understand?: "find") { |
12 maybeErr <- vals find: :val { | 12 maybeErr <- vals find: :val { |
13 (object does: val understand?: "isError?") && val isError? | 13 (object does: val understand?: "isError?") && (val isError?) |
14 } | 14 } |
15 maybeErr value: :err { | 15 maybeErr value: :err { |
16 err | 16 iferror: err |
17 } none: ifnoterr | 17 } none: ifnoterr |
18 } else: ifnoterr | 18 } else: ifnoterr |
19 } | |
20 | |
21 _notError <- :vals ifnoterr { | |
22 _notError: vals ifnoterr else: :e { e } | |
19 } | 23 } |
20 | 24 |
21 _ilFun <- :_name { | 25 _ilFun <- :_name { |
22 _buff <- #[] | 26 _buff <- #[] |
23 _blockStack <- [] | 27 _blockStack <- [] |
41 res | 45 res |
42 } | 46 } |
43 buffer <- { _buff } | 47 buffer <- { _buff } |
44 } | 48 } |
45 } | 49 } |
50 | |
51 _sizeMap <- dict hash | |
52 _sizeMap set: "8" (il b) | |
53 _sizeMap set: "16" (il w) | |
54 _sizeMap set: "32" (il l) | |
55 _sizeMap set: "64" (il q) | |
56 | |
57 _parseType <- :expr { | |
58 if: (expr nodeType) = (ast sym) { | |
59 name <- expr name | |
60 _signed? <- true | |
61 if: (name startsWith?: "u") { | |
62 _signed? <- false | |
63 name <- name from: 1 | |
64 } | |
65 if: (name startsWith?: "int") && ((name length) <= 5) { | |
66 size <- name from: 3 | |
67 _sizeMap ifget: size :llsize { | |
68 #{ | |
69 size <- llsize | |
70 signed? <- _signed? | |
71 } | |
72 } else: { | |
73 _compileError: "LL integer type " . (expr name) . " has an invalid size" | |
74 } | |
75 } else: { | |
76 _compileError: "LL Type " . (expr name) . " not implemented yet" | |
77 } | |
78 } else: { | |
79 _compileError: "LL Type with node type " . (expr nodeType) . " not implemented yet" | |
80 } | |
81 } | |
46 | 82 |
47 _exprHandlers <- false | 83 _exprHandlers <- false |
48 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { | 84 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { |
49 _exprHandlers ifget: (expr nodeType) :handler { | 85 _exprHandlers ifget: (expr nodeType) :handler { |
50 handler: expr syms ilf dst | 86 handler: expr syms ilf dst |
56 | 92 |
57 _compOps <- false | 93 _compOps <- false |
58 | 94 |
59 _compileBinary <- :expr syms ilf assignTo { | 95 _compileBinary <- :expr syms ilf assignTo { |
60 _assignSize? <- false | 96 _assignSize? <- false |
61 _asize <- 0 | 97 _asize <- il b |
62 dest <- option value: assignTo :asn { | 98 dest <- assignTo value: :asn { |
63 _assignSize? <- true | 99 _assignSize? <- true |
64 _asize <- asn size | 100 _asize <- asn size |
65 asn | 101 asn |
66 } none: { | 102 } none: { |
67 ilf getReg | 103 #{ |
68 } | 104 val <- ilf getReg |
69 l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest) | 105 signed? <- true |
70 r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (option none) | 106 size <- _asize |
107 } | |
108 } | |
109 l <- _compileExpr: (expr left) syms: syms ilfun: ilf dest: (option value: dest) | |
110 r <- _compileExpr: (expr right) syms: syms ilfun: ilf dest: (option none) | |
71 _notError: [(l) (r)] { | 111 _notError: [(l) (r)] { |
72 lv <- l val | 112 lv <- l val |
73 ls <- l size | 113 ls <- l size |
74 rv <- r val | 114 rv <- r val |
75 rs <- r size | 115 rs <- r size |
76 _size <- if: ls > rs { ls } else: { rs } | 116 _size <- if: ls > rs { |
77 _signed <- (ls signed?) || (rs signed?) | 117 ls |
118 //TODO: sign/zero extend rv | |
119 } else: { | |
120 rs | |
121 //TODO: sign/zero extend lv if rs > ls | |
122 } | |
123 if: _assignSize? && _asize > _size { | |
124 _size <- _asize | |
125 //TODO: sign/zero extend result | |
126 } | |
127 _signed <- (l signed?) || (r signed?) | |
78 _opMap ifget: (expr op) :ingen { | 128 _opMap ifget: (expr op) :ingen { |
79 ilf add: (ingen: lv rv (dest val) _size) | 129 ilf add: (ingen: lv rv (dest val) _size) |
80 #{ | 130 #{ |
81 val <- dest | 131 val <- dest val |
82 size <- _size | 132 size <- _size |
83 signed? <- _signed | 133 signed? <- _signed |
84 } | 134 } |
85 } else: { | 135 } else: { |
86 _compOps ifget: (expr op) :cond { | 136 _compOps ifget: (expr op) :condFun { |
87 ilf add: (il bool: cond dest) | 137 ilf add: (il cmp: lv rv _size) |
138 cond <- condFun: _signed | |
139 ilf add: (il bool: cond (dest val)) | |
88 #{ | 140 #{ |
89 val <- dest | 141 val <- dest val |
90 size <- il b | 142 size <- il b |
91 signed? <- false | 143 signed? <- false |
92 } | 144 } |
93 } else: { | 145 } else: { |
94 _compileError: "Operator " . (expr op) . " is not supported yet\n" 0 | 146 _compileError: "Operator " . (expr op) . " is not supported yet\n" 0 |
98 } | 150 } |
99 _compileString <- :expr syms ilf assignTo { | 151 _compileString <- :expr syms ilf assignTo { |
100 | 152 |
101 } | 153 } |
102 _compileInt <- :expr syms ilf assignTo { | 154 _compileInt <- :expr syms ilf assignTo { |
103 expr | 155 sz <- il sizeFromBytes: (expr size) |
156 assignTo value: :asn { | |
157 ilf add: (il mov: (expr val) (asn val) sz) | |
158 #{ | |
159 val <- asn val | |
160 signed? <- expr signed? | |
161 size <- sz | |
162 } | |
163 } none: { | |
164 #{ | |
165 val <- expr val | |
166 signed? <- expr signed? | |
167 size <- sz | |
168 } | |
169 } | |
104 } | 170 } |
105 _compileSym <- :expr syms ilf assignTo { | 171 _compileSym <- :expr syms ilf assignTo { |
106 syms ifDefined: (expr name) :def { | 172 syms ifDefined: (expr name) :syminfo { |
107 def | 173 if: (syminfo isLocal?) { |
174 syminfo def | |
175 } else: { | |
176 print: "Symbol " . (expr name) . " is not local and other types are not yet supported in LL dialect\n" | |
177 } | |
108 } else: { | 178 } else: { |
109 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) | 179 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) |
110 } | 180 } |
111 } | 181 } |
112 _compileIf <- :expr syms ilf assignTo { | 182 _compileIf <- :expr syms ilf assignTo { |
118 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) | 188 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) |
119 _notError: [cond] { | 189 _notError: [cond] { |
120 if: (blockArg nodeType) != (ast lambda) { | 190 if: (blockArg nodeType) != (ast lambda) { |
121 _compileError: "second argument to if must be a lambda" | 191 _compileError: "second argument to if must be a lambda" |
122 } else: { | 192 } else: { |
123 ilf add: (il cmp: condArg 0 (condArg size)) | 193 ilf add: (il cmp: 0 (cond val) (cond size)) |
124 //TODO: Deal with if in return position | 194 dest <- if: (assignTo none?) { |
195 option value: #{ | |
196 val <- ilf reg | |
197 //TODO: FIXME | |
198 size <- il q | |
199 signed? <- true | |
200 } | |
201 } else: { | |
202 assignTo | |
203 } | |
125 ilf startBlock | 204 ilf startBlock |
126 foreach: (blockArg expressions) :idx expr{ | 205 foreach: (blockArg expressions) :idx expr{ |
127 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | 206 asn <- if: idx = ((blockArg expressions) length) - 1 { |
207 dest | |
208 } else: { | |
209 option none | |
210 } | |
211 _compileExpr: expr syms: syms ilfun: ilf dest: asn | |
128 } | 212 } |
129 block <- ilf popBlock | 213 block <- ilf popBlock |
130 ilf add: (il skipIf: (il neq) block) | 214 ilf add: (il skipIf: (il neq) block) |
215 dest value: :d { d } none: { _compileError: "Something went wrong" } | |
131 } | 216 } |
132 } | 217 } |
133 } | 218 } |
134 } | 219 } |
135 _compileIfElse <- :expr syms ilf assignTo { | 220 _compileIfElse <- :expr syms ilf assignTo { |
136 if: ((expr args) length) != 2 { | 221 if: ((expr args) length) != 3 { |
137 _compileError: "if takes exactly 2 arguments" 0 | 222 _compileError: "if:else takes exactly 3 arguments" 0 |
138 } else: { | 223 } else: { |
139 condArg <- (expr args) value | 224 condArg <- (expr args) value |
140 blockArg <- ((expr args) tail) value | 225 blockArg <- ((expr args) tail) value |
141 elseArg <- (((expr args) tail) tail) value | 226 elseArg <- (((expr args) tail) tail) value |
142 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) | 227 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) |
145 _compileError: "second argument to if:else must be a lambda" | 230 _compileError: "second argument to if:else must be a lambda" |
146 } else: { | 231 } else: { |
147 if: (elseArg nodeType) != (ast lambda) { | 232 if: (elseArg nodeType) != (ast lambda) { |
148 _compileError: "third argument to if:else must be a lambda" | 233 _compileError: "third argument to if:else must be a lambda" |
149 } else: { | 234 } else: { |
150 ilf add: (il cmp: condArg 0 (condArg size)) | 235 ilf add: (il cmp: 0 (cond val) (cond size)) |
151 //TODO: Deal with if:else in return position | 236 dest <- if: (assignTo none?) { |
237 option value: #{ | |
238 val <- ilf reg | |
239 //TODO: FIXME | |
240 size <- il q | |
241 signed? <- true | |
242 } | |
243 } else: { | |
244 assignTo | |
245 } | |
152 ilf startBlock | 246 ilf startBlock |
153 foreach: (blockArg expressions) :idx expr { | 247 foreach: (blockArg expressions) :idx expr { |
154 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | 248 asn <- if: idx = ((blockArg expressions) length) - 1 { |
249 dest | |
250 } else: { | |
251 option none | |
252 } | |
253 _compileExpr: expr syms: syms ilfun: ilf dest: asn | |
155 } | 254 } |
156 block <- ilf popBlock | 255 block <- ilf popBlock |
157 ilf startBlock | 256 ilf startBlock |
158 foreach: (elseArg expressions) :idx expr { | 257 foreach: (elseArg expressions) :idx expr { |
258 asn <- if: idx = ((elseArg expressions) length) - 1 { | |
259 dest | |
260 } else: { | |
261 option none | |
262 } | |
159 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) | 263 _compileExpr: expr syms: syms ilfun: ilf dest: (option none) |
160 } | 264 } |
161 elseblock <- ilf popBlock | 265 elseblock <- ilf popBlock |
162 ilf add: (il skipIf: (il neq) block else: elseblock) | 266 ilf add: (il skipIf: (il neq) block else: elseblock) |
267 dest value: :d { d } none: { _compileError: "Something went wrong" } | |
163 } | 268 } |
164 } | 269 } |
165 } | 270 } |
166 } | 271 } |
167 } | 272 } |
169 _compileCall <- :expr syms ilf assignTo { | 274 _compileCall <- :expr syms ilf assignTo { |
170 if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) { | 275 if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) { |
171 handler <- _funMap get: ((expr tocall) name) else: { false } | 276 handler <- _funMap get: ((expr tocall) name) else: { false } |
172 handler: expr syms ilf assignTo | 277 handler: expr syms ilf assignTo |
173 } else: { | 278 } else: { |
174 ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none) | 279 ctocall <- if: ((expr tocall) nodeType) = (ast sym) { |
280 ctocall <- (expr tocall) name | |
281 } else: { | |
282 _compileExpr: (expr tocall) syms: syms ilfun: ilf dest: (option none) | |
283 } | |
175 cargs <- (expr args) map: :arg { | 284 cargs <- (expr args) map: :arg { |
176 _compileExpr: arg syms: syms ilfun: ilf dest: (option none) | 285 _compileExpr: arg syms: syms ilfun: ilf dest: (option none) |
177 } | 286 } |
178 _notError: ctocall | cargs { | 287 _notError: ctocall | cargs { |
179 ilf add: (il call: ctocall withArgs: cargs) | 288 ilf add: (il call: ctocall withArgs: (cargs map: :arg { arg val } )) |
180 il retr | 289 |
290 retval <- assignTo value: :asn { | |
291 ilf add: (il mov: (il retr) (asn val) (asn size)) | |
292 asn | |
293 } none: { | |
294 #{ | |
295 val <- il retr | |
296 //TODO: Use correct values based on return type | |
297 size <- il q | |
298 signed? <- true | |
299 } | |
300 } | |
301 retval | |
181 } | 302 } |
182 } | 303 } |
183 } | 304 } |
184 | 305 |
185 _compileAssign <- :expr syms ilf assignTo { | 306 _compileAssign <- :expr syms ilf assignTo { |
186 dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none) | 307 dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none) |
187 _notError: [dest] { | 308 _notError: [dest] { |
188 value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest | 309 value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest |
189 _notError: [value] { | 310 _notError: [value] { |
190 //TODO: adjust size of value if necessary | 311 //TODO: adjust size of value if necessary |
191 ilf add: (il mov: (value val) (dest val) (dest size)) | 312 //ilf add: (il mov: (value val) (dest val) (dest size)) |
192 value | 313 value |
193 } | 314 } |
194 } | 315 } |
195 } | 316 } |
196 | 317 |
252 argnames <- dict hash | 373 argnames <- dict hash |
253 foreach: (code args) :idx arg { | 374 foreach: (code args) :idx arg { |
254 if: (arg startsWith?: ":") { | 375 if: (arg startsWith?: ":") { |
255 arg <- arg from: 1 | 376 arg <- arg from: 1 |
256 } | 377 } |
257 argnames set: arg true | 378 argnames set: arg idx |
258 } | 379 } |
259 ilf <- _ilFun: name | 380 ilf <- _ilFun: name |
260 _nextReg <- 0 | 381 _nextReg <- 0 |
261 foreach: vars :idx var { | 382 varErrors <- (vars expressions) fold: [] with: :acc var { |
262 type <- _parseType: (var assign) | 383 type <- _parseType: (var assign) |
263 varname <- ((var to) name) | 384 _notError: [type] { |
264 v <- argnames ifget: varname :argnum { | 385 varname <- ((var to) name) |
265 il arg: argnum | 386 v <- argnames ifget: varname :argnum { |
266 } else: { | 387 il arg: argnum |
267 ilf getReg | 388 } else: { |
268 } | 389 ilf getReg |
269 syms define: varname #{ | 390 } |
270 val <- v | 391 syms define: varname #{ |
271 size <- (type size) | 392 val <- v |
272 } | 393 size <- (type size) |
273 } | 394 signed? <- (type signed?) |
274 last <- option none | 395 } |
275 numexprs <- code length | 396 acc |
276 foreach: code :idx expr { | 397 } else: :err { |
277 asn <- option none | 398 err | acc |
278 if: idx = numexprs - 1 { | 399 } |
279 option value: (il retr) | 400 } |
280 } | 401 if: (varErrors empty?) { |
281 last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn) | 402 last <- option none |
282 } | 403 numexprs <- (code expressions) length |
283 last value: :v { | 404 foreach: (code expressions) :idx expr { |
284 ilf add: (il return: (v val) (v size)) | 405 asn <- if: idx = numexprs - 1 { |
285 } none: { | 406 option value: #{ |
286 ilf add: (il return: 0 (il l)) | 407 val <- ilf getReg |
287 } | 408 //TODO: FIxme |
288 ilf | 409 size <- il q |
410 signed? <- true | |
411 } | |
412 } else: { | |
413 option none | |
414 } | |
415 last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn) | |
416 } | |
417 last value: :v { | |
418 ilf add: (il return: (v val) (v size)) | |
419 } none: { | |
420 ilf add: (il return: 0 (il l)) | |
421 } | |
422 ilf | |
423 } else: { | |
424 varErrors | |
425 } | |
289 } | 426 } |
290 | 427 |
291 compileText <- :text { | 428 compileText <- :text { |
292 res <- parser top: text | 429 res <- parser top: text |
293 if: res { | 430 if: res { |
294 tree <- res yield | 431 tree <- res yield |
295 if: (tree nodeType) = obj { | 432 if: (tree nodeType) = obj { |
296 errors <- [] | 433 errors <- [] |
297 syms <- symbols table | 434 syms <- symbols table |
298 functions <- tree messages fold: [] :curfuncs msg { | 435 functions <- (tree messages) fold: [] with: :curfuncs msg { |
299 if: (msg nodeType) = call { | 436 if: (msg nodeType) = call { |
300 if: ((msg tocall) name) = "llFun:withVars:andCode" { | 437 if: ((msg tocall) name) = "llFun:withVars:andCode" { |
301 if: ((msg args) length) = 3 { | 438 if: ((msg args) length) = 3 { |
302 fname <- ((msg args) get: 0) name | 439 fname <- ((msg args) value) name |
303 syms define: fname #{ | 440 syms define: fname #{ |
304 type <- "topfun" | 441 type <- "topfun" |
305 } | 442 } |
443 rest <- (msg args) tail | |
306 #{ | 444 #{ |
307 name <- fname | 445 name <- fname |
308 vars <- (msg args) get: 1 | 446 vars <- rest value |
309 body <- (msg args) get: 2 | 447 body <- (rest tail) value |
310 } | curfuncs | 448 } | curfuncs |
311 } else: { | 449 } else: { |
312 errors <- ( | 450 errors <- ( |
313 _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0 | 451 _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0 |
314 ) | errors | 452 ) | errors |
326 ) | errors | 464 ) | errors |
327 curfuncs | 465 curfuncs |
328 } | 466 } |
329 } | 467 } |
330 if: (errors empty?) { | 468 if: (errors empty?) { |
469 errors <- [] | |
331 fmap <- functions fold: (dict hash) with: :acc func { | 470 fmap <- functions fold: (dict hash) with: :acc func { |
332 _notError: acc { | 471 ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body) |
333 ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body) | 472 _notError: ilf { |
334 _notError: ilf { | 473 acc set: (func name) (ilf buffer) |
335 acc set: (func name) (ilf buffer) | 474 } else: { |
475 errors <- ilf . errors | |
476 } | |
477 acc | |
478 } | |
479 if: (errors empty?) { | |
480 foreach: fmap :name instarr { | |
481 print: "Function: " . name . "\n" | |
482 foreach: instarr :_ inst { | |
483 print: "\t" . inst . "\n" | |
336 } | 484 } |
337 } | 485 } |
338 } | 486 print: "Translating IL to x86\n" |
339 fmap toBackend: x86 | 487 il toBackend: fmap x86 |
488 } else: { | |
489 errors | |
490 } | |
340 } else: { | 491 } else: { |
341 errors | 492 errors |
342 } | 493 } |
343 } else: { | 494 } else: { |
344 [(_compileError: "Top level must be an object in llcompile dialect" 1)] | 495 [(_compileError: "Top level must be an object in llcompile dialect" 1)] |
354 mcode <- compileText: text | 505 mcode <- compileText: text |
355 _notError: mcode { | 506 _notError: mcode { |
356 ba <- bytearray executableFromBytes: mcode | 507 ba <- bytearray executableFromBytes: mcode |
357 arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0} | 508 arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0} |
358 ba runWithArg: (arg i64) | 509 ba runWithArg: (arg i64) |
510 } else: :err { | |
511 (file stderr) write: (err msg) . "\n" | |
359 } | 512 } |
360 } else: { | 513 } else: { |
361 (file stderr) write: "Usage: llcompile FILE\n" | 514 (file stderr) write: "Usage: llcompile FILE\n" |
362 1 | 515 1 |
363 } | 516 } |