diff --git a/README.md b/README.md index 7f1c2d0..a39ef6b 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,7 @@ - echo-client.rkt measures roundtrip latency of pinging a remote server - echoserver.erl is a matching ping server in Erlang - echo-server-minimart-tcp-driver.rkt is a server using Minimart's TCP driver + - echo-server-prospect-tcp-driver.rkt is a server using Prospect's TCP driver - echo-server.rkt is a server using Minimart, but eschewing the TCP driver - plain-racket-server.rkt is a server using built-in Racket threads - uvserver.c is a server written in C with libuv diff --git a/echo-client.rkt b/echo-client.rkt index 648d958..a283327 100644 --- a/echo-client.rkt +++ b/echo-client.rkt @@ -151,6 +151,7 @@ ['() (void)] [(cons next-waypoint rest) (when (<= next-waypoint max-waypoint) + (printf "Moving to waypoint ~a\n" next-waypoint) (grow-to-waypoint next-waypoint) (when (equal? remaining-waypoints waypoints) ;; First ever waypoint. Do some warmup. (printf "Warming up.\n") diff --git a/echo-server-minimart-tcp-driver.rkt b/echo-server-minimart-tcp-driver.rkt index 0763ecd..8dfc01b 100644 --- a/echo-server-minimart-tcp-driver.rkt +++ b/echo-server-minimart-tcp-driver.rkt @@ -12,7 +12,7 @@ (define server-entry-name #f) (define server-entry-type #f) -(command-line #:program "echo-server.rkt" +(command-line #:program "echo-server-minimart-tcp-driver.rkt" #:once-each ["--logbook-entry-name" name "set logbook entry name to use when recording run statistics" diff --git a/echo-server-prospect-tcp-driver.rkt b/echo-server-prospect-tcp-driver.rkt new file mode 100644 index 0000000..1fb85a4 --- /dev/null +++ b/echo-server-prospect-tcp-driver.rkt @@ -0,0 +1,80 @@ +#lang racket/base + +(require racket/match) +(require racket/port) +(require prospect) +(require prospect/demand-matcher) +(require prospect/drivers/timer) +(require prospect/drivers/tcp) +(require logbook) +(require racket/cmdline) + +(define server-entry-name #f) +(define server-entry-type #f) + +(command-line #:program "echo-server-prospect-tcp-driver.rkt" + #:once-each + ["--logbook-entry-name" name + "set logbook entry name to use when recording run statistics" + (set! server-entry-name name)] + ["--logbook-entry-type" type + "set logbook entry type to use" + (set! server-entry-type type)]) + +(when (not server-entry-type) + (error 'echo-server "Please supply the --logbook-entry-type command-line argument.")) + +(define L (default-logbook)) +(define E (logbook-entry L "minimart" server-entry-name server-entry-type)) +(define Tmem (logbook-table E "server-memory-use" #:column-spec '(time-seconds memory-use))) +(define Tconn (logbook-table E "server-connections" #:column-spec '(time-seconds connection-count))) + +(define connection-count 0) +(define first-connection-seen? #f) + +(define statistics-poll-interval 2000) + +(define (statistician) + (list (spawn (lambda (e s) + (match e + [(message (timer-expired 'statistician now)) + ;; (collect-garbage) + ;; (collect-garbage) + ;; (collect-garbage) + (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use))) + (write-logbook-datum! Tconn (list (/ now 1000.0) connection-count)) + (when (and first-connection-seen? (zero? connection-count)) + (exit 0)) + (transition s + (message (set-timer 'statistician statistics-poll-interval 'relative)))] + [_ #f])) + #f + (sub (timer-expired 'statistician ?))) + (message (set-timer 'statistician statistics-poll-interval 'relative)))) + +(define (listener port-number) + (define server-id (tcp-listener port-number)) + (spawn-demand-matcher (advertise (tcp-channel (?! (tcp-address ? ?)) server-id ?)) + (observe (tcp-channel (?! (tcp-address ? ?)) server-id ?)) + (spawn-connection-handler server-id))) + +(define ((spawn-connection-handler server-id) c) + (set! connection-count (+ connection-count 1)) + (set! first-connection-seen? #t) + (spawn (lambda (e s) + (match e + [(? patch/removed?) + (set! connection-count (- connection-count 1)) + (quit)] + [(message (tcp-channel src dst bs)) + (transition s (message (tcp-channel dst src bs)))] + [_ #f])) + #f + (sub (advertise (tcp-channel c server-id ?))) + (sub (tcp-channel c server-id ?)) + (pub (tcp-channel server-id c ?)))) + +(run-ground (spawn-timer-driver) + (spawn-tcp-driver) + (listener 5999) + (statistician)) diff --git a/echo-server.rkt b/echo-server.rkt index 235da63..7ea2d95 100644 --- a/echo-server.rkt +++ b/echo-server.rkt @@ -48,7 +48,7 @@ (send (set-timer 'statistician statistics-poll-interval 'relative)))] [_ #f])) #f - (list (sub (timer-expired 'statistician ?)))) + (sub (timer-expired 'statistician ?))) (send (set-timer 'statistician statistics-poll-interval 'relative)))) (define (listener port-number) @@ -58,8 +58,8 @@ (transition s (connection in out))] [_ #f])) #f - (list (sub (event (tcp-accept-evt (tcp-listen port-number 4 #t)) ?) - #:meta-level 1)))) + (sub (event (tcp-accept-evt (tcp-listen port-number 4 #t)) ?) + #:meta-level 1))) (define (connection in out) (set! connection-count (+ connection-count 1)) @@ -77,8 +77,8 @@ (transition s '())] [_ #f])) #f - (list (sub (event (read-line-evt in 'any) ?) - #:meta-level 1)))) + (sub (event (read-line-evt in 'any) ?) + #:meta-level 1))) (run-ground (listener 5999) (spawn-timer-driver) diff --git a/external-latency.rkt b/external-latency.rkt index 6ffd12d..c7b48b7 100644 --- a/external-latency.rkt +++ b/external-latency.rkt @@ -21,6 +21,12 @@ ["--erlang" "use erlang server" (set! server-variation 'erlang)] ["--uv" "use libuv server" (set! server-variation 'uv)] ["--minimart" "use minimart server" (set! server-variation 'minimart)] + ["--minimart+tcp" + "use minimart server with TCP driver" + (set! server-variation 'minimart+tcp)] + ["--prospect+tcp" + "use prospect server with TCP driver" + (set! server-variation 'prospect+tcp)] ["--racket" "use plain racket server" (set! server-variation 'racket)] ["--other" name "use other server" (set! server-variation name)]) @@ -45,18 +51,20 @@ (define (capture-output command) (string-trim (with-output-to-string (lambda () (system command))))) +(define (format-racket-server-command-line file) + (format "racket ~a --logbook-entry-name ~a --logbook-entry-type ~a" + file + entry-name + entry-type)) + (log-info "Starting server...") (define server-control (start-bg (match server-variation - ['minimart - (format "racket echo-server.rkt --logbook-entry-name ~a --logbook-entry-type ~a" - entry-name - entry-type)] - ['racket - (format "racket plain-racket-server.rkt --logbook-entry-name ~a --logbook-entry-type ~a" - entry-name - entry-type)] + ['minimart (format-racket-server-command-line "echo-server.rkt")] + ['minimart+tcp (format-racket-server-command-line "echo-server-minimart-tcp-driver.rkt")] + ['prospect+tcp (format-racket-server-command-line "echo-server-prospect-tcp-driver.rkt")] + ['racket (format-racket-server-command-line "plain-racket-server.rkt")] ['erlang (define erlang-version-command "erl -noshell -eval 'io:format(erlang:system_info(otp_release)), halt().'") diff --git a/plain-racket-server.rkt b/plain-racket-server.rkt index 7d2e1f4..a0eda01 100644 --- a/plain-racket-server.rkt +++ b/plain-racket-server.rkt @@ -41,6 +41,7 @@ (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use))) (write-logbook-datum! Tconn (list (/ now 1000.0) connection-count)) (when (and first-connection-seen? (zero? connection-count)) + (close-logbook L) (exit 0)) (loop)))))