use new accessors, throw -> ERROR:

db4
Doug Coleman 2008-08-29 01:00:39 -05:00
parent 4f8bc90cca
commit 92fe9cfb45
2 changed files with 18 additions and 13 deletions

View File

@ -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

View File

@ -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