minimart-benchmark-2017/internal-latency-symbols-no...

109 lines
3.2 KiB
Racket

#lang racket/base
;; Measurement of message delivery latency.
(require racket/match)
(require minimart)
(require logbook)
(provide run)
(struct ping (src dst timestamp) #:transparent)
(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
))
(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 (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 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
(gestalt-union (sub (ping dst src ?))
(sub 'kickoff)
(pub (ping src dst ?)))))
(define (echoer id)
(spawn (lambda (e s)
(match e
[(message (ping src (== id) stamp) _ _)
(transition s (send (ping id src stamp)))]
[_ #f]))
#f
(gestalt-union (sub (ping ? id ?))
(pub (ping id ? ?)))))
(begin
(run-ground (echoer 'base)
(for/list [(id (in-range (- echoer-count 1)))] (echoer (gensym 'ballast)))
(pinger 'pinger 'base)
(send '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" "internal-latency-symbols-not-fixnums"))
(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))))