Better grow-times stats

This commit is contained in:
Tony Garnock-Jones 2014-05-05 13:18:38 -04:00
parent ffc9835ad6
commit 13756a448f
1 changed files with 25 additions and 14 deletions

View File

@ -37,9 +37,11 @@
(when (not (logbook-machine-info-recorded? E)) (when (not (logbook-machine-info-recorded? E))
(logbook-record-machine-info! E)) (logbook-record-machine-info! E))
(define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count (define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count
secs/connection wallclock-secs/connection
connections/sec connections/wallclock-sec
elapsed-sec cpu+gc-sec
wallclock-sec
gc-sec
final-count))) final-count)))
(define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count (define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count
secs/roundtrip secs/roundtrip
@ -114,18 +116,27 @@
;; Add connections until we hit the given waypoint. ;; Add connections until we hit the given waypoint.
(define (grow-to-waypoint waypoint) (define (grow-to-waypoint waypoint)
(define old-count (connection-count)) (define old-count (connection-count))
(define start-time (current-inexact-milliseconds)) (collect-garbage)
(let loop () (collect-garbage)
(when (< (connection-count) waypoint) (collect-garbage)
(start-connection) (define-values (ignorable-results cpu+gc-time wallclock-time gc-time)
(loop))) (time-apply
(ping-connection (- waypoint 1)) ;; make sure the newest connection is really live. (lambda ()
(define grow-complete-time (current-inexact-milliseconds)) (let loop ()
(define elapsed-sec (/ (- grow-complete-time start-time) 1000.0)) (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 (write-logbook-datum! Tgrowth (list old-count
(/ elapsed-sec (- waypoint old-count)) (/ wallclock-sec (- waypoint old-count))
(/ (- waypoint old-count) elapsed-sec) (/ (- waypoint old-count) wallclock-sec)
elapsed-sec cpu+gc-sec
wallclock-sec
gc-sec
waypoint))) waypoint)))
(let loop ((remaining-waypoints waypoints)) (let loop ((remaining-waypoints waypoints))