93 lines
3.3 KiB
Racket
93 lines
3.3 KiB
Racket
#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))))
|