Mercurial > repos > icfp2014

comparison code/gqc.tp @ 56:fde898a3cbbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Mostly complete version of gqc. Biggest omission is if:else. Defining labels also needs work.
author Michael Pavone <pavone@retrodev.com>
date Sun, 27 Jul 2014 19:52:30 -0700
parents 194a1414e240
children d35601d47db1
comparison
equal deleted inserted replaced
55:194a1414e240 56:fde898a3cbbe
12 reg <- :_num { 12 reg <- :_num {
13 #{ 13 #{
14 num <- { _num } 14 num <- { _num }
15 string <- { (#["a" "b" "c" "d" "e" "f" "g" "h" "pc"]) get: _num } 15 string <- { (#["a" "b" "c" "d" "e" "f" "g" "h" "pc"]) get: _num }
16 isReg? <- { true } 16 isReg? <- { true }
17 != <- :other { (reg?: other) && _num != (other num) } 17 != <- :other { (not: (reg?: other)) || _num != (other num) }
18 = <- :other { (reg?: other) && _num = (other num) } 18 = <- :other { (reg?: other) && _num = (other num) }
19 } 19 }
20 } 20 }
21 inst <- :_name _args { 21 inst <- :_name _args {
22 #{ 22 #{
23 name <- _name 23 name <- _name
24 args <- _args 24 args <- _args
25 translateLabels <- :labelDict { 25 translateLabels <- :labelDict {
26 missing <- #[] 26 missing <- #[]
27 foreach: args :idx arg { 27 args <- args map: :arg {
28 if: (object does: arg understand?: "isString?") && (arg isString?) { 28 if: (object does: arg understand?: "isString?") && (arg isString?) {
29 labelDict ifget: arg :translated { 29 labelDict get: arg else: {
30 args set: idx translated
31 } else: {
32 missing append: arg 30 missing append: arg
31 arg
33 } 32 }
33 } else: {
34 arg
34 } 35 }
35 } 36 }
36 missing 37 missing
37 } 38 }
38 label <- "" 39 label <- ""
82 (file stderr) write: "Error - " . msg . "\n" 83 (file stderr) write: "Error - " . msg . "\n"
83 } 84 }
84 _nextVar <- 0 85 _nextVar <- 0
85 //a and b are reserved for int/return values 86 //a and b are reserved for int/return values
86 //h is reserved as a stack pointer 87 //h is reserved as a stack pointer
87 _tempRegs <- [ 88 _allTemp <- [
88 reg: 2 89 reg: 2
89 reg: 3 90 reg: 3
90 reg: 4 91 reg: 4
91 reg: 5 92 reg: 5
92 reg: 6 93 reg: 6
93 ] 94 ]
95 _tempRegs <- _allTemp
94 96
95 _exprHandlers <- dict hash 97 _exprHandlers <- dict hash
96 98
97 compileExpr:syms <- :expr :syms { 99 compileExpr:syms <- :expr :syms {
98 _exprHandlers ifget: (expr nodeType) :handler { 100 _exprHandlers ifget: (expr nodeType) :handler {
168 v 170 v
169 ]) 171 ])
170 dest 172 dest
171 } 173 }
172 174
173 _compileFun <- :name fun globsyms { 175 _funHandlers <- dict hash
176 //provide symbolic names for all the interupt routines
177 _funHandlers set: "debug" :args syms {
178 prog add: (inst: "INT" #[8])
179 0
180 }
181 _funHandlers set: "direction!" :args syms {
182 dir <- args value
183 startTempRegs <- _tempRegs
184 v <- compileExpr: dir syms: syms
185 _tempRegs <- startTempRegs
186 if: (reg: 0) != v {
187 prog add: (inst: "MOV" #[
188 reg: 0
189 v
190 ])
191 }
192 prog add: (inst: "INT" #[0])
193 0
194 }
195 _funHandlers set: "lambdamanPos" :args syms {
196 prog add: (inst: "INT" #[1])
197 reg: 0
198 }
199 _funHandlers set: "lambdaman2Pos" :args syms {
200 prog add: (inst: "INT" #[2])
201 reg: 0
202 }
203 _funHandlers set: "me" :args syms {
204 prog add: (inst: "INT" #[3])
205 reg: 0
206 }
207 foreach: #["ghostStartPos" "ghostPos" "ghostStatus"] :idx name {
208 intNum <- idx + 4
209 _funHandlers set: name :args syms {
210 ghostIdx <- args value
211 startTempRegs <- _tempRegs
212 v <- compileExpr: ghostIdx syms: syms
213 _tempRegs <- startTempRegs
214 if: (reg: 0) != v {
215 prog add: (inst: "MOV" #[
216 reg: 0
217 v
218 ])
219 }
220 prog add: (inst: "INT" #[intNum])
221 reg: 0
222 }
223 }
224 _funHandlers set: "mapContentsAt" :args syms {
225 x <- args value
226 y <- (args tail) value
227 startTempRegs <- _tempRegs
228 x <- compileExpr: x syms: syms
229 y <- compileExpr: y syms: syms
230 _tempRegs <- startTempRegs
231 if: (reg: 0) != x {
232 prog add: (inst: "MOV" #[
233 reg: 0
234 x
235 ])
236 }
237 if: (reg: 1) != y {
238 prog add: (inst: "MOV" #[
239 reg: 1
240 y
241 ])
242 }
243 prog add: (inst: "INT" #[7])
244 reg: 0
245 }
246
247 //allow access to raw instructions
248 foreach: #["MOV" "INC" "DEC" "ADD" "SUB" "MUL" "DIV" "AND" "OR" "XOR" "JLT" "JEQ" "JGT" "HLT"] :idx instName {
249 _funHandlers set: instName :args syms {
250 saveTempRegs <- _tempRegs
251 args <- args map: :arg { compileExpr: arg syms: syms }
252 prog add: (inst: instName args)
253 }
254 }
255
256 _funHandlers set: "while:do" :args syms {
257 cond <- ((args value) expressions) value
258 body <- ((args tail) value) expressions
259
260 if: (cond nodeType) = (ast binary) {
261 top <- prog makeLabel: "loop_top"
262 end <- prog makeLabel: "loop_end"
263 prog setLabel: top
264
265 saveTempRegs <- _tempRegs
266 l <- compileExpr: (cond left) syms: syms
267 r <- compileExpr: (cond right) syms: syms
268 _tempRegs <- saveTempRegs
269
270 ok <- true
271 //we need the inverse check in the instruction since a true condition
272 //means continue the loop, whereas we need a jump instruction that jumps
273 //only when it is time to exit
274 if: (cond op) = ">=" {
275 prog add: (inst: "JLT" #[
276 end
277 l
278 r
279 ])
280 } else: {
281 if: (cond op) = "<=" {
282 prog add: (inst: "JGT" #[
283 end
284 l
285 r
286 ])
287 } else: {
288 if: (cond op) = "!=" {
289 prog add: (inst: "JEQ" #[
290 end
291 l
292 r
293 ])
294 } else: {
295 if: (cond op) = ">" {
296 bodyLbl <- prog makeLabel: "loop_body"
297 prog add: (inst: "JGT" #[
298 bodyLbl
299 l
300 r
301 ])
302 prog add: (inst: "MOV" #[
303 reg: 8
304 end
305 ])
306 prog setLabel: bodyLbl
307 } else: {
308 if: (cond op) = "<" {
309 bodyLbl <- prog makeLabel: "loop_body"
310 prog add: (inst: "JLT" #[
311 bodyLbl
312 l
313 r
314 ])
315 prog add: (inst: "MOV" #[
316 reg: 8
317 end
318 ])
319 prog setLabel: bodyLbl
320 } else: {
321 bodyLbl <- prog makeLabel: "loop_body"
322 if: (cond op) = "=" {
323 prog add: (inst: "JEQ" #[
324 bodyLbl
325 l
326 r
327 ])
328 prog add: (inst: "MOV" #[
329 reg: 8
330 end
331 ])
332 prog setLabel: bodyLbl
333 } else: {
334 ok <- false
335 }
336 }
337 }
338 }
339 }
340 }
341 if: ok {
342 //TODO: do 2 passes for labels to allow forward references
343 foreach: body :idx expr {
344 if: (expr nodeType) = (ast sym) {
345 //allow using bare symbols to define labels
346 lbl <- prog makeLabel: (expr name)
347 prog setLabel: lbl
348 syms define: (expr name) lbl
349 } else: {
350 saveTempRegsExpr <- _tempRegs
351 v <- compileExpr: expr syms: syms
352 _tempRegs <- saveTempRegsExpr
353 }
354 }
355 prog add: (inst: "MOV" #[
356 reg: 8
357 top
358 ])
359 prog setLabel: end
360 } else: {
361 error: "Condition parameter to while:do must be a comparison operator expression"
362 }
363 } else: {
364 error: "Condition parameter to while:do must be a comparison operator expression"
365 }
366 }
367
368 _exprHandlers set: (ast call) :expr syms {
369 tc <- (expr tocall)
370 if: (tc nodeType) = (ast sym) {
371 _funHandlers ifget: (tc name) :handler {
372 handler: (expr args) syms
373 } else: {
374 syms ifDefined: (tc name) :info {
375 saveTempRegs <- _tempRegs
376 funArgs <- (expr args) map: :arg { compileExpr: arg syms: syms}
377 _tempRegs <- saveTempRegs
378
379 //save registers that need it
380 needSave <- _allTemp filter: :r {
381 not: (_tempRegs contains?: r)
382 }
383 foreach: needSave :idx r {
384 prog add: (inst: "DEC" #[(reg: 7)])
385 prog add: (inst: "MOV" #[
386 mem: (reg: 7)
387 r
388 ])
389 }
390 after <- prog makeLabel: "after_call"
391 //save PC value after call
392 prog add: (inst: "DEC" #[(reg: 7)])
393 prog add: (inst: "MOV" #[
394 mem: (reg: 7)
395 after
396 ])
397 //put arguments into the appropriate registers
398 passregs <- _allTemp
399 foreach: funArgs :idx arg {
400 passreg <- passregs value
401 passregs <- passregs tail
402 if: passreg != arg {
403 //there's a potential for clobbering argument temp regs
404 //but there's no time to figure out a good solution
405 prog add: (inst: "MOV" #[
406 passreg
407 arg
408 ])
409 } else: {
410 print: "Skipping MOV for argument: " . arg . "\n"
411 }
412 }
413 //jump to function
414 prog add: (inst: "MOV" #[
415 reg: 8
416 info def
417 ])
418 prog setLabel: after
419 //adjust PC
420 prog add: (inst: "INC" #[(reg: 7)])
421
422 //restore registers that were saved earlier
423 foreach: (reverse: needSave) :idx r {
424 prog add: (inst: "MOV" #[
425 r
426 mem: (reg: 7)
427 ])
428 prog add: (inst: "INC" #[(reg: 7)])
429 }
430 reg: 0
431 } else: {
432 error: "Function " . (tc name) . " is not defined"
433 }
434 }
435 } else: {
436 error: "Calling expressions is not supported in"
437 }
438 }
439
440
441 _compileFun <- :fName fun globsyms {
174 syms <- symbols tableWithParent: globsyms 442 syms <- symbols tableWithParent: globsyms
175 443
176 saveTempRegs <- _tempRegs 444 saveTempRegs <- _tempRegs
177 foreach: (fun args) :idx arg { 445 foreach: (fun args) :idx arg {
178 argname <- (if: (arg startsWith?: ":") { arg from: 1 } else: { arg }) 446 argname <- (if: (arg startsWith?: ":") { arg from: 1 } else: { arg })
179 reg <- _tempRegs value 447 r <- _tempRegs value
180 _tempRegs <- _tempRegs tail 448 _tempRegs <- _tempRegs tail
181 syms define: argname reg 449 syms define: argname r
182 } 450 }
183 451
184 lastexpr <- ((fun expressions) length) - 1 452 lastexpr <- ((fun expressions) length) - 1
185 453
454 //TODO: do 2 passes for labels to allow forward references
186 foreach: (fun expressions) :idx expr { 455 foreach: (fun expressions) :idx expr {
187 saveTempRegsExpr <- _tempRegs 456 if: idx != lastexpr && (expr nodeType) = (ast sym) {
188 v <- compileExpr: expr syms: syms 457 //allow using bare symbols to define labels
189 _tempRegs <- saveTempRegsExpr 458 prog setLabel: (expr name)
190 if: idx = lastexpr && (name != "main") { 459 syms define: (expr name) (expr name)
191 //move result to a register 460 } else: {
192 prog add: (inst: "MOV" #[ 461 saveTempRegsExpr <- _tempRegs
193 reg: 0 462 v <- compileExpr: expr syms: syms
194 v 463 _tempRegs <- saveTempRegsExpr
195 ]) 464 if: idx = lastexpr && (fName != "main") {
196 //return instruction 465 //move result to a register
197 prog add: (inst: "MOV" #[ 466 prog add: (inst: "MOV" #[
198 reg: 8 467 reg: 0
199 mem: (reg: 7) 468 v
200 ]) 469 ])
470 //return instruction
471 prog add: (inst: "MOV" #[
472 reg: 8
473 mem: (reg: 7)
474 ])
475 }
201 } 476 }
202 } 477 }
203 saveTempRegs <- _tempRegs 478 saveTempRegs <- _tempRegs
204 } 479 }
205 480
208 res <- parser top: code 483 res <- parser top: code
209 if: res { 484 if: res {
210 outer <- res yield 485 outer <- res yield
211 functions <- dict hash 486 functions <- dict hash
212 syms <- symbols table 487 syms <- symbols table
488 //define symbols for all registers
489 //for low level shenanigans
490 i <- 0
491 while: { i < 9 } do: {
492 r <- reg: i
493 syms define: (string: r) r
494 i <- i + 1
495 }
496 //define symbols for interrupt return values
497 syms define: "xCoord" (reg: 0)
498 syms define: "yCoord" (reg: 1)
499 syms define: "vitality" (reg: 0)
500 syms define: "direction" (reg: 1)
501
502 //process top level assignments
213 foreach: (outer messages) :idx msg { 503 foreach: (outer messages) :idx msg {
214 if: (msg nodeType) = (ast assignment) { 504 if: (msg nodeType) = (ast assignment) {
215 def <- msg assign 505 def <- msg assign
216 sym <- (msg to) name 506 sym <- (msg to) name
217 507
235 prog add: (inst: "HLT" #[]) 525 prog add: (inst: "HLT" #[])
236 526
237 foreach: functions :name def { 527 foreach: functions :name def {
238 if: name != "main" { 528 if: name != "main" {
239 prog setLabel: name 529 prog setLabel: name
240 _comipleFun: name def syms 530 _compileFun: name def syms
241 } 531 }
242 } 532 }
243 print: prog 533 print: prog
244 } 534 }
245 } 535 }