This commit is contained in:
Tony Garnock-Jones 2016-03-14 08:29:33 -04:00
parent 1216fba58b
commit 6a00f105af
1 changed files with 27 additions and 18 deletions

View File

@ -9,29 +9,38 @@
(struct ping (src dst timestamp) #:transparent) (struct ping (src dst timestamp) #:transparent)
;; (define (current-microseconds)
;; (* (current-inexact-milliseconds) 1000.0))
(define (current-microseconds)
(modulo (* (current-inexact-milliseconds) 1000.0) 1000000000))
;; (define (current-microseconds)
;; (truncate (modulo (* (current-inexact-milliseconds) 1000.0) 1000000000)))
;; (define (current-microseconds)
;; (inexact->exact (truncate (modulo (* (current-inexact-milliseconds) 1000.0) 1000000000))))
(define (send-ping src dst) (define (send-ping src dst)
(message (ping src dst (current-inexact-milliseconds)))) (message (ping src dst (current-microseconds))))
(define (run #:echoer-count [echoer-count 100] (define (run #:echoer-count [echoer-count 100]
#:run-time [run-time 10000]) #:run-time [run-time 10000])
(define total-latency 0) (define total-latency 0)
(define total-roundtrips 0) (define total-roundtrips 0)
(define boot-start-time (current-inexact-milliseconds)) (define boot-start-time (current-microseconds))
(define run-start-time #f) (define run-start-time #f)
(define (rate-at count) (define (rate-at count)
(/ (* count 2) ;; two messages per roundtrip (/ (* count 2) ;; two messages per roundtrip
(/ total-latency 1000.0) ;; latency in seconds (/ total-latency 1000000.0) ;; latency in seconds
)) ))
(define (pinger src dst) (define (pinger src dst)
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(message 'kickoff) [(message 'kickoff)
(set! run-start-time (current-inexact-milliseconds)) (set! run-start-time (current-microseconds))
(transition s (send-ping src dst))] (transition s (send-ping src dst))]
[(message (ping (== dst) (== src) start-time)) [(message (ping (== dst) (== src) start-time))
(define stop-time (current-inexact-milliseconds)) (define stop-time (current-microseconds))
;; TODO: is there a way of reducing the measurement error here, ;; TODO: is there a way of reducing the measurement error here,
;; perhaps by recording against run-start-time instead of start-time, somehow? ;; perhaps by recording against run-start-time instead of start-time, somehow?
;; TODO: first, characterize the measurement error ;; TODO: first, characterize the measurement error
@ -39,12 +48,12 @@
(set! total-latency (+ total-latency delta)) (set! total-latency (+ total-latency delta))
(set! total-roundtrips (+ total-roundtrips 1)) (set! total-roundtrips (+ total-roundtrips 1))
(when (zero? (modulo total-roundtrips 1000)) (when (zero? (modulo total-roundtrips 1000))
(log-info "After ~a roundtrips, ~a milliseconds; ~a Hz" (log-info "After ~a roundtrips, ~a milliseconds; ~a Hz."
total-roundtrips total-roundtrips
total-latency total-latency
(rate-at total-roundtrips))) (rate-at total-roundtrips)))
(transition s (transition s
(if (< (- stop-time run-start-time) run-time) (if (< (/ (- stop-time run-start-time) 1000.0) run-time)
(send-ping src dst) (send-ping src dst)
'()))] '()))]
[_ #f])) [_ #f]))
@ -71,15 +80,15 @@
(module+ main (module+ main
(define t 10000) (define t 10000)
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "internal-latency-prospect")) ;; (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "internal-latency-prospect"))
(define T (logbook-table E "internal-latency" ;; (define T (logbook-table E "internal-latency"
#:column-spec '(number-of-echoers ;; #:column-spec '(number-of-echoers
secs/msg ;; secs/msg
msgs/sec ;; msgs/sec
boot-delay-ms ;; boot-delay-ms
secs/process-booted ;; secs/process-booted
roundtrip-count ;; roundtrip-count
run-duration-ms))) ;; run-duration-ms)))
;; Warmup ;; Warmup
(let () (let ()
(run #:echoer-count 1 #:run-time 1000) (run #:echoer-count 1 #:run-time 1000)
@ -88,7 +97,7 @@
;; Real run ;; Real run
(for ((n (for ((n
(list* 1 2 5 (list* 1 2 5
(let loop ((n 10)) '()#;(let loop ((n 10))
(if (>= n 30000) (if (>= n 30000)
'() '()
(cons (inexact->exact (round n)) (cons (inexact->exact (round n))
@ -98,7 +107,7 @@
(collect-garbage) (collect-garbage)
(collect-garbage) (collect-garbage)
(define-values (count v boot-delay-ms) (run #:echoer-count n #:run-time t)) (define-values (count v boot-delay-ms) (run #:echoer-count n #:run-time t))
(write-logbook-datum! T (list n (void)#;(write-logbook-datum! T (list n
(/ 1.0 v) (/ 1.0 v)
v v
boot-delay-ms boot-delay-ms