From 5c4747e56b601f2ba3c81194f6bc35ec55c4dc56 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 1 May 2014 15:04:24 -0400
Subject: [PATCH] Measure internal messaging ping-pong latency

---
 minimart/examples/benchmark/Makefile          |  9 +++
 .../examples/benchmark/internal-latency.rkt   | 74 +++++++++++++++++++
 2 files changed, 83 insertions(+)
 create mode 100644 minimart/examples/benchmark/Makefile
 create mode 100644 minimart/examples/benchmark/internal-latency.rkt

diff --git a/minimart/examples/benchmark/Makefile b/minimart/examples/benchmark/Makefile
new file mode 100644
index 0000000..c6f2fe7
--- /dev/null
+++ b/minimart/examples/benchmark/Makefile
@@ -0,0 +1,9 @@
+all: tmp.csv
+
+clean:
+	rm -f tmp.csv
+	rm -rf compiled
+
+tmp.csv:
+	raco make internal-latency.rkt
+	PLTSTDERR=warning racket internal-latency.rkt | tee $@
diff --git a/minimart/examples/benchmark/internal-latency.rkt b/minimart/examples/benchmark/internal-latency.rkt
new file mode 100644
index 0000000..eace994
--- /dev/null
+++ b/minimart/examples/benchmark/internal-latency.rkt
@@ -0,0 +1,74 @@
+#lang racket/base
+;; Measurement of message delivery latency.
+
+(require racket/match)
+(require "../../main.rkt")
+
+(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 run-start-time (current-inexact-milliseconds))
+
+  (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 (ping (== dst) (== src) start-time) _ _)
+		(define stop-time (current-inexact-milliseconds))
+		(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
+	   (list (sub (ping dst src ?))
+		 (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
+	   (list (sub (ping ? id ?))
+		 (pub (ping id ? ?)))))
+
+  (begin
+    (run-ground (for/list [(id (in-range echoer-count))] (echoer id))
+		(pinger echoer-count 0)
+		(send-ping echoer-count 0))
+    (values total-roundtrips (rate-at total-roundtrips))))
+
+(module+ main
+  (define t 5000)
+  (printf "Num echoers,Run duration (ms),Num roundtrips,Msgs/sec,Sec/msg\n")
+  (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
+	       600 800)
+	 ))
+    (collect-garbage)
+    (collect-garbage)
+    (collect-garbage)
+    (define-values (count v) (run #:echoer-count n #:run-time t))
+    (printf "~a,~a,~a,~a,~a\n" n t count v (/ 1.0 v))
+    (flush-output)))