# HG changeset patch # User William Morgan # Date 1406494352 25200 # Node ID a482086958e1944ff515debd97998b27bef7935f # Parent 57a4bddadd4625b82dfdf414cf2b4234c649c9e6# Parent ec87d53603dd3e460cd0039d11c1fb89b4304312 merge diff -r 57a4bddadd46 -r a482086958e1 code/gcc.tp --- 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"