steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Another threads fix

db4
Slava Pestov 2008-05-07 01:56:55 -05:00
parent 918418e9e6
commit cbac71c3bf
2 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
core/threads/threads.factor
View File

@ -12,7 +12,7 @@ SYMBOL: initial-thread
TUPLE: thread TUPLE: thread
name quot exit-handler name quot exit-handler
id id
continuation state continuation state runnable
mailbox variables sleep-entry ; mailbox variables sleep-entry ;
: self ( -- thread ) 40 getenv ; inline : self ( -- thread ) 40 getenv ; inline
@ -138,8 +138,11 @@ DEFER: next
: (next) ( arg thread -- * ) : (next) ( arg thread -- * )
f >>state f >>state
dup set-self dup set-self
dup continuation>> ?box dup runnable>> [
[ nip continue-with ] [ drop start ] if ; continuation>> box> continue-with
] [
t >>runnable start
] if ;
: next ( -- * ) : next ( -- * )
expire-sleep-loop expire-sleep-loop

19
extra/ui/tools/interactor/interactor.factor
View File

@ -6,12 +6,12 @@ models namespaces parser prettyprint quotations sequences
strings threads listener classes.tuple ui.commands ui.gadgets strings threads listener classes.tuple ui.commands ui.gadgets
ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
ui.gestures definitions calendar concurrency.flags ui.gestures definitions calendar concurrency.flags
ui.tools.workspace accessors ; concurrency.mailboxes ui.tools.workspace accessors ;
IN: ui.tools.interactor IN: ui.tools.interactor
! If waiting is t, we're waiting for user input, and invoking ! If waiting is t, we're waiting for user input, and invoking
! evaluate-input resumes the thread. ! evaluate-input resumes the thread.
TUPLE: interactor output history flag thread waiting help ; TUPLE: interactor output history flag mailbox thread waiting help ;
: register-self ( interactor -- ) : register-self ( interactor -- )
self >>thread drop ; self >>thread drop ;
@ -40,6 +40,7 @@ TUPLE: interactor output history flag thread waiting help ;
interactor construct-editor interactor construct-editor
V{ } clone >>history V{ } clone >>history
<flag> >>flag <flag> >>flag
<mailbox> >>mailbox
dup <help-model> >>help dup <help-model> >>help
swap >>output ; swap >>output ;
@ -77,7 +78,7 @@ M: interactor model-changed
over empty? [ 2drop ] [ interactor-history push-new ] if ; over empty? [ 2drop ] [ interactor-history push-new ] if ;
: interactor-continue ( obj interactor -- ) : interactor-continue ( obj interactor -- )
thread>> resume-with ; mailbox>> mailbox-put ;
: clear-input ( interactor -- ) gadget-model clear-doc ; : clear-input ( interactor -- ) gadget-model clear-doc ;
@ -100,14 +101,16 @@ M: interactor model-changed
: interactor-yield ( interactor -- obj ) : interactor-yield ( interactor -- obj )
dup thread>> self eq? [ dup thread>> self eq? [
t >>waiting {
[ [ flag>> raise-flag ] curry "input" suspend ] keep [ t >>waiting drop ]
f >>waiting [ flag>> raise-flag ]
drop [ mailbox>> mailbox-get ]
[ f >>waiting drop ]
} cleave
] [ drop f ] if ; ] [ drop f ] if ;
M: interactor stream-readln M: interactor stream-readln
[ interactor-yield ] keep interactor-finish [ interactor-yield ] [ interactor-finish ] bi
dup [ first ] when ; dup [ first ] when ;
: interactor-call ( quot interactor -- ) : interactor-call ( quot interactor -- )