Broadcast measurements
This commit is contained in:
parent
b38eb42d77
commit
af178f6497
|
@ -0,0 +1,111 @@
|
|||
#lang racket/base
|
||||
;; Measurement of *broadcast* message delivery latency.
|
||||
|
||||
(require racket/match)
|
||||
(require prospect)
|
||||
(require logbook)
|
||||
|
||||
(provide run)
|
||||
|
||||
(struct ping (src dst timestamp) #:transparent)
|
||||
(struct pong (timestamp) #:transparent)
|
||||
|
||||
(define (send-ping src dst)
|
||||
(message (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
|
||||
))
|
||||
|
||||
(define (pinger src dst)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message 'kickoff)
|
||||
(set! run-start-time (current-inexact-milliseconds))
|
||||
(transition s (send-ping src dst))]
|
||||
[(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 1000))
|
||||
(log-info "After ~a roundtrips, ~a milliseconds; ~a Hz"
|
||||
total-roundtrips
|
||||
total-latency
|
||||
(rate-at total-roundtrips)))
|
||||
(transition s
|
||||
(if (< (- stop-time run-start-time) run-time)
|
||||
(send-ping src dst)
|
||||
'()))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(sub (pong ?))
|
||||
(sub 'kickoff)
|
||||
(pub (ping src dst ?))))
|
||||
|
||||
(define (echoer id)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (ping src (== id) stamp))
|
||||
(transition s (message (pong stamp)))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(sub (ping ? ? ?))
|
||||
(pub (pong ?))))
|
||||
|
||||
(begin
|
||||
(run-ground (for/list [(id (in-range echoer-count))] (echoer id))
|
||||
(pinger echoer-count 0)
|
||||
(message 'kickoff))
|
||||
(values total-roundtrips (rate-at total-roundtrips) (- run-start-time boot-start-time))))
|
||||
|
||||
(module+ main
|
||||
(define t 10000)
|
||||
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "broadcast-latency-prospect"))
|
||||
(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))))
|
|
@ -18,6 +18,7 @@ racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --racket
|
|||
|
||||
racket internal-latency.rkt
|
||||
racket internal-latency-prospect.rkt
|
||||
racket broadcast-latency-prospect.rkt
|
||||
|
||||
racket observe-all-minimart.rkt
|
||||
racket observe-all-prospect.rkt
|
||||
|
|
Loading…
Reference in New Issue