Fix walker

db4
Slava Pestov 2008-03-17 05:08:47 -05:00
parent d4be6ea98c
commit 7bd91f68c9
1 changed files with 4 additions and 20 deletions

View File

@ -24,11 +24,7 @@ SYMBOL: walking-thread
: break ( -- )
continuation callstack over set-continuation-call
USE: prettyprint USE: io.streams.c
"BREAK" show
get-walker-thread dup unparse-short show "SS" show send-synchronous
USE: prettyprint USE: io.streams.c
unparse-short show {
get-walker-thread send-synchronous {
{ [ dup continuation? ] [ (continue) ] }
{ [ dup quotation? ] [ call ] }
{ [ dup not ] [ "Single stepping abandoned" throw ] }
@ -150,18 +146,10 @@ SYMBOL: +detached+
walker-status tget set-model ;
: unassociate-thread ( -- )
walker-thread walking-thread tget thread-variables at self eq? [
walker-thread walking-thread tget thread-variables delete-at
[ ] walking-thread tget set-thread-exit-handler
] [
USE: io
global [ "OOPS" print flush ] bind
] if ;
: xshow self unparse-short append show ;
walker-thread walking-thread tget thread-variables delete-at
[ ] walking-thread tget set-thread-exit-handler ;
: detach-msg ( -- )
"DETACH" xshow
+detached+ set-status
unassociate-thread ;
@ -207,7 +195,6 @@ USE: io
: walker-suspended ( continuation -- continuation' )
+suspended+ set-status
[ status +suspended+ eq? ] [
"SUSPENDED" xshow
dup walker-history tget push
dup walker-continuation tget set-model
[
@ -235,7 +222,6 @@ USE: io
: walker-loop ( -- )
+running+ set-status
[ status +detached+ eq? not ] [
"RUNNING" xshow
[
{
{ detach [ detach-msg f ] }
@ -255,9 +241,7 @@ USE: io
[ walker-suspended ]
} case
] handle-synchronous
] [ ] while USE: dlists USE: concurrency.mailboxes
"EXIT" xshow
my-mailbox mailbox-data dlist-empty? [ "Crap" print flush ] unless ;
] [ ] while ;
: associate-thread ( walker -- )
walker-thread tset