diff options
author | Kartik K. Agaram <vc@akkartik.com> | 2015-01-21 02:01:54 -0800 |
---|---|---|
committer | Kartik K. Agaram <vc@akkartik.com> | 2015-01-21 02:04:33 -0800 |
commit | 5f0ed45e8de50e566228fc637697c2ddca21ffe1 (patch) | |
tree | 871d40e46291c9fbc252bdb2cd6d137b8f4c1a75 | |
parent | fab56ebcecbf04db315c7f6f0ab642ef48ee48dd (diff) | |
download | mu-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.1 | 384 | ||||
-rw-r--r-- | chessboard-cursor.arc.t.2 | 280 | ||||
-rw-r--r-- | chessboard-cursor.arc.t.3 | 130 | ||||
-rw-r--r-- | mu.arc | 108 |
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) |