diff options
| -rw-r--r-- | mu.arc | 185 | ||||
| -rw-r--r-- | trace.arc.t | 977 |
2 files changed, 584 insertions, 578 deletions
diff --git a/mu.arc b/mu.arc index 9676112a..cbe34425 100644 --- a/mu.arc +++ b/mu.arc @@ -59,26 +59,29 @@ (= curr-trace-file* filename)) (= dump-trace* nil) -(def trace (label . args) - (when (or (is dump-trace* t) - (and dump-trace* (is label "-")) - (and dump-trace* (pos label dump-trace*!whitelist)) - (and dump-trace* (no dump-trace*!whitelist) (~pos label dump-trace*!blacklist))) - (apply prn label ": " args)) - (enq (list label (apply tostring:prn args)) - traces*) - (car args)) - -(on-init - (wipe dump-trace*)) - -(redef tr args ; why am I still returning to prn when debugging? Will this help? - (do1 nil - (apply trace "-" args))) - -(def tr2 (msg arg) - (tr msg arg) - arg) +(mac trace (label . args) + ) +(mac tr args) +;? (def trace (label . args) +;? (when (or (is dump-trace* t) +;? (and dump-trace* (is label "-")) +;? (and dump-trace* (pos label dump-trace*!whitelist)) +;? (and dump-trace* (no dump-trace*!whitelist) (~pos label dump-trace*!blacklist))) +;? (apply prn label ": " args)) +;? (enq (list label (apply tostring:prn args)) +;? traces*) +;? (car args)) +;? +;? (on-init +;? (wipe dump-trace*)) +;? +;? (redef tr args ; why am I still returning to prn when debugging? Will this help? +;? (do1 nil +;? (apply trace "-" args))) +;? +;? (def tr2 (msg arg) +;? (tr msg arg) +;? arg) (def check-trace-contents (msg expected-contents) (unless (trace-contents-match expected-contents) @@ -248,28 +251,28 @@ (defextend empty (x) (isa x 'routine) (no rep.x!call-stack)) -(def stack (routine) +(deftimed stack (routine) ((rep routine) 'call-stack)) -(def push-stack (routine op) +(deftimed push-stack (routine op) (push (obj fn-name op pc 0 caller-arg-idx 0 t0 (msec)) rep.routine!call-stack)) -(def pop-stack (routine) +(deftimed pop-stack (routine) ;? (update-time label.routine (msec)) ;? 1 (pop rep.routine!call-stack)) -(def top (routine) +(deftimed top (routine) stack.routine.0) -(def label (routine) +(deftimed label (routine) (whenlet stack stack.routine (or= stack.0!label (label2 stack)))) -(def label2 (stack) +(deftimed label2 (stack) (string:intersperse "/" (map [_ 'fn-name] stack)));)) -(def body (routine) +(deftimed body (routine) (function* stack.routine.0!fn-name)) (mac pc (routine (o idx 0)) ; assignable @@ -290,10 +293,10 @@ (mac reply-args (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'reply-args)) -(def waiting-for-exact-cycle? (routine) +(deftimed waiting-for-exact-cycle? (routine) (is 'until rep.routine!sleep.0)) -(def ready-to-wake-up (routine) +(deftimed ready-to-wake-up (routine) (assert no.routine*) (case rep.routine!sleep.0 until @@ -355,7 +358,7 @@ ; particular time or for a particular memory location to change) ; detect termination: all non-helper routines completed ; detect deadlock: kill all sleeping routines when none can be woken -(def update-scheduler-state () +(deftimed update-scheduler-state () (when routine* ;? (prn "update scheduler state: " routine*) (if @@ -420,7 +423,7 @@ (detect-deadlock) ) -(def detect-deadlock () +(deftimed detect-deadlock () (when (and (empty running-routines*) (~empty sleeping-routines*) (~some 'literal (map (fn(_) rep._!sleep.1) @@ -430,7 +433,7 @@ (= rep.routine!error "deadlock detected") (push routine completed-routines*)))) -(def die (msg) +(deftimed die (msg) (tr "die: " msg) (= rep.routine*!error msg) (iflet abort-continuation (abort-routine*) @@ -445,7 +448,7 @@ ; routines consist of instrs ; instrs consist of oargs, op and args -(def parse-instr (instr) +(deftimed parse-instr (instr) (iflet delim (pos '<- instr) (do (when (atom (instr (+ delim 1))) (err "operator not tokenized in @instr; maybe you need to freeze functions*?")) @@ -454,31 +457,31 @@ (cut instr (+ delim 2)))) ; args (list nil (v car.instr) cdr.instr))) -(def metadata (operand) +(deftimed metadata (operand) cdr.operand) -(def ty (operand) +(deftimed ty (operand) (cdr operand.0)) -(def literal? (operand) +(deftimed literal? (operand) (unless (acons ty.operand) (err "no type in operand @operand")) (in ty.operand.0 'literal 'offset 'fn)) -(def typeinfo (operand) +(deftimed typeinfo (operand) (or (type* ty.operand.0) (err "unknown type @(tostring prn.operand)"))) ; operand accessors -(def nondummy (operand) ; precondition for helpers below +(deftimed nondummy (operand) ; precondition for helpers below (~is '_ operand)) ; just for convenience, 'new' instruction sometimes takes a raw string and ; allocates just enough space to store it -(def not-raw-string (operand) +(deftimed not-raw-string (operand) (~isa operand 'string)) -(def address? (operand) +(deftimed address? (operand) (or (is ty.operand.0 'location) typeinfo.operand!address)) @@ -493,7 +496,7 @@ ($:define (reset) (tput 'sgr0)) ; run instructions from 'routine*' for 'time-slice' -(def run-for-time-slice (time-slice) +(deftimed run-for-time-slice (time-slice) (point return (for ninstrs 0 (< ninstrs time-slice) (++ ninstrs) (if (empty body.routine*) (err "@stack.routine*.0!fn-name not defined")) @@ -973,7 +976,7 @@ (++ pc.routine*))) (return time-slice))) -(def prepare-reply (args) +(deftimed prepare-reply (args) (= results.routine* (accum yield (each a args @@ -986,7 +989,7 @@ ; indirect addressing - 'deref' ; relative addressing - if routine* has 'default-space' -(def m (loc) ; read memory, respecting metadata +(deftimed m (loc) ; read memory, respecting metadata (point return (when (literal? loc) (return v.loc)) @@ -1005,7 +1008,7 @@ (map memory* (addrs addr n))))) (trace "mem" loc " => " result)))) -(def setm (loc val) ; set memory, respecting metadata +(deftimed setm (loc val) ; set memory, respecting metadata ;? (tr 111) (point return ;? (tr 112) @@ -1040,22 +1043,22 @@ (trace "mem" loc ": " dest " <= " repr.src) (= memory*.dest src)))))))) -(def typeof (operand) +(deftimed typeof (operand) (let loc absolutize.operand (while (pos '(deref) metadata.loc) (zap deref loc)) ty.loc.0)) -(def addr (operand) +(deftimed addr (operand) (v canonize.operand)) -(def addrs (n sz) +(deftimed addrs (n sz) (accum yield (repeat sz (yield n) (++ n)))) -(def canonize (operand) +(deftimed canonize (operand) ;? (tr "0: @operand") (ret operand ;? (prn "1: " operand) @@ -1067,7 +1070,7 @@ ;? (tr "3: @repr.operand") ))) -(def array-len (operand) +(deftimed array-len (operand) (trace "array-len" operand) (zap canonize operand) (if typeinfo.operand!array @@ -1075,7 +1078,7 @@ :else (err "can't take len of non-array @operand"))) -(def sizeof (x) +(deftimed sizeof (x) ;? (trace "sizeof" x) ;? 1 (assert acons.x) (zap canonize x) @@ -1095,7 +1098,7 @@ ;? (tr "sizeof: @x is a primitive") (return typeinfo.x!size))) -(def absolutize (operand) +(deftimed absolutize (operand) (if (no routine*) operand (in v.operand '_ 'default-space) @@ -1115,7 +1118,7 @@ space.operand) operand))) -(def lookup-space (operand base space) +(deftimed lookup-space (operand base space) (if (is 0 space) ; base case (if (< v.operand memory*.base) @@ -1127,17 +1130,17 @@ (lookup-space operand (memory* (+ base 1)) ; location 0 points to next space (- space 1)))) -(def space (operand) +(deftimed space (operand) (or (alref metadata.operand 'space) 0)) -(def deref (operand) +(deftimed deref (operand) (assert (pos '(deref) metadata.operand)) (assert address?.operand) (cons `(,(memory* v.operand) ,@typeinfo.operand!elem) (drop-one '(deref) metadata.operand))) -(def drop-one (f x) +(deftimed drop-one (f x) (when acons.x ; proper lists only (if (testify.f car.x) cdr.x @@ -1145,7 +1148,7 @@ ; memory allocation -(def alloc (sz) +(deftimed alloc (sz) (when (> sz (- rep.routine*!alloc-max rep.routine*!alloc)) (let curr-alloc Memory-allocated-until (= rep.routine*!alloc curr-alloc) @@ -1154,16 +1157,16 @@ (ret result rep.routine*!alloc (++ rep.routine*!alloc sz))) -(def new-scalar (type) +(deftimed new-scalar (type) ;? (tr "new scalar: @type") (alloc (sizeof `((_ ,type))))) -(def new-array (type size) +(deftimed new-array (type size) ;? (tr "new array: @type @size") (ret result (alloc (+ 1 (* (sizeof `((_ ,@type*.type!elem))) size))) (= memory*.result size))) -(def new-string (literal-string) +(deftimed new-string (literal-string) ;? (tr "new string: @literal-string") (ret result (alloc (+ 1 len.literal-string)) (= memory*.result len.literal-string) @@ -1171,14 +1174,14 @@ ;? (prn index " " repr.c) ;? 1 (= (memory* (+ result 1 index)) c)))) -(def to-arc-string (string-address) +(deftimed to-arc-string (string-address) (let len (memory* string-address) (string:map memory* (range (+ string-address 1) (+ string-address len))))) ;; desugar structured assembly based on blocks -(def convert-braces (instrs) +(deftimed convert-braces (instrs) ;? (prn "convert-braces " instrs) (let locs () ; list of information on each brace: (open/close pc) (let pc 0 @@ -1242,7 +1245,7 @@ (yield-unchanged))) (++ pc)))))))) -(def close-offset (pc locs nblocks) +(deftimed close-offset (pc locs nblocks) (or= nblocks 1) ;? (tr nblocks) (point return @@ -1261,13 +1264,13 @@ ;? (tr "close now " loc) (return (- loc pc 1)))))))) -(def open-offset (pc stack nblocks) +(deftimed open-offset (pc stack nblocks) (or= nblocks 1) (- (stack (- nblocks 1)) 1 pc)) ;; convert jump targets to offsets -(def convert-labels (instrs) +(deftimed convert-labels (instrs) ;? (tr "convert-labels " instrs) (let labels (table) (let pc 0 @@ -1292,7 +1295,7 @@ ;; convert symbolic names to raw memory locations -(def add-next-space-generator (instrs name) +(deftimed add-next-space-generator (instrs name) ;? (prn "== @name") (each instr instrs (when acons.instr @@ -1385,7 +1388,7 @@ ; todo: can't allocate arrays on the stack (++ idx (sizeof `((_ ,@ty.arg)))))))))))))) -(def replace-names-with-location (instrs name) +(deftimed replace-names-with-location (instrs name) (each instr instrs (when (acons instr) (let (oargs op args) (parse-instr instr) @@ -1398,7 +1401,7 @@ instrs) (= allow-raw-addresses* nil) -(def check-default-space (instrs name) +(deftimed check-default-space (instrs name) (unless allow-raw-addresses* (let oarg-names (accum yield (each (oargs _ _) (map parse-instr (keep acons ; non-label @@ -1410,7 +1413,7 @@ (prn "function @name has no default-space"))))) ; assign an index to an arg -(def maybe-add (arg location idx) +(deftimed maybe-add (arg location idx) (trace "maybe-add" arg) (when (and nondummy.arg ;? (prn arg " " (assoc 'space arg)) @@ -1423,7 +1426,7 @@ (= (location v.arg) idx))) ; convert the arg to corresponding index -(def convert-name (arg default-name) +(deftimed convert-name (arg default-name) ;? (prn "111 @arg @default-name") (when (and nondummy.arg not-raw-string.arg (~is ty.arg.0 'literal)) ; can't use 'literal?' because we want to rename offsets @@ -1438,7 +1441,7 @@ ;? (prn 115) ))) -(def space-to-name (arg default-name) +(deftimed space-to-name (arg default-name) (ret name default-name (when (~is space.arg 'global) (repeat space.arg @@ -1446,7 +1449,7 @@ ;; literate tangling system for reordering code -(def convert-quotes (instrs) +(deftimed convert-quotes (instrs) (let deferred (queue) (each instr instrs (when (acons instr) @@ -1508,7 +1511,7 @@ ;; loading code into the virtual machine -(def add-code (forms) +(deftimed add-code (forms) (each (op . rest) forms (case op ; function <name> [ <instructions> ] @@ -1586,7 +1589,7 @@ (prn "unrecognized top-level " (cons op rest)) ))) -(def freeze (function-table) +(deftimed freeze (function-table) (each (name body) canon.function-table ;? (prn "freeze " name) (= function-table.name (convert-labels:convert-braces:tokenize-args:insert-code body name))) @@ -1610,14 +1613,14 @@ ; we could clear location* at this point, but maybe we'll find a use for it ) -(def freeze-another (fn-name) +(deftimed freeze-another (fn-name) (= function*.fn-name (convert-labels:convert-braces:tokenize-args:insert-code function*.fn-name fn-name)) (check-default-space function*.fn-name fn-name) (add-next-space-generator function*.fn-name fn-name) (= location*.fn-name (assign-names-to-location function*.fn-name fn-name location*.fn-name)) (replace-names-with-location function*.fn-name fn-name)) -(def tokenize-arg (arg) +(deftimed tokenize-arg (arg) ;? (tr "tokenize-arg " arg) (if (in arg '<- '_) arg @@ -1628,7 +1631,7 @@ :else arg)) -(def tokenize-args (instrs) +(deftimed tokenize-args (instrs) ;? (tr "tokenize-args " instrs) ;? (prn2 "@(tostring prn.instrs) => " (accum yield @@ -1645,21 +1648,21 @@ (pr msg) (apply prn args)) -(def canon (table) +(deftimed canon (table) (sort (compare < [tostring (prn:car _)]) (as cons table))) -(def int-canon (table) +(deftimed int-canon (table) (sort (compare < car) (as cons table))) -(def routine-canon (routine-table) +(deftimed routine-canon (routine-table) (sort (compare < label:car) (as cons routine-table))) -(def repr (val) +(deftimed repr (val) (tostring write.val)) ;; test helpers -(def memory-contains (addr value) +(deftimed memory-contains (addr value) ;? (prn "Looking for @value starting at @addr") (loop (addr addr idx 0) @@ -1672,7 +1675,7 @@ :else (recur (+ addr 1) (+ idx 1))))) -(def memory-contains-array (addr value) +(deftimed memory-contains-array (addr value) (and (>= memory*.addr len.value) (loop (addr (+ addr 1) ; skip count idx 0) @@ -1684,7 +1687,7 @@ (recur (+ addr 1) (+ idx 1)))))) ; like memory-contains-array but shows diffs -(def memory-contains-array-verbose (addr value) +(deftimed memory-contains-array-verbose (addr value) (prn "Mismatch when looking at @addr, size @memory*.addr vs @len.value") (and (>= memory*.addr len.value) (loop (addr (+ addr 1) ; skip count @@ -1700,7 +1703,7 @@ (recur (+ addr 1) (+ idx 1)))))) ; like memory-contains-array but shows diffs in 2D -(def screen-contains (addr width value) +(deftimed screen-contains (addr width value) (or (memory-contains-array addr value) (do ;(memory-contains-array-verbose addr value) (prn "Mismatch detected. Screen contents:") @@ -1729,11 +1732,11 @@ (freeze-another ',name) (run-more ',name))) -(def routine-that-ran (f) +(deftimed routine-that-ran (f) (find [some [is f _!fn-name] stack._] completed-routines*)) -(def routine-running (f) +(deftimed routine-running (f) (or (find [some [is f _!fn-name] stack._] completed-routines*) @@ -1745,19 +1748,19 @@ (some [is f _!fn-name] stack.routine*) routine*))) -(def ran-to-completion (f) +(deftimed ran-to-completion (f) ; if a routine calling f ran to completion there'll be no sign of it in any ; completed call-stacks. (~routine-that-ran f)) -(def restart (routine) +(deftimed restart (routine) (while (in top.routine!fn-name 'read 'write) (pop-stack routine)) (wipe rep.routine!sleep) (wipe rep.routine!error) (enq routine running-routines*)) -(def dump (msg routine) +(deftimed dump (msg routine) (prn "= @msg " rep.routine!sleep) (prn:rem [in car._ 'sleep 'call-stack] (as cons rep.routine)) (each frame rep.routine!call-stack @@ -1776,7 +1779,7 @@ (let real-name (v tokenize-arg.name) `(= (system-function* ',real-name) ',body))) -(def load-system-functions () +(deftimed load-system-functions () (each (name f) system-function* (= (function* name) (system-function* name)))) @@ -3073,7 +3076,7 @@ ) ; repl -(def run-interactive (stmt) +(deftimed run-interactive (stmt) ; careful to avoid re-processing functions and adding noise to traces (= function*!interactive (convert-labels:convert-braces:tokenize-args (list stmt))) (add-next-space-generator function*!interactive 'interactive) diff --git a/trace.arc.t b/trace.arc.t index e8844ff1..2056824d 100644 --- a/trace.arc.t +++ b/trace.arc.t @@ -1,398 +1,400 @@ (selective-load "mu.arc" section-level) (set allow-raw-addresses*) +;? (load "profiler.arc") +;? (profiling-just (reset new-trace trace tr2 check-trace-contents trace-contents-match print-trace-contents-mismatch check-trace-doesnt-contain make-routine stack push-stack pop-stack top label label2 body waiting-for-exact-cycle? ready-to-wake-up run run-more update-scheduler-state detect-deadlock die parse-instr metadata ty literal? typeinfo nondummy not-raw-string address? run-for-time-slice prepare-reply m setm typeof addr addrs canonize array-len sizeof absolutize lookup-space space deref drop-one alloc new-scalar new-array new-string to-arc-string convert-braces close-offset open-offset convert-labels add-next-space-generator convert-names assign-names-to-location replace-names-with-location check-default-space maybe-add convert-name space-to-name convert-quotes insert-code add-code freeze freeze-another tokenize-arg tokenize-args prn2 canon int-canon routine-canon repr memory-contains memory-contains-array memory-contains-array-verbose screen-contains routine-that-ran routine-running ran-to-completion restart dump load-system-functions run-interactive) -(reset) -(new-trace "print-trace") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"schedule: main -run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) -run: main 0: 1 => ((1 integer)) -mem: ((1 integer)): 1 <= 1 -run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) -run: main 1: 3 => ((2 integer)) -mem: ((2 integer)): 2 <= 3 -run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) -mem: ((1 integer)) => 1 -mem: ((2 integer)) => 3 -run: main 2: 4 => ((3 integer)) -mem: ((3 integer)): 3 <= 4 -schedule: done with routine") - (s:stream-address <- init-stream x:string-address) - (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) - (len:integer <- length traces:instruction-trace-address-array-address/deref) - (screen:terminal-address <- init-fake-terminal 70:literal 15:literal) - (screen-state:space-address <- screen-state traces:instruction-trace-address-array-address 30:literal/screen-height) - (print-traces-collapsed screen-state:space-address screen:terminal-address) - (1:string-address/raw <- get screen:terminal-address/deref data:offset) - ]))) -;? (set dump-trace*) -;? (= dump-trace* (obj whitelist '("run"))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -;? (prn memory*.1) -(when (~screen-contains memory*.1 70 - (+ "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - print-traces-collapsed works")) -;? (quit) ;? 1 - -(reset) -(new-trace "print-trace-from-middle-of-screen") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"schedule: main -run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) -run: main 0: 1 => ((1 integer)) -mem: ((1 integer)): 1 <= 1 -run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) -run: main 1: 3 => ((2 integer)) -mem: ((2 integer)): 2 <= 3 -run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) -mem: ((1 integer)) => 1 -mem: ((2 integer)) => 3 -run: main 2: 4 => ((3 integer)) -mem: ((3 integer)): 3 <= 4 -schedule: done with routine") - (s:stream-address <- init-stream x:string-address) - (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) - (len:integer <- length traces:instruction-trace-address-array-address/deref) - (1:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) - ; position the cursor away from top of screen - (cursor-down 1:terminal-address/raw) - (cursor-down 1:terminal-address/raw) - (screen-state:space-address <- screen-state traces:instruction-trace-address-array-address 30:literal/screen-height) - (print-traces-collapsed screen-state:space-address 1:terminal-address/raw traces:instruction-trace-address-array-address) - (2:string-address/raw <- get 1:terminal-address/raw/deref data:offset) - ]))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -(when (~screen-contains memory*.2 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - print-traces-collapsed works")) -(run-code main2 - (print-character 1:terminal-address/raw ((#\* literal)))) -(when (~screen-contains memory*.2 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) " - "* ")) - (prn "F - print-traces-collapsed leaves cursor at next line")) - -(reset) -(new-trace "process-key-move-up-down") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"schedule: main -run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) -run: main 0: 1 => ((1 integer)) -mem: ((1 integer)): 1 <= 1 -run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) -run: main 1: 3 => ((2 integer)) -mem: ((2 integer)): 2 <= 3 -run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) -mem: ((1 integer)) => 1 -mem: ((2 integer)) => 3 -run: main 2: 4 => ((3 integer)) -mem: ((3 integer)): 3 <= 4 -schedule: done with routine") - (s:stream-address <- init-stream x:string-address) - (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) - (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) - (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) - ; position the cursor away from top of screen - (cursor-down 2:terminal-address/raw) - (cursor-down 2:terminal-address/raw) - (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) - ; draw trace - (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) - ; move cursor up - ; we have no way yet to test special keys like up-arrow - (s:string-address <- new "k") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - ; draw cursor - (replace-character 2:terminal-address/raw ((#\* literal))) - (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) - ]))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "* main/ 2 : 4 => ((3 integer)) ")) - ;^cursor - (prn "F - process-key can move up")) -(run-code main2 - (default-space:space-address <- new space:literal 30:literal/capacity) - ; reset previous cursor - (replace-character 2:terminal-address/raw ((#\+ literal))) - ; move cursor up 3 more lines - (s:string-address <- new "kkk") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (replace-character 2:terminal-address/raw ((#\* literal))) - ) -; cursor is now at line 3 -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "* main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - ;^cursor - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - process-key can move up multiple times")) -; try to move cursor up thrice more -(run-code main3 - (default-space:space-address <- new space:literal 30:literal/capacity) - (replace-character 2:terminal-address/raw ((#\+ literal))) - (s:string-address <- new "kkk") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (replace-character 2:terminal-address/raw ((#\* literal))) - ) -; cursor doesn't go beyond the first line printed -; stuff on screen before screen-state was initialized is inviolate -(when (~screen-contains memory*.4 70 - (+ " " - " " - "* main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - ;^cursor - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - process-key doesn't move above bounds")) -; now move cursor down 4 times -(run-code main4 - (default-space:space-address <- new space:literal 30:literal/capacity) - (replace-character 2:terminal-address/raw ((#\+ literal))) - (s:string-address <- new "jjjj") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (replace-character 2:terminal-address/raw ((#\* literal))) - ) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "* main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - ;^cursor - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - process-key can move down multiple times")) -; try to move cursor down 4 more times -(run-code main5 - (default-space:space-address <- new space:literal 30:literal/capacity) - (replace-character 2:terminal-address/raw ((#\+ literal))) - (s:string-address <- new "jjjj") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (replace-character 2:terminal-address/raw ((#\* literal))) - ) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) " - "* ")) - (prn "F - process-key doesn't move below bounds")) - -(reset) -(new-trace "process-key-expand") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"schedule: main -run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) -run: main 0: 1 => ((1 integer)) -mem: ((1 integer)): 1 <= 1 -run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) -run: main 1: 3 => ((2 integer)) -mem: ((2 integer)): 2 <= 3 -run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) -mem: ((1 integer)) => 1 -mem: ((2 integer)) => 3 -run: main 2: 4 => ((3 integer)) -mem: ((3 integer)): 3 <= 4 -schedule: done with routine") - (s:stream-address <- init-stream x:string-address) - (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) - (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) - (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) - ; position the cursor away from top of screen - (cursor-down 2:terminal-address/raw) - (cursor-down 2:terminal-address/raw) - (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) - ; draw trace - (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) - (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) - ]))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - process-key: before expand")) -(run-code main2 - (default-space:space-address <- new space:literal 30:literal/capacity) - ; move cursor to final line and expand - (s:string-address <- new "k\n") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - ) -; final line is expanded -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "- main/ 2 : 4 => ((3 integer)) " - " mem : ((3 integer)): 3 <= 4 " - " schedule : done with routine ")) - (prn "F - process-key expands current trace segment on <enter>")) -; and cursor should remain on the top-level line -(run-code main3 - (replace-character 2:terminal-address/raw ((#\* literal))) - ) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - "* main/ 2 : 4 => ((3 integer)) " - ;^cursor - " mem : ((3 integer)): 3 <= 4 " - " schedule : done with routine ")) - (prn "F - process-key positions cursor on top of trace after expanding")) - -(reset) -(new-trace "process-key-expand-nonlast") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"schedule: main -run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) -run: main 0: 1 => ((1 integer)) -mem: ((1 integer)): 1 <= 1 -run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) -run: main 1: 3 => ((2 integer)) -mem: ((2 integer)): 2 <= 3 -run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) -mem: ((1 integer)) => 1 -mem: ((2 integer)) => 3 -run: main 2: 4 => ((3 integer)) -mem: ((3 integer)): 3 <= 4 -schedule: done with routine") - (s:stream-address <- init-stream x:string-address) - (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) - (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) - (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) - ; position the cursor away from top of screen - (cursor-down 2:terminal-address/raw) - (cursor-down 2:terminal-address/raw) - (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) - ; draw trace - (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) - ; expand penultimate line - (s:string-address <- new "kk\n") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) - ]))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -(when (~screen-contains memory*.4 70 - (+ " " - " " - "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " - "+ main/ 0 : 1 => ((1 integer)) " - "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " - "+ main/ 1 : 3 => ((2 integer)) " - "- main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " - " mem : ((1 integer)) => 1 " - " mem : ((2 integer)) => 3 " - "+ main/ 2 : 4 => ((3 integer)) ")) - (prn "F - process-key: expanding a line continues to print lines after it")) +;? (reset) +;? (new-trace "print-trace") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "schedule: main +;? run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) +;? run: main 0: 1 => ((1 integer)) +;? mem: ((1 integer)): 1 <= 1 +;? run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) +;? run: main 1: 3 => ((2 integer)) +;? mem: ((2 integer)): 2 <= 3 +;? run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) +;? mem: ((1 integer)) => 1 +;? mem: ((2 integer)) => 3 +;? run: main 2: 4 => ((3 integer)) +;? mem: ((3 integer)): 3 <= 4 +;? schedule: done with routine") +;? (s:stream-address <- init-stream x:string-address) +;? (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) +;? (len:integer <- length traces:instruction-trace-address-array-address/deref) +;? (screen:terminal-address <- init-fake-terminal 70:literal 15:literal) +;? (screen-state:space-address <- screen-state traces:instruction-trace-address-array-address 30:literal/screen-height) +;? (print-traces-collapsed screen-state:space-address screen:terminal-address) +;? (1:string-address/raw <- get screen:terminal-address/deref data:offset) +;? ]))) +;? ;? (set dump-trace*) +;? ;? (= dump-trace* (obj whitelist '("run"))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? ;? (prn memory*.1) +;? (when (~screen-contains memory*.1 70 +;? (+ "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - print-traces-collapsed works")) +;? ;? (quit) ;? 1 +;? +;? (reset) +;? (new-trace "print-trace-from-middle-of-screen") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "schedule: main +;? run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) +;? run: main 0: 1 => ((1 integer)) +;? mem: ((1 integer)): 1 <= 1 +;? run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) +;? run: main 1: 3 => ((2 integer)) +;? mem: ((2 integer)): 2 <= 3 +;? run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) +;? mem: ((1 integer)) => 1 +;? mem: ((2 integer)) => 3 +;? run: main 2: 4 => ((3 integer)) +;? mem: ((3 integer)): 3 <= 4 +;? schedule: done with routine") +;? (s:stream-address <- init-stream x:string-address) +;? (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) +;? (len:integer <- length traces:instruction-trace-address-array-address/deref) +;? (1:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) +;? ; position the cursor away from top of screen +;? (cursor-down 1:terminal-address/raw) +;? (cursor-down 1:terminal-address/raw) +;? (screen-state:space-address <- screen-state traces:instruction-trace-address-array-address 30:literal/screen-height) +;? (print-traces-collapsed screen-state:space-address 1:terminal-address/raw traces:instruction-trace-address-array-address) +;? (2:string-address/raw <- get 1:terminal-address/raw/deref data:offset) +;? ]))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? (when (~screen-contains memory*.2 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - print-traces-collapsed works")) +;? (run-code main2 +;? (print-character 1:terminal-address/raw ((#\* literal)))) +;? (when (~screen-contains memory*.2 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) " +;? "* ")) +;? (prn "F - print-traces-collapsed leaves cursor at next line")) +;? +;? (reset) +;? (new-trace "process-key-move-up-down") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "schedule: main +;? run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) +;? run: main 0: 1 => ((1 integer)) +;? mem: ((1 integer)): 1 <= 1 +;? run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) +;? run: main 1: 3 => ((2 integer)) +;? mem: ((2 integer)): 2 <= 3 +;? run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) +;? mem: ((1 integer)) => 1 +;? mem: ((2 integer)) => 3 +;? run: main 2: 4 => ((3 integer)) +;? mem: ((3 integer)): 3 <= 4 +;? schedule: done with routine") +;? (s:stream-address <- init-stream x:string-address) +;? (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) +;? (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) +;? (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) +;? ; position the cursor away from top of screen +;? (cursor-down 2:terminal-address/raw) +;? (cursor-down 2:terminal-address/raw) +;? (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) +;? ; draw trace +;? (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) +;? ; move cursor up +;? ; we have no way yet to test special keys like up-arrow +;? (s:string-address <- new "k") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? ; draw cursor +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) +;? ]))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "* main/ 2 : 4 => ((3 integer)) ")) +;? ;^cursor +;? (prn "F - process-key can move up")) +;? (run-code main2 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? ; reset previous cursor +;? (replace-character 2:terminal-address/raw ((#\+ literal))) +;? ; move cursor up 3 more lines +;? (s:string-address <- new "kkk") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? ) +;? ; cursor is now at line 3 +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "* main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? ;^cursor +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - process-key can move up multiple times")) +;? ; try to move cursor up thrice more +;? (run-code main3 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (replace-character 2:terminal-address/raw ((#\+ literal))) +;? (s:string-address <- new "kkk") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? ) +;? ; cursor doesn't go beyond the first line printed +;? ; stuff on screen before screen-state was initialized is inviolate +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "* main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? ;^cursor +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - process-key doesn't move above bounds")) +;? ; now move cursor down 4 times +;? (run-code main4 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (replace-character 2:terminal-address/raw ((#\+ literal))) +;? (s:string-address <- new "jjjj") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? ) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "* main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? ;^cursor +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - process-key can move down multiple times")) +;? ; try to move cursor down 4 more times +;? (run-code main5 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (replace-character 2:terminal-address/raw ((#\+ literal))) +;? (s:string-address <- new "jjjj") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? ) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) " +;? "* ")) +;? (prn "F - process-key doesn't move below bounds")) +;? +;? (reset) +;? (new-trace "process-key-expand") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "schedule: main +;? run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) +;? run: main 0: 1 => ((1 integer)) +;? mem: ((1 integer)): 1 <= 1 +;? run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) +;? run: main 1: 3 => ((2 integer)) +;? mem: ((2 integer)): 2 <= 3 +;? run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) +;? mem: ((1 integer)) => 1 +;? mem: ((2 integer)) => 3 +;? run: main 2: 4 => ((3 integer)) +;? mem: ((3 integer)): 3 <= 4 +;? schedule: done with routine") +;? (s:stream-address <- init-stream x:string-address) +;? (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) +;? (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) +;? (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) +;? ; position the cursor away from top of screen +;? (cursor-down 2:terminal-address/raw) +;? (cursor-down 2:terminal-address/raw) +;? (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) +;? ; draw trace +;? (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) +;? (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) +;? ]))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - process-key: before expand")) +;? (run-code main2 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? ; move cursor to final line and expand +;? (s:string-address <- new "k\n") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? ) +;? ; final line is expanded +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "- main/ 2 : 4 => ((3 integer)) " +;? " mem : ((3 integer)): 3 <= 4 " +;? " schedule : done with routine ")) +;? (prn "F - process-key expands current trace segment on <enter>")) +;? ; and cursor should remain on the top-level line +;? (run-code main3 +;? (replace-character 2:terminal-address/raw ((#\* literal))) +;? ) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? "* main/ 2 : 4 => ((3 integer)) " +;? ;^cursor +;? " mem : ((3 integer)): 3 <= 4 " +;? " schedule : done with routine ")) +;? (prn "F - process-key positions cursor on top of trace after expanding")) +;? +;? (reset) +;? (new-trace "process-key-expand-nonlast") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "schedule: main +;? run: main 0: (((1 integer)) <- ((copy)) ((1 literal))) +;? run: main 0: 1 => ((1 integer)) +;? mem: ((1 integer)): 1 <= 1 +;? run: main 1: (((2 integer)) <- ((copy)) ((3 literal))) +;? run: main 1: 3 => ((2 integer)) +;? mem: ((2 integer)): 2 <= 3 +;? run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) +;? mem: ((1 integer)) => 1 +;? mem: ((2 integer)) => 3 +;? run: main 2: 4 => ((3 integer)) +;? mem: ((3 integer)): 3 <= 4 +;? schedule: done with routine") +;? (s:stream-address <- init-stream x:string-address) +;? (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address) +;? (len:integer <- length 1:instruction-trace-address-array-address/raw/deref) +;? (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal) +;? ; position the cursor away from top of screen +;? (cursor-down 2:terminal-address/raw) +;? (cursor-down 2:terminal-address/raw) +;? (3:space-address/raw <- screen-state 1:instruction-trace-address-array-address/raw 30:literal/screen-height) +;? ; draw trace +;? (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw) +;? ; expand penultimate line +;? (s:string-address <- new "kk\n") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) +;? ]))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? (when (~screen-contains memory*.4 70 +;? (+ " " +;? " " +;? "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal))) " +;? "+ main/ 0 : 1 => ((1 integer)) " +;? "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal))) " +;? "+ main/ 1 : 3 => ((2 integer)) " +;? "- main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer))) " +;? " mem : ((1 integer)) => 1 " +;? " mem : ((2 integer)) => 3 " +;? "+ main/ 2 : 4 => ((3 integer)) ")) +;? (prn "F - process-key: expanding a line continues to print lines after it")) (reset) (new-trace "process-key-expanded") @@ -537,100 +539,101 @@ schedule: done with routine") "+ main/ 2 : 4 => ((3 integer)) ")) (prn "F - process-key: navigation moves between top-level lines only")) -;; manage screen height - -(reset) -(new-trace "trace-paginate") -(add-code:readfile "trace.mu") -(add-code - '((function! main [ - (default-space:space-address <- new space:literal 30:literal/capacity) - (x:string-address <- new -"run: main 0: a b c -mem: 0 a -run: main 1: d e f -mem: 1 a -mem: 1 b -mem: 1 c -run: main 2: g hi -run: main 3: j -mem: 3 a -run: main 4: k -run: main 5: l -run: main 6: m -run: main 7: n -run: main 8: o") - (s:stream-address <- init-stream x:string-address) - (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) - (len:integer <- length traces:instruction-trace-address-array-address/deref) - (2:terminal-address/raw <- init-fake-terminal 17:literal 15:literal) - (3:space-address/raw/screen-state <- screen-state traces:instruction-trace-address-array-address 3:literal/screen-height) - (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw) - (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) - ]))) -(run 'main) -(each routine completed-routines* - (awhen rep.routine!error - (prn "error - " it))) -; screen shows a subset of collapsed trace lines -(when (~screen-contains memory*.4 17 - (+ "+ main/ 0 : a b c" - "+ main/ 1 : d e f" - "+ main/ 2 : g hi ")) - (prn "F - print-traces-collapsed can show just one 'page' of a larger trace")) -; expand top line -(run-code main2 - (default-space:space-address <- new space:literal 30:literal/capacity) - (s:string-address <- new "kkk\n") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - ) -; screen shows just first trace line fully expanded -(when (~screen-contains memory*.4 17 - (+ "- main/ 0 : a b c" - " mem : 0 a " - "+ main/ 1 : d e f" - " ")) - (prn "F - expanding doesn't print past end of page")) -; expand line below without first collapsing previously expanded line -(run-code main3 - (default-space:space-address <- new space:literal 30:literal/capacity) - (s:string-address <- new "j\n") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - ) -; screen shows part of the second trace line expanded -(when (~screen-contains memory*.4 17 - (+ "+ main/ 0 : a b c" - "- main/ 1 : d e f" - " mem : 1 a " - " " - " ")) - (prn "F - expanding below expanded line respects screen/page height")) -; expand line *above* without first collapsing previously expanded line -(run-code main4 - (default-space:space-address <- new space:literal 30:literal/capacity) - (s:string-address <- new "k\n") - (k:keyboard-address <- init-keyboard s:string-address) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) - ) -; screen again shows first trace line expanded -(when (~screen-contains memory*.4 17 - (+ "- main/ 0 : a b c" - " mem : 0 a " - "+ main/ 1 : d e f" - " ")) - (prn "F - expanding above expanded line respects screen/page height")) - -; todo -; pgup/pgdn to navigate pages (minimize up/down responsibilities for performance) -; expanded trace straddles page boundary -; what if entire page is within an expanded trace? +;? ;; manage screen height +;? +;? (reset) +;? (new-trace "trace-paginate") +;? (add-code:readfile "trace.mu") +;? (add-code +;? '((function! main [ +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (x:string-address <- new +;? "run: main 0: a b c +;? mem: 0 a +;? run: main 1: d e f +;? mem: 1 a +;? mem: 1 b +;? mem: 1 c +;? run: main 2: g hi +;? run: main 3: j +;? mem: 3 a +;? run: main 4: k +;? run: main 5: l +;? run: main 6: m +;? run: main 7: n +;? run: main 8: o") +;? (s:stream-address <- init-stream x:string-address) +;? (traces:instruction-trace-address-array-address <- parse-traces s:stream-address) +;? (len:integer <- length traces:instruction-trace-address-array-address/deref) +;? (2:terminal-address/raw <- init-fake-terminal 17:literal 15:literal) +;? (3:space-address/raw/screen-state <- screen-state traces:instruction-trace-address-array-address 3:literal/screen-height) +;? (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw) +;? (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset) +;? ]))) +;? (run 'main) +;? (each routine completed-routines* +;? (awhen rep.routine!error +;? (prn "error - " it))) +;? ; screen shows a subset of collapsed trace lines +;? (when (~screen-contains memory*.4 17 +;? (+ "+ main/ 0 : a b c" +;? "+ main/ 1 : d e f" +;? "+ main/ 2 : g hi ")) +;? (prn "F - print-traces-collapsed can show just one 'page' of a larger trace")) +;? ; expand top line +;? (run-code main2 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (s:string-address <- new "kkk\n") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? ) +;? ; screen shows just first trace line fully expanded +;? (when (~screen-contains memory*.4 17 +;? (+ "- main/ 0 : a b c" +;? " mem : 0 a " +;? "+ main/ 1 : d e f" +;? " ")) +;? (prn "F - expanding doesn't print past end of page")) +;? ; expand line below without first collapsing previously expanded line +;? (run-code main3 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (s:string-address <- new "j\n") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? ) +;? ; screen shows part of the second trace line expanded +;? (when (~screen-contains memory*.4 17 +;? (+ "+ main/ 0 : a b c" +;? "- main/ 1 : d e f" +;? " mem : 1 a " +;? " " +;? " ")) +;? (prn "F - expanding below expanded line respects screen/page height")) +;? ; expand line *above* without first collapsing previously expanded line +;? (run-code main4 +;? (default-space:space-address <- new space:literal 30:literal/capacity) +;? (s:string-address <- new "k\n") +;? (k:keyboard-address <- init-keyboard s:string-address) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw) +;? ) +;? ; screen again shows first trace line expanded +;? (when (~screen-contains memory*.4 17 +;? (+ "- main/ 0 : a b c" +;? " mem : 0 a " +;? "+ main/ 1 : d e f" +;? " ")) +;? (prn "F - expanding above expanded line respects screen/page height")) +;? +;? ; todo +;? ; pgup/pgdn to navigate pages (minimize up/down responsibilities for performance) +;? ; expanded trace straddles page boundary +;? ; what if entire page is within an expanded trace? +;? ) ; profiling-just ;? 1 (reset) -;? (print-times) ;? 2 +(print-times) ;? 2 |