1 ! Copyright (C) 2008 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: dlists kernel threads math concurrency.conditions
\r
4 continuations accessors summary locals fry ;
\r
5 IN: concurrency.semaphores
\r
7 TUPLE: semaphore count threads ;
\r
9 ERROR: negative-count-semaphore ;
\r
11 M: negative-count-semaphore summary
\r
12 drop "Cannot have semaphore with negative count" ;
\r
14 : <semaphore> ( n -- semaphore )
\r
15 dup 0 < [ negative-count-semaphore ] when
\r
16 <dlist> semaphore boa ;
\r
18 : wait-to-acquire ( semaphore timeout -- )
\r
19 [ threads>> ] dip "semaphore" wait ;
\r
21 : acquire-timeout ( semaphore timeout -- )
\r
23 [ dupd wait-to-acquire ] [ drop ] if
\r
24 [ 1- ] change-count drop ;
\r
26 : acquire ( semaphore -- )
\r
29 : release ( semaphore -- )
\r
31 threads>> notify-1 ;
\r
33 :: with-semaphore-timeout ( semaphore timeout quot -- )
\r
34 semaphore timeout acquire-timeout
\r
35 quot [ semaphore release ] [ ] cleanup ; inline
\r
37 : with-semaphore ( semaphore quot -- )
\r
38 swap dup acquire '[ _ release ] [ ] cleanup ; inline
\r