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
5 IN: concurrency.semaphores
\r
7 TUPLE: semaphore count threads ;
\r
9 : <semaphore> ( n -- semaphore )
\r
10 dup 0 < [ "Cannot have semaphore with negative count" throw ] when
\r
11 <dlist> semaphore boa ;
\r
13 : wait-to-acquire ( semaphore timeout -- )
\r
14 >r semaphore-threads r> "semaphore" wait ;
\r
16 : acquire-timeout ( semaphore timeout -- )
\r
17 over semaphore-count zero?
\r
18 [ dupd wait-to-acquire ] [ drop ] if
\r
19 dup semaphore-count 1- swap set-semaphore-count ;
\r
21 : acquire ( semaphore -- )
\r
24 : release ( semaphore -- )
\r
25 dup semaphore-count 1+ over set-semaphore-count
\r
26 semaphore-threads notify-1 ;
\r
28 : with-semaphore-timeout ( semaphore timeout quot -- )
\r
29 pick rot acquire-timeout swap
\r
30 [ release ] curry [ ] cleanup ; inline
\r
32 : with-semaphore ( semaphore quot -- )
\r
33 over acquire swap [ release ] curry [ ] cleanup ; inline
\r