extra/benchmark/tcp-echo0/tcp-echo0.factor

   1 ! Copyright (C) 2011 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays io io.encodings.binary io.servers
   4 io.sockets kernel math memoize namespaces sequences fry literals
   5 locals formatting ;
   6 IN: benchmark.tcp-echo0
   7
   8 ! Max size here is 26 2^ 1 - because array-capacity limits on 32bit platforms
   9 CONSTANT: test-size0 $[ 23 2^ 1 - ]
  10
  11 MEMO: test-bytes ( n -- byte-array ) iota >byte-array ;
  12
  13 TUPLE: tcp-echo < threaded-server #times #bytes ;
  14
  15 : <tcp-echo> ( #times #bytes -- obj )
  16     binary \ tcp-echo new-threaded-server
  17         swap >>#bytes
  18         swap >>#times
  19         f 0 <inet4> >>insecure ;
  20
  21 ERROR: incorrect-#bytes ;
  22
  23 : check-bytes ( bytes n -- bytes )
  24     over length = [ incorrect-#bytes ] unless ;
  25
  26 : read-n ( n -- bytes )
  27     [ read ] [ check-bytes ] bi ;
  28
  29 : read-write ( n -- ) read-n write flush ;
  30
  31 : write-read ( bytes -- )
  32     [ write flush ] [ length read-n drop ] bi ;
  33
  34 M: tcp-echo handle-client*
  35     [ #times>> ] [ #bytes>> ] bi
  36     '[ _ [ _ test-bytes write-read ] times ] call ;
  37
  38 : server>address ( server -- port )
  39     servers>> first addr>> port>> local-server ;
  40
  41 : tcp-echo-banner ( #times #bytes -- )
  42     "Network testing: times: %d, length: %d\n" printf ;
  43
  44 :: tcp-echo-benchmark ( #times #bytes -- )
  45     #times #bytes [ tcp-echo-banner ] 2keep
  46     <tcp-echo> [
  47         \ threaded-server get server>address binary [
  48             #times [ #bytes read-write ] times
  49             contents empty? [ incorrect-#bytes ] unless
  50         ] with-client
  51     ] with-threaded-server ;
  52
  53 : tcp-echo0-benchmark ( -- )
  54     4 test-size0 tcp-echo-benchmark ;
  55
  56 MAIN: tcp-echo0-benchmark