WIP
This commit is contained in:
parent
1216fba58b
commit
6a00f105af
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue