Commit | Line | Data |
---|---|---|
02378956 DH |
1 | #!../libguile/guile \ |
2 | -e main -s | |
3 | !# | |
4 | ||
5 | ;;;; guile-benchmark --- run the Guile benchmark suite | |
6 | ;;;; Adapted from code by Jim Blandy <jimb@red-bean.com> --- May 1999 | |
7 | ;;;; | |
010b159f | 8 | ;;;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc. |
02378956 | 9 | ;;;; |
53befeb7 NJ |
10 | ;;;; This program is free software; you can redistribute it and/or |
11 | ;;;; modify it under the terms of the GNU Lesser General Public | |
12 | ;;;; License as published by the Free Software Foundation; either | |
13 | ;;;; version 3, or (at your option) any later version. | |
02378956 DH |
14 | ;;;; |
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 | |
53befeb7 | 18 | ;;;; GNU Lesser General Public License for more details. |
02378956 | 19 | ;;;; |
53befeb7 NJ |
20 | ;;;; You should have received a copy of the GNU Lesser General Public |
21 | ;;;; License along with this software; see the file COPYING.LESSER. | |
22 | ;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin | |
23 | ;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA | |
02378956 DH |
24 | |
25 | ||
26 | ;;;; Usage: [guile -e main -s] guile-benchmark [OPTIONS] [BENCHMARK ...] | |
27 | ;;;; | |
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'. | |
32 | ;;;; | |
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. | |
37 | ;;;; | |
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). | |
43 | ;;;; | |
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. | |
48 | ;;;; | |
49 | ;;;; If present, the `--log-file LOG' option tells `guile-benchmark' to put | |
50 | ;;;; the log output in a file named LOG. | |
51 | ;;;; | |
52 | ;;;; If present, the `--debug' option will enable a debugging mode. | |
53 | ;;;; | |
54 | ;;;; | |
55 | ;;;; Installation: | |
56 | ;;;; | |
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'. | |
64 | ;;;; | |
65 | ;;;; | |
66 | ;;;; Shortcomings: | |
67 | ;;;; | |
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. | |
74 | ;;;; | |
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. | |
79 | ||
80 | \f | |
81 | ;;; User configurable settings: | |
82 | (define default-benchmark-suite | |
83 | (string-append (getenv "HOME") "/bogus-path/benchmark-suite")) | |
84 | ||
85 | \f | |
86 | (use-modules (benchmark-suite lib) | |
87 | (ice-9 getopt-long) | |
88 | (ice-9 and-let-star) | |
89 | (ice-9 rdelim)) | |
90 | ||
91 | \f | |
92 | ;;; Variables that will receive their actual values later. | |
93 | (define benchmark-suite default-benchmark-suite) | |
94 | ||
95 | (define tmp-dir #f) | |
96 | ||
97 | \f | |
98 | ;;; General utilities, that probably should be in a library somewhere. | |
99 | ||
100 | ;;; Enable debugging | |
101 | (define (enable-debug-mode) | |
102 | (write-line %load-path) | |
103 | (set! %load-verbosely #t) | |
104 | (debug-enable 'backtrace 'debug)) | |
105 | ||
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 | |
109 | ;;; symlinks. | |
110 | (define (for-each-file f root) | |
111 | ||
112 | ;; A "hard directory" is a path that denotes a directory and is not a | |
113 | ;; symlink. | |
114 | (define (file-is-hard-directory? filename) | |
115 | (eq? (stat:type (lstat filename)) 'directory)) | |
116 | ||
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))) | |
121 | (let loop () | |
122 | (let ((entry (readdir dir))) | |
123 | (cond | |
124 | ((eof-object? entry) #f) | |
125 | ((or (string=? entry ".") | |
126 | (string=? entry "..") | |
127 | (string=? entry "CVS") | |
128 | (string=? entry "RCS")) | |
129 | (loop)) | |
130 | (else | |
131 | (visit (string-append root "/" entry)) | |
132 | (loop)))))))))) | |
133 | ||
134 | \f | |
135 | ;;; The benchmark driver. | |
136 | ||
137 | \f | |
138 | ;;; Localizing benchmark files and temporary data files. | |
139 | ||
140 | (define (data-file-name filename) | |
141 | (in-vicinity tmp-dir filename)) | |
142 | ||
143 | (define (benchmark-file-name benchmark) | |
144 | (in-vicinity benchmark-suite benchmark)) | |
145 | ||
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))) | |
149 | (benchmarks '())) | |
150 | (for-each-file (lambda (file) | |
010b159f | 151 | (if (string-suffix? ".bm" file) |
02378956 DH |
152 | (let ((short-name |
153 | (substring file root-len))) | |
154 | (set! benchmarks (cons short-name benchmarks)))) | |
155 | #t) | |
156 | benchmark-dir) | |
157 | ||
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<?))) | |
163 | ||
164 | (define (main args) | |
165 | (let ((options (getopt-long args | |
166 | `((benchmark-suite | |
167 | (single-char #\t) | |
168 | (value #t)) | |
169 | (iteration-factor | |
170 | (single-char #\t) | |
171 | (value #t)) | |
172 | (log-file | |
173 | (single-char #\l) | |
174 | (value #t)) | |
175 | (debug | |
176 | (single-char #\d)))))) | |
177 | (define (opt tag default) | |
178 | (let ((pair (assq tag options))) | |
179 | (if pair (cdr pair) default))) | |
180 | ||
181 | (if (opt 'debug #f) | |
182 | (enable-debug-mode)) | |
183 | ||
184 | (set! benchmark-suite | |
185 | (or (opt 'benchmark-suite #f) | |
186 | (getenv "BENCHMARK_SUITE_DIR") | |
187 | default-benchmark-suite)) | |
188 | ||
189 | (set! iteration-factor | |
190 | (string->number (opt 'iteration-factor "1"))) | |
191 | ||
192 | ;; directory where temporary files are created. | |
193 | (set! tmp-dir (getcwd)) | |
194 | ||
195 | (let* ((benchmarks | |
196 | (let ((foo (opt '() '()))) | |
197 | (if (null? foo) | |
198 | (enumerate-benchmarks benchmark-suite) | |
199 | foo))) | |
200 | (log-file | |
201 | (opt 'log-file "benchmarks.log"))) | |
202 | ||
203 | ;; Open the log file. | |
204 | (let ((log-port (open-output-file log-file))) | |
205 | ||
206 | ;; Register some reporters. | |
207 | (register-reporter (make-log-reporter log-port)) | |
208 | (register-reporter user-reporter) | |
209 | ||
210 | ;; Run the benchmarks. | |
211 | (for-each (lambda (benchmark) | |
212 | (with-benchmark-prefix benchmark | |
213 | (load (benchmark-file-name benchmark)))) | |
214 | benchmarks) | |
215 | (close-port log-port))))) | |
216 | ||
217 | \f | |
218 | ;;; Local Variables: | |
219 | ;;; mode: scheme | |
220 | ;;; End: |