96 lines
3.3 KiB
Racket
96 lines
3.3 KiB
Racket
#lang racket
|
|
|
|
(require prospect/route)
|
|
(require logbook)
|
|
|
|
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "routes-size"))
|
|
(define Ttime (logbook-table E "timing"
|
|
#:column-spec '(initial-count
|
|
wallclock-secs/entry
|
|
entries/wallclock-sec
|
|
cpu+gc-sec
|
|
wallclock-sec
|
|
gc-sec
|
|
final-count)))
|
|
(define T (logbook-table E "measurements"
|
|
#:column-spec '(number-of-entries
|
|
bytes-per-entry
|
|
current-memory-use)))
|
|
(define Tprobe (logbook-table E "probe-rate"
|
|
#:column-spec '(number-of-entries
|
|
positive-probes-per-second
|
|
negative-probes-per-second
|
|
large-positive-per-second
|
|
seconds-per-positive-probe
|
|
seconds-per-negative-probe
|
|
seconds-per-large-positive)))
|
|
|
|
(define *the-routes* #f)
|
|
(define *count* 0)
|
|
(define *zero-datapoint* #f)
|
|
|
|
(define (record-datapoint!)
|
|
(collect-garbage)
|
|
(collect-garbage)
|
|
(collect-garbage)
|
|
(define latest-datapoint (current-memory-use))
|
|
(define n *count*)
|
|
(when (not *zero-datapoint*) (set! *zero-datapoint* latest-datapoint))
|
|
(define delta (- latest-datapoint *zero-datapoint*))
|
|
(define perentry (/ delta (exact->inexact n)))
|
|
(write-logbook-datum! T (list n perentry latest-datapoint)))
|
|
|
|
(define (run-probes!)
|
|
(define n-probes 100000)
|
|
(define-syntax-rule (probe message-expr)
|
|
(let-values (((ignorable-results cpu+gc-time wallclock-time gc-time)
|
|
(time-apply
|
|
(lambda ()
|
|
(let loop ((i 0))
|
|
(when (< i n-probes)
|
|
(trie-lookup *the-routes* message-expr)
|
|
(loop (+ i 1)))))
|
|
'())))
|
|
(/ n-probes (/ wallclock-time 1000.0))))
|
|
(define positive-probes-per-second (probe (list (random *count*) "hello")))
|
|
(define large-list (make-list 1000 'x))
|
|
(define large-positive-per-second (probe (list (random *count*) large-list)))
|
|
(define negative-probes-per-second (probe (list "hello" (random *count*))))
|
|
(write-logbook-datum! Tprobe (list *count*
|
|
positive-probes-per-second
|
|
negative-probes-per-second
|
|
large-positive-per-second
|
|
(/ positive-probes-per-second)
|
|
(/ negative-probes-per-second)
|
|
(/ large-positive-per-second))))
|
|
|
|
(record-datapoint!)
|
|
(let loop ((next-count 1000))
|
|
(when (< next-count 500000)
|
|
(define old-count *count*)
|
|
(define-values (ignorable-results cpu+gc-time wallclock-time gc-time)
|
|
(time-apply
|
|
(lambda ()
|
|
(let inner-loop ()
|
|
(when (< *count* next-count)
|
|
(set! *the-routes* (trie-union *the-routes*
|
|
(pattern->trie *count* (list *count* ?))))
|
|
(set! *count* (+ *count* 1))
|
|
(inner-loop))))
|
|
'()))
|
|
(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! Ttime (list old-count
|
|
(/ wallclock-sec (- next-count old-count))
|
|
(and (positive? wallclock-sec)
|
|
(/ (- next-count old-count) wallclock-sec))
|
|
cpu+gc-sec
|
|
wallclock-sec
|
|
gc-sec
|
|
next-count))
|
|
|
|
(record-datapoint!)
|
|
(run-probes!)
|
|
(loop (inexact->exact (truncate (* next-count 1.2))))))
|