akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Kartik K. Agaram 2015-01-21 01:23:57 -08:00
parent 4d1f6bd730
commit fab56ebcec
4 changed files with 860 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

384
chessboard-cursor.arc.t.1 Normal file
View File

@ -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 (<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)

280
chessboard-cursor.arc.t.2 Normal file
View File

@ -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 (<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)

116
chessboard-cursor.arc.t.3 Normal file
View File

@ -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

93
mu.arc
View File

@ -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)