Fix walker
parent
d4be6ea98c
commit
7bd91f68c9
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue