diff --git a/internal-latency-symbols-not-fixnums.rkt b/internal-latency-symbols-not-fixnums.rkt new file mode 100644 index 0000000..c32236a --- /dev/null +++ b/internal-latency-symbols-not-fixnums.rkt @@ -0,0 +1,105 @@ +#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 5000) + (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 10 20 30 40 50 60 70 80 90 100 120 + 150 200 210 220 230 240 250 260 270 280 290 300 400 + 500 600 700 800 900 1000) + )) + (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))))