Changeset 39356 in project


Ignore:
Timestamp:
11/24/20 00:06:04 (8 weeks ago)
Author:
Kon Lovett
Message:

add glossed support echoing saved results, fix per100ms count

Location:
release/5/micro-benchmark/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/micro-benchmark/trunk/micro-benchmark.scm

    r39350 r39356  
    1313  (benchmark-ips generate-statistics)
    1414  run-benchmark-ips
    15   *iterations-overhead*
    16   ;DEPRECATED
    17   %gettime/microsecs )
     15  *iterations-overhead*)
    1816
    1917(import scheme
     
    140138(: current-benchmark-statistics-set (#!optional statistics-set-id -> statistics-set-id))
    141139(: run-benchmark-ips (procedure #!optional (or false real) (or false real) -> runtimes))
    142 (: iterations-per-100ms (procedure real -> real real))
     140(: iterations-per-100ms (procedure real -> fixnum real))
    143141
    144142;;;
     
    147145(define (secs->ÎŒs secs) (* secs 1000000.0))
    148146
     147(define (ÎŒs->ms ÎŒs) (/ ÎŒs 1000.0))
     148(define (ÎŒs->secs ÎŒs) (/ ÎŒs 1000000.0))
     149
    149150(define (ms->ÎŒs ms) (* ms 1000.0))
    150 (define (ÎŒs->ms ÎŒs) (/ ÎŒs 1000.0))
    151151
    152152;;
     
    191191;;
    192192
    193 (define (*realtime-microsecs loc)
     193(define (*realtime-microsecs)
    194194  (let ((ÎŒs (realtime-microsecs)))
    195     (when (negative? ÎŒs) (warning loc "cannot retrieve time reliably" ÎŒs))
     195    (when (negative? ÎŒs) (warning "cannot retrieve time reliably"))
    196196    ÎŒs ) )
    197197
     
    200200    ((benchmark-measure ?code ...)
    201201      (let* (
    202         (start  (*realtime-microsecs 'benchmark-measure))
     202        (start  (*realtime-microsecs))
    203203        (result (begin ?code ...))
    204         (stop   (*realtime-microsecs 'benchmark-measure)) )
     204        (stop   (*realtime-microsecs)) )
    205205        (- stop start) ) ) ) )
    206206
     
    306306    (let-values (
    307307      ((per-100ms _) (iterations-per-100ms thunk (secs->ms warmups)))
    308       ((threshold) (+ (*realtime-microsecs 'run-benchmark-ips) (secs->ÎŒs seconds))) )
    309       (let loop ((iterations 0) (timings (list)))
    310         (if (< (*realtime-microsecs 'run-benchmark-ips) threshold)
    311           (let ((before (*realtime-microsecs 'run-benchmark-ips)))
     308      ((threshold) (+ (*realtime-microsecs) (secs->ÎŒs seconds))) )
     309      (let loop ((iterations (the fixnum 0)) (timings (list)))
     310        (if (< (*realtime-microsecs) threshold)
     311          (let ((before (*realtime-microsecs)))
    312312            ;NOTE this will run at least once, so long as per-100ms > 0
    313313            (dotimes (_ per-100ms) (thunk))
    314             (let ((after (*realtime-microsecs 'run-benchmark-ips)))
     314            (let ((after (*realtime-microsecs)))
    315315              (loop (+ iterations per-100ms) (cons (- after before) timings))))
    316           ;timings
    317           ;#; ;???
    318           (map (lambda (i) (print "i = " i) (* per-100ms (/ (ÎŒs->ms i) 100.0)) (* 10.0 per-100ms)) timings) ) ) ) ) )
     316          (map (lambda (i) (/ per-100ms (ÎŒs->secs i))) timings) ) ) ) ) )
    319317
    320318;;
     
    324322;calc any overhead
    325323(define-constant OVERHEAD-ITERATIONS 10000000)
    326 (let ((before (*realtime-microsecs 'iterations-overhead)))
     324(let ((before (*realtime-microsecs)))
    327325  (dotimes (_ OVERHEAD-ITERATIONS) (void))
    328326  (set! *iterations-overhead*
    329     (/ (- (*realtime-microsecs 'iterations-overhead) before) OVERHEAD-ITERATIONS)) )
     327    (/ (- (*realtime-microsecs) before) OVERHEAD-ITERATIONS)) )
    330328
    331329;@thunk benchmark procedure
     
    334332(define (iterations-per-100ms thunk limit)
    335333  (let* (
    336     (before (*realtime-microsecs 'iterations-per-100ms))
     334    (before (*realtime-microsecs))
    337335    (threshold (+ before (ms->ÎŒs limit))) )
    338336    (let loop ((iterations (the fixnum 0)))
    339       (let ((after (*realtime-microsecs 'iterations-per-100ms)))
     337      (let ((after (*realtime-microsecs)))
    340338        (cond
    341339          ((< after threshold)
     
    346344              (overhead (* iterations *iterations-overhead*))
    347345              (total-time (- after before overhead))
    348               (per-100ms (* (/ iterations total-time) (ms->ÎŒs 100.0))) )
    349 (print "overhead = " overhead)
    350 (print "iterations = " iterations)
    351 (print "total-time = " total-time)
    352 (print "per-100ms = " per-100ms)
    353               (values (max 0.0 per-100ms) (max 0.0 total-time)) ) ) ) ) ) ) )
    354 
    355 ;;DEPRECATED
    356 
    357 (: %gettime/microsecs (deprecated realtime-microsecs))
    358 (define %gettime/microsecs realtime-microsecs)
     346              (per-100ms (inexact->exact (round (* (/ iterations total-time) (ms->ÎŒs 100.0))))) )
     347              (values (max 1 per-100ms) total-time) ) ) ) ) ) ) )
    359348
    360349) ;module micro-benchmark
  • release/5/micro-benchmark/trunk/tests/micro-benchmark-test.scm

    r39350 r39356  
    33(import test)
    44(include "test-gloss.incl")
     5
     6(define glossed
     7  (let ((saved #f))
     8    (lambda (#!optional (x (void)))
     9      (if (eq? x (void))
     10        (gloss saved)
     11        (begin (set! saved x) x)))))
    512
    613(test-begin "micro-benchmark")
     
    1522(test-begin "micro-benchmark")
    1623
    17 (test-assert *iterations-overhead*)
    18 (gloss *iterations-overhead*)
     24(test-assert (glossed *iterations-overhead*))
     25(glossed)
    1926
    2027(test-group "examples"
    2128  (import (only (chicken base) sleep))
     29
    2230  ;simply measure the runtime of the given fragment
    23   (gloss "(benchmark-measure (sleep 2))")
    24   (gloss (benchmark-measure (sleep 2)))
     31  (test-assert (glossed (benchmark-measure (sleep 2))))
     32  (glossed)
     33
    2534  ;run code 3 times and return results
    26   (gloss "(gloss (benchmark-run (sleep 1)))")
    2735  (parameterize ((current-benchmark-iterations 3))
    28     (gloss (benchmark-run (sleep 1))))
     36    (test-assert (glossed (benchmark-run (sleep 1))))
     37    (glossed))
     38
    2939  ;find out how many iterations we can make per second
    30   (gloss "(benchmark-ips (sleep 2))")
    31   (gloss (benchmark-ips (sleep 2)))
     40  (test-assert (glossed (benchmark-ips (sleep 2))))
     41  (glossed)
    3242)
    3343
     
    4858              (benchmark-measure-run (begin (busy-work) 'test)))) )
    4959          (generate-statistics runs (current-benchmark-statistics-set)))) )
    50       (gloss stats)
     60      #;(gloss stats)
    5161      (bigO-stats-tests 1000000.0 stats '(
    5262        max min
     
    5666    (let ((stats (benchmark-run (1) #t)))
    5767      (test "deviation for a single result" 0.0 (stats-item sd stats))
    58       (gloss stats) )
     68      #;(gloss stats) )
    5969  )
    6070)
Note: See TracChangeset for help on using the changeset viewer.