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