use new accessors, throw -> ERROR:
parent
4f8bc90cca
commit
92fe9cfb45
|
@ -4,7 +4,7 @@
|
|||
! Concurrency library for Factor, based on Erlang/Termite style
|
||||
! concurrency.
|
||||
USING: kernel threads concurrency.mailboxes continuations
|
||||
namespaces assocs random ;
|
||||
namespaces assocs random accessors ;
|
||||
IN: concurrency.messaging
|
||||
|
||||
GENERIC: send ( message thread -- )
|
||||
|
@ -45,11 +45,11 @@ TUPLE: synchronous data sender tag ;
|
|||
TUPLE: reply data tag ;
|
||||
|
||||
: <reply> ( data synchronous -- reply )
|
||||
synchronous-tag \ reply boa ;
|
||||
tag>> \ reply boa ;
|
||||
|
||||
: synchronous-reply? ( response synchronous -- ? )
|
||||
over reply?
|
||||
[ >r reply-tag r> synchronous-tag = ]
|
||||
[ >r tag>> r> tag>> = ]
|
||||
[ 2drop f ] if ;
|
||||
|
||||
: send-synchronous ( message thread -- reply )
|
||||
|
@ -58,15 +58,15 @@ TUPLE: reply data tag ;
|
|||
] [
|
||||
>r <synchronous> dup r> send
|
||||
[ synchronous-reply? ] curry receive-if
|
||||
reply-data
|
||||
data>>
|
||||
] if ;
|
||||
|
||||
: reply-synchronous ( message synchronous -- )
|
||||
[ <reply> ] keep synchronous-sender send ;
|
||||
[ <reply> ] keep sender>> send ;
|
||||
|
||||
: handle-synchronous ( quot -- )
|
||||
receive [
|
||||
synchronous-data swap call
|
||||
data>> swap call
|
||||
] keep reply-synchronous ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
@ -1,29 +1,34 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: dlists kernel threads math concurrency.conditions
|
||||
continuations ;
|
||||
continuations accessors summary ;
|
||||
IN: concurrency.semaphores
|
||||
|
||||
TUPLE: semaphore count threads ;
|
||||
|
||||
ERROR: negative-count-semaphore ;
|
||||
|
||||
M: negative-count-semaphore summary
|
||||
drop "Cannot have semaphore with negative count" ;
|
||||
|
||||
: <semaphore> ( n -- semaphore )
|
||||
dup 0 < [ "Cannot have semaphore with negative count" throw ] when
|
||||
dup 0 < [ negative-count-semaphore ] when
|
||||
<dlist> semaphore boa ;
|
||||
|
||||
: wait-to-acquire ( semaphore timeout -- )
|
||||
>r semaphore-threads r> "semaphore" wait ;
|
||||
[ threads>> ] dip "semaphore" wait ;
|
||||
|
||||
: acquire-timeout ( semaphore timeout -- )
|
||||
over semaphore-count zero?
|
||||
over count>> zero?
|
||||
[ dupd wait-to-acquire ] [ drop ] if
|
||||
dup semaphore-count 1- swap set-semaphore-count ;
|
||||
[ 1- ] change-count drop ;
|
||||
|
||||
: acquire ( semaphore -- )
|
||||
f acquire-timeout ;
|
||||
|
||||
: release ( semaphore -- )
|
||||
dup semaphore-count 1+ over set-semaphore-count
|
||||
semaphore-threads notify-1 ;
|
||||
[ 1+ ] change-count
|
||||
threads>> notify-1 ;
|
||||
|
||||
: with-semaphore-timeout ( semaphore timeout quot -- )
|
||||
pick rot acquire-timeout swap
|
||||
|
|
Loading…
Reference in New Issue