syndicate-lang
/
minimart-benchmark-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Prospect echo server, and various fixes to get older experiments running again

This commit is contained in:
Tony Garnock-Jones 2015-03-18 17:13:36 -04:00
parent 2f8a6482c1
commit e2614c7b94
7 changed files with 105 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
README.md
View File

@ -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

1
echo-client.rkt
View File

@ -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")

2
echo-server-minimart-tcp-driver.rkt
View File

@ -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"

80
echo-server-prospect-tcp-driver.rkt Normal file
View File

@ -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))

10
echo-server.rkt
View File

@ -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)

24
external-latency.rkt
View File

@ -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().'")

1
plain-racket-server.rkt
View File

@ -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)))))