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

Multiple threads can now wait on one flag simultaneously

db4
Slava Pestov 2008-05-07 03:28:45 -05:00
parent 2f44e86ee1
commit 8065f8834e
2 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/concurrency/flags/flags-tests.factor
View File

@ -1,5 +1,6 @@
IN: concurrency.flags.tests IN: concurrency.flags.tests
USING: tools.test concurrency.flags kernel threads locals ; USING: tools.test concurrency.flags concurrency.combinators
kernel threads locals ;
:: flag-test-1 ( -- ) :: flag-test-1 ( -- )
[let | f [ <flag> ] | [let | f [ <flag> ] |
@ -44,3 +45,9 @@ USING: tools.test concurrency.flags kernel threads locals ;
] ; ] ;
[ t ] [ flag-test-5 ] unit-test [ t ] [ flag-test-5 ] unit-test
[ ] [
{ 1 2 } <flag>
[ [ 1000 sleep raise-flag ] curry "Flag test" spawn drop ]
[ [ wait-for-flag drop ] curry parallel-each ] bi
] unit-test

20
extra/concurrency/flags/flags.factor
View File

@ -1,22 +1,20 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: boxes kernel threads ; USING: dlists kernel threads concurrency.conditions accessors ;
IN: concurrency.flags IN: concurrency.flags
TUPLE: flag value? thread ; TUPLE: flag value threads ;
: <flag> ( -- flag ) f <box> flag boa ; : <flag> ( -- flag ) f <dlist> flag boa ;
: raise-flag ( flag -- ) : raise-flag ( flag -- )
dup flag-value? [ dup value>> [ drop ] [ t >>value threads>> notify-all ] if ;
t over set-flag-value?
dup flag-thread [ resume ] if-box? : wait-for-flag-timeout ( flag timeout -- )
] unless drop ; over value>> [ 2drop ] [ >r threads>> r> "flag" wait ] if ;
: wait-for-flag ( flag -- ) : wait-for-flag ( flag -- )
dup flag-value? [ drop ] [ f wait-for-flag-timeout ;
[ flag-thread >box ] curry "flag" suspend drop
] if ;
: lower-flag ( flag -- ) : lower-flag ( flag -- )
dup wait-for-flag f swap set-flag-value? ; [ wait-for-flag ] [ f >>value drop ] bi ;