# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1406515950 25200
# Node ID fde898a3cbbeb01f2afa934d0dcb161891989917
# Parent  194a1414e240ae6a05809e162844ea9ef91202dc
Mostly complete version of gqc. Biggest omission is if:else. Defining labels also needs work.

diff -r 194a1414e240 -r fde898a3cbbe code/gqc.tp
--- a/code/gqc.tp	Sun Jul 27 16:26:56 2014 -0700
+++ b/code/gqc.tp	Sun Jul 27 19:52:30 2014 -0700
@@ -14,7 +14,7 @@
 			num <- { _num }
 			string <- { (#["a" "b" "c" "d" "e" "f" "g" "h" "pc"]) get: _num }
 			isReg? <- { true }
-			!= <- :other { (reg?: other) && _num != (other num) }
+			!= <- :other { (not: (reg?: other)) || _num != (other num) }
 			= <- :other { (reg?: other) && _num = (other num) }
 		}
 	}
@@ -24,13 +24,14 @@
 			args <- _args
 			translateLabels <- :labelDict {
 				missing <- #[]
-				foreach: args :idx arg {
+				args <- args map: :arg {
 					if: (object does: arg understand?: "isString?") && (arg isString?) {
-						labelDict ifget: arg :translated {
-							args set: idx translated
-						} else: {
+						labelDict get: arg else: {
 							missing append: arg
+							arg
 						}
+					} else: {
+						arg
 					}
 				}
 				missing
@@ -84,13 +85,14 @@
 	_nextVar <- 0
 	//a and b are reserved for int/return values
 	//h is reserved as a stack pointer
-	_tempRegs <- [
+	_allTemp <- [
 		reg: 2
 		reg: 3
 		reg: 4
 		reg: 5
 		reg: 6
 	]
+	_tempRegs <- _allTemp
 	
 	_exprHandlers <- dict hash
 	
@@ -170,34 +172,307 @@
 		dest
 	}
 	
-	_compileFun <- :name fun globsyms {
+	_funHandlers <- dict hash
+	//provide symbolic names for all the interupt routines
+	_funHandlers set: "debug" :args syms {
+		prog add: (inst: "INT" #[8])
+		0
+	}
+	_funHandlers set: "direction!" :args syms {
+		dir <- args value
+		startTempRegs <- _tempRegs
+		v <- compileExpr: dir syms: syms
+		_tempRegs <- startTempRegs
+		if: (reg: 0) != v {	
+			prog add: (inst: "MOV" #[
+				reg: 0
+				v
+			])
+		}
+		prog add: (inst: "INT" #[0])
+		0
+	}
+	_funHandlers set: "lambdamanPos" :args syms {
+		prog add: (inst: "INT" #[1])
+		reg: 0
+	}
+	_funHandlers set: "lambdaman2Pos" :args syms {
+		prog add: (inst: "INT" #[2])
+		reg: 0
+	}
+	_funHandlers set: "me" :args syms {
+		prog add: (inst: "INT" #[3])
+		reg: 0
+	}
+	foreach: #["ghostStartPos" "ghostPos" "ghostStatus"] :idx name {
+		intNum <- idx + 4
+		_funHandlers set: name :args syms {
+			ghostIdx <- args value
+			startTempRegs <- _tempRegs
+			v <- compileExpr: ghostIdx syms: syms
+			_tempRegs <- startTempRegs
+			if: (reg: 0) != v {	
+				prog add: (inst: "MOV" #[
+					reg: 0
+					v
+				])
+			}
+			prog add: (inst: "INT" #[intNum])
+			reg: 0
+		}
+	}
+	_funHandlers set: "mapContentsAt" :args syms {
+		x <- args value
+		y <- (args tail) value
+		startTempRegs <- _tempRegs
+		x <- compileExpr: x syms: syms
+		y <- compileExpr: y syms: syms
+		_tempRegs <- startTempRegs
+		if: (reg: 0) != x {
+			prog add: (inst: "MOV" #[	
+				reg: 0
+				x
+			])
+		}
+		if: (reg: 1) != y {
+			prog add: (inst: "MOV" #[	
+				reg: 1
+				y
+			])
+		}
+		prog add: (inst: "INT" #[7])
+		reg: 0
+	}
+	
+	//allow access to raw instructions
+	foreach: #["MOV" "INC" "DEC" "ADD" "SUB" "MUL" "DIV" "AND" "OR" "XOR" "JLT" "JEQ" "JGT" "HLT"] :idx instName {
+		_funHandlers set: instName :args syms {
+			saveTempRegs <- _tempRegs
+			args <- args map: :arg { compileExpr: arg syms: syms }
+			prog add: (inst: instName args)
+		}
+	}
+	
+	_funHandlers set: "while:do" :args syms {
+		cond <- ((args value) expressions) value
+		body <- ((args tail) value) expressions
+		
+		if: (cond nodeType) = (ast binary) {
+			top <- prog makeLabel: "loop_top"
+			end <- prog makeLabel: "loop_end"
+			prog setLabel: top
+			
+			saveTempRegs <- _tempRegs
+			l <- compileExpr: (cond left) syms: syms
+			r <- compileExpr: (cond right) syms: syms
+			_tempRegs <- saveTempRegs
+			
+			ok <- true
+			//we need the inverse check in the instruction since a true condition
+			//means continue the loop, whereas we need a jump instruction that jumps
+			//only when it is time to exit
+			if: (cond op) = ">=" {
+				prog add: (inst: "JLT" #[
+					end
+					l
+					r
+				])
+			} else: {
+				if: (cond op) = "<=" {
+					prog add: (inst: "JGT" #[
+						end
+						l
+						r
+					])
+				} else: {
+					if: (cond op) = "!=" {
+						prog add: (inst: "JEQ" #[
+							end
+							l
+							r
+						])
+					} else: {
+						if: (cond op) = ">" {
+							bodyLbl <- prog makeLabel: "loop_body"
+							prog add: (inst: "JGT" #[
+								bodyLbl
+								l
+								r
+							])
+							prog add: (inst: "MOV" #[
+								reg: 8
+								end
+							])
+							prog setLabel: bodyLbl
+						} else: {
+							if: (cond op) = "<" {
+								bodyLbl <- prog makeLabel: "loop_body"
+								prog add: (inst: "JLT" #[
+									bodyLbl
+									l
+									r
+								])
+								prog add: (inst: "MOV" #[
+									reg: 8
+									end
+								])
+								prog setLabel: bodyLbl
+							}  else: {
+								bodyLbl <- prog makeLabel: "loop_body"
+								if: (cond op) = "=" {
+									prog add: (inst: "JEQ" #[
+										bodyLbl
+										l
+										r
+									])
+									prog add: (inst: "MOV" #[
+										reg: 8
+										end
+									])
+									prog setLabel: bodyLbl
+								} else: {
+									ok <- false
+								}
+							}
+						}
+					}
+				}
+			}
+			if: ok {
+				//TODO: do 2 passes for labels to allow forward references
+				foreach: body :idx expr {
+					if: (expr nodeType) = (ast sym) {
+						//allow using bare symbols to define labels
+						lbl <- prog makeLabel: (expr name)
+						prog setLabel: lbl
+						syms define: (expr name) lbl
+					} else: {
+						saveTempRegsExpr <- _tempRegs
+						v <- compileExpr: expr syms: syms
+						_tempRegs <- saveTempRegsExpr
+					}
+				}
+				prog add: (inst: "MOV" #[
+					reg: 8
+					top
+				])
+				prog setLabel: end
+			} else: {
+				error: "Condition parameter to while:do must be a comparison operator expression"
+			}
+		} else: {
+			error: "Condition parameter to while:do must be a comparison operator expression"
+		}
+	}
+	
+	_exprHandlers set: (ast call) :expr syms {
+		tc <- (expr tocall)
+		if: (tc nodeType) = (ast sym) {
+			_funHandlers ifget: (tc name) :handler {
+				handler: (expr args) syms
+			} else: {
+				syms ifDefined: (tc name) :info {
+					saveTempRegs <- _tempRegs
+					funArgs <- (expr args) map: :arg { compileExpr: arg syms: syms}
+					_tempRegs <- saveTempRegs
+				
+					//save registers that need it
+					needSave <- _allTemp filter: :r {
+						not: (_tempRegs contains?: r)
+					}
+					foreach: needSave :idx r {
+						prog add: (inst: "DEC" #[(reg: 7)])
+						prog add: (inst: "MOV" #[
+							mem: (reg: 7)
+							r
+						])
+					}
+					after <- prog makeLabel: "after_call"
+					//save PC value after call
+					prog add: (inst: "DEC" #[(reg: 7)])
+					prog add: (inst: "MOV" #[
+						mem: (reg: 7)
+						after
+					])
+					//put arguments into the appropriate registers
+					passregs <- _allTemp
+					foreach: funArgs :idx arg {
+						passreg <- passregs value
+						passregs <- passregs tail
+						if: passreg != arg {
+							//there's a potential for clobbering argument temp regs
+							//but there's no time to figure out a good solution
+							prog add: (inst: "MOV" #[
+								passreg
+								arg
+							])
+						} else: {
+							print: "Skipping MOV for argument: " . arg . "\n"
+						}
+					}
+					//jump to function
+					prog add: (inst: "MOV" #[	
+						reg: 8
+						info def
+					])
+					prog setLabel: after
+					//adjust PC
+					prog add: (inst: "INC" #[(reg: 7)])
+					
+					//restore registers that were saved earlier
+					foreach: (reverse: needSave) :idx r {
+						prog add: (inst: "MOV" #[
+							r
+							mem: (reg: 7)
+						])
+						prog add: (inst: "INC" #[(reg: 7)])
+					}
+					reg: 0
+				} else: {
+					error: "Function " . (tc name) . " is not defined"
+				}
+			}
+		} else: {
+			error: "Calling expressions is not supported in"
+		}
+	}
+	
+	
+	_compileFun <- :fName fun globsyms {
 		syms <- symbols tableWithParent: globsyms
 		
 		saveTempRegs <- _tempRegs
 		foreach: (fun args) :idx arg {
 			argname <- (if: (arg startsWith?: ":") { arg from: 1 } else: { arg })
-			reg <- _tempRegs value
+			r <- _tempRegs value
 			_tempRegs <- _tempRegs tail
-			syms define: argname reg
+			syms define: argname r
 		}
 		
 		lastexpr <- ((fun expressions) length) - 1
 		
+		//TODO: do 2 passes for labels to allow forward references
 		foreach: (fun expressions) :idx expr {
-			saveTempRegsExpr <- _tempRegs
-			v <- compileExpr: expr syms: syms
-			_tempRegs <- saveTempRegsExpr
-			if: idx = lastexpr && (name != "main") {
-				//move result to a register
-				prog add: (inst: "MOV" #[
-					reg: 0
-					v
-				])
-				//return instruction
-				prog add: (inst: "MOV" #[
-					reg: 8
-					mem: (reg: 7)
-				])
+			if: idx != lastexpr && (expr nodeType) = (ast sym) {
+				//allow using bare symbols to define labels
+				prog setLabel: (expr name)
+				syms define: (expr name) (expr name)
+			} else: {
+				saveTempRegsExpr <- _tempRegs
+				v <- compileExpr: expr syms: syms
+				_tempRegs <- saveTempRegsExpr
+				if: idx = lastexpr && (fName != "main") {
+					//move result to a register
+					prog add: (inst: "MOV" #[
+						reg: 0
+						v
+					])
+					//return instruction
+					prog add: (inst: "MOV" #[
+						reg: 8
+						mem: (reg: 7)
+					])
+				}
 			}
 		}
 		saveTempRegs <- _tempRegs
@@ -210,6 +485,21 @@
 				outer <- res yield
 				functions <- dict hash
 				syms <- symbols table
+				//define symbols for all registers
+				//for low level shenanigans
+				i <- 0
+				while: { i < 9 } do: {
+					r <- reg: i
+					syms define: (string: r) r
+					i <- i + 1
+				}
+				//define symbols for interrupt return values
+				syms define: "xCoord" (reg: 0)
+				syms define: "yCoord" (reg: 1)
+				syms define: "vitality" (reg: 0)
+				syms define: "direction" (reg: 1)
+				
+				//process top level assignments
 				foreach: (outer messages) :idx msg {
 					if: (msg nodeType) = (ast assignment) {
 						def <- msg assign
@@ -237,7 +527,7 @@
 				foreach: functions :name def {
 					if: name != "main" {
 						prog setLabel: name
-						_comipleFun: name def syms
+						_compileFun: name def syms
 					}
 				}
 				print: prog