basis/concurrency/semaphores/semaphores.factor

   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
   6
   7 TUPLE: semaphore count threads ;
   8
   9 ERROR: negative-count-semaphore ;
  10
  11 M: negative-count-semaphore summary
  12     drop "Cannot have semaphore with negative count" ;
  13
  14 : <semaphore> ( n -- semaphore )
  15     dup 0 < [ throw-negative-count-semaphore ] when
  16     <dlist> semaphore boa ;
  17
  18 : wait-to-acquire ( semaphore timeout -- )
  19     [ threads>> ] dip "semaphore" wait ;
  20
  21 : acquire-timeout ( semaphore timeout -- )
  22     over count>> zero?
  23     [ dupd wait-to-acquire ] [ drop ] if
  24     [ 1 - ] change-count drop ;
  25
  26 : acquire ( semaphore -- )
  27     f acquire-timeout ;
  28
  29 : release ( semaphore -- )
  30     [ 1 + ] change-count
  31     threads>> notify-1 ;
  32
  33 :: with-semaphore-timeout ( semaphore timeout quot -- )
  34     semaphore timeout acquire-timeout
  35     quot [ semaphore release ] [ ] cleanup ; inline
  36
  37 : with-semaphore ( semaphore quot -- )
  38     swap dup acquire '[ _ release ] [ ] cleanup ; inline