5 ;;;; guile-benchmark --- run the Guile benchmark suite
6 ;;;; Adapted from code by Jim Blandy <jimb@red-bean.com> --- May 1999
8 ;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
10 ;;;; This program is free software; you can redistribute it and/or modify
11 ;;;; it under the terms of the GNU General Public License as published by
12 ;;;; the Free Software Foundation; either version 2, or (at your option)
13 ;;;; any later version.
15 ;;;; This program is distributed in the hope that it will be useful,
16 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;;; GNU General Public License for more details.
20 ;;;; You should have received a copy of the GNU General Public License
21 ;;;; along with this software; see the file COPYING. If not, write to
22 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;;;; Boston, MA 02110-1301 USA
26 ;;;; Usage: [guile -e main -s] guile-benchmark [OPTIONS] [BENCHMARK ...]
28 ;;;; Run benchmarks from the Guile benchmark suite. Report timing
29 ;;;; results to the standard output, along with a summary of all
30 ;;;; the results. Record each reported benchmark outcome in the log
31 ;;;; file, `benchmarks.log'.
33 ;;;; Normally, guile-benchmark scans the benchmark directory, and
34 ;;;; executes all files whose names end in `.bm'. (It assumes they contain
35 ;;;; Scheme code.) However, you can have it execute specific benchmarks by
36 ;;;; listing their filenames on the command line.
38 ;;;; The option `--benchmark-suite' can be given to specify the benchmark
39 ;;;; directory. If no such option is given, the benchmark directory is
40 ;;;; taken from the environment variable BENCHMARK_SUITE_DIR (if defined),
41 ;;;; otherwise a default directory that is hardcoded in this file is
42 ;;;; used (see "Installation" below).
44 ;;;; If present, the `--iteration-factor FACTOR' option tells
45 ;;;; `guile-benchmark' to multiply the number of iterations given with
46 ;;;; each single benchmark by the value of FACTOR. This allows to
47 ;;;; reduce or increase the total time for benchmarking.
49 ;;;; If present, the `--log-file LOG' option tells `guile-benchmark' to put
50 ;;;; the log output in a file named LOG.
52 ;;;; If present, the `--debug' option will enable a debugging mode.
57 ;;;; If you change the #! line at the top of this script to point at
58 ;;;; the Guile interpreter you want to run, you can call this script
59 ;;;; as an executable instead of having to pass it as a parameter to
60 ;;;; guile via "guile -e main -s guile-benchmark". Further, you can edit
61 ;;;; the definition of default-benchmark-suite to point to the parent
62 ;;;; directory of the `benchmarks' tree, which makes it unnecessary to set
63 ;;;; the environment variable `BENCHMARK_SUITE_DIR'.
68 ;;;; At the moment, due to a simple-minded implementation, benchmark files
69 ;;;; must live in the benchmark directory, and you must specify their names
70 ;;;; relative to the top of the benchmark directory. If you want to send
71 ;;;; me a patch that fixes this, but still leaves sane benchmark names in
72 ;;;; the log file, that would be great. At the moment, all the benchmarks
73 ;;;; I care about are in the benchmark directory, though.
75 ;;;; It would be nice if you could specify the Guile interpreter you
76 ;;;; want to benchmark on the command line. As it stands, if you want to
77 ;;;; change which Guile interpreter you're benchmarking, you need to edit
78 ;;;; the #! line at the top of this file, which is stupid.
81 ;;; User configurable settings:
82 (define default-benchmark-suite
83 (string-append (getenv "HOME") "/bogus-path/benchmark-suite"))
86 (use-modules (benchmark-suite lib)
92 ;;; Variables that will receive their actual values later.
93 (define benchmark-suite default-benchmark-suite)
98 ;;; General utilities, that probably should be in a library somewhere.
101 (define (enable-debug-mode)
102 (write-line %load-path)
103 (set! %load-verbosely #t)
104 (debug-enable 'backtrace 'debug))
106 ;;; Traverse the directory tree at ROOT, applying F to the name of
107 ;;; each file in the tree, including ROOT itself. For a subdirectory
108 ;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow
110 (define (for-each-file f root)
112 ;; A "hard directory" is a path that denotes a directory and is not a
114 (define (file-is-hard-directory? filename)
115 (eq? (stat:type (lstat filename)) 'directory))
117 (let visit ((root root))
118 (let ((should-recur (f root)))
119 (if (and should-recur (file-is-hard-directory? root))
120 (let ((dir (opendir root)))
122 (let ((entry (readdir dir)))
124 ((eof-object? entry) #f)
125 ((or (string=? entry ".")
126 (string=? entry "..")
127 (string=? entry "CVS")
128 (string=? entry "RCS"))
131 (visit (string-append root "/" entry))
135 ;;; The benchmark driver.
138 ;;; Localizing benchmark files and temporary data files.
140 (define (data-file-name filename)
141 (in-vicinity tmp-dir filename))
143 (define (benchmark-file-name benchmark)
144 (in-vicinity benchmark-suite benchmark))
146 ;;; Return a list of all the benchmark files in the benchmark tree.
147 (define (enumerate-benchmarks benchmark-dir)
148 (let ((root-len (+ 1 (string-length benchmark-dir)))
150 (for-each-file (lambda (file)
151 (if (has-suffix? file ".bm")
153 (substring file root-len)))
154 (set! benchmarks (cons short-name benchmarks))))
158 ;; for-each-file presents the files in whatever order it finds
159 ;; them in the directory. We sort them here, so they'll always
160 ;; appear in the same order. This makes it easier to compare benchmark
161 ;; log files mechanically.
162 (sort benchmarks string<?)))
165 (let ((options (getopt-long args
176 (single-char #\d))))))
177 (define (opt tag default)
178 (let ((pair (assq tag options)))
179 (if pair (cdr pair) default)))
184 (set! benchmark-suite
185 (or (opt 'benchmark-suite #f)
186 (getenv "BENCHMARK_SUITE_DIR")
187 default-benchmark-suite))
189 (set! iteration-factor
190 (string->number (opt 'iteration-factor "1")))
192 ;; directory where temporary files are created.
193 (set! tmp-dir (getcwd))
196 (let ((foo (opt '() '())))
198 (enumerate-benchmarks benchmark-suite)
201 (opt 'log-file "benchmarks.log")))
203 ;; Open the log file.
204 (let ((log-port (open-output-file log-file)))
206 ;; Register some reporters.
207 (register-reporter (make-log-reporter log-port))
208 (register-reporter user-reporter)
210 ;; Run the benchmarks.
211 (for-each (lambda (benchmark)
212 (with-benchmark-prefix benchmark
213 (load (benchmark-file-name benchmark))))
215 (close-port log-port)))))