Changeset 39350 in project


Ignore:
Timestamp:
11/23/20 17:17:05 (5 months ago)
Author:
Kon Lovett
Message:

use clock_gettime_nsec_np for macos, current-benchmark-statistics-set-id -> current-benchmark-statistics-set, list-tabulate used by benchmark-measure-run, always check microsecs stability, microsecond grain

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

Legend:

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

    r39344 r39350  
     1
     2(foreign-declare "#include <time.h>")
     3(define realtime-microsecs (foreign-lambda* double ()
     4  "uint64_t time = clock_gettime_nsec_np(CLOCK_UPTIME_RAW);
     5  return( ((double) time) / 1000.0 );"))
     6
     7#|
    18(foreign-declare "#include <mach/mach_time.h>")
    29
     
    2027  (when (< %factor 0.0)
    2128    (error 'macosx-realtime-microsecs "cannot determine scale factor") ) )
     29|#
  • release/5/micro-benchmark/trunk/micro-benchmark.scm

    r39347 r39350  
    55(;export
    66  bigO bigO= bigO< bigO-compare
    7   realtime-microsecs
    87  current-benchmark-iterations
    9   current-benchmark-statistics-set-id
    10   benchmark-measure
    11   benchmark-measure-run
     8  current-benchmark-statistics-set
     9  (benchmark-measure *realtime-microsecs)
     10  (benchmark-measure-run list-tabulate)
    1211  benchmark-measure-ips
    1312  (benchmark-run generate-statistics)
    1413  (benchmark-ips generate-statistics)
    15   run-benchmark-measure
    1614  run-benchmark-ips
    1715  *iterations-overhead*
     
    2422  (chicken syntax)
    2523  (chicken foreign)
    26   (only (chicken time) current-milliseconds)
    27   (only (srfi 1) list-tabulate first)
     24  (only (srfi 1) list-tabulate)
    2825  micro-stats)
    2926
     
    3734  (else
    3835    (error "unsupported platform") ) )
    39 
    40 ;;;
    41 
    42 (define-type real (or integer float ratnum))
    43 
    44 (define-type statistics-alist (or null (list-of (pair symbol *))))
    45 
    46 (define-type runtimes (list-of number))
    47 
    48 (define-type statistics-set-id (or symbol boolean))
    49 
    50 (: current-benchmark-iterations (#!optional fixnum -> fixnum))
    51 (: current-benchmark-statistics-set-id (#!optional statistics-set-id -> statistics-set-id))
    52 ;(: benchmark-measure (sexp -> number))
    53 ;(: benchmark-measure-run (sexp -> number))
    54 ;(: benchmark-measure-ips (sexp -> runtimes))
    55 ;(: benchmark-run (sexp -> (or boolean statistics-alist)))
    56 ;(: benchmark-ips (sexp -> (or boolean statistics-alist)))
    57 (: run-benchmark-measure (procedure -> number))
    58 (: run-benchmark-ips (procedure #!optional (or false real) (or false real) -> runtimes))
    59 (: iterations-per-100ms (procedure real -> fixnum number))
    6036
    6137;;;
     
    147123;;;
    148124
    149 (define (secs->ms secs) (* secs 1000))
    150 
    151 (define (->exact x) (inexact->exact (round x)))
    152 
    153 ;;
    154 
    155 (define (statistics-set-id? obj) (or (symbol? obj) (boolean? obj)))
     125(define-type real (or integer float ratnum))
     126
     127(define-type statistics-alist (or null (list-of (pair symbol *))))
     128
     129(define-type statistics-set-id (or symbol boolean))
     130
     131(define-type runtimes (list-of real))
     132
     133;(: benchmark-measure (sexp -> number))
     134;(: benchmark-measure-run (sexp -> runtimes))
     135;(: benchmark-measure-ips (sexp -> (list-of real)))
     136;(: benchmark-run (sexp -> (or boolean statistics-alist)))
     137;(: benchmark-ips (sexp -> (or boolean statistics-alist)))
     138
     139(: current-benchmark-iterations (#!optional fixnum -> fixnum))
     140(: current-benchmark-statistics-set (#!optional statistics-set-id -> statistics-set-id))
     141(: run-benchmark-ips (procedure #!optional (or false real) (or false real) -> runtimes))
     142(: iterations-per-100ms (procedure real -> real real))
     143
     144;;;
     145
     146(define (secs->ms secs) (* secs 1000.0))
     147(define (secs->ÎŒs secs) (* secs 1000000.0))
     148
     149(define (ms->ÎŒs ms) (* ms 1000.0))
     150(define (ÎŒs->ms ÎŒs) (/ ÎŒs 1000.0))
     151
     152;;
     153
     154(define (statistics-set-id? obj)
     155  (or (boolean? obj) (eq? obj 'verbose) (eq? obj 'normal)) )
     156
     157(define (check-statistics-set-id loc obj . args)
     158  (unless (statistics-set-id? obj)
     159    (error-fixnum loc obj (let ((tmp args)) (if (null? tmp) #f (car tmp)))) )
     160  obj )
     161
     162(define (error-statistics-set-id loc obj #!optional argnam)
     163  (import (only (chicken string) conc))
     164  (##sys#signal-hook #:type-error loc
     165    (string-append
     166      (if (not argnam) "bad argument" (conc "bad `" argnam "' argument"))
     167      " type - not " "an " "statistics-set-id")
     168    obj) )
    156169
    157170;;
     
    159172(define-constant INITIAL-ITERATIONS 100)
    160173
    161 (define-constant DEFAULT-THRESHOLDS 5)
     174(define-constant DEFAULT-SECONDS 5)
    162175(define-constant DEFAULT-WARMUPS 2)
    163176
     
    165178
    166179(define (bigO a) (round (log10 a)))
     180
    167181(define (bigO< a b) (< (bigO a) (bigO b)))
    168182(define (bigO= a b) (= (bigO a) (bigO b)))
     
    173187(define-checked-parameter current-benchmark-iterations INITIAL-ITERATIONS fixnum)
    174188
    175 (define-checked-parameter current-benchmark-statistics-set-id #f statistics-set-id)
    176 
    177 ;;
     189(define-checked-parameter current-benchmark-statistics-set #f statistics-set-id)
     190
     191;;
     192
     193(define (*realtime-microsecs loc)
     194  (let ((ÎŒs (realtime-microsecs)))
     195    (when (negative? ÎŒs) (warning loc "cannot retrieve time reliably" ÎŒs))
     196    ÎŒs ) )
    178197
    179198(define-syntax benchmark-measure
    180199  (syntax-rules ()
    181200    ((benchmark-measure ?code ...)
    182       (let (
    183         (start  (realtime-microsecs))
     201      (let* (
     202        (start  (*realtime-microsecs 'benchmark-measure))
    184203        (result (begin ?code ...))
    185         (stop   (realtime-microsecs)) )
    186         (when (or (< start 0) (< stop 0))
    187           (warning 'benchmark-measure "cannot retrieve time reliably" start stop))
     204        (stop   (*realtime-microsecs 'benchmark-measure)) )
    188205        (- stop start) ) ) ) )
    189206
     
    191208;; returns an alist with statistics
    192209
     210(define-syntax benchmark-measure-run
     211  (syntax-rules ()
     212    ;
     213    ((benchmark-measure-run (begin ?code ...))
     214     (benchmark-measure-run () ?code ...) )
     215    ;
     216    ((benchmark-measure-run () ?code0 ?code1 ...)
     217      (benchmark-measure-run ((current-benchmark-iterations)) ?code0 ?code1 ...) )
     218    ;
     219    ((benchmark-measure-run (?tabs) ?code0 ?code1 ...)
     220      (list-tabulate ?tabs (lambda _ (benchmark-measure ?code0 ?code1 ...)) ) ) ) )
     221
    193222(define-syntax benchmark-run
    194223  (syntax-rules ()
     
    198227    ;
    199228    ((benchmark-run (?tabs) ?code0 ?code1 ...)
    200       (benchmark-run (?tabs (current-benchmark-statistics-set-id)) ?code0 ?code1 ...) )
    201     ;
    202     ((benchmark-run (#t ?stat-set-id) ?code0 ?code1 ...)
    203       (benchmark-run ((current-benchmark-iterations) ?stat-set-id) ?code0 ?code1 ...) )
    204     ;
    205     ((benchmark-run (?tabs ?stat-set-id) ?code0 ?code1 ...)
     229      (benchmark-run (?tabs (current-benchmark-statistics-set)) ?code0 ?code1 ...) )
     230    ;
     231    ((benchmark-run (#t ?stat-set) ?code0 ?code1 ...)
     232      (benchmark-run ((current-benchmark-iterations) ?stat-set) ?code0 ?code1 ...) )
     233    ;
     234    ((benchmark-run (?tabs ?stat-set) ?code0 ?code1 ...)
    206235      (let ((observed (benchmark-measure-run (?tabs) ?code0 ?code1 ...)))
    207         (generate-statistics observed ?stat-set-id) ) )
     236        (generate-statistics observed ?stat-set) ) )
    208237    ;C4 API
    209238    ((benchmark-run ?code)
     
    212241    ((benchmark-run ?iters ?code)
    213242      (benchmark-run (?iters) ?code) ) ) )
    214 
    215 (define-syntax benchmark-measure-run
    216   (syntax-rules ()
    217     ;
    218     ((benchmark-measure-run (begin ?code ...))
    219      (benchmark-measure-run () ?code ...) )
    220     ;
    221     ((benchmark-measure-run () ?code0 ?code1 ...)
    222       (benchmark-measure-run ((current-benchmark-iterations)) ?code0 ?code1 ...) )
    223     ;
    224     ((benchmark-measure-run (?tabs) ?code0 ?code1 ...)
    225       (list-tabulate ?tabs (lambda _ (benchmark-measure ?code0 ?code1 ...)) ) ) ) )
    226243
    227244;; benchmarking that tries to find out how many times your code can run in a given
     
    234251;;
    235252
     253(define-syntax benchmark-measure-ips
     254  (syntax-rules ()
     255    ;
     256    ((benchmark-measure-ips () ?code0 ?code1 ...)
     257     (benchmark-measure-ips (#f) ?code0 ?code1 ...) )
     258    ;
     259    ((benchmark-measure-ips (?seconds) ?code0 ?code1 ...)
     260     (benchmark-measure-ips (?seconds #f) ?code0 ?code1 ...) )
     261    ;
     262    ((benchmark-measure-ips (?seconds ?warmups) ?code0 ?code1 ...)
     263      (run-benchmark-ips (lambda () ?code0 ?code1 ...) ?seconds ?warmups) ) ) )
     264
    236265(define-syntax benchmark-ips
    237266  (syntax-rules ()
     
    240269     (benchmark-ips (#f) ?code0 ?code1 ...) )
    241270    ;
    242     ((benchmark-ips (?thresholds) ?code0 ?code1 ...)
    243      (benchmark-ips (?thresholds #f) ?code0 ?code1 ...) )
    244     ;
    245     ((benchmark-ips (?thresholds ?warmups) ?code0 ?code1 ...)
    246       (benchmark-ips (?thresholds ?warmups (current-benchmark-statistics-set-id)) ?code0 ?code1 ...) )
    247     ;
    248     ((_ (?thresholds ?warmups ?stat-set-id) ?code0 ?code1 ...)
    249       (let ((observed (benchmark-measure-ips (?thresholds ?warmups) ?code0 ?code1 ...)))
    250         (generate-statistics observed ?stat-set-id) ) )
     271    ((benchmark-ips (?seconds) ?code0 ?code1 ...)
     272     (benchmark-ips (?seconds #f) ?code0 ?code1 ...) )
     273    ;
     274    ((benchmark-ips (?seconds ?warmups) ?code0 ?code1 ...)
     275      (benchmark-ips (?seconds ?warmups (current-benchmark-statistics-set)) ?code0 ?code1 ...) )
     276    ;
     277    ((benchmark-ips (?seconds ?warmups ?stat-set) ?code0 ?code1 ...)
     278      (let ((observed (benchmark-measure-ips (?seconds ?warmups) ?code0 ?code1 ...)))
     279        (generate-statistics observed ?stat-set ) ) )
    251280    ;C4 API
    252281    ((benchmark-ips ?code)
     
    256285     (benchmark-ips (?secs) ?code) ) ) )
    257286
    258 (define-syntax benchmark-measure-ips
    259   (syntax-rules ()
    260     ;
    261     ((benchmark-measure-ips () ?code0 ?code1 ...)
    262      (benchmark-measure-ips (#f) ?code0 ?code1 ...) )
    263     ;
    264     ((benchmark-measure-ips (?thresholds) ?code0 ?code1 ...)
    265      (benchmark-measure-ips (?thresholds #f) ?code0 ?code1 ...) )
    266     ;
    267     ((benchmark-measure-ips (?thresholds ?warmups) ?code0 ?code1 ...)
    268       (run-benchmark-ips (lambda () ?code0 ?code1 ...) ?thresholds ?warmups) ) ) )
     287;;
    269288
    270289#; ;FIXME
     
    272291  (syntax-rules ()
    273292    ;
    274     ((with-expected-benchmark ?expected ?code)
    275       (and-let* (
    276         (stats (begin ?code)) )
     293    ((with-expected-benchmark ?expected ?code ...)
     294      (and-let* ((stats (begin ?code ...)))
    277295        () ) ) ) )
    278296
    279297;;
    280298
    281 (define (run-benchmark-measure thunk)
    282   (let (
    283     (start  (realtime-microsecs))
    284     (result (thunk))
    285     (stop   (realtime-microsecs)) )
    286     (when (or (< start 0.0) (< stop 0.0))
    287       (error 'run-benchmark-measure "cannot retrieve time reliably") )
    288     (- stop start) ) )
    289 
    290 ;@thresholds # of seconds
     299;@seconds # of seconds
    291300;@warmups # of seconds
    292301;
    293 (define (run-benchmark-ips thunk #!optional thresholds warmups)
     302(define (run-benchmark-ips thunk #!optional seconds warmups)
    294303  (let (
    295     (thresholds (or thresholds DEFAULT-THRESHOLDS))
     304    (seconds (or seconds DEFAULT-SECONDS))
    296305    (warmups (or warmups DEFAULT-WARMUPS)) )
    297306    (let-values (
    298307      ((per-100ms _) (iterations-per-100ms thunk (secs->ms warmups)))
    299       ((threshold) (+ (current-milliseconds) (secs->ms thresholds))) )
    300       (assume ((per-100ms fixnum))
    301         (let loop ((iterations (the fixnum 0)) (timings (list)))
    302           (if (< (current-milliseconds) threshold)
    303             (let* (
    304               (before (current-milliseconds))
    305               (_ (dotimes (tmp per-100ms) (thunk)))
    306               (after  (current-milliseconds)) )
    307               (loop (+ iterations per-100ms) (cons (- after before) timings)))
    308             (map (lambda (i) (/ per-100ms (/ i 1000))) timings) ) ) ) ) ) )
     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)))
     312            ;NOTE this will run at least once, so long as per-100ms > 0
     313            (dotimes (_ per-100ms) (thunk))
     314            (let ((after (*realtime-microsecs 'run-benchmark-ips)))
     315              (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) ) ) ) ) )
     319
     320;;
    309321
    310322;any overhead
    311323(define *iterations-overhead* 0.0)
    312 
    313324;calc any overhead
    314325(define-constant OVERHEAD-ITERATIONS 10000000)
    315 (let ((before (current-milliseconds)))
    316   (let loop ((iterations 0))
    317     (cond
    318       ((< iterations OVERHEAD-ITERATIONS)
    319         (void)
    320         (loop (add1 iterations)) )
    321       (else
    322         (let ((after (current-milliseconds)))
    323           (set! *iterations-overhead*
    324             (exact->inexact (/ (- after before) OVERHEAD-ITERATIONS))) ) ) ) ) )
     326(let ((before (*realtime-microsecs 'iterations-overhead)))
     327  (dotimes (_ OVERHEAD-ITERATIONS) (void))
     328  (set! *iterations-overhead*
     329    (/ (- (*realtime-microsecs 'iterations-overhead) before) OVERHEAD-ITERATIONS)) )
    325330
    326331;@thunk benchmark procedure
     
    329334(define (iterations-per-100ms thunk limit)
    330335  (let* (
    331     (before (current-milliseconds))
    332     (threshold (+ limit before)) )
     336    (before (*realtime-microsecs 'iterations-per-100ms))
     337    (threshold (+ before (ms->ÎŒs limit))) )
    333338    (let loop ((iterations (the fixnum 0)))
    334       (cond
    335         ((< (current-milliseconds) threshold)
    336           (thunk)
    337           (loop (add1 iterations)) )
    338         (else
    339           (let* (
    340             (after (current-milliseconds))
    341             (overhead (->exact (* iterations *iterations-overhead*)))
    342             (total-time (max 0 (- after before overhead)))
    343             (per-100ms (* (/ iterations total-time) 100)) )
    344             (values (max 0 per-100ms) total-time) ) ) ) ) ) )
     339      (let ((after (*realtime-microsecs 'iterations-per-100ms)))
     340        (cond
     341          ((< after threshold)
     342            (thunk)
     343            (loop (add1 iterations)) )
     344          (else
     345            (let* (
     346              (overhead (* iterations *iterations-overhead*))
     347              (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)) ) ) ) ) ) ) )
    345354
    346355;;DEPRECATED
  • release/5/micro-benchmark/trunk/tests/micro-benchmark-test.scm

    r39347 r39350  
    1818(gloss *iterations-overhead*)
    1919
     20(test-group "examples"
     21  (import (only (chicken base) sleep))
     22  ;simply measure the runtime of the given fragment
     23  (gloss "(benchmark-measure (sleep 2))")
     24  (gloss (benchmark-measure (sleep 2)))
     25  ;run code 3 times and return results
     26  (gloss "(gloss (benchmark-run (sleep 1)))")
     27  (parameterize ((current-benchmark-iterations 3))
     28    (gloss (benchmark-run (sleep 1))))
     29  ;find out how many iterations we can make per second
     30  (gloss "(benchmark-ips (sleep 2))")
     31  (gloss (benchmark-ips (sleep 2)))
     32)
     33
    2034(parameterize ((current-test-epsilon 0.001)
    21                (current-benchmark-statistics-set-id #t) )
     35               (current-benchmark-statistics-set #t) )
    2236  ;
    2337  (gloss "Please Wait")
     
    3347              (gloss "Please Wait")
    3448              (benchmark-measure-run (begin (busy-work) 'test)))) )
    35           (generate-statistics runs (current-benchmark-statistics-set-id)))) )
     49          (generate-statistics runs (current-benchmark-statistics-set)))) )
    3650      (gloss stats)
    3751      (bigO-stats-tests 1000000.0 stats '(
     
    4458      (gloss stats) )
    4559  )
    46   ;
    47   (test-group "examples"
    48     (import (only (chicken base) sleep))
    49     ;simply measure the runtime of the given fragment
    50     (gloss "(benchmark-measure (sleep 2))")
    51     (gloss (benchmark-measure (sleep 2)))
    52     ;run code 3 times and return results
    53     (gloss "(gloss (benchmark-run (sleep 1)))")
    54     (parameterize ((current-benchmark-iterations 3))
    55       (gloss (benchmark-run (sleep 1))))
    56     ;find out how many iterations we can make per second
    57     (gloss "(benchmark-ips (sleep 2))")
    58     (gloss (benchmark-ips (sleep 2)))
    59   )
    6060)
    6161
Note: See TracChangeset for help on using the changeset viewer.