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