Mercurial > repos > tabletprog

comparison modules/llcompile.tp @ 352:f74ce841fd1e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 }