From fab56ebcecbf04db315c7f6f0ab642ef48ee48dd Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Wed, 21 Jan 2015 01:23:57 -0800 Subject: [PATCH] 594 - random snapshot after a lengthy debug I'd caused a bug in Arc: https://github.com/arclanguage/anarki/commit/97b3464256 Almost done interrupting and restarting routines. --- chessboard-cursor.arc.t.1 | 384 ++++++++++++++++++++++++++++++++++++++ chessboard-cursor.arc.t.2 | 280 +++++++++++++++++++++++++++ chessboard-cursor.arc.t.3 | 116 ++++++++++++ mu.arc | 93 +++++++-- 4 files changed, 860 insertions(+), 13 deletions(-) create mode 100644 chessboard-cursor.arc.t.1 create mode 100644 chessboard-cursor.arc.t.2 create mode 100644 chessboard-cursor.arc.t.3 diff --git a/chessboard-cursor.arc.t.1 b/chessboard-cursor.arc.t.1 new file mode 100644 index 00000000..85ac8a78 --- /dev/null +++ b/chessboard-cursor.arc.t.1 @@ -0,0 +1,384 @@ +(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 (-)")) +;? (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 new file mode 100644 index 00000000..4bfcec80 --- /dev/null +++ b/chessboard-cursor.arc.t.2 @@ -0,0 +1,280 @@ +(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 (-)")) +(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 new file mode 100644 index 00000000..dd9fe694 --- /dev/null +++ b/chessboard-cursor.arc.t.3 @@ -0,0 +1,116 @@ +(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) +; 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) + ; 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 "=======================") + (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*) + (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 + (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 + (prn "== restart: read-move") + (restart read-move-routine) + (keep-running) + (dump "5" read-move-routine) + (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 b66ec3bb..648890eb 100644 --- a/mu.arc +++ b/mu.arc @@ -206,11 +206,13 @@ ;; managing concurrent routines (on-init +;? (prn "-- resetting memory allocation") (= Memory-allocated-until 1000)) ; routine = runtime state for a serial thread of execution (def make-routine (fn-name . args) (let curr-alloc Memory-allocated-until +;? (prn "-- allocating routine: @curr-alloc") (++ Memory-allocated-until 100000) (annotate 'routine (obj alloc curr-alloc alloc-max Memory-allocated-until call-stack @@ -301,17 +303,29 @@ (= 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 @@ -326,13 +340,17 @@ ; detect termination: all non-helper routines completed ; detect deadlock: kill all sleeping routines when none can be woken (def update-scheduler-state () -;? (tr curr-cycle*) (when routine* (if 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*)) + (set sleeping-routines*.routine*) + (when foo-routine* + (prn "AAA update2 " (is foo-routine* (routine-running2 'read-move)))) + ) rep.routine*!error (do (trace "schedule" "done with dead routine " top.routine*!fn-name) ;? (tr rep.routine*) @@ -354,24 +372,38 @@ (enq routine* running-routines*))) :else (err "illegal scheduler state")) + (when foo-routine* + (prn "AAA update3 " (is foo-routine* (routine-running2 'read-move)))) (= routine* nil)) -;? (tr 111) + (when foo-routine* + (prn "AAA update4 " (is foo-routine* (routine-running2 'read-move)))) (each (routine _) canon.sleeping-routines* -;? (tr routine) (when (aand rep.routine!limit (<= it (- curr-cycle* rep.routine!running-since))) (trace "schedule" "routine timed out") (wipe sleeping-routines*.routine) (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*))) -;? (tr 112) + (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*) @@ -379,21 +411,29 @@ (= curr-cycle* (+ 1 next-wakeup-cycle))) (trace "schedule" "skipping to cycle " curr-cycle*) (update-scheduler-state))) -;? (prn running-routines*) -;? (prn sleeping-routines*) + (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*) - (push (deq running-routines*) completed-routines*)) + (= routine* (deq running-routines*)) +;? (routine-mark +;? (run-for-time-slice scheduling-interval*)) + (push routine* completed-routines*)) (each (routine _) sleeping-routines* (wipe sleeping-routines*.routine) + (= routine* routine) +;? (routine-mark +;? (run-for-time-slice scheduling-interval*)) (push routine completed-routines*))) -;? (tr 113) + (when foo-routine* + (prn "AAA update8 " (is foo-routine* (routine-running2 'read-move)))) (detect-deadlock) -;? (tr 114) + (when foo-routine* + (prn "AAA update9 " (is foo-routine* (routine-running2 'read-move)))) ) (def detect-deadlock () @@ -459,6 +499,8 @@ ($:require graphics/graphics) (= Viewport nil) +(= foo-routine* nil) + ; run instructions from 'routine*' for 'time-slice' (def run-for-time-slice (time-slice) (point return @@ -643,6 +685,12 @@ (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 @@ -664,7 +712,7 @@ (do1 nil ($.charterm-newline)) print-primitive-to-host (do1 nil -;? (prn (m arg.0) " => " (type (m arg.0))) +;? (write (m arg.0)) (pr " => ") (prn (type (m arg.0))) ((if ($.current-charterm) $.charterm-display pr) (m arg.0)) ) read-key @@ -717,8 +765,6 @@ (let pixel (($.get-color-pixel Viewport) ($.make-posn (m arg.0) (m arg.1))) (prn ($.rgb-red pixel) " " ($.rgb-blue pixel) " " ($.rgb-green pixel)) ($:rgb-red pixel)) - foo - (= times* (table)) ; user-defined functions next-input @@ -1442,6 +1488,18 @@ (find [some [is f _!fn-name] stack._] completed-routines*)) +(def routine-running2 (f) + (or + (find [some [is f _!fn-name] stack._] + completed-routines*) + (find [some [is f _!fn-name] stack._] + (as cons running-routines*)) + (find [some [is f _!fn-name] stack._] + (keys sleeping-routines*)) + (and routine* + (some [is f _!fn-name] stack.routine*) + routine*))) + (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. @@ -1596,8 +1654,12 @@ (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) @@ -1622,8 +1684,13 @@ (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)