about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2015-01-21 02:01:54 -0800
committerKartik K. Agaram <vc@akkartik.com>2015-01-21 02:04:33 -0800
commit5f0ed45e8de50e566228fc637697c2ddca21ffe1 (patch)
tree871d40e46291c9fbc252bdb2cd6d137b8f4c1a75
parentfab56ebcecbf04db315c7f6f0ab642ef48ee48dd (diff)
downloadmu-5f0ed45e8de50e566228fc637697c2ddca21ffe1.tar.gz
595 - tests can now interrupt and restart routines
Also cleaned up much of the mess in 594.
-rw-r--r--chessboard-cursor.arc.t.1384
-rw-r--r--chessboard-cursor.arc.t.2280
-rw-r--r--chessboard-cursor.arc.t.3130
-rw-r--r--mu.arc108
4 files changed, 70 insertions, 832 deletions
diff --git a/chessboard-cursor.arc.t.1 b/chessboard-cursor.arc.t.1
deleted file mode 100644
index 85ac8a78..00000000
--- a/chessboard-cursor.arc.t.1
+++ /dev/null
@@ -1,384 +0,0 @@
-(selective-load "mu.arc" section-level)
-
-;? (reset)
-;? (new-trace "read-move-legal")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (2:string-address/raw <- get screen:terminal-address/deref data:offset)
-;?       (r:integer/routine <- fork read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address screen:terminal-address)
-;?       (c:character <- copy ((#\a literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\2 literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\- literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\a literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\4 literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (sleep until-routine-done:literal r:integer/routine)
-;?      ])))
-;? ;? (set dump-trace*)
-;? ;? (= dump-trace* (obj whitelist '("schedule")))
-;? ;? (= dump-trace* (obj whitelist '("schedule" "run")))
-;? (run 'main)
-;? (each routine completed-routines*
-;? ;?   (prn "  " routine)
-;?   (awhen rep.routine!error
-;?     (prn "error - " it)))
-;? (when (~ran-to-completion 'read-move)
-;?   (prn "F - chessboard accepts legal moves (<rank><file>-<rank><file>)"))
-;? (when (~memory-contains-array memory*.2 "a2-a4")
-;?   (prn "F - chessboard prints moves read from keyboard"))
-;? ;? (quit)
-
-; todo: test that restarting a routine works
-;   when it died
-;   when it timed out
-;   when it completed
-; test that run checks status of sleep
-; run multiple routines in tandem
-
-(def restart (routine)
-  (while (in top.routine!fn-name 'read 'write)
-    (pop-stack routine))
-  (prn routine)
-;?   (let r read-move-routine
-;?     (each frame rep.r!call-stack
-;?       (prn " @frame!fn-name")
-;?       (each (key val) frame
-;?         (prn "  " key " " val))))
-  (wipe rep.routine!sleep)
-  (enq routine running-routines*))
-
-(reset)
-(new-trace "read-move-incomplete")
-(add-code:readfile "chessboard-cursor.mu")
-(prn "init")
-; initialize location 1 to stdin; location 2 to screen fake; 3 to the contents
-; of the fake
-(add-code 
-  '((function test-init [
-      (1:channel-address/raw <- init-channel 1:literal)
-      (2:terminal-address/raw <- init-fake-terminal 20:literal 10:literal)
-      (3:string-address/raw <- get 2:terminal-address/raw/deref data:offset)
-     ])))
-(prn "run init")
-(run 'test-init)
-(prn "make routine under test")
-; the component under test; we'll be running this repeatedly
-(let read-move-routine (make-routine 'read-move memory*.1 memory*.2)
-  (set rep.read-move-routine!helper)
-  (prn "send first key")
-  ; send in first letter
-  (add-code
-    '((function test-send-first-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-first-key)
-  (prn "consume first key")
-;?   (prn read-move-routine)
-  ; check that read-move consumes it and then goes to sleep
-  (enq read-move-routine running-routines*)
-;?   (set dump-trace*)
-;?   (prn int-canon.memory*)
-  (wipe completed-routines*)
-;?   (set dump-trace*)
-  (keep-running)
-  (prn rep.read-move-routine!sleep)
-;?   (prn int-canon.memory*)
-;?   (each routine completed-routines*
-;?     (prn routine))
-;?   (quit)
-  (prn "check routine state")
-  (when (ran-to-completion 'read-move)
-    (prn "F - chessboard waits after first letter of move"))
-  ; send in a few more letters
-  (prn "send and consume more keys")
-  (add-code
-    '((function test-send-next-keys [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\2 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\- literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-;?   (set dump-trace*)
-  (restart read-move-routine)
-  (run 'test-send-next-keys)
-;?   (each routine completed-routines*
-;?     (prn routine))
-;?   (quit)
-;?   (prn "-- before: " rep.read-move-routine!sleep)
-;?   (while (~empty running-routines*)
-;?     (prn "iter: " rep.read-move-routine!sleep)
-;?     (= routine* deq.running-routines*)
-;?     (when rep.routine*!limit
-;?       ; start the clock if it wasn't already running
-;?       (or= rep.routine*!running-since curr-cycle*))
-;?     (routine-mark
-;?       (run-for-time-slice scheduling-interval*))
-;?     (prn "after iter: " rep.read-move-routine!sleep)
-;?     (when routine*
-;?       (if
-;?           rep.routine*!sleep
-;?             (do
-;?                 (set sleeping-routines*.routine*))
-;?           rep.routine*!error
-;?             (do
-;?                 (push routine* completed-routines*))
-;?           empty.routine*
-;?             (do
-;?                 (push routine* completed-routines*))
-;?           (no rep.routine*!limit)
-;?             (do
-;?                 (enq routine* running-routines*))
-;?           :else
-;?             (err "illegal scheduler state"))
-;?       (= routine* nil))
-;?     (each (routine _) canon.sleeping-routines*
-;?       (when (ready-to-wake-up routine)
-;?         (wipe sleeping-routines*.routine)  ; do this before modifying routine
-;?         (wipe rep.routine!sleep)
-;?         (++ pc.routine)
-;?         (enq routine running-routines*)))
-;?     (when (and (or (~empty running-routines*)
-;?                    (~empty sleeping-routines*))
-;?                (all [rep._ 'helper] (as cons running-routines*))
-;?                (all [rep._ 'helper] keys.sleeping-routines*))
-;?       (until (empty running-routines*)
-;?         (push (deq running-routines*) completed-routines*))
-;?       (each (routine _) sleeping-routines*
-;?         (wipe sleeping-routines*.routine)
-;?         (push routine completed-routines*)))
-;?     )
-;?   (prn "-- after: " rep.read-move-routine!sleep)
-;?   (quit)
-  ; check that read-move consumes it and then goes to sleep
-  (prn "check routine state")
-  (when (ran-to-completion 'read-move)
-    (prn "F - chessboard waits after each subsequent letter of move until the last"))
-  ; send final key
-  (prn "send final key")
-  (add-code
-    '((function test-send-final-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\4 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-final-key)
-  ; check that read-move consumes it and -- this time -- returns
-  (prn "consume final key")
-  (restart read-move-routine)
-  (keep-running)
-  (prn rep.read-move-routine!sleep)
-  (prn "check routine done")
-;?   (each routine completed-routines*
-;?     (prn routine))
-  (when (~ran-to-completion 'read-move)
-    (prn "F - 'read-move' completes after final letter of move"))
-)
-
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (2:string-address/raw <- get screen:terminal-address/deref data:offset)
-;?       (r:integer/routine <- fork-helper read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address screen:terminal-address)
-;?       (c:character <- copy ((#\a literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\2 literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\- literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (c:character <- copy ((#\a literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (sleep until-routine-done:literal r:integer/routine)
-;?      ])))
-;? (run 'main)
-;? (when (ran-to-completion 'read-move)
-;?   (prn "F - chessboard hangs until 5 characters are entered"))
-;? (when (~memory-contains-array memory*.2 "a2-a")
-;?   (prn "F - chessboard prints keys from keyboard before entire move is read"))
-
-;? (reset)
-;? (new-trace "read-move-quit")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (r:integer/routine <- fork-helper read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-;?       (c:character <- copy ((#\q literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (sleep until-routine-done:literal r:integer/routine)
-;?      ])))
-;? (run 'main)
-;? (when (~ran-to-completion 'read-move)
-;?   (prn "F - chessboard quits on move starting with 'q'"))
-;? 
-;? (reset)
-;? (new-trace "read-illegal-file")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (r:integer/routine <- fork-helper read-file:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-;?       (c:character <- copy ((#\i literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (sleep until-routine-done:literal r:integer/routine)
-;?      ])))
-;? ;? (= dump-trace* (obj whitelist '("schedule")))
-;? (run 'main)
-;? ;? (each routine completed-routines*
-;? ;?   (prn "  " routine))
-;? (when (or (ran-to-completion 'read-file)
-;?           (let routine routine-running!read-file
-;?             (~posmatch "file too high" rep.routine!error)))
-;?   (prn "F - 'read-file' checks that file lies between 'a' and 'h'"))
-;? 
-;? (reset)
-;? (new-trace "read-illegal-rank")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (r:integer/routine <- fork-helper read-rank:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-;?       (c:character <- copy ((#\9 literal)))
-;?       (x:tagged-value <- save-type c:character)
-;?       (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-;?       (sleep until-routine-done:literal r:integer/routine)
-;?      ])))
-;? (run 'main)
-;? (when (or (ran-to-completion 'read-rank)
-;?           (let routine routine-running!read-rank
-;?             (~posmatch "rank too high" rep.routine!error)))
-;?   (prn "F - 'read-rank' checks that rank lies between '1' and '8'"))
-;? 
-;? (reset)
-;? (new-trace "print-board")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       (initial-position:list-address <- init-list ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
-;?                                                   ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-;?                                                   ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-;?                                                   ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
-;?                                                   ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
-;?                                                   ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-;?                                                   ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-;?                                                   ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
-;?       (b:board-address <- init-board initial-position:list-address)
-;?       (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       (print-board screen:terminal-address b:board-address)
-;?       (5: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*.5)
-;? (when (~memory-contains-array memory*.5
-;?           (+ "8 | r n b q k b n r "
-;?              "7 | p p p p p p p p "
-;?              "6 | _ _ _ _ _ _ _ _ "
-;?              "5 | _ _ _ _ _ _ _ _ "
-;?              "4 | _ _ _ _ _ _ _ _ "
-;?              "3 | _ _ _ _ _ _ _ _ "
-;?              "2 | P P P P P P P P "
-;?              "1 | R N B Q K B N R "
-;?              "  +---------------- "
-;?              "    a b c d e f g h "))
-;?   (prn "F - print-board works; chessboard begins at @memory*.5"))
-;? 
-;? ; todo: how to fold this more elegantly with the previous test?
-;? (reset)
-;? (new-trace "make-move")
-;? (add-code:readfile "chessboard-cursor.mu")
-;? (add-code
-;?   '((function! main [
-;?       (default-space:space-address <- new space:literal 30:literal/capacity)
-;?       ; hook up stdin
-;?       (stdin:channel-address <- init-channel 1:literal)
-;?       ; fake screen
-;?       (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-;?       ; initial position
-;?       (initial-position:list-address <- init-list ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
-;?                                                   ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-;?                                                   ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-;?                                                   ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
-;?                                                   ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
-;?                                                   ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-;?                                                   ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-;?                                                   ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
-;?       (b:board-address <- init-board initial-position:list-address)
-;?       ; move: a2-a4
-;?       (m:move-address <- new move:literal)
-;?       (f:integer-integer-pair-address <- get-address m:move-address/deref from:offset)
-;?       (dest:integer-address <- get-address f:integer-integer-pair-address/deref 0:offset)
-;?       (dest:integer-address/deref <- copy 0:literal)  ; from-file: a
-;?       (dest:integer-address <- get-address f:integer-integer-pair-address/deref 1:offset)
-;?       (dest:integer-address/deref <- copy 1:literal)  ; from-rank: 2
-;?       (t0:integer-integer-pair-address <- get-address m:move-address/deref to:offset)
-;?       (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 0:offset)
-;?       (dest:integer-address/deref <- copy 0:literal)  ; to-file: a
-;?       (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 1:offset)
-;?       (dest:integer-address/deref <- copy 3:literal)  ; to-rank: 4
-;?       (b:board-address <- make-move b:board-address m:move-address)
-;?       (print-board screen:terminal-address b:board-address)
-;?       (5: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*.5)
-;? (when (~memory-contains-array memory*.5
-;?           (+ "8 | r n b q k b n r "
-;?              "7 | p p p p p p p p "
-;?              "6 | _ _ _ _ _ _ _ _ "
-;?              "5 | _ _ _ _ _ _ _ _ "
-;?              "4 | P _ _ _ _ _ _ _ "
-;?              "3 | _ _ _ _ _ _ _ _ "
-;?              "2 | _ P P P P P P P "
-;?              "1 | R N B Q K B N R "
-;?              "  +---------------- "
-;?              "    a b c d e f g h "))
-;?   (prn "F - make-move works; chessboard begins at @memory*.5"))
-
-(reset)
diff --git a/chessboard-cursor.arc.t.2 b/chessboard-cursor.arc.t.2
deleted file mode 100644
index 4bfcec80..00000000
--- a/chessboard-cursor.arc.t.2
+++ /dev/null
@@ -1,280 +0,0 @@
-(selective-load "mu.arc" section-level)
-
-(reset)
-(new-trace "read-move-legal")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      (stdin:channel-address <- init-channel 1:literal)
-      (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      (2:string-address/raw <- get screen:terminal-address/deref data:offset)
-      (r:integer/routine <- fork read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address screen:terminal-address)
-      (c:character <- copy ((#\a literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (c:character <- copy ((#\2 literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (c:character <- copy ((#\- literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (c:character <- copy ((#\a literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (c:character <- copy ((#\4 literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (sleep until-routine-done:literal r:integer/routine)
-     ])))
-;? (set dump-trace*)
-;? (= dump-trace* (obj whitelist '("schedule")))
-;? (= dump-trace* (obj whitelist '("schedule" "run")))
-(run 'main)
-(each routine completed-routines*
-;?   (prn "  " routine)
-  (awhen rep.routine!error
-    (prn "error - " it)))
-(when (~ran-to-completion 'read-move)
-  (prn "F - chessboard accepts legal moves (<rank><file>-<rank><file>)"))
-(when (~memory-contains-array memory*.2 "a2-a4")
-  (prn "F - chessboard prints moves read from keyboard"))
-;? (quit)
-
-; todo: test that restarting a routine works
-;   when it died
-;   when it timed out
-;   when it completed
-; test that run checks status of sleep
-; run multiple routines in tandem
-
-(def restart (routine)
-  (while (in top.routine!fn-name 'read 'write)
-    (pop-stack routine))
-  (wipe rep.routine!sleep)
-  (enq routine running-routines*))
-
-(reset)
-(new-trace "read-move-incomplete")
-(add-code:readfile "chessboard-cursor.mu")
-; initialize location 1 to stdin; location 2 to screen fake; 3 to the contents
-; of the fake
-(add-code 
-  '((function test-init [
-      (1:channel-address/raw <- init-channel 1:literal)
-      (2:terminal-address/raw <- init-fake-terminal 20:literal 10:literal)
-      (3:string-address/raw <- get 2:terminal-address/raw/deref data:offset)
-     ])))
-(run 'test-init)
-; the component under test; we'll be running this repeatedly
-(let read-move-routine (make-routine 'read-move memory*.1 memory*.2)
-  (set rep.read-move-routine!helper)
-  ; send in first letter
-  (add-code
-    '((function test-send-first-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-first-key)
-  ; check that read-move consumes it and then goes to sleep
-  (enq read-move-routine running-routines*)
-  (wipe completed-routines*)
-  (keep-running)
-  (when (ran-to-completion 'read-move)
-    (prn "F - chessboard waits after first letter of move"))
-  ; send in a few more letters
-  (add-code
-    '((function test-send-next-keys [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\2 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\- literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (restart read-move-routine)
-  (run 'test-send-next-keys)
-  ; check that read-move consumes it and then goes to sleep
-  (when (ran-to-completion 'read-move)
-    (prn "F - chessboard waits after each subsequent letter of move until the last"))
-  ; send final key
-  (add-code
-    '((function test-send-final-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\4 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-final-key)
-  ; check that read-move consumes it and -- this time -- returns
-  (restart read-move-routine)
-  (keep-running)
-  (prn rep.read-move-routine!sleep)
-  (when (~ran-to-completion 'read-move)
-    (prn "F - 'read-move' completes after final letter of move"))
-)
-
-(reset)
-(new-trace "read-move-quit")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      (stdin:channel-address <- init-channel 1:literal)
-      (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      (r:integer/routine <- fork-helper read-move:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-      (c:character <- copy ((#\q literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (sleep until-routine-done:literal r:integer/routine)
-     ])))
-(run 'main)
-(when (~ran-to-completion 'read-move)
-  (prn "F - chessboard quits on move starting with 'q'"))
-
-(reset)
-(new-trace "read-illegal-file")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      (stdin:channel-address <- init-channel 1:literal)
-      (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      (r:integer/routine <- fork-helper read-file:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-      (c:character <- copy ((#\i literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (sleep until-routine-done:literal r:integer/routine)
-     ])))
-;? (= dump-trace* (obj whitelist '("schedule")))
-(run 'main)
-;? (each routine completed-routines*
-;?   (prn "  " routine))
-(when (or (ran-to-completion 'read-file)
-          (let routine routine-running!read-file
-            (~posmatch "file too high" rep.routine!error)))
-  (prn "F - 'read-file' checks that file lies between 'a' and 'h'"))
-
-(reset)
-(new-trace "read-illegal-rank")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      (stdin:channel-address <- init-channel 1:literal)
-      (dummy:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      (r:integer/routine <- fork-helper read-rank:fn nil:literal/globals 2000:literal/limit stdin:channel-address dummy:terminal-address)
-      (c:character <- copy ((#\9 literal)))
-      (x:tagged-value <- save-type c:character)
-      (stdin:channel-address/deref <- write stdin:channel-address x:tagged-value)
-      (sleep until-routine-done:literal r:integer/routine)
-     ])))
-(run 'main)
-(when (or (ran-to-completion 'read-rank)
-          (let routine routine-running!read-rank
-            (~posmatch "rank too high" rep.routine!error)))
-  (prn "F - 'read-rank' checks that rank lies between '1' and '8'"))
-
-(reset)
-(new-trace "print-board")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      (initial-position:list-address <- init-list ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
-                                                  ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-                                                  ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-                                                  ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
-                                                  ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
-                                                  ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-                                                  ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-                                                  ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
-      (b:board-address <- init-board initial-position:list-address)
-      (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      (print-board screen:terminal-address b:board-address)
-      (5: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*.5)
-(when (~memory-contains-array memory*.5
-          (+ "8 | r n b q k b n r "
-             "7 | p p p p p p p p "
-             "6 | _ _ _ _ _ _ _ _ "
-             "5 | _ _ _ _ _ _ _ _ "
-             "4 | _ _ _ _ _ _ _ _ "
-             "3 | _ _ _ _ _ _ _ _ "
-             "2 | P P P P P P P P "
-             "1 | R N B Q K B N R "
-             "  +---------------- "
-             "    a b c d e f g h "))
-  (prn "F - print-board works; chessboard begins at @memory*.5"))
-
-; todo: how to fold this more elegantly with the previous test?
-(reset)
-(new-trace "make-move")
-(add-code:readfile "chessboard-cursor.mu")
-(add-code
-  '((function! main [
-      (default-space:space-address <- new space:literal 30:literal/capacity)
-      ; hook up stdin
-      (stdin:channel-address <- init-channel 1:literal)
-      ; fake screen
-      (screen:terminal-address <- init-fake-terminal 20:literal 10:literal)
-      ; initial position
-      (initial-position:list-address <- init-list ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))
-                                                  ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-                                                  ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-                                                  ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal))
-                                                  ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal))
-                                                  ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal))
-                                                  ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal))
-                                                  ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)))
-      (b:board-address <- init-board initial-position:list-address)
-      ; move: a2-a4
-      (m:move-address <- new move:literal)
-      (f:integer-integer-pair-address <- get-address m:move-address/deref from:offset)
-      (dest:integer-address <- get-address f:integer-integer-pair-address/deref 0:offset)
-      (dest:integer-address/deref <- copy 0:literal)  ; from-file: a
-      (dest:integer-address <- get-address f:integer-integer-pair-address/deref 1:offset)
-      (dest:integer-address/deref <- copy 1:literal)  ; from-rank: 2
-      (t0:integer-integer-pair-address <- get-address m:move-address/deref to:offset)
-      (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 0:offset)
-      (dest:integer-address/deref <- copy 0:literal)  ; to-file: a
-      (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 1:offset)
-      (dest:integer-address/deref <- copy 3:literal)  ; to-rank: 4
-      (b:board-address <- make-move b:board-address m:move-address)
-      (print-board screen:terminal-address b:board-address)
-      (5: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*.5)
-(when (~memory-contains-array memory*.5
-          (+ "8 | r n b q k b n r "
-             "7 | p p p p p p p p "
-             "6 | _ _ _ _ _ _ _ _ "
-             "5 | _ _ _ _ _ _ _ _ "
-             "4 | P _ _ _ _ _ _ _ "
-             "3 | _ _ _ _ _ _ _ _ "
-             "2 | _ P P P P P P P "
-             "1 | R N B Q K B N R "
-             "  +---------------- "
-             "    a b c d e f g h "))
-  (prn "F - make-move works; chessboard begins at @memory*.5"))
-
-(reset)
diff --git a/chessboard-cursor.arc.t.3 b/chessboard-cursor.arc.t.3
index dd9fe694..89b78be8 100644
--- a/chessboard-cursor.arc.t.3
+++ b/chessboard-cursor.arc.t.3
@@ -1,116 +1,52 @@
 (selective-load "mu.arc" section-level)
 
-(def restart (routine)
-  (dump "before restart" routine)
-  (while (in top.routine!fn-name 'read 'write)
-    (pop-stack routine))
-  (wipe rep.routine!sleep)
-  (dump "after restart" routine)
-  (when foo-routine*
-    (prn "AAA " (is routine foo-routine*)))
-  (enq routine running-routines*))
-
-(def dump (msg r)
-  (prn "= @msg " rep.r!sleep)
-  (prn:rem [in car._ 'sleep 'call-stack] (as cons rep.r))
-  (each frame rep.r!call-stack
-    (prn " @frame!fn-name")
-    (each (key val) frame
-      (unless (is key 'fn-name)
-        (prn "  " key " " val)))))
-
 (reset)
 (add-code:readfile "chessboard-cursor.mu")
-; initialize location 1 to stdin; location 2 to screen fake; 3 to the contents
-; of the fake
-(add-code 
-  '((function test-init [
-      (1:channel-address/raw <- init-channel 1:literal)
-      (2:terminal-address/raw <- init-fake-terminal 20:literal 10:literal)
-      (3:string-address/raw <- get 2:terminal-address/raw/deref data:offset)
-     ])))
-;? (= dump-trace* (obj whitelist '("schedule")))
-(run 'test-init)
+; initialize some variables at specific raw locations
+(run-code test-init
+  (1:channel-address/raw <- init-channel 1:literal)
+  (2:terminal-address/raw <- init-fake-terminal 20:literal 10:literal)
+  (3:string-address/raw <- get 2:terminal-address/raw/deref data:offset))
+(wipe completed-routines*)
 ; the component under test; we'll be running this repeatedly
 (let read-move-routine (make-routine 'read-move memory*.1 memory*.2)
-  (= foo-routine* read-move-routine)
-;?   (set rep.read-move-routine!helper)
-  ; send in first letter
-  (add-code
-    '((function test-send-first-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-first-key)
+  (run-code send-first-key
+    (default-space:space-address <- new space:literal 30:literal/capacity)
+    (c:character <- copy ((#\a literal)))
+    (x:tagged-value <- save-type c:character)
+    (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
+  (wipe completed-routines*)
   ; check that read-move consumes it and then goes to sleep
-  (prn "AAA routine: " (routine-running 'read-move))
-  (prn "AAA routine changed? " (is read-move-routine (routine-running 'read-move)))
   (enq read-move-routine running-routines*)
-  (wipe completed-routines*)
-  (keep-running)
-  (prn "AAA routine: " (routine-running 'read-move))
-  (prn "AAA routine changed? " (is read-move-routine (routine-running 'read-move)))
-  (prn "=======================")
+  (run)
   (when (ran-to-completion 'read-move)
     (prn "F - chessboard waits after first letter of move"))
-  ; send in a few more letters
-  (add-code
-    '((function test-send-next-keys [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\2 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\- literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-        (c:character <- copy ((#\a literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (prn "== restart: read-move")
-  (prn "AAA routine3: " (routine-running 'read-move))
-  (prn "AAA routine changed? " (is read-move-routine (routine-running 'read-move)))
   (wipe completed-routines*)
+  ; send in a few more letters
   (restart read-move-routine)
-;?   (= dump-trace* (obj blacklist '("c{0" "c{1" "cn0" "cn1" "maybe-add")))
-  (= dump-trace* (obj whitelist '("schedule")))
-  (prn "AAA routine4: " (routine-running 'read-move))
-  (prn "AAA routine changed? " (is read-move-routine (routine-running 'read-move)))
-  (run 'test-send-next-keys)
-  (prn "AAA routine5: " (routine-running 'read-move))
-  (prn "AAA routine changed? " (is read-move-routine (routine-running 'read-move)))
-  (dump "Final" read-move-routine)
-  (quit)
-  ; check that read-move consumes it and then goes to sleep
+  (run-code send-more-keys
+    (default-space:space-address <- new space:literal 30:literal/capacity)
+    (c:character <- copy ((#\2 literal)))
+    (x:tagged-value <- save-type c:character)
+    (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
+    (c:character <- copy ((#\- literal)))
+    (x:tagged-value <- save-type c:character)
+    (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
+    (c:character <- copy ((#\a literal)))
+    (x:tagged-value <- save-type c:character)
+    (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
+  ; check that read-move consumes them and then goes to sleep
   (when (ran-to-completion 'read-move)
     (prn "F - chessboard waits after each subsequent letter of move until the last"))
+  (wipe completed-routines*)
   ; send final key
-  (add-code
-    '((function test-send-final-key [
-        (default-space:space-address <- new space:literal 30:literal/capacity)
-        (c:character <- copy ((#\4 literal)))
-        (x:tagged-value <- save-type c:character)
-        (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value)
-       ])))
-  (run 'test-send-final-key)
-  ; check that read-move consumes it and -- this time -- returns
-  (prn "== restart: read-move")
   (restart read-move-routine)
-  (keep-running)
-  (dump "5" read-move-routine)
+  (run-code send-final-key
+    (default-space:space-address <- new space:literal 30:literal/capacity)
+    (c:character <- copy ((#\4 literal)))
+    (x:tagged-value <- save-type c:character)
+    (1:channel-address/raw/deref <- write 1:channel-address/raw x:tagged-value))
+  ; check that read-move consumes it and -- this time -- returns
   (when (~ran-to-completion 'read-move)
     (prn "F - 'read-move' completes after final letter of move"))
 )
-
-; log
-;   drop helper bit in component under test
-;   canon messing up 'is' over table contents
-;   mergesort not preserving pointers of list members!!!
-;     (should have chased down why canon was breaking things a whole day ago)
-;   bad commit in anarki:
-;     commit 4a5bad8a4fa3c60a6e270285c5a98af9d0faf17f
-;     Date:   Sun Nov 11 17:40:58 2012 -0800
-;
-;         make copy work with nested lists and tables
diff --git a/mu.arc b/mu.arc
index 648890eb..f482bbcd 100644
--- a/mu.arc
+++ b/mu.arc
@@ -205,6 +205,14 @@
 
 ;; managing concurrent routines
 
+; todo: test that restarting a routine works
+;   when it died
+;   when it timed out
+;   when it completed
+; test that run checks status of sleep
+; run multiple routines in tandem
+; drop helper bit in component under test -- comment
+
 (on-init
 ;?   (prn "-- resetting memory allocation")
   (= Memory-allocated-until 1000))
@@ -303,29 +311,17 @@
   (= traces* (queue))
   (each it fn-names
     (enq make-routine.it running-routines*))
-  (keep-running))
-
-(def keep-running ()
-;?   (prn "---")
   (while (~empty running-routines*)
-    (when foo-routine*
-      (prn "AAA keep-running0 " (is foo-routine* (routine-running2 'read-move))))
     (= routine* deq.running-routines*)
     (when rep.routine*!limit
       ; start the clock if it wasn't already running
       (or= rep.routine*!running-since curr-cycle*))
     (trace "schedule" top.routine*!fn-name)
-    (when foo-routine*
-      (prn "AAA keep-running1 " (is foo-routine* (routine-running2 'read-move))))
     (routine-mark
       (run-for-time-slice scheduling-interval*))
-    (when foo-routine*
-      (prn "AAA keep-running2 " (is foo-routine* (routine-running2 'read-move))))
     (update-scheduler-state)
 ;?     (tr "after run iter " running-routines*)
 ;?     (tr "after run iter " empty.running-routines*)
-    (when foo-routine*
-      (prn "AAA keep-running3 " (is foo-routine* (routine-running2 'read-move))))
     ))
 
 ; prepare next iteration of round-robin scheduler
@@ -341,23 +337,19 @@
 ;   detect deadlock: kill all sleeping routines when none can be woken
 (def update-scheduler-state ()
   (when routine*
+;?     (prn routine*)
     (if
+        empty.routine*
+          (do (trace "schedule" "done with routine")
+              (push routine* completed-routines*))
         rep.routine*!sleep
           (do (trace "schedule" "pushing " top.routine*!fn-name " to sleep queue")
-              (when foo-routine*
-                (prn "AAA update1 " (is foo-routine* (routine-running2 'read-move))))
               ; keep the clock ticking at rep.routine*!running-since
-              (set sleeping-routines*.routine*)
-              (when foo-routine*
-                (prn "AAA update2 " (is foo-routine* (routine-running2 'read-move))))
-              )
+              (set sleeping-routines*.routine*))
         rep.routine*!error
           (do (trace "schedule" "done with dead routine " top.routine*!fn-name)
 ;?               (tr rep.routine*)
               (push routine* completed-routines*))
-        empty.routine*
-          (do (trace "schedule" "done with routine")
-              (push routine* completed-routines*))
         (no rep.routine*!limit)
           (do (trace "schedule" "scheduling " top.routine*!fn-name " for further processing")
               (enq routine* running-routines*))
@@ -372,11 +364,7 @@
                 (enq routine* running-routines*)))
         :else
           (err "illegal scheduler state"))
-    (when foo-routine*
-      (prn "AAA update3 " (is foo-routine* (routine-running2 'read-move))))
     (= routine* nil))
-  (when foo-routine*
-    (prn "AAA update4 " (is foo-routine* (routine-running2 'read-move))))
   (each (routine _) canon.sleeping-routines*
     (when (aand rep.routine!limit (<= it (- curr-cycle* rep.routine!running-since)))
       (trace "schedule" "routine timed out")
@@ -384,26 +372,13 @@
       (push routine completed-routines*)
 ;?       (tr completed-routines*)
       ))
-  (when foo-routine*
-    (prn "AAA update5 " (is foo-routine* (routine-running2 'read-move))))
   (each (routine _) canon.sleeping-routines*
-    (when foo-routine*
-      (prn "AAA update5.1 " (is foo-routine* (routine-running2 'read-move))))
     (when (ready-to-wake-up routine)
       (trace "schedule" "waking up " top.routine!fn-name)
-      (when foo-routine*
-        (prn "AAA update5.3 " (is foo-routine* (prn:routine-running2 'read-move)))
-        (prn "AAA update5.3.2 " (is foo-routine* routine)))
       (wipe sleeping-routines*.routine)  ; do this before modifying routine
-      (when foo-routine*
-        (prn "AAA update5.4 " (is foo-routine* (routine-running2 'read-move))))
       (wipe rep.routine!sleep)
-      (when foo-routine*
-        (prn "AAA update5.5 " (is foo-routine* (routine-running2 'read-move))))
       (++ pc.routine)
       (enq routine running-routines*)))
-  (when foo-routine*
-    (prn "AAA update6 " (is foo-routine* (routine-running2 'read-move))))
   ; optimization for simulated time
   (when (empty running-routines*)
     (whenlet exact-sleeping-routines (keep waiting-for-exact-cycle? keys.sleeping-routines*)
@@ -411,29 +386,17 @@
         (= curr-cycle* (+ 1 next-wakeup-cycle)))
       (trace "schedule" "skipping to cycle " curr-cycle*)
       (update-scheduler-state)))
-  (when foo-routine*
-    (prn "AAA update7 " (is foo-routine* (routine-running2 'read-move))))
   (when (and (or (~empty running-routines*)
                  (~empty sleeping-routines*))
              (all [rep._ 'helper] (as cons running-routines*))
              (all [rep._ 'helper] keys.sleeping-routines*))
     (trace "schedule" "just helpers left; stopping everything")
     (until (empty running-routines*)
-      (= routine* (deq running-routines*))
-;?       (routine-mark
-;?         (run-for-time-slice scheduling-interval*))
-      (push routine* completed-routines*))
+      (push (deq running-routines*) completed-routines*))
     (each (routine _) sleeping-routines*
       (wipe sleeping-routines*.routine)
-      (= routine* routine)
-;?       (routine-mark
-;?         (run-for-time-slice scheduling-interval*))
       (push routine completed-routines*)))
-  (when foo-routine*
-    (prn "AAA update8 " (is foo-routine* (routine-running2 'read-move))))
   (detect-deadlock)
-  (when foo-routine*
-    (prn "AAA update9 " (is foo-routine* (routine-running2 'read-move))))
   )
 
 (def detect-deadlock ()
@@ -499,8 +462,6 @@
 ($:require graphics/graphics)
 (= Viewport nil)
 
-(= foo-routine* nil)
-
 ; run instructions from 'routine*' for 'time-slice'
 (def run-for-time-slice (time-slice)
   (point return
@@ -685,12 +646,6 @@
                         (die "badly formed 'sleep' call @(tostring:prn (body.routine* pc.routine*))")
                       )
                     ((abort-routine*)))
-                foo
-                  (when foo-routine*
-                    (prn "AAAA " (is routine* foo-routine*))
-;?                     (dump (m arg.0) foo-routine*)
-;?                     (dump "routine*" routine*)
-                    )
                 assert
                   (unless (m arg.0)
                     (die (v arg.1)))  ; other routines will be able to look at the error status
@@ -1484,11 +1439,16 @@
              :else
                (recur (+ addr 1) (+ idx 1))))))
 
-(def routine-running (f)
+(mac run-code (name . body)
+  `(do
+     (add-code '((function ,name [ ,@body ])))
+     (run ',name)))
+
+(def routine-that-ran (f)
   (find [some [is f _!fn-name] stack._]
         completed-routines*))
 
-(def routine-running2 (f)
+(def routine-running (f)
   (or
     (find [some [is f _!fn-name] stack._]
           completed-routines*)
@@ -1503,7 +1463,22 @@
 (def 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-running f))
+  (~routine-that-ran f))
+
+(def restart (routine)
+  (while (in top.routine!fn-name 'read 'write)
+    (pop-stack routine))
+  (wipe rep.routine!sleep)
+  (enq routine running-routines*))
+
+(def 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
+    (prn " @frame!fn-name")
+    (each (key val) frame
+      (unless (is key 'fn-name)
+        (prn "  " key " " val)))))
 
 ;; system software
 ; create once, load before every test
@@ -1654,12 +1629,8 @@
     (full:boolean <- full? chan:channel-address/deref)
     (break-unless full:boolean)
     (full-address:integer-address <- get-address chan:channel-address/deref first-full:offset)
-;?     (print-primitive-to-host (("write sleep: " literal)))
-;?     (print-primitive-to-host full-address:integer-address/deref)
-;?     (print-primitive-to-host (("\n" literal)))
     (sleep until-location-changes:literal full-address:integer-address/deref)
   }
-;?   (print-primitive-to-host (("continuing write" literal)))
   ; store val
   (q:tagged-value-array-address <- get chan:channel-address/deref circular-buffer:offset)
   (free:integer-address <- get-address chan:channel-address/deref first-free:offset)
@@ -1684,13 +1655,8 @@
     (empty:boolean <- empty? chan:channel-address/deref)
     (break-unless empty:boolean)
     (free-address:integer-address <- get-address chan:channel-address/deref first-free:offset)
-;?     (foo (("blocking read" literal)))
-;?     (print-primitive-to-host (("read sleep: " literal)))
-;?     (print-primitive-to-host free-address:integer-address/deref)
-;?     (print-primitive-to-host (("\n" literal)))
     (sleep until-location-changes:literal free-address:integer-address/deref)
   }
-;?   (foo (("continuing read" literal)))
   ; read result
   (full:integer-address <- get-address chan:channel-address/deref first-full:offset)
   (q:tagged-value-array-address <- get chan:channel-address/deref circular-buffer:offset)