X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/8f28ea31bb2a95e88b9d9e6e4f29655ab077c939..679cceeda4e45ac03a10cc9c8adac1446571dd9a:/benchmark-suite/lib.scm diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm index 7dfc8b48c..a6feed818 100644 --- a/benchmark-suite/lib.scm +++ b/benchmark-suite/lib.scm @@ -1,20 +1,20 @@ ;;;; benchmark-suite/lib.scm --- generic support for benchmarking -;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3, or (at your option) any later version. ;;;; ;;;; This program is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. +;;;; GNU Lesser General Public License for more details. ;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this software; see the file COPYING.LESSER. +;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin +;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (benchmark-suite lib) :export ( @@ -110,7 +110,7 @@ ;;;; ("multiplication"). ;;;; ;;;; WITH-BENCHMARK-PREFIX can be nested. Each WITH-BENCHMARK-PREFIX -;;;; postpends a new element to the current prefix: +;;;; appends a new element to the current prefix: ;;;; ;;;; (with-benchmark-prefix "arithmetic" ;;;; (with-benchmark-prefix "addition" @@ -147,7 +147,7 @@ ;;;; execution of the benchmark code would not deliver usable timing results: ;;;; The resolution of the system time is not arbitrarily fine. Thus, some ;;;; benchmarks would be executed too quickly to be measured at all. A rule -;;;; of thumb is, that the longer a benchmark runs, be more exact is the +;;;; of thumb is, that the longer a benchmark runs, the more exact is the ;;;; information about the execution time. ;;;; ;;;; However, execution time depends on several influences: First, the @@ -255,7 +255,7 @@ ;;;; 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 giben +;;;; 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 @@ -278,7 +278,7 @@ ;;;; interested in, except if you are doing some garbage collection ;;;; checks. ;;;; -;;;; There is not function to calculate the garbage-collection time, since the +;;;; 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. @@ -286,12 +286,17 @@ ;;;; MISCELLANEOUS ;;;; +;;; Perform a division and convert the result to inexact. +(define (i/ a b) + (exact->inexact (/ a b))) + ;;; Scale the number of iterations according to the given scaling factor. (define iteration-factor 1) (define (scale-iterations iterations) (let* ((i (inexact->exact (round (* iterations iteration-factor))))) (if (< i 1) 1 i))) + ;;;; CORE FUNCTIONS ;;;; @@ -320,7 +325,7 @@ ;;; A short form for benchmarks. (defmacro benchmark (name iterations body . rest) - `(,run-benchmark ,name ,iterations (lambda () ,body ,@rest))) + `(run-benchmark ,name ,iterations (lambda () ,body ,@rest))) ;;;; BENCHMARK NAMES @@ -452,14 +457,14 @@ (benchmark-core-time\interpreter (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations - 'total (/ total-time time-base) - 'user (/ user-time time-base) - 'system (/ system-time time-base) - 'frame (/ frame-time time-base) - 'benchmark (/ benchmark-time time-base) - 'user/interp (/ user-time\interpreter time-base) - 'bench/interp (/ benchmark-core-time\interpreter time-base) - 'gc (/ gc-time time-base)) + '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)) port) (newline port))) @@ -484,10 +489,10 @@ (benchmark-core-time\interpreter (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations - 'user (/ user-time time-base) - 'benchmark (/ benchmark-time time-base) - 'bench/interp (/ benchmark-core-time\interpreter time-base) - 'gc (/ gc-time time-base)) + '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)) port) (newline port))) @@ -499,19 +504,24 @@ ;;;; Initialize the benchmarking system: ;;;; -;;; First, make sure the benchmarking routines are compiled. +;;; 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) -;;; Second, initialize the system constants +;;; 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 (/ frame-time/iteration time-base) (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)