extra/benchmark/ring/ring.factor

   1 USING: threads concurrency.messaging kernel
   2 tools.time math sequences ;
   3 IN: benchmark.ring
   4
   5 SYMBOL: done
   6
   7 : tunnel ( process -- process )
   8     receive 2dup swap send done eq? [ tunnel ] unless ;
   9
  10 : create-ring ( processes -- target )
  11     self swap [
  12         dup [ tunnel ] curry "Tunnel" spawn nip
  13     ] times ;
  14
  15 : send-messages ( messages target -- )
  16     dupd [ send ] curry each [ receive drop ] times ;
  17
  18 : destroy-ring ( target -- )
  19     done swap send [ done eq? ] receive-if drop ;
  20
  21 : ring-bench ( messages processes -- )
  22     create-ring [ send-messages ] keep destroy-ring ;
  23
  24 : main-ring-bench ( -- )
  25     1000 1000 ring-bench ;
  26
  27 MAIN: main-ring-bench