basis/concurrency/semaphores/semaphores.factor

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