Changeset 39346 in project


Ignore:
Timestamp:
11/22/20 22:08:21 (8 weeks ago)
Author:
Kon Lovett
Message:

macro 0+ => 1+ for code

File:
1 edited

Legend:

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

    r39344 r39346  
    4242(define-type real (or integer float ratnum))
    4343
    44 ;(define-type seq (or list vector string #;linear-sequence #;random-access-sequence))
    45 
    4644(define-type statistics-alist (or null (list-of (pair symbol *))))
    4745
     
    166164;;
    167165
    168 (define (bigO a)
    169   (round (log10 a)) )
    170 
    171 (define (bigO= a b)
    172   (= (bigO a) (bigO b)) )
    173 
    174 (define (bigO< a b)
    175   (< (bigO a) (bigO b)) )
    176 
    177 (define (bigO-compare a b)
    178   (let ((a (bigO a)) (b (bigO b)))
    179     (if (< a b) -1 (if (= a b) 0 1)) ) )
    180 
    181 ;;
    182 
     166(define (bigO a) (round (log10 a)))
     167(define (bigO< a b) (< (bigO a) (bigO b)))
     168(define (bigO= a b) (= (bigO a) (bigO b)))
     169(define (bigO-compare a b) (if (bigO< a b) -1 (if (bigO= a b) 0 1)))
     170
     171;;
    183172
    184173(define-checked-parameter current-benchmark-iterations INITIAL-ITERATIONS fixnum)
     
    195184        (result (begin ?code ...))
    196185        (stop   (realtime-microsecs)) )
    197         (when (or (< start 0.0) (< stop 0.0))
    198           (warning 'benchmark-measure "cannot retrieve time reliably" start stop) )
     186        (when (or (< start 0) (< stop 0))
     187          (warning 'benchmark-measure "cannot retrieve time reliably" start stop))
    199188        (- stop start) ) ) ) )
     189
     190;; run the given procedure n times and return statistics about the runtime
     191;; returns an alist with statistics
     192
     193(define-syntax benchmark-run
     194  (syntax-rules ()
     195    ;
     196    ((benchmark-run () ?code0 ?code1 ...)
     197      (benchmark-run ((current-benchmark-iterations)) ?code0 ?code1 ...) )
     198    ;
     199    ((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 ...)
     206      (let ((observed (benchmark-measure-run (?tabs) ?code0 ?code1 ...)))
     207        (generate-statistics observed ?stat-set-id) ) )
     208    ;C4 API
     209    ((benchmark-run ?code)
     210      (benchmark-run () ?code) )
     211    ;
     212    ((benchmark-run ?iters ?code)
     213      (benchmark-run (?iters) ?code) ) ) )
    200214
    201215(define-syntax benchmark-measure-run
     
    205219     (benchmark-measure-run () ?code ...) )
    206220    ;
    207     ((benchmark-measure-run () ?code ...)
    208       (benchmark-measure-run ((current-benchmark-iterations)) ?code ...) )
    209     ;
    210     ((benchmark-measure-run (?tabs) ?code ...)
    211       (list-tabulate ?tabs (lambda _ (benchmark-measure ?code ...)) ) ) ) )
     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 ...)) ) ) ) )
    212226
    213227;; benchmarking that tries to find out how many times your code can run in a given
     
    220234;;
    221235
     236(define-syntax benchmark-ips
     237  (syntax-rules ()
     238    ;
     239    ((benchmark-ips () ?code0 ?code1 ...)
     240     (benchmark-ips (#f) ?code0 ?code1 ...) )
     241    ;
     242    ((benchmark-ips (?thresholds) ?code0 ?code1 ...)
     243     (benchmark-ips (?thresholds #f) ?code0 ?code1 ...) )
     244    ;
     245    ((benchmark-ips (?thresholds ?warmups) ?code0 ?code1 ...)
     246      (benchmark-measure-ips (?thresholds ?warmups) ?code0 ?code1 ...) )
     247    ;C4 API
     248    ((benchmark-ips ?code)
     249     (benchmark-ips () ?code) )
     250    ;
     251    ((benchmark-ips ?secs ?code)
     252     (benchmark-ips (?secs) ?code) ) ) )
     253
    222254(define-syntax benchmark-measure-ips
    223255  (syntax-rules ()
    224256    ;
    225     ((benchmark-measure-ips (begin ?code ...))
    226      (benchmark-measure-ips () ?code ...) )
    227     ;
    228     ((benchmark-measure-ips () ?code ...)
    229      (benchmark-measure-ips (DEFAULT-THRESHOLDS) ?code ...) )
    230     ;
    231     ((benchmark-measure-ips (?thresholds) ?code ...)
    232      (benchmark-measure-ips (?thresholds DEFAULT-WARMUPS) ?code ...) )
    233     ;
    234     ((benchmark-measure-ips (?thresholds ?warmups) ?code ...)
    235       (run-benchmark-ips (lambda () ?code ...) ?thresholds ?warmups) ) ) )
     257    ((benchmark-measure-ips () ?code0 ?code1 ...)
     258     (benchmark-measure-ips (#f) ?code0 ?code1 ...) )
     259    ;
     260    ((benchmark-measure-ips (?thresholds) ?code0 ?code1 ...)
     261     (benchmark-measure-ips (?thresholds #f) ?code0 ?code1 ...) )
     262    ;
     263    ((benchmark-measure-ips (?thresholds ?warmups) ?code0 ?code1 ...)
     264      (run-benchmark-ips (lambda () ?code0 ?code1 ...) ?thresholds ?warmups) ) ) )
    236265
    237266#; ;FIXME
     
    239268  (syntax-rules ()
    240269    ;
    241     ((with-expected-benchmark ?expected ?code ...)
     270    ((with-expected-benchmark ?expected ?code)
    242271      (and-let* (
    243         (stats (begin ?code ...)) )
     272        (stats (begin ?code)) )
    244273        () ) ) ) )
    245 
    246 ;; run the given procedure n times and return statistics about the runtime
    247 ;; returns an alist with statistics
    248 
    249 (define-syntax benchmark-run
    250   (syntax-rules ()
    251     ;
    252     ((benchmark-run (begin ?code ...))
    253       (benchmark-run () ?code ...) )
    254     ;
    255     ((benchmark-run () ?code ...)
    256       (benchmark-run ((current-benchmark-iterations)) ?code ...) )
    257     ;
    258     ((benchmark-run (?tabs) ?code ...)
    259       (benchmark-run (?tabs (current-benchmark-statistics-set-id)) ?code ...) )
    260     ;
    261     ((benchmark-run (#t ?stat-set-id) ?code ...)
    262       (benchmark-run ((current-benchmark-iterations) ?stat-set-id) ?code ...) )
    263     ;
    264     ((benchmark-run (?tabs ?stat-set-id) ?code ...)
    265       (let ((observed (benchmark-measure-run (?tabs) ?code ...)))
    266         (generate-statistics observed ?stat-set-id) ) ) ) )
    267 
    268 (define-syntax benchmark-ips
    269   (syntax-rules ()
    270     ;
    271     ((benchmark-ips (begin ?code ...))
    272      (benchmark-ips () ?code ...) )
    273     ;
    274     ((benchmark-ips () ?code ...)
    275      (benchmark-ips (DEFAULT-THRESHOLDS) ?code ...) )
    276     ;
    277     ((benchmark-ips (?thresholds) ?code ...)
    278      (benchmark-ips (?thresholds DEFAULT-WARMUPS) ?code ...) )
    279     ;
    280     ((benchmark-ips (?thresholds ?warmups) ?code ...)
    281      (benchmark-ips (?thresholds ?warmups (current-benchmark-statistics-set-id)) ?code ...) )
    282     ;
    283     ((benchmark-ips (?thresholds ?warmups ?stat-set-id) ?code ...)
    284       (let ((observed (benchmark-measure-ips (?thresholds ?warmups) ?code ...)))
    285         (generate-statistics observed ?stat-set-id) ) ) ) )
    286274
    287275;;
     
    299287;@warmups # of seconds
    300288;
    301 (define (run-benchmark-ips thunk
    302            #!optional
    303            (thresholds DEFAULT-THRESHOLDS)
    304            (warmups DEFAULT-WARMUPS))
    305   (let-values (
    306     ((per-100ms _) (iterations-per-100ms thunk (secs->exact-ms warmups)))
    307     ((threshold) (+ (secs->exact-ms thresholds) (current-milliseconds))) )
    308     (let loop ((iterations 0) (timings (list)))
    309       (assume ((per-100ms fixnum) (iterations fixnum))
    310         (if (< threshold (current-milliseconds))
    311           (map (lambda (i) (/ per-100ms (/ i 1000.0))) timings)
    312           (let* (
    313             (before (current-milliseconds))
    314             (_ (dotimes (tmp per-100ms) (thunk)))
    315             (after  (current-milliseconds)) )
    316             (loop (+ iterations per-100ms) (cons (- after before) timings))) ) ) ) ) )
    317 
     289(define (run-benchmark-ips thunk #!optional thresholds warmups)
     290  (let (
     291    (thresholds (or thresholds DEFAULT-THRESHOLDS))
     292    (warmups (or warmups DEFAULT-WARMUPS)) )
     293    (let-values (
     294      ((per-100ms _) (iterations-per-100ms thunk (secs->exact-ms warmups)))
     295      ((threshold) (+ (secs->exact-ms thresholds) (current-milliseconds))) )
     296      (let loop ((iterations 0) (timings (list)))
     297        (assume ((per-100ms fixnum) (iterations fixnum))
     298          (if (< threshold (current-milliseconds))
     299            (map (lambda (i) (/ per-100ms (/ i 1000.0))) timings)
     300            (let* (
     301              (before (current-milliseconds))
     302              (_ (dotimes (tmp per-100ms) (thunk)))
     303              (after  (current-milliseconds)) )
     304              (loop (+ iterations per-100ms) (cons (- after before) timings))) ) ) ) ) ) )
     305
     306;calc any overhead
    318307(define *iterations-overhead* 0)
     308(define-constant OVERHEAD-ITERATIONS 10000000)
     309(let ((before (current-milliseconds)))
     310  (let loop ((iterations 0))
     311    (cond
     312      ((< iterations OVERHEAD-ITERATIONS)
     313        (void)
     314        (loop (add1 iterations)) )
     315      (else
     316        (let ((after (current-milliseconds)))
     317          (set! *iterations-overhead*
     318            (exact->inexact (/ (- after before) OVERHEAD-ITERATIONS))) ) ) ) ) )
    319319
    320320;@thunk benchmark procedure
     
    334334            (after (current-milliseconds))
    335335            (total-time (max 0 (- after before (* iterations *iterations-overhead*))))
    336             (per-100ms (* (/ iterations total-time) 100)) )
    337             (values (max 1 per-100ms) total-time) ) ) ) ) ) )
     336            (per-100ms (inexact->exact (round (* (/ iterations total-time) 100)))) )
     337            (values (min 0 per-100ms) total-time) ) ) ) ) ) )
    338338
    339339;;DEPRECATED
     
    342342(define %gettime/microsecs realtime-microsecs)
    343343
    344 ;;;
    345 
    346 (define-constant OVERHEAD-ITERATIONS 10000000)
    347 (let ((before (current-milliseconds)))
    348   (let loop ((iterations 0))
    349     (cond
    350       ((< iterations 10000000)
    351         (void)
    352         (loop (add1 iterations)) )
    353       (else
    354         (let ((after (current-milliseconds)))
    355           (set! *iterations-overhead* (/ (- after before) OVERHEAD-ITERATIONS) ) ) ) ) ) )
    356 ;(print "*iterations-overhead* = " *iterations-overhead*)
    357 
    358344) ;module micro-benchmark
Note: See TracChangeset for help on using the changeset viewer.