! 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 locals fry ;\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
- [ release ] curry [ ] cleanup ; inline\r
+:: with-semaphore-timeout ( semaphore timeout quot -- )\r
+ semaphore timeout acquire-timeout\r
+ quot [ semaphore release ] [ ] cleanup ; inline\r
\r
: with-semaphore ( semaphore quot -- )\r
- over acquire swap [ release ] curry [ ] cleanup ; inline\r
+ swap dup acquire '[ _ release ] [ ] cleanup ; inline\r