From 13756a448fae0eb55918270cb99addabcabf53cf Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 5 May 2014 13:18:38 -0400 Subject: [PATCH] Better grow-times stats --- echo-client.rkt | 39 +++++++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/echo-client.rkt b/echo-client.rkt index 4b4cf5d..daa05dd 100644 --- a/echo-client.rkt +++ b/echo-client.rkt @@ -37,9 +37,11 @@ (when (not (logbook-machine-info-recorded? E)) (logbook-record-machine-info! E)) (define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count - secs/connection - connections/sec - elapsed-sec + wallclock-secs/connection + connections/wallclock-sec + cpu+gc-sec + wallclock-sec + gc-sec final-count))) (define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count secs/roundtrip @@ -114,18 +116,27 @@ ;; Add connections until we hit the given waypoint. (define (grow-to-waypoint waypoint) (define old-count (connection-count)) - (define start-time (current-inexact-milliseconds)) - (let loop () - (when (< (connection-count) waypoint) - (start-connection) - (loop))) - (ping-connection (- waypoint 1)) ;; make sure the newest connection is really live. - (define grow-complete-time (current-inexact-milliseconds)) - (define elapsed-sec (/ (- grow-complete-time start-time) 1000.0)) + (collect-garbage) + (collect-garbage) + (collect-garbage) + (define-values (ignorable-results cpu+gc-time wallclock-time gc-time) + (time-apply + (lambda () + (let loop () + (when (< (connection-count) waypoint) + (start-connection) + (loop))) + (ping-connection (- waypoint 1))) ;; make sure the newest connection is really live. + '())) + (define cpu+gc-sec (/ cpu+gc-time 1000.0)) + (define wallclock-sec (/ wallclock-time 1000.0)) + (define gc-sec (/ gc-time 1000.0)) (write-logbook-datum! Tgrowth (list old-count - (/ elapsed-sec (- waypoint old-count)) - (/ (- waypoint old-count) elapsed-sec) - elapsed-sec + (/ wallclock-sec (- waypoint old-count)) + (/ (- waypoint old-count) wallclock-sec) + cpu+gc-sec + wallclock-sec + gc-sec waypoint))) (let loop ((remaining-waypoints waypoints))