diff options
Diffstat (limited to 'benchmark-suite')
| -rw-r--r-- | benchmark-suite/benchmark-suite/lib.scm | 442 |
1 files changed, 203 insertions, 239 deletions
diff --git a/benchmark-suite/benchmark-suite/lib.scm b/benchmark-suite/benchmark-suite/lib.scm index 4ba0e3e1c..ae57cc02a 100644 --- a/benchmark-suite/benchmark-suite/lib.scm +++ b/benchmark-suite/benchmark-suite/lib.scm @@ -1,5 +1,5 @@ ;;;; benchmark-suite/lib.scm --- generic support for benchmarking -;;;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2006, 2011, 2012 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -17,31 +17,33 @@ ;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (benchmark-suite lib) - :export ( - - ;; Controlling the execution. - iteration-factor - scale-iterations - - ;; Running benchmarks. - run-benchmark - benchmark - - ;; Naming groups of benchmarks in a regular fashion. - with-benchmark-prefix with-benchmark-prefix* current-benchmark-prefix - format-benchmark-name - - ;; Computing timing results - benchmark-time-base - benchmark-total-time benchmark-user-time benchmark-system-time - benchmark-frame-time benchmark-core-time - benchmark-user-time\interpreter benchmark-core-time\interpreter - - ;; Reporting results in various ways. - register-reporter unregister-reporter reporter-registered? - make-log-reporter - full-reporter - user-reporter)) + #:use-module (srfi srfi-9) + #:export (;; Controlling the execution. + iteration-factor + scale-iterations + + ;; Running benchmarks. + run-benchmark + benchmark + + ;; Naming groups of benchmarks in a regular fashion. + with-benchmark-prefix with-benchmark-prefix* + current-benchmark-prefix format-benchmark-name + + ;; <benchmark-result> accessors + benchmark-result:name + benchmark-result:iterations + benchmark-result:real-time + benchmark-result:run-time + benchmark-result:gc-time + benchmark-result:core-time + + ;; Reporting results in various ways. + report current-reporter + register-reporter unregister-reporter reporter-registered? + make-log-reporter + full-reporter + user-reporter)) ;;;; If you're using Emacs's Scheme mode: @@ -214,81 +216,71 @@ ;;;; TIME CALCULATION ;;;; -;;;; The library uses the guile functions (times) and (gc-run-time) to -;;;; determine the execution time for a single benchmark. Based on these -;;;; functions, the values of BEFORE, AFTER and GC-TIME are computed, which -;;;; are then passed to the reporter functions. All three values BEFORE, -;;;; AFTER and GC-TIME include the time needed to executed the benchmark code -;;;; itself, but also the surrounding code that implements the loop to run the -;;;; benchmark code for the given number of times. This is undesirable, since -;;;; one would prefer to only get the timing data for the benchmarking code. +;;;; The library uses the guile functions `get-internal-run-time', +;;;; `get-internal-real-time', and `gc-run-time' to determine the +;;;; execution time for a single benchmark. Based on these functions, +;;;; Guile makes a <benchmark-result>, a record containing the elapsed +;;;; run time, real time, gc time, and possibly other metrics. These +;;;; times include the time needed to executed the benchmark code +;;;; itself, but also the surrounding code that implements the loop to +;;;; run the benchmark code for the given number of times. This is +;;;; undesirable, since one would prefer to only get the timing data for +;;;; the benchmarking code. ;;;; ;;;; To cope with this, the benchmarking framework uses a trick: During -;;;; initialization of the library, the time for executing an empty benchmark -;;;; is measured and stored. This is an estimate for the time needed by the -;;;; benchmarking framework itself. For later benchmarks, this time can then -;;;; be subtracted from the measured execution times. -;;;; -;;;; In order to simplify the time calculation for users who want to write -;;;; their own reporters, benchmarking framework provides the following -;;;; definitions: -;;;; -;;;; benchmark-time-base : This variable holds the number of time units that -;;;; make up a second. By deviding the results of each of the functions -;;;; below by this value, you get the corresponding time in seconds. For -;;;; example (/ (benchmark-total-time before after) benchmark-time-base) -;;;; will give you the total time in seconds. -;;;; benchmark-total-time : this function takes two arguments BEFORE and AFTER -;;;; and computes the total time between the two timestamps. The result -;;;; of this function is what the time command of the unix command line -;;;; would report as real time. -;;;; benchmark-user-time : this function takes two arguments BEFORE and AFTER -;;;; and computes the time spent in the benchmarking process between the -;;;; two timestamps. That means, the time consumed by other processes -;;;; running on the same machine is not part of the resulting time, -;;;; neither is time spent within the operating system. The result of -;;;; this function is what the time command of the unix command line would -;;;; report as user time. -;;;; benchmark-system-time : similar to benchmark-user-time, but here the time -;;;; spent within the operating system is given. The result of this -;;;; function is what the time command of the unix command line would -;;;; report as system time. -;;;; benchmark-frame-time : this function takes the argument ITERATIONS. It -;;;; reports the part of the user time that is consumed by the -;;;; benchmarking framework itself to run some benchmark for the given -;;;; number of iterations. You can think of this as the time that would -;;;; still be consumed, even if the benchmarking code itself was empty. -;;;; This value does not include any time for garbage collection, even if -;;;; it is the benchmarking framework which is responsible for causing a -;;;; garbage collection. -;;;; benchmark-core-time : this function takes three arguments ITERATIONS, -;;;; BEFORE and AFTER. It reports the part of the user time that is -;;;; actually spent within the benchmarking code. That is, the time -;;;; needed for the benchmarking framework is subtracted from the user -;;;; time. This value, however, includes all garbage collection times, -;;;; even if some part of the gc-time had actually to be attributed to the -;;;; benchmarking framework. -;;;; benchmark-user-time\interpreter : this function takes three arguments -;;;; BEFORE AFTER and GC-TIME. It reports the part of the user time that -;;;; is spent in the interpreter (and not in garbage collection). -;;;; benchmark-core-time\interpreter : this function takes four arguments -;;;; ITERATIONS, BEFORE, AFTER. and GC-TIME. It reports the part of the -;;;; benchmark-core-time that is spent in the interpreter (and not in -;;;; garbage collection). This value is most probably the one you are -;;;; interested in, except if you are doing some garbage collection -;;;; checks. -;;;; -;;;; There is no function to calculate the garbage-collection time, since the -;;;; garbage collection time is already passed as an argument GC-TIME to the -;;;; reporter functions. +;;;; initialization of the library, the time for executing an empty +;;;; benchmark is measured and stored. This is an estimate for the time +;;;; needed by the benchmarking framework itself. For later benchmarks, +;;;; this time can then be subtracted from the measured execution times. +;;;; Note that for very short benchmarks, this may result in a negative +;;;; number. +;;;; +;;;; The benchmarking framework provides the following accessors for +;;;; <benchmark-result> values. Note that all time values are in +;;;; internal time units; divide by internal-time-units-per-second to +;;;; get seconds. +;;;; +;;;; benchmark-result:name : Return the name of the benchmark. +;;;; +;;;; benchmark-result:iterations : Return the number of iterations that +;;;; this benchmark ran for. +;;;; +;;;; benchmark-result:real-time : Return the clock time elapsed while +;;;; this benchmark executed. +;;;; +;;;; benchmark-result:run-time : Return the CPU time elapsed while this +;;;; benchmark executed, both in user and kernel space. +;;;; +;;;; benchmark-result:gc-time : Return the approximate amount of time +;;;; spent in garbage collection while this benchmark executed, both +;;;; in user and kernel space. +;;;; +;;;; benchmark-result:core-time : Like benchmark-result:run-time, but +;;;; also estimates the time spent by the framework for the number +;;;; of iterations, and subtracts off that time from the result. +;;;; + +;;;; This module is used when benchmarking different Guiles, and so it +;;;; should run on all the Guiles of interest. Currently this set +;;;; includes Guile 1.8, so be careful with introducing features that +;;;; only Guile 2.0 supports. ;;;; MISCELLANEOUS ;;;; +(define-record-type <benchmark-result> + (make-benchmark-result name iterations real-time run-time gc-time) + benchmark-result? + (name benchmark-result:name) + (iterations benchmark-result:iterations) + (real-time benchmark-result:real-time) + (run-time benchmark-result:run-time) + (gc-time benchmark-result:gc-time)) + ;;; Perform a division and convert the result to inexact. -(define (i/ a b) - (exact->inexact (/ a b))) +(define (->seconds time) + (/ time 1.0 internal-time-units-per-second)) ;;; Scale the number of iterations according to the given scaling factor. (define iteration-factor 1) @@ -296,36 +288,49 @@ (let* ((i (inexact->exact (round (* iterations iteration-factor))))) (if (< i 1) 1 i))) +;;; Parameters. +(cond-expand + (srfi-39 #t) + (else (use-modules (srfi srfi-39)))) ;;;; CORE FUNCTIONS ;;;; ;;; The central routine for executing benchmarks. ;;; The idea is taken from Greg, the GNUstep regression test environment. -(define run-benchmark #f) -(let ((benchmark-running #f)) - (define (local-run-benchmark name iterations thunk) - (if benchmark-running - (error "Nested calls to run-benchmark are not permitted.") - (let ((benchmark-name (full-name name)) - (iterations (scale-iterations iterations))) - (set! benchmark-running #t) - (let ((before #f) (after #f) (gc-time #f)) - (gc) - (set! gc-time (gc-run-time)) - (set! before (times)) - (do ((i 0 (+ i 1))) - ((= i iterations)) - (thunk)) - (set! after (times)) - (set! gc-time (- (gc-run-time) gc-time)) - (report benchmark-name iterations before after gc-time)) - (set! benchmark-running #f)))) - (set! run-benchmark local-run-benchmark)) +(define benchmark-running? (make-parameter #f)) +(define (run-benchmark name iterations thunk) + (if (benchmark-running?) + (error "Nested calls to run-benchmark are not permitted.")) + (if (not (and (integer? iterations) (exact? iterations))) + (error "Expected exact integral number of iterations")) + (parameterize ((benchmark-running? #t)) + ;; Warm up the benchmark first. This will resolve any toplevel-ref + ;; forms. + (thunk) + (gc) + (let* ((before-gc-time (gc-run-time)) + (before-real-time (get-internal-real-time)) + (before-run-time (get-internal-run-time))) + (do ((i iterations (1- i))) + ((zero? i)) + (thunk)) + (let ((after-run-time (get-internal-run-time)) + (after-real-time (get-internal-real-time)) + (after-gc-time (gc-run-time))) + (report (make-benchmark-result (full-name name) iterations + (- after-real-time before-real-time) + (- after-run-time before-run-time) + (- after-gc-time before-gc-time))))))) ;;; A short form for benchmarks. -(defmacro benchmark (name iterations body . rest) - `(run-benchmark ,name ,iterations (lambda () ,body ,@rest))) +(cond-expand + (guile-2 + (define-syntax-rule (benchmark name iterations body body* ...) + (run-benchmark name iterations (lambda () body body* ...)))) + (else + (defmacro benchmark (name iterations body . rest) + `(run-benchmark ,name ,iterations (lambda () ,body ,@rest))))) ;;;; BENCHMARK NAMES @@ -333,31 +338,21 @@ ;;;; Turn a benchmark name into a nice human-readable string. (define (format-benchmark-name name) - (call-with-output-string - (lambda (port) - (let loop ((name name) - (separator "")) - (if (pair? name) - (begin - (display separator port) - (display (car name) port) - (loop (cdr name) ": "))))))) + (string-join name ": ")) ;;;; For a given benchmark-name, deliver the full name including all prefixes. (define (full-name name) (append (current-benchmark-prefix) (list name))) -;;; A fluid containing the current benchmark prefix, as a list. -(define prefix-fluid (make-fluid '())) -(define (current-benchmark-prefix) - (fluid-ref prefix-fluid)) +;;; A parameter containing the current benchmark prefix, as a list. +(define current-benchmark-prefix + (make-parameter '())) ;;; Postpend PREFIX to the current name prefix while evaluting THUNK. ;;; The name prefix is only changed within the dynamic scope of the ;;; call to with-benchmark-prefix*. Return the value returned by THUNK. (define (with-benchmark-prefix* prefix thunk) - (with-fluids ((prefix-fluid - (append (fluid-ref prefix-fluid) (list prefix)))) + (parameterize ((current-benchmark-prefix (full-name prefix))) (thunk))) ;;; (with-benchmark-prefix PREFIX BODY ...) @@ -365,77 +360,58 @@ ;;; The name prefix is only changed within the dynamic scope of the ;;; with-benchmark-prefix expression. Return the value returned by the last ;;; BODY expression. -(defmacro with-benchmark-prefix (prefix . body) - `(with-benchmark-prefix* ,prefix (lambda () ,@body))) +(cond-expand + (guile-2 + (define-syntax-rule (with-benchmark-prefix prefix body body* ...) + (with-benchmark-prefix* prefix (lambda () body body* ...)))) + (else + (defmacro with-benchmark-prefix (prefix . body) + `(with-benchmark-prefix* ,prefix (lambda () ,@body))))) -;;;; TIME CALCULATION +;;;; Benchmark results ;;;; -(define benchmark-time-base - internal-time-units-per-second) - -(define time-base ;; short-cut, not exported - benchmark-time-base) - -(define frame-time/iteration +(define *calibration-result* "<will be set during initialization>") -(define (benchmark-total-time before after) - (- (tms:clock after) (tms:clock before))) - -(define (benchmark-user-time before after) - (- (tms:utime after) (tms:utime before))) +(define (benchmark-overhead iterations accessor) + (* (/ iterations 1.0 (benchmark-result:iterations *calibration-result*)) + (accessor *calibration-result*))) -(define (benchmark-system-time before after) - (- (tms:stime after) (tms:stime before))) - -(define (benchmark-frame-time iterations) - (* iterations frame-time/iteration)) - -(define (benchmark-core-time iterations before after) - (- (benchmark-user-time before after) (benchmark-frame-time iterations))) - -(define (benchmark-user-time\interpreter before after gc-time) - (- (benchmark-user-time before after) gc-time)) - -(define (benchmark-core-time\interpreter iterations before after gc-time) - (- (benchmark-core-time iterations before after) gc-time)) +(define (benchmark-result:core-time result) + (- (benchmark-result:run-time result) + (benchmark-overhead (benchmark-result:iterations result) + benchmark-result:run-time))) ;;;; REPORTERS ;;;; -;;; The global list of reporters. -(define reporters '()) +;;; The global set of reporters. +(define report-hook (make-hook 1)) + +(define (default-reporter result) + (if (hook-empty? report-hook) + (user-reporter result) + (run-hook report-hook result))) -;;; The default reporter, to be used only if no others exist. -(define default-reporter #f) +(define current-reporter + (make-parameter default-reporter)) -;;; Add the procedure REPORTER to the current set of reporter functions. -;;; Signal an error if that reporter procedure object is already registered. (define (register-reporter reporter) - (if (memq reporter reporters) - (error "register-reporter: reporter already registered: " reporter)) - (set! reporters (cons reporter reporters))) + (add-hook! report-hook reporter)) -;;; Remove the procedure REPORTER from the current set of reporter -;;; functions. Signal an error if REPORTER is not currently registered. (define (unregister-reporter reporter) - (if (memq reporter reporters) - (set! reporters (delq! reporter reporters)) - (error "unregister-reporter: reporter not registered: " reporter))) + (remove-hook! report-hook reporter)) ;;; Return true iff REPORTER is in the current set of reporter functions. (define (reporter-registered? reporter) - (if (memq reporter reporters) #t #f)) + (if (memq reporter (hook->list report-hook)) #t #f)) ;;; Send RESULT to all currently registered reporter functions. -(define (report . args) - (if (pair? reporters) - (for-each (lambda (reporter) (apply reporter args)) - reporters) - (apply default-reporter args))) +(define (report result) + ((current-reporter) result)) ;;;; Some useful standard reporters: @@ -444,26 +420,22 @@ ;;;; User reporters write some interesting results to the standard output. ;;; Display a single benchmark result to the given port -(define (print-result port name iterations before after gc-time) - (let* ((name (format-benchmark-name name)) - (total-time (benchmark-total-time before after)) - (user-time (benchmark-user-time before after)) - (system-time (benchmark-system-time before after)) - (frame-time (benchmark-frame-time iterations)) - (benchmark-time (benchmark-core-time iterations before after)) - (user-time\interpreter - (benchmark-user-time\interpreter before after gc-time)) - (benchmark-core-time\interpreter - (benchmark-core-time\interpreter iterations before after gc-time))) +(define (print-result port result) + (let ((name (format-benchmark-name (benchmark-result:name result))) + (iterations (benchmark-result:iterations result)) + (real-time (benchmark-result:real-time result)) + (run-time (benchmark-result:run-time result)) + (gc-time (benchmark-result:gc-time result)) + (core-time (benchmark-result:core-time result))) (write (list name iterations - 'total (i/ total-time time-base) - 'user (i/ user-time time-base) - 'system (i/ system-time time-base) - 'frame (i/ frame-time time-base) - 'benchmark (i/ benchmark-time time-base) - 'user/interp (i/ user-time\interpreter time-base) - 'bench/interp (i/ benchmark-core-time\interpreter time-base) - 'gc (i/ gc-time time-base)) + 'total (->seconds real-time) + 'user (->seconds run-time) + 'system 0 + 'frame (->seconds (- run-time core-time)) + 'benchmark (->seconds core-time) + 'user/interp (->seconds (- run-time gc-time)) + 'bench/interp (->seconds (- core-time gc-time)) + 'gc (->seconds gc-time)) port) (newline port))) @@ -472,58 +444,50 @@ (define (make-log-reporter file) (let ((port (if (output-port? file) file (open-output-file file)))) - (lambda args - (apply print-result port args) + (lambda (result) + (print-result port result) (force-output port)))) ;;; A reporter that reports all results to the user. -(define (full-reporter . args) - (apply print-result (current-output-port) args)) +(define (full-reporter result) + (print-result (current-output-port) result)) ;;; Display interesting results of a single benchmark to the given port -(define (print-user-result port name iterations before after gc-time) - (let* ((name (format-benchmark-name name)) - (user-time (benchmark-user-time before after)) - (benchmark-time (benchmark-core-time iterations before after)) - (benchmark-core-time\interpreter - (benchmark-core-time\interpreter iterations before after gc-time))) - (write (list name iterations - 'user (i/ user-time time-base) - 'benchmark (i/ benchmark-time time-base) - 'bench/interp (i/ benchmark-core-time\interpreter time-base) - 'gc (i/ gc-time time-base)) +(define (print-user-result port result) + (let ((name (format-benchmark-name (benchmark-result:name result))) + (iterations (benchmark-result:iterations result)) + (real-time (benchmark-result:real-time result)) + (run-time (benchmark-result:run-time result)) + (gc-time (benchmark-result:gc-time result)) + (core-time (benchmark-result:core-time result))) + (write (list name iterations + 'real (->seconds real-time) + 'real/iteration (->seconds (/ real-time iterations)) + 'run/iteration (->seconds (/ run-time iterations)) + 'core/iteration (->seconds (/ core-time iterations)) + 'gc (->seconds gc-time)) port) (newline port))) ;;; A reporter that reports interesting results to the user. -(define (user-reporter . args) - (apply print-user-result (current-output-port) args)) +(define (user-reporter result) + (print-user-result (current-output-port) result)) ;;;; Initialize the benchmarking system: ;;;; -;;; First, display version information -(display ";; running guile version " (current-output-port)) -(display (version) (current-output-port)) -(newline (current-output-port)) - -;;; Second, make sure the benchmarking routines are compiled. -(define (null-reporter . args) #t) -(set! default-reporter null-reporter) -(benchmark "empty initialization benchmark" 2 #t) - -;;; Third, initialize the system constants -(display ";; calibrating the benchmarking framework..." (current-output-port)) -(newline (current-output-port)) -(define (initialization-reporter name iterations before after gc-time) - (let* ((frame-time (- (tms:utime after) (tms:utime before) gc-time 3))) - (set! frame-time/iteration (/ frame-time iterations)) - (display ";; framework time per iteration: " (current-output-port)) - (display (i/ frame-time/iteration time-base) (current-output-port)) - (newline (current-output-port)))) -(set! default-reporter initialization-reporter) -(benchmark "empty initialization benchmark" 524288 #t) - -;;; Finally, set the default reporter -(set! default-reporter user-reporter) +(define (calibrate-benchmark-framework) + (display ";; running guile version ") + (display (version)) + (newline) + (display ";; calibrating the benchmarking framework...") + (newline) + (parameterize ((current-reporter + (lambda (result) + (set! *calibration-result* result) + (display ";; calibration: ") + (print-user-result (current-output-port) result)))) + (benchmark "empty initialization benchmark" 10000000 #t))) + +(calibrate-benchmark-framework) |