Fix channels for recent changes
Slava Pestov
parent
743b62da22
commit
27656fe0e3
|
|
@ -2,7 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Channels - based on ideas from newsqueak
|
||||
USING: kernel sequences sequences.lib threads continuations random math ;
|
||||
USING: kernel sequences sequences.lib threads continuations
|
||||
random math ;
|
||||
IN: channels
|
||||
|
||||
TUPLE: channel receivers senders ;
|
||||
|
|
@ -16,7 +17,8 @@ GENERIC: from ( channel -- value )
|
|||
<PRIVATE
|
||||
|
||||
: wait ( channel -- )
|
||||
[ channel-senders push stop ] curry callcc0 ;
|
||||
[ channel-senders push ] curry
|
||||
"channel send" suspend drop ;
|
||||
|
||||
: (to) ( value receivers -- )
|
||||
delete-random resume-with yield ;
|
||||
|
|
@ -24,8 +26,8 @@ GENERIC: from ( channel -- value )
|
|||
: notify ( continuation channel -- channel )
|
||||
[ channel-receivers push ] keep ;
|
||||
|
||||
: (from) ( senders -- * )
|
||||
delete-random continue ;
|
||||
: (from) ( senders -- )
|
||||
delete-random resume ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -36,5 +38,5 @@ M: channel to ( value channel -- )
|
|||
M: channel from ( channel -- value )
|
||||
[
|
||||
notify channel-senders
|
||||
dup empty? [ stop ] [ (from) ] if
|
||||
] curry callcc1 ;
|
||||
dup empty? [ drop ] [ (from) ] if
|
||||
] curry "channel receive" suspend ;
|
||||
|
|
|
|||
|
|
@ -1,31 +0,0 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.interpreter kernel arrays continuations threads
|
||||
sequences namespaces ;
|
||||
IN: tools.interpreter.debug
|
||||
|
||||
: run-interpreter ( interpreter -- )
|
||||
dup interpreter-continuation [
|
||||
dup step-into run-interpreter
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: quot>cont ( quot -- cont )
|
||||
[
|
||||
swap [
|
||||
continue-with
|
||||
] curry callcc0 call stop
|
||||
] curry callcc1 ;
|
||||
|
||||
: init-interpreter ( quot interpreter -- )
|
||||
>r
|
||||
[ datastack "datastack" set ] compose quot>cont
|
||||
f swap 2array
|
||||
r> restore ;
|
||||
|
||||
: test-interpreter ( quot -- )
|
||||
<interpreter>
|
||||
[ init-interpreter ] keep
|
||||
run-interpreter
|
||||
"datastack" get ;
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
USING: help.markup help.syntax kernel generic
|
||||
math hashtables quotations classes continuations ;
|
||||
IN: tools.interpreter
|
||||
|
||||
ARTICLE: "meta-interpreter" "Meta-circular interpreter"
|
||||
"The meta-circular interpreter is used to implement the walker tool in the UI. If you are simply interested in single stepping through a piece of code, use the " { $link "ui-walker" } "."
|
||||
$nl
|
||||
"On the other hand, if you want to implement a similar tool yourself, then you can use the words described in this section."
|
||||
$nl
|
||||
"Meta-circular interpreter words are found in the " { $vocab-link "tools.interpreter" } " vocabulary."
|
||||
$nl
|
||||
"Breakpoints can be inserted in user code:"
|
||||
{ $subsection break }
|
||||
"Breakpoints invoke a hook:"
|
||||
{ $subsection break-hook }
|
||||
"Single stepping with the meta-circular interpreter:"
|
||||
{ $subsection step }
|
||||
{ $subsection step-into }
|
||||
{ $subsection step-out }
|
||||
{ $subsection step-all } ;
|
||||
|
||||
ABOUT: "meta-interpreter"
|
||||
|
||||
HELP: interpreter
|
||||
{ $class-description "An interpreter instance." } ;
|
||||
|
||||
HELP: step
|
||||
{ $values { "interpreter" interpreter } }
|
||||
{ $description "Evaluates the object in the single stepper using Factor evaluation semantics:"
|
||||
{ $list
|
||||
{ "If the object is a " { $link wrapper } ", then the wrapped object is pushed on the single stepper's data stack" }
|
||||
{ "If the object is a word, then the word is executed in the single stepper's continuation atomically" }
|
||||
{ "Otherwise, the object is pushed on the single stepper's data stack" }
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: step-into
|
||||
{ $values { "interpreter" interpreter } }
|
||||
{ $description "Evaluates the object in the single stepper using Factor evaluation semantics:"
|
||||
{ $list
|
||||
{ "If the object is a " { $link wrapper } ", then the wrapped object is pushed on the single stepper's data stack" }
|
||||
{ "If the object is a compound word, then the single stepper enters the word definition" }
|
||||
{ "If the object is a primitive word or a word with special single stepper behavior, it is executed in the single stepper's continuation atomically" }
|
||||
{ "Otherwise, the object is pushed on the single stepper's data stack" }
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: step-out
|
||||
{ $values { "interpreter" interpreter } }
|
||||
{ $description "Evaluates the remainder of the current quotation in the single stepper." } ;
|
||||
|
||||
HELP: step-all
|
||||
{ $values { "interpreter" interpreter } }
|
||||
{ $description "Executes the remainder of the single stepper's continuation. This effectively ends single stepping unless the continuation invokes " { $link break } " at a later point in time." } ;
|
||||
|
|
@ -1,113 +0,0 @@
|
|||
USING: tools.interpreter io io.streams.string kernel math
|
||||
math.private namespaces prettyprint sequences tools.test
|
||||
continuations math.parser threads arrays
|
||||
tools.interpreter.private tools.interpreter.debug ;
|
||||
IN: temporary
|
||||
|
||||
[ "Ooops" throw ] break-hook set
|
||||
|
||||
[ { } ] [
|
||||
[ ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 1 } ] [
|
||||
[ 1 ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 1 2 3 } ] [
|
||||
[ 1 2 3 ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { "Yo" 2 } ] [
|
||||
[ 2 >r "Yo" r> ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 2 } ] [
|
||||
[ t [ 2 ] [ "hi" ] if ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { "hi" } ] [
|
||||
[ f [ 2 ] [ "hi" ] if ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 4 } ] [
|
||||
[ 2 2 fixnum+ ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
: foo 2 2 fixnum+ ;
|
||||
|
||||
[ { 8 } ] [
|
||||
[ foo 4 fixnum+ ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { C{ 1 1.5 } { } C{ 1 1.5 } { } } ] [
|
||||
[ C{ 1 1.5 } { } 2dup ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ 5 5 number= ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ 5 6 number= ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ "XYZ" "XYZ" mismatch ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ "XYZ" "XYZ" sequence= ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ "XYZ" "XYZ" = ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ "XYZ" "XuZ" = ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 4 } ] [
|
||||
[ 2 2 + ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { } 2 ] [
|
||||
2 "x" set [ [ 3 "x" set ] with-scope ] test-interpreter "x" get
|
||||
] unit-test
|
||||
|
||||
[ { 3 } ] [
|
||||
[ 3 "x" set "x" get ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { "hi\n" } ] [
|
||||
[ [ "hi" print ] with-string-writer ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { "4\n" } ] [
|
||||
[ [ 2 2 + number>string print ] with-string-writer ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 1 2 3 } ] [
|
||||
[ { 1 2 3 } set-datastack ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ 3 [ nip continue ] callcc0 2 * ] test-interpreter ] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ [ 3 swap continue-with ] callcc1 2 * ] test-interpreter ] unit-test
|
||||
|
||||
[ { } ]
|
||||
[ [ [ ] [ ] recover ] test-interpreter ] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ [ 3 throw ] [ 2 * ] recover ] test-interpreter ] unit-test
|
||||
|
||||
[ { "{ 1 2 3 }\n" } ] [
|
||||
[ [ { 1 2 3 } . ] with-string-writer ] test-interpreter
|
||||
] unit-test
|
||||
|
||||
[ { } ] [
|
||||
[ "a" "b" set "c" "d" set [ ] test-interpreter ] with-scope
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: concurrency.promises models tools.walker kernel
|
||||
sequences concurrency.messaging locals ;
|
||||
IN: tools.walker.debug
|
||||
|
||||
:: test-walker | quot |
|
||||
[let | p [ <promise> ]
|
||||
s [ f <model> ]
|
||||
c [ f <model> ] |
|
||||
[ s c start-walker-thread p fulfill break ]
|
||||
quot compose
|
||||
|
||||
step-into-all
|
||||
p ?promise
|
||||
send-synchronous drop
|
||||
|
||||
c model-value continuation-data
|
||||
] ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
USING: tools.walker io io.streams.string kernel math
|
||||
math.private namespaces prettyprint sequences tools.test
|
||||
continuations math.parser threads arrays tools.walker.debug ;
|
||||
IN: temporary
|
||||
|
||||
[ { } ] [
|
||||
[ ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 1 } ] [
|
||||
[ 1 ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 1 2 3 } ] [
|
||||
[ 1 2 3 ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { "Yo" 2 } ] [
|
||||
[ 2 >r "Yo" r> ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 2 } ] [
|
||||
[ t [ 2 ] [ "hi" ] if ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { "hi" } ] [
|
||||
[ f [ 2 ] [ "hi" ] if ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 4 } ] [
|
||||
[ 2 2 fixnum+ ] test-walker
|
||||
] unit-test
|
||||
|
||||
: foo 2 2 fixnum+ ;
|
||||
|
||||
[ { 8 } ] [
|
||||
[ foo 4 fixnum+ ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { C{ 1 1.5 } { } C{ 1 1.5 } { } } ] [
|
||||
[ C{ 1 1.5 } { } 2dup ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ 5 5 number= ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ 5 6 number= ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ "XYZ" "XYZ" mismatch ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ "XYZ" "XYZ" sequence= ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { t } ] [
|
||||
[ "XYZ" "XYZ" = ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { f } ] [
|
||||
[ "XYZ" "XuZ" = ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 4 } ] [
|
||||
[ 2 2 + ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 3 } ] [
|
||||
[ [ 3 "x" set "x" get ] with-scope ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { "hi\n" } ] [
|
||||
[ [ "hi" print ] with-string-writer ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { "4\n" } ] [
|
||||
[ [ 2 2 + number>string print ] with-string-writer ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 1 2 3 } ] [
|
||||
[ { 1 2 3 } set-datastack ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ 3 [ nip continue ] callcc0 2 * ] test-walker ] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ [ 3 swap continue-with ] callcc1 2 * ] test-walker ] unit-test
|
||||
|
||||
[ { } ]
|
||||
[ [ [ ] [ ] recover ] test-walker ] unit-test
|
||||
|
||||
[ { 6 } ]
|
||||
[ [ [ 3 throw ] [ 2 * ] recover ] test-walker ] unit-test
|
||||
|
||||
[ { "{ 1 2 3 }\n" } ] [
|
||||
[ [ { 1 2 3 } . ] with-string-writer ] test-walker
|
||||
] unit-test
|
||||
|
||||
[ { } ] [
|
||||
[ "a" "b" set "c" "d" set [ ] test-walker ] with-scope
|
||||
] unit-test
|
||||
|
|
@ -1,54 +1,54 @@
|
|||
: walk ( quot -- ) \ break add* call ;
|
||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: threads kernel namespaces continuations combinators
|
||||
sequences math namespaces.private continuations.private
|
||||
concurrency.messaging quotations kernel.private words
|
||||
sequences.private assocs models ;
|
||||
IN: tools.walker
|
||||
|
||||
SYMBOL: walker-hook
|
||||
|
||||
! Thread local
|
||||
SYMBOL: interpreter-thread
|
||||
SYMBOL: walker-thread
|
||||
|
||||
: get-interpreter-thread ( -- thread )
|
||||
interpreter-thread tget dup [
|
||||
walker-hook get
|
||||
[ "No walker hook" throw ] or
|
||||
interpreter-thread
|
||||
: get-walker-thread ( -- thread )
|
||||
walker-thread tget [
|
||||
walker-hook get [ "No walker hook" throw ] or call
|
||||
walker-thread tget
|
||||
] unless* ;
|
||||
|
||||
: break ( -- )
|
||||
callstack [
|
||||
over set-continuation-callstack
|
||||
over set-continuation-call
|
||||
|
||||
interpreter-thread send-synchronous {
|
||||
get-walker-thread send-synchronous {
|
||||
{ [ dup continuation? ] [ (continue) ] }
|
||||
{ [ dup quotation? ] [ call ] }
|
||||
{ [ dup not ] [ "Single stepping abandoned" throw ] }
|
||||
} cond
|
||||
] curry callcc0 ;
|
||||
|
||||
SYMBOL: +suspended+
|
||||
SYMBOL: +running+
|
||||
SYMBOL: +stopped+
|
||||
|
||||
! Messages sent to interpreter thread
|
||||
SYMBOL: status
|
||||
: walk ( quot -- ) \ break add* call ;
|
||||
|
||||
! Messages sent to walker thread
|
||||
SYMBOL: step
|
||||
SYMBOL: step-out
|
||||
SYMBOL: step-into
|
||||
SYMBOL: step-all
|
||||
SYMBOL: step-into-all
|
||||
SYMBOL: step-back
|
||||
SYMBOL: detach
|
||||
SYMBOL: abandon
|
||||
SYMBOL: call-in
|
||||
|
||||
SYMBOL: get-thread
|
||||
SYMBOL: get-continuation
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! Thread locals
|
||||
SYMBOL: interpreter-running?
|
||||
SYMBOL: interpreter-stepping?
|
||||
SYMBOL: interpreter-continuation
|
||||
SYMBOL: interpreter-history
|
||||
SYMBOL: walker-status
|
||||
SYMBOL: walker-continuation
|
||||
SYMBOL: walker-history
|
||||
|
||||
SYMBOL: +running+
|
||||
SYMBOL: +suspended+
|
||||
SYMBOL: +stopped+
|
||||
|
||||
: change-frame ( continuation quot -- continuation' )
|
||||
#! Applies quot to innermost call frame of the
|
||||
|
|
@ -112,7 +112,7 @@ M: word (step-into) (step-into-execute) ;
|
|||
{
|
||||
>n ndrop >c c>
|
||||
continue continue-with
|
||||
(continue-with) stop yield suspend sleep (spawn)
|
||||
stop yield suspend sleep (spawn)
|
||||
suspend
|
||||
} [
|
||||
dup [ execute break ] curry
|
||||
|
|
@ -126,102 +126,107 @@ M: word (step-into) (step-into-execute) ;
|
|||
swap cut [
|
||||
swap % unclip literalize , \ (step-into) , %
|
||||
] [ ] make
|
||||
] (step) ;
|
||||
] change-frame ;
|
||||
|
||||
: status-change ( symbol -- )
|
||||
+running+ interpreter-status tget set-model ;
|
||||
: status ( -- symbol )
|
||||
walker-status tget model-value ;
|
||||
|
||||
: set-status ( symbol -- )
|
||||
walker-status tget set-model ;
|
||||
|
||||
: detach-msg ( -- f )
|
||||
+detached+ status-change
|
||||
f interpreter-stepping? tset
|
||||
f interpreter-running? tset
|
||||
f ;
|
||||
+stopped+ set-status ;
|
||||
|
||||
: continuation-msg ( -- continuation )
|
||||
interpreter-thread tget thread-continuation box-value ;
|
||||
: keep-running ( continuation -- continuation )
|
||||
+running+ set-status
|
||||
dup continuation? [ dup walker-history tget push ] when ;
|
||||
|
||||
: keep-running f interpreter-stepping? tset ;
|
||||
|
||||
: save-continuation ( continuation -- )
|
||||
dup interpreter-continuation tget set-model
|
||||
interpreter-history tget push ;
|
||||
|
||||
: handle-command ( continuation -- continuation' )
|
||||
t interpreter-stepping? tset
|
||||
[ interpreter-stepping? tget ] [
|
||||
: walker-stopped ( -- )
|
||||
+stopped+ set-status
|
||||
[
|
||||
{
|
||||
! These are sent by the walker tool. We reply and
|
||||
! keep cycling.
|
||||
{ status [ +suspended+ ] }
|
||||
{ detach [ detach-msg ] }
|
||||
{ get-thread [ interpreter-thread tget ] }
|
||||
{ get-continuation [ dup ] }
|
||||
[ drop f ]
|
||||
} case
|
||||
] handle-synchronous
|
||||
walker-stopped ;
|
||||
|
||||
: step-into-all-loop ( -- )
|
||||
+running+ set-status
|
||||
[ status +stopped+ eq? not ] [
|
||||
[
|
||||
{
|
||||
{ detach [ detach-msg ] }
|
||||
{ step [ f ] }
|
||||
{ step-out [ f ] }
|
||||
{ step-into [ f ] }
|
||||
{ step-all [ f ] }
|
||||
{ step-into-all [ f ] }
|
||||
{ step-back [ f ] }
|
||||
{ f [ walker-stopped ] }
|
||||
[ step-into-msg ]
|
||||
} case
|
||||
] handle-synchronous
|
||||
] [ ] while ;
|
||||
|
||||
: walker-suspended ( continuation -- continuation' )
|
||||
+suspended+ set-status
|
||||
[ status +suspended+ eq? ] [
|
||||
[
|
||||
{
|
||||
! These are sent by the walker tool. We reply
|
||||
! and keep cycling.
|
||||
{ detach [ detach-msg ] }
|
||||
! These change the state of the thread being
|
||||
! interpreted, so we modify the continuation and
|
||||
! output f.
|
||||
{ step [ (step) keep-running ] }
|
||||
{ step-out [ (step-out) keep-running ] }
|
||||
{ step-into [ (step-into) keep-running ] }
|
||||
{ step [ step-msg keep-running ] }
|
||||
{ step-out [ step-out-msg keep-running ] }
|
||||
{ step-into [ step-into-msg keep-running ] }
|
||||
{ step-all [ keep-running ] }
|
||||
{ step-into-all [ step-into-all-loop ] }
|
||||
{ abandon [ drop f keep-running ] }
|
||||
! Pass quotation to debugged thread
|
||||
{ call-in [ nip keep-running ] }
|
||||
! Pass previous continuation to debugged thread
|
||||
{ step-back [ drop interpreter-history tget pop f ] }
|
||||
{ step-back [ drop walker-history tget pop f ] }
|
||||
} case
|
||||
] handle-synchronous
|
||||
] [ ] while
|
||||
dup continuation? [ dup save-continuation ] when ;
|
||||
] [ ] while ;
|
||||
|
||||
: interpreter-stopped ( -- )
|
||||
: walker-loop ( -- )
|
||||
+running+ set-status
|
||||
[ status +stopped+ eq? not ] [
|
||||
[
|
||||
{
|
||||
{ detach [ detach-msg ] }
|
||||
{ status [ +stopped+ ] }
|
||||
{ get-thread [ interpreter-thread tget ] }
|
||||
{ get-continuation [ f ] }
|
||||
[ drop f ]
|
||||
} case
|
||||
] handle-synchronous
|
||||
interpreter-stopped ;
|
||||
|
||||
: interpreter-loop ( -- )
|
||||
[ interpreter-running? tget ] [
|
||||
[
|
||||
status-change
|
||||
{
|
||||
{ detach [ detach-msg ] }
|
||||
{ get-thread [ interpreter-thread tget ] }
|
||||
{ get-continuation [ f ] }
|
||||
! ignore these commands while the thread is
|
||||
! running
|
||||
{ step [ f ] }
|
||||
{ step-out [ f ] }
|
||||
{ step-into [ f ] }
|
||||
{ step-all [ f ] }
|
||||
{ step-into-all [ step-into-all-loop ] }
|
||||
{ step-back [ f ] }
|
||||
! thread has exited so we exit the monitor too
|
||||
{ f [ interpreter-stopped ] }
|
||||
{ f [ walker-stopped f ] }
|
||||
! thread hit a breakpoint and sent us the
|
||||
! continuation, so we modify it and send it back.
|
||||
[ handle-command ]
|
||||
! continuation, so we modify it and send it
|
||||
! back.
|
||||
[ walker-suspended ]
|
||||
} case
|
||||
] handle-synchronous
|
||||
] [ ] while;
|
||||
] [ ] while ;
|
||||
|
||||
PRIVATE>
|
||||
: associate-thread ( walker -- )
|
||||
dup walker-thread tset
|
||||
[ f swap send ] curry self set-thread-exit-handler ;
|
||||
|
||||
: start-interpreter-thread ( thread -- thread' )
|
||||
: start-walker-thread ( status continuation -- thread' )
|
||||
[
|
||||
[
|
||||
interpreter-thread tset
|
||||
t interpreter-running tset
|
||||
f interpreter-stepping tset
|
||||
f <model> interpreter-continuation tset
|
||||
V{ } clone interpreter-history tset
|
||||
interpreter-loop
|
||||
] curry
|
||||
] keep
|
||||
"Interpreter for " over thread-name append spawn
|
||||
dup rot set-thread-;
|
||||
walker-continuation tset
|
||||
walker-status tset
|
||||
V{ } clone walker-history tset
|
||||
walker-loop
|
||||
] 2curry
|
||||
"Walker on " self thread-name append spawn
|
||||
[ associate-thread ] keep ;
|
||||
Loading…
Reference in New Issue