extra/benchmark/sockets/sockets.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math threads io io.sockets
   4 io.encodings.ascii io.streams.duplex debugger tools.time
   5 prettyprint concurrency.count-downs concurrency.promises
   6 namespaces arrays continuations destructors ;
   7 IN: benchmark.sockets
   8
   9 SYMBOL: counter
  10 SYMBOL: server-promise
  11 SYMBOL: server
  12 SYMBOL: port
  13
  14 CONSTANT: number-of-requests 1000
  15
  16 : server-addr ( -- addr )
  17     "127.0.0.1" port get <inet4> ;
  18
  19 : server-loop ( server -- )
  20     dup accept drop [
  21         [
  22             read1 CHAR: x = [
  23                 server get dispose
  24             ] [
  25                 number-of-requests
  26                 [ read1 write1 flush ] times
  27             ] if
  28         ] with-stream
  29     ] curry "Client handler" spawn drop server-loop ;
  30
  31 : simple-server ( -- )
  32     [ server get [ server-loop ] with-disposal ] ignore-errors
  33     t server-promise get fulfill ;
  34
  35 : simple-client ( -- )
  36     [
  37         server-addr ascii [
  38             CHAR: b write1 flush
  39             number-of-requests
  40             [ CHAR: a dup write1 flush read1 assert= ] times
  41         ] with-client
  42     ] try
  43     counter get count-down ;
  44
  45 : stop-server ( -- )
  46     server-addr ascii [
  47         CHAR: x write1
  48     ] with-client ;
  49
  50 : clients ( n -- )
  51     dup pprint " clients: " write [
  52         <promise> server-promise set
  53         dup <count-down> counter set
  54         "127.0.0.1" 0 <inet4> ascii <server>
  55         [ server set ] [ addr>> port>> port set ] bi
  56
  57         [ simple-server ] "Simple server" spawn drop
  58         [ yield [ simple-client ] "Simple client" spawn drop ] times
  59
  60         counter get await
  61         stop-server
  62         server-promise get ?promise drop
  63     ] benchmark . flush ;
  64
  65 : sockets-benchmark ( -- )
  66     1 clients
  67     10 clients
  68     20 clients
  69     40 clients
  70     100 clients ;
  71
  72 MAIN: sockets-benchmark