imperative-syndicate versions
This commit is contained in:
Tony Garnock-Jones
parent
1216fba58b
commit
da3f737079
10
README.md
10
README.md
|
|
@ -10,6 +10,7 @@
|
|||
- 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-imperative-syndicate-tcp-driver.rkt is a server using Imperative Syndicate'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
|
||||
|
|
@ -20,11 +21,14 @@
|
|||
symbols instead of fixnums to identify peers.
|
||||
- internal-latency-prospect.rkt is the same, but using Prospect
|
||||
instead of Minimart.
|
||||
- internal-latency-imperative-syndicate.rkt is the same, but using
|
||||
Imperative Syndicate instead of Minimart.
|
||||
|
||||
- observe-all-minimart.rkt, observe-all-prospect.rkt,
|
||||
sum-all-minimart.rkt and sum-all-prospect.rkt measure the costs of
|
||||
presence notification and processing in Minimart and Prospect
|
||||
worlds, respectively.
|
||||
observe-all-imperative-syndicate.rkt, sum-all-minimart.rkt,
|
||||
sum-all-prospect.rkt, and sum-all-imperative-syndicate.rkt measure
|
||||
the costs of presence notification and processing in Minimart,
|
||||
Prospect, and Imperative Syndicate worlds, respectively.
|
||||
|
||||
- pingpong.rkt and pingpong.erl are simple measurements of Racket's
|
||||
and Erlang's built-in thread communication latency, respectively.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,92 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Measurement of *broadcast* message delivery latency.
|
||||
|
||||
(require logbook)
|
||||
|
||||
(message-struct ping (src dst timestamp))
|
||||
(message-struct pong (timestamp))
|
||||
|
||||
(define (send-ping! src dst)
|
||||
(send! (ping src dst (current-inexact-milliseconds))))
|
||||
|
||||
(define (run #:echoer-count [echoer-count 100]
|
||||
#:run-time [run-time 10000])
|
||||
(define total-latency 0)
|
||||
(define total-roundtrips 0)
|
||||
(define boot-start-time (current-inexact-milliseconds))
|
||||
(define run-start-time #f)
|
||||
|
||||
(define (rate-at count)
|
||||
;; count is the number of roundtrips
|
||||
;; each roundtrip involves (+ echoer-count 1) messages
|
||||
;; we want messages per second
|
||||
(/ (* count (+ echoer-count 1)) ;; echoer-count pings and one pong per roundtrip
|
||||
(/ total-latency 1000.0) ;; latency in seconds
|
||||
))
|
||||
|
||||
(test-case
|
||||
[(for [(id (in-range echoer-count))]
|
||||
(spawn (on (message (ping $src $dst $stamp))
|
||||
(when (= dst id) (send! (pong stamp))))))
|
||||
|
||||
(let ((src echoer-count)
|
||||
(dst 0))
|
||||
(spawn (on-start
|
||||
(set! run-start-time (current-inexact-milliseconds))
|
||||
(send-ping! src dst))
|
||||
|
||||
(on (message (pong $start-time))
|
||||
(define stop-time (current-inexact-milliseconds))
|
||||
;; TODO: is there a way of reducing the measurement error here,
|
||||
;; perhaps by recording against run-start-time instead of start-time, somehow?
|
||||
;; TODO: first, characterize the measurement error
|
||||
(define delta (- stop-time start-time))
|
||||
(set! total-latency (+ total-latency delta))
|
||||
(set! total-roundtrips (+ total-roundtrips 1))
|
||||
(when (zero? (modulo total-roundtrips 10000))
|
||||
(log-info "After ~a roundtrips, ~a milliseconds; ~a Hz"
|
||||
total-roundtrips
|
||||
total-latency
|
||||
(rate-at total-roundtrips)))
|
||||
(when (< (- stop-time run-start-time) run-time)
|
||||
(send-ping! src dst)))))])
|
||||
(values total-roundtrips
|
||||
(rate-at total-roundtrips)
|
||||
(- run-start-time boot-start-time)))
|
||||
|
||||
(module+ main
|
||||
(define t 2000)
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "broadcast-latency-imperative-syndicate"))
|
||||
(define T (logbook-table E "broadcast-latency"
|
||||
#:column-spec '(number-of-echoers
|
||||
secs/msg
|
||||
msgs/sec
|
||||
boot-delay-ms
|
||||
secs/process-booted
|
||||
roundtrip-count
|
||||
run-duration-ms)))
|
||||
;; Warmup
|
||||
(let ()
|
||||
(run #:echoer-count 1 #:run-time 1000)
|
||||
(run #:echoer-count 10 #:run-time 1000)
|
||||
(void))
|
||||
;; Real run
|
||||
(for ((n
|
||||
(list* 1 2 5
|
||||
(let loop ((n 10))
|
||||
(if (>= n 30000)
|
||||
'()
|
||||
(cons (inexact->exact (round n))
|
||||
(loop (* n (sqrt (sqrt 2))))))))
|
||||
))
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(define-values (count v boot-delay-ms) (run #:echoer-count n #:run-time t))
|
||||
(write-logbook-datum! T (list n
|
||||
(/ 1.0 v)
|
||||
v
|
||||
boot-delay-ms
|
||||
(/ (/ boot-delay-ms 1000.0) n)
|
||||
count
|
||||
t))))
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
#lang imperative-syndicate
|
||||
|
||||
(require racket/port)
|
||||
(require logbook)
|
||||
(require racket/cmdline)
|
||||
|
||||
(require/activate imperative-syndicate/drivers/timer)
|
||||
(require/activate imperative-syndicate/drivers/tcp)
|
||||
|
||||
(begin-for-declarations
|
||||
(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)
|
||||
(spawn #:name 'statistician
|
||||
(field [sample-deadline (+ (current-inexact-milliseconds) statistics-poll-interval)])
|
||||
(on (asserted (later-than (sample-deadline)))
|
||||
;; (collect-garbage)
|
||||
;; (collect-garbage)
|
||||
;; (collect-garbage)
|
||||
(define now (sample-deadline))
|
||||
(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))
|
||||
(sample-deadline (+ (sample-deadline) statistics-poll-interval)))))
|
||||
|
||||
(define (listener port-number)
|
||||
(spawn #:name 'listener
|
||||
(during/spawn (tcp-connection $id (tcp-listener port-number))
|
||||
#:name (list 'connection id)
|
||||
(assert (tcp-accepted id))
|
||||
(on-start
|
||||
(set! connection-count (+ connection-count 1))
|
||||
(set! first-connection-seen? #t))
|
||||
(on-stop
|
||||
(set! connection-count (- connection-count 1)))
|
||||
(on (message (tcp-in id $bs))
|
||||
(send! (tcp-out id bs))))))
|
||||
|
||||
(listener 5999)
|
||||
(statistician)
|
||||
|
|
@ -27,6 +27,9 @@
|
|||
["--prospect+tcp"
|
||||
"use prospect server with TCP driver"
|
||||
(set! server-variation 'prospect+tcp)]
|
||||
["--imperative-syndicate+tcp"
|
||||
"use imperative-syndicate server with TCP driver"
|
||||
(set! server-variation 'imperative-syndicate+tcp)]
|
||||
["--racket" "use plain racket server" (set! server-variation 'racket)]
|
||||
["--other" name "use other server" (set! server-variation name)])
|
||||
|
||||
|
|
@ -64,6 +67,7 @@
|
|||
['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")]
|
||||
['imperative-syndicate+tcp (format-racket-server-command-line "echo-server-imperative-syndicate-tcp-driver.rkt")]
|
||||
['racket (format-racket-server-command-line "plain-racket-server.rkt")]
|
||||
['erlang
|
||||
(define erlang-version-command
|
||||
|
|
|
|||
|
|
@ -0,0 +1,87 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Measurement of message delivery latency.
|
||||
|
||||
(require logbook)
|
||||
|
||||
(message-struct ping (src dst timestamp))
|
||||
|
||||
(define (send-ping! src dst)
|
||||
(send! (ping src dst (current-inexact-milliseconds))))
|
||||
|
||||
(define (run #:echoer-count [echoer-count 100]
|
||||
#:run-time [run-time 10000])
|
||||
(define total-latency 0)
|
||||
(define total-roundtrips 0)
|
||||
(define boot-start-time (current-inexact-milliseconds))
|
||||
(define run-start-time #f)
|
||||
|
||||
(define (rate-at count)
|
||||
(/ (* count 2) ;; two messages per roundtrip
|
||||
(/ total-latency 1000.0) ;; latency in seconds
|
||||
))
|
||||
|
||||
(test-case
|
||||
[(for [(id (in-range echoer-count))]
|
||||
(spawn (on (message (ping $src id $stamp))
|
||||
(send! (ping id src stamp)))))
|
||||
|
||||
(let ((src echoer-count)
|
||||
(dst 0))
|
||||
(spawn (on-start
|
||||
(set! run-start-time (current-inexact-milliseconds))
|
||||
(send-ping! src dst))
|
||||
|
||||
(on (message (ping dst src $start-time))
|
||||
(define stop-time (current-inexact-milliseconds))
|
||||
;; TODO: is there a way of reducing the measurement error here,
|
||||
;; perhaps by recording against run-start-time instead of start-time, somehow?
|
||||
;; TODO: first, characterize the measurement error
|
||||
(define delta (- stop-time start-time))
|
||||
(set! total-latency (+ total-latency delta))
|
||||
(set! total-roundtrips (+ total-roundtrips 1))
|
||||
(when (zero? (modulo total-roundtrips 10000))
|
||||
(log-info "After ~a roundtrips, ~a milliseconds; ~a Hz"
|
||||
total-roundtrips
|
||||
total-latency
|
||||
(rate-at total-roundtrips)))
|
||||
(when (< (- stop-time run-start-time) run-time)
|
||||
(send-ping! src dst)))))])
|
||||
|
||||
(values total-roundtrips (rate-at total-roundtrips) (- run-start-time boot-start-time)))
|
||||
|
||||
(module+ main
|
||||
(define t 2000)
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "internal-latency-imperative-syndicate"))
|
||||
(define T (logbook-table E "internal-latency"
|
||||
#:column-spec '(number-of-echoers
|
||||
secs/msg
|
||||
msgs/sec
|
||||
boot-delay-ms
|
||||
secs/process-booted
|
||||
roundtrip-count
|
||||
run-duration-ms)))
|
||||
;; Warmup
|
||||
(let ()
|
||||
(run #:echoer-count 1 #:run-time 1000)
|
||||
(run #:echoer-count 10 #:run-time 1000)
|
||||
(void))
|
||||
;; Real run
|
||||
(for ((n
|
||||
(list* 1 2 5
|
||||
(let loop ((n 10))
|
||||
(if (>= n 30000)
|
||||
'()
|
||||
(cons (inexact->exact (round n))
|
||||
(loop (* n (sqrt (sqrt 2))))))))
|
||||
))
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(define-values (count v boot-delay-ms) (run #:echoer-count n #:run-time t))
|
||||
(write-logbook-datum! T (list n
|
||||
(/ 1.0 v)
|
||||
v
|
||||
boot-delay-ms
|
||||
(/ (/ boot-delay-ms 1000.0) n)
|
||||
count
|
||||
t))))
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Measurement of presence processing.
|
||||
;; Peers observe each other, but do not process the resulting routing events.
|
||||
|
||||
(require logbook)
|
||||
|
||||
(assertion-struct presence (id))
|
||||
|
||||
(define (run #:peer-count [peer-count 100])
|
||||
(define event-count 0)
|
||||
|
||||
(define-values (results cpu-time wall-clock-time gc-time)
|
||||
(time-apply
|
||||
(lambda ()
|
||||
(test-case
|
||||
[(for [(id (in-range peer-count))]
|
||||
(spawn (assert (presence id))
|
||||
(on (asserted (presence $peer))
|
||||
(set! event-count (+ event-count 1)))))]))
|
||||
'()))
|
||||
|
||||
(values event-count (max 1 (- cpu-time gc-time))))
|
||||
|
||||
(module+ main
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "observe-all-imperative-syndicate"))
|
||||
(define T (logbook-table E "presence-processing"
|
||||
#:column-spec '(number-of-peers
|
||||
secs/routing-update
|
||||
routing-updates/sec
|
||||
secs/peer
|
||||
peers/sec
|
||||
event-count
|
||||
run-duration-ms)))
|
||||
;; Warmup
|
||||
(let ()
|
||||
(run #:peer-count 1)
|
||||
(run #:peer-count 10)
|
||||
(void))
|
||||
;; Real run
|
||||
(for ((n
|
||||
(list* 1 2 5
|
||||
(let loop ((n 10))
|
||||
(if (>= n 1000)
|
||||
'()
|
||||
(cons (inexact->exact (round n))
|
||||
(loop (* n (sqrt (sqrt 2))))))))
|
||||
))
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(define-values (event-count run-duration-ms) (run #:peer-count n))
|
||||
(write-logbook-datum! T (list n
|
||||
(/ (/ run-duration-ms 1000.0) event-count)
|
||||
(/ event-count (/ run-duration-ms 1000.0))
|
||||
(/ (/ run-duration-ms 1000.0) n)
|
||||
(/ n (/ run-duration-ms 1000.0))
|
||||
event-count
|
||||
run-duration-ms))))
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Measurement of presence processing.
|
||||
;; Peers observe just one distinguished peer, and do not process resulting routing events.
|
||||
|
||||
(require logbook)
|
||||
|
||||
(provide run)
|
||||
|
||||
(assertion-struct client ())
|
||||
|
||||
(define (run #:peer-count [peer-count 100] #:client-first? [client-first? #f])
|
||||
(define event-count 0)
|
||||
|
||||
(define-values (results cpu-total-ms wall-ms cpu-gc-ms)
|
||||
(time-apply
|
||||
(lambda ()
|
||||
(test-case
|
||||
[(define (spawn-client)
|
||||
(spawn (assert (client))))
|
||||
|
||||
(define (spawn-server id)
|
||||
(spawn (on (asserted (client))
|
||||
(set! event-count (+ event-count 1)))))
|
||||
|
||||
(define (spawn-servers)
|
||||
(for [(id (in-range (- peer-count 1)))]
|
||||
(spawn-server id)))
|
||||
|
||||
(if client-first?
|
||||
(begin (spawn-client) (spawn-servers))
|
||||
(begin (spawn-servers) (spawn-client)))]))
|
||||
'()))
|
||||
|
||||
(values event-count (max 1 (- cpu-total-ms cpu-gc-ms))))
|
||||
|
||||
(module+ main
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "observe-some-imperative-syndicate"))
|
||||
(define T-client-first (logbook-table E "presence-processing-narrow-client-first"
|
||||
#:column-spec '(number-of-peers
|
||||
secs/routing-update
|
||||
routing-updates/sec
|
||||
secs/peer
|
||||
peers/sec
|
||||
event-count
|
||||
run-duration-ms)))
|
||||
(define T-client-last (logbook-table E "presence-processing-narrow-client-last"
|
||||
#:column-spec '(number-of-peers
|
||||
secs/routing-update
|
||||
routing-updates/sec
|
||||
secs/peer
|
||||
peers/sec
|
||||
event-count
|
||||
run-duration-ms)))
|
||||
;; Warmup
|
||||
(let ()
|
||||
(run #:peer-count 1)
|
||||
(run #:peer-count 10)
|
||||
(void))
|
||||
;; Real run
|
||||
(for ((n
|
||||
#;(list 5)
|
||||
(list* 2 5
|
||||
(let loop ((n 10))
|
||||
(if (>= n 100000)
|
||||
'()
|
||||
(cons (inexact->exact (round n))
|
||||
(loop (* n (sqrt (sqrt 2))))))))
|
||||
))
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(for ((client-first? (list #t #f)))
|
||||
(define-values (event-count run-duration-ms)
|
||||
(run #:peer-count n #:client-first? client-first?))
|
||||
(write-logbook-datum! (if client-first? T-client-first T-client-last)
|
||||
(list n
|
||||
(/ (/ run-duration-ms 1000.0) event-count)
|
||||
(/ event-count (/ run-duration-ms 1000.0))
|
||||
(/ (/ run-duration-ms 1000.0) n)
|
||||
(/ n (/ run-duration-ms 1000.0))
|
||||
event-count
|
||||
run-duration-ms)))))
|
||||
|
|
@ -14,14 +14,20 @@ racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --uv
|
|||
## racket external-latency.rkt --max-waypoint $MAX_MINIMART_WAYPOINT --minimart ## don't bother
|
||||
racket external-latency.rkt --max-waypoint $MAX_MINIMART_WAYPOINT --minimart+tcp
|
||||
racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --prospect+tcp
|
||||
racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --imperative-syndicate+tcp
|
||||
racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --racket
|
||||
|
||||
racket internal-latency.rkt
|
||||
racket internal-latency-prospect.rkt
|
||||
racket internal-latency-imperative-syndicate.rkt
|
||||
|
||||
racket broadcast-latency-prospect.rkt
|
||||
racket broadcast-latency-imperative-syndicate.rkt
|
||||
|
||||
racket observe-all-minimart.rkt
|
||||
racket observe-all-prospect.rkt
|
||||
racket observe-all-imperative-syndicate.rkt
|
||||
|
||||
racket observe-some-minimart.rkt
|
||||
racket observe-some-prospect.rkt
|
||||
racket observe-some-imperative-syndicate.rkt
|
||||
|
|
|
|||
|
|
@ -0,0 +1,56 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Measurement of presence processing.
|
||||
;; Peers observe each other, AND ALSO process the resulting routing events.
|
||||
|
||||
(require logbook)
|
||||
|
||||
(assertion-struct presence (id))
|
||||
|
||||
(define (run #:peer-count [peer-count 100])
|
||||
(define event-count 0)
|
||||
(define start-time (current-inexact-milliseconds))
|
||||
(test-case [(for [(id (in-range peer-count))]
|
||||
(spawn (assert (presence id))
|
||||
(field [peer-count 0])
|
||||
(on (asserted (presence $peer))
|
||||
(set! event-count (+ event-count 1))
|
||||
(peer-count (+ (peer-count) 1)))))])
|
||||
(define stop-time (current-inexact-milliseconds))
|
||||
(define delta (- stop-time start-time))
|
||||
(values event-count delta))
|
||||
|
||||
(module+ main
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "sum-all-imperative-syndicate"))
|
||||
(define T (logbook-table E "presence-processing"
|
||||
#:column-spec '(number-of-peers
|
||||
secs/event
|
||||
events/sec
|
||||
secs/peer
|
||||
peers/sec
|
||||
event-count
|
||||
run-duration-ms)))
|
||||
;; Warmup
|
||||
(let ()
|
||||
(run #:peer-count 1)
|
||||
(run #:peer-count 10)
|
||||
(void))
|
||||
;; Real run
|
||||
(for ((n
|
||||
(list* 1 2 5
|
||||
(let loop ((n 10))
|
||||
(if (>= n 1000)
|
||||
'()
|
||||
(cons (inexact->exact (round n))
|
||||
(loop (* n (sqrt (sqrt 2))))))))
|
||||
))
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(define-values (event-count run-duration-ms) (run #:peer-count n))
|
||||
(write-logbook-datum! T (list n
|
||||
(/ (/ run-duration-ms 1000.0) event-count)
|
||||
(/ event-count (/ run-duration-ms 1000.0))
|
||||
(/ (/ run-duration-ms 1000.0) n)
|
||||
(/ n (/ run-duration-ms 1000.0))
|
||||
event-count
|
||||
run-duration-ms))))
|
||||
Loading…
Reference in New Issue