changeset 51:a482086958e1

merge
author William Morgan <billjunk@mrgn.org>
date Sun, 27 Jul 2014 13:52:32 -0700
parents 57a4bddadd46 (current diff) ec87d53603dd (diff)
children 70423511f49d
files
diffstat 1 files changed, 123 insertions(+), 39 deletions(-) [+]
line wrap: on
line diff
--- a/code/gcc.tp	Sun Jul 27 13:49:45 2014 -0700
+++ b/code/gcc.tp	Sun Jul 27 13:52:32 2014 -0700
@@ -1,10 +1,30 @@
 #{
-	new <- :code {
+	getTag <- :val {
+		if: (val isInteger?) {
+			"INTEGER"
+		} else: {
+			val tag
+		}
+	}
+	
+	ifError:else <- :val iferr :else {
+		if: (val isInteger?) {
+			else:
+		} else: {
+			if: (val isError?) {
+				iferr:
+			} else: {
+				else:
+			}
+		}
+	}
+		
+	new <- :rawCode {
 		consUsage <- 0
 		dataStack <- []
 		controlStack <- 0
 		stackSize <- 0
-		pc <- 0
+		_pc <- 0
 		
 		error <- :_msg {
 			#{
@@ -17,6 +37,7 @@
 				isJoin? <- { false }
 				isStop? <- { false }
 				tag <- { "ERROR" }
+				string <- { _msg }
 			}
 		}
 		_dummy <- #{
@@ -28,14 +49,7 @@
 			isJoin? <- { false }
 			isStop? <- { false }
 			tag <- { "DUMMY" }
-		}
-		
-		getTag <- :val {
-			if: (val isInteger?) {
-				"INTEGER"
-			} else: {
-				val tag
-			}
+			string <- { tag }
 		}
 		
 		push <- :val {
@@ -64,12 +78,14 @@
 			rapLoad <- {
 				error: "invalid environment"
 			}
+			arr <- { #[] }
 			isError? <- { false }
 			isEnvironment? <- { true }
 			isJoin? <- { false }
 			isReturn? <- { false }
 			isStop? <- { false }
 			tag <- { "TOPENV" }
+			string <- { tag }
 		}
 		
 		cons <- :_car _cdr {
@@ -84,6 +100,7 @@
 				isCons? <- { true }
 				isJoin? <- { false }
 				tag <- { "CONS" }
+				string <- { "(" . _car . ", " . _cdr . ")" }
 			}
 		}
 		
@@ -186,6 +203,8 @@
 					isReturn? <- { false }
 					isStop? <- { false }
 					tag <- { "ENVIRONMENT" }
+					string <- { tag }
+					arr <- { _arr }
 				}
 			}
 		}
@@ -203,10 +222,11 @@
 				isCons? <- { false }
 				isJoin? <- { false }
 				tag <- { "CLOSURE" }
+				string <- { "{" . _address . ", " . _env . "}" }
 			}
 		}
 		
-		join <- :_address {
+		joinVal <- :_address {
 			#{
 				address <- { _address }
 				isError? <- { false }
@@ -215,6 +235,7 @@
 				isReturn? <- { false }
 				isStop? <- { false }
 				tag <- { "JOIN" }
+				string <- { tag }
 			}
 		}
 		return <- :_address {
@@ -226,6 +247,7 @@
 				isReturn? <- { true }
 				isStop? <- { false }
 				tag <- { "RETURN" }
+				string <- { tag . " " . _address }
 			}
 		}
 		stop <- #{
@@ -235,6 +257,7 @@
 			isReturn? <- { false }
 			isStop? <- { true }
 			tag <- { "STOP" }
+			string <- { tag }
 		}
 		
 		_instConstructors <- dict hash
@@ -281,7 +304,7 @@
 							push: op
 							_dummy
 						} else: {
-							if: (b isError?) {	
+							if: (b isError?) {
 								b
 							} else: {
 								error: "Got wrong type for left param of " . name . " instruction"
@@ -381,8 +404,8 @@
 			{
 				val <- pop:
 				if: (val isInteger?) {
-					controlStack <- cons: (join: pc) controlStack
-					pc <- if: (val != 0) { _t } else: { _f }
+					controlStack <- cons: (joinVal: _pc) controlStack
+					_pc <- if: (val != 0) { _t } else: { _f }
 					_dummy
 				} else: {
 					if: (val isError?) {
@@ -399,7 +422,7 @@
 			{
 				val <- pop:
 				if: (val isInteger?) {
-					pc <- if: (val != 0) { _t } else: { _f }
+					_pc <- if: (val != 0) { _t } else: { _f }
 					_dummy
 				} else: {
 					if: (val isError?) {
@@ -418,7 +441,7 @@
 					val <- controlStack car
 					controlStack <- controlStack cdr
 					if: (val isJoin?) {
-						pc <- val address
+						_pc <- val address
 						_dummy
 					} else: {
 						error: "JOIN expects JOIN cell, got " . (val tag) . " instead"
@@ -448,9 +471,9 @@
 							if: (frame isError?) {
 								frame
 							} else: {
-								controlStack <- cons: (return: pc+1) (cons: _curEnv controlStack)
+								controlStack <- cons: (return: _pc) (cons: _curEnv controlStack)
 								_curEnv <- frame
-								pc <- val address
+								_pc <- val address
 								_dummy
 							}
 						} else: {
@@ -476,7 +499,7 @@
 								frame
 							} else: {
 								_curEnv <- frame
-								pc <- val address
+								_pc <- val address
 								_dummy
 							}
 						} else: {
@@ -496,7 +519,7 @@
 					if: (val isReturn?) {
 						_curEnv <- controlStack car
 						controlStack <- controlStack cdr
-						pc <- val address
+						_pc <- val address
 						_dummy
 					} else: {
 						if: (val isStop?) {
@@ -536,8 +559,8 @@
 								if: (val env) != _curEnv {
 									res <- error: "CLOSURE environment must equal current environment for RAP"
 								} else: {
-									controlStack <- cons: (return: pc+1) (cons: (_curEnv parent) controlStack)
-									pc <- val address
+									controlStack <- cons: (return: _pc) (cons: (_curEnv parent) controlStack)
+									_pc <- val address
 								}
 							}
 							res
@@ -564,7 +587,7 @@
 								if: (val env) != _curEnv {
 									res <- error: "CLOSURE environment must equal current environment for RAP"
 								} else: {
-									pc <- val address
+									_pc <- val address
 								}
 							}
 							res
@@ -597,35 +620,95 @@
 			}
 		}
 		
-		code <- code map: :i {
+		code <- rawCode map: :i {
 			foobar <- _instConstructors get: (i inst) else: { { stop } }
 			foobar: (i args)
 		}
 		
+		
+		_stepMode? <- false
+		_lastCommand <- ""
+		_breakFun <- :cpu {
+			i <-  (rawCode get: (cpu pc))
+			print: (string: (cpu pc)) . ": " . (i inst) . " " . ((i args) join: " ") . "\n"
+			
+			command <- ""
+			while: { command != "c" && command != "s"} do: {
+				command <- ((file stdin) nextLine) trim
+				if: command = "" {
+					command <- _lastCommand
+				} else: {
+					_lastCommand <- command
+				}
+				if: command = "d" {
+					print: "Data Stack:\n"
+					ds <- cpu dstack
+					while: { not: (ds empty?) } do: {
+						print: "\t" . (ds value) . "\n"
+						ds <- ds tail
+					}
+				}
+				if: command = "b" {
+					print: "Control Stack:\n"
+					cs <- cpu cstack
+					while: { not: (cs isInteger?) } do: {
+						print: "\t" . (cs car) . "\n"
+						cs <- cs cdr
+					}
+				}
+				if: command = "e" {
+					print: "Environment:\n"
+					env <- cpu environment
+					foreach: ((cpu environment) arr) :idx val {
+						print: "\t" . idx . ": " . val . "\n"
+					}
+				}
+			}
+			if: command = "c" {
+				cpu runMode
+			}
+		}
+		_cycles <- 0
 		#{
 			limit <- 3072 * 1000
+			stepMode <- { 
+				_stepMode? <- true
+				self
+			}
+			runMode <- { 
+				_stepMode? <- false
+				self
+			}
+			breakFun <- _breakFun
+			
+			pc <- { _pc }
+			dstack <- { dataStack }
+			cstack <- { controlStack }
+			environment <- { _curEnv }
+			cycles <- { _cycles }
+			
 			run <- {
-				cycles <- 0
+				_cycles <- 0
+				controlStack <- cons: stop 0
 				status <- _dummy
 				while: { (not: (status isError?)) && (not: (status isStop?)) } do: {
-					oldpc <- pc
-					if: (cycles >= limit) {
+					if: _stepMode? {
+						break <- breakFun
+						break: self
+					}
+					if: (_cycles >= limit) {
 						status <- error: "cycle limit of " . limit . " exceeded"
 					} else: {
-						if: (pc >= (code length)) {
+						if: (_pc >= (code length)) {
 							status <- error: "PC walked off end of program"
 						} else: {
-							inst <- code get: pc
-							pc <- -1
+							inst <- code get: _pc
+							_pc <- _pc + 1
 							status <- inst:
-							if: pc = -1 {
-								pc <- oldpc + 1
-							}
-							cycles <- cycles + 1
+							_cycles <- _cycles + 1
 						}
 					}
 				}
-				print: "Status: " . (status tag) . "\n"
 				if: (status isStop?) {
 					if: (dataStack empty?) {
 						_dummy
@@ -666,11 +749,12 @@
 			if: (f fd) >= 0 {
 				code <- parseFile: f
 				cpu <- new: code
+				if: (args length) > 2 {
+					cpu stepMode
+				}
 				res <- cpu run
-				print: "Returned value of type: " . (res tag) . "\n"
-				if: (res isError?) {
-					print: (res msg) . "\n"
-				}
+				print: "Ran for " . (cpu cycles) . " cycles\n"
+				print: "Returned value of type: " . (getTag: res) . " - value: " . res . "\n"
 				0
 			} else: {
 				(file stderr) write: "Failed to open " . (args get: 1) . " for reading\n"