From 648ff57e303fac2288a50f873939779924f9725b Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Wed, 18 Mar 2015 16:13:58 -0400
Subject: [PATCH] Prospect variant of internal-latency test

---
 internal-latency-prospect.rkt | 104 ++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)
 create mode 100644 internal-latency-prospect.rkt

diff --git a/internal-latency-prospect.rkt b/internal-latency-prospect.rkt
new file mode 100644
index 0000000..f15827c
--- /dev/null
+++ b/internal-latency-prospect.rkt
@@ -0,0 +1,104 @@
+#lang racket/base
+;; Measurement of message delivery latency.
+
+(require racket/match)
+(require prospect)
+(require logbook)
+
+(provide run)
+
+(struct ping (src dst 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 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
+           (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 (message (ping id src stamp)))]
+	       [_ #f]))
+	   #f
+	   (sub (ping ? id ?))
+           (pub (ping id ? ?))))
+
+  (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 5000)
+  (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "internal-latency-prospect"))
+  (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))))