extra/benchmark/sockets/sockets.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://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: port-promise
  11 SYMBOL: server
  12
  13 CONSTANT: number-of-requests 1000
  14
  15 : server-addr ( -- addr )
  16     "127.0.0.1" port-promise get ?promise <inet4> ;
  17
  18 : server-loop ( server -- )
  19     dup accept drop [
  20         [
  21             read1 CHAR: x = [
  22                 server get dispose
  23             ] [
  24                 number-of-requests
  25                 [ read1 write1 flush ] times
  26             ] if
  27         ] with-stream
  28     ] curry "Client handler" spawn drop server-loop ;
  29
  30 : simple-server ( -- )
  31     [
  32         "127.0.0.1" 0 <inet4> ascii <server>
  33         [ server set ]
  34         [ addr>> port>> port-promise get fulfill ]
  35         [ [ server-loop ] with-disposal ]
  36         tri
  37     ] ignore-errors ;
  38
  39 : simple-client ( -- )
  40     [
  41         server-addr ascii [
  42             CHAR: b write1 flush
  43             number-of-requests
  44             [ CHAR: a dup write1 flush read1 assert= ] times
  45         ] with-client
  46     ] try
  47     counter get count-down ;
  48
  49 : stop-server ( -- )
  50     server-addr ascii [
  51         CHAR: x write1
  52     ] with-client ;
  53
  54 : clients ( n -- )
  55     dup pprint " clients: " write [
  56         <promise> port-promise set
  57         dup <count-down> counter set
  58         [ simple-server ] "Simple server" spawn drop
  59         yield yield
  60         [ [ simple-client ] "Simple client" spawn drop ] times
  61         counter get await
  62         stop-server
  63         yield yield
  64     ] benchmark . flush ;
  65
  66 : socket-benchmarks ( -- )
  67     1 clients
  68     10 clients
  69     20 clients
  70     40 clients
  71     100 clients ;
  72
  73 MAIN: socket-benchmarks