Commit | Line | Data |
---|---|---|
69ecc0ba LC |
1 | #!/bin/sh |
2 | # -*- Scheme -*- | |
3 | exec ${GUILE-guile} -q -l "$0" \ | |
4 | -c '(apply main (cdr (command-line)))' \ | |
5 | --benchmark-dir="$(dirname $0)" "$@" | |
6 | !# | |
7 | ;;; Copyright (C) 2008 Free Software Foundation, Inc. | |
8 | ;;; | |
53befeb7 NJ |
9 | ;;; This program is free software; you can redistribute it and/or |
10 | ;;; modify it under the terms of the GNU Lesser General Public License | |
11 | ;;; as published by the Free Software Foundation; either version 3, or | |
12 | ;;; (at your option) any later version. | |
69ecc0ba LC |
13 | ;;; |
14 | ;;; This program is distributed in the hope that it will be useful, | |
15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
53befeb7 | 17 | ;;; GNU Lesser General Public License for more details. |
69ecc0ba | 18 | ;;; |
53befeb7 NJ |
19 | ;;; You should have received a copy of the GNU Lesser General Public |
20 | ;;; License along with this software; see the file COPYING.LESSER. If | |
21 | ;;; not, write to the Free Software Foundation, Inc., 51 Franklin | |
22 | ;;; Street, Fifth Floor, Boston, MA 02110-1301 USA | |
69ecc0ba LC |
23 | |
24 | (use-modules (ice-9 rdelim) | |
25 | (ice-9 popen) | |
26 | (ice-9 regex) | |
27 | (ice-9 format) | |
28 | (srfi srfi-1) | |
29 | (srfi srfi-37)) | |
30 | ||
31 | \f | |
32 | ;;; | |
33 | ;;; Running Guile. | |
34 | ;;; | |
35 | ||
36 | (define (run-reference-guile env bench-dir profile-opts bench) | |
37 | "Run the ``mainstream'' Guile, i.e., Guile 1.9 with its own GC." | |
38 | (open-input-pipe (string-append | |
39 | env " " | |
40 | bench-dir "/gc-profile.scm " profile-opts | |
41 | " \"" bench "\""))) | |
42 | ||
43 | (define (run-bdwgc-guile env bench-dir profile-opts options bench) | |
44 | "Run the Guile port to the Boehm-Demers-Weiser GC (BDW-GC)." | |
45 | (let ((fsd (assoc-ref options 'free-space-divisor))) | |
46 | (open-input-pipe (string-append env " " | |
47 | "GC_FREE_SPACE_DIVISOR=" | |
48 | (number->string fsd) | |
49 | ||
50 | (if (or (assoc-ref options 'incremental?) | |
51 | (assoc-ref options 'generational?)) | |
52 | " GC_ENABLE_INCREMENTAL=yes" | |
53 | "") | |
54 | (if (assoc-ref options 'generational?) | |
55 | " GC_PAUSE_TIME_TARGET=999999" | |
56 | "") | |
57 | (if (assoc-ref options 'parallel?) | |
58 | "" ;; let it choose the number of procs | |
59 | " GC_MARKERS=1") | |
60 | " " | |
61 | bench-dir "/gc-profile.scm " profile-opts | |
62 | " \"" bench "\"")))) | |
63 | ||
64 | \f | |
65 | ;;; | |
66 | ;;; Extracting performance results. | |
67 | ;;; | |
68 | ||
69 | (define (grep regexp input) | |
70 | "Read line by line from the @var{input} port and return all matches for | |
71 | @var{regexp}." | |
72 | (let ((regexp (if (string? regexp) (make-regexp regexp) regexp))) | |
73 | (with-input-from-port input | |
74 | (lambda () | |
75 | (let loop ((line (read-line)) | |
76 | (result '())) | |
77 | (format #t "> ~A~%" line) | |
78 | (if (eof-object? line) | |
79 | (reverse result) | |
80 | (cond ((regexp-exec regexp line) | |
81 | => | |
82 | (lambda (match) | |
83 | (loop (read-line) | |
84 | (cons match result)))) | |
85 | (else | |
86 | (loop (read-line) result))))))))) | |
87 | ||
88 | (define (parse-result benchmark-output) | |
89 | (let ((result (grep "^(execution time|heap size):[[:blank:]]+([0-9.]+)" | |
90 | benchmark-output))) | |
91 | (fold (lambda (match result) | |
92 | (cond ((equal? (match:substring match 1) "execution time") | |
93 | (cons (cons 'execution-time | |
94 | (string->number (match:substring match 2))) | |
95 | result)) | |
96 | ((equal? (match:substring match 1) "heap size") | |
97 | (cons (cons 'heap-size | |
98 | (string->number (match:substring match 2))) | |
99 | result)) | |
100 | (else | |
101 | result))) | |
102 | '() | |
103 | result))) | |
104 | ||
105 | (define (pretty-print-result benchmark reference bdwgc) | |
106 | (define (print-line name result ref?) | |
107 | (let ((name (string-pad-right name 23)) | |
108 | (time (assoc-ref result 'execution-time)) | |
109 | (heap (assoc-ref result 'heap-size)) | |
110 | (ref-heap (assoc-ref reference 'heap-size)) | |
111 | (ref-time (assoc-ref reference 'execution-time))) | |
112 | (format #t "~a ~1,2f (~,2fx) ~6,3f (~,2fx)~A~%" | |
113 | name | |
114 | (/ heap 1000000.0) (/ heap ref-heap 1.0) | |
115 | time (/ time ref-time 1.0) | |
116 | (if (and (not ref?) | |
117 | (<= heap ref-heap) (<= time ref-time)) | |
118 | " !" | |
119 | "")))) | |
120 | ||
121 | (format #t "benchmark: `~a'~%" benchmark) | |
122 | (format #t " heap size (MiB) execution time (s.)~%") | |
123 | (print-line "Guile" reference #t) | |
124 | (for-each (lambda (bdwgc) | |
125 | (let ((name (format #f "BDW-GC, FSD=~a~a" | |
126 | (assoc-ref bdwgc 'free-space-divisor) | |
127 | (cond ((assoc-ref bdwgc 'incremental?) | |
128 | " incr.") | |
129 | ((assoc-ref bdwgc 'generational?) | |
130 | " gene.") | |
131 | ((assoc-ref bdwgc 'parallel?) | |
132 | " paral.") | |
133 | (else ""))))) | |
134 | (print-line name bdwgc #f))) | |
135 | bdwgc)) | |
136 | ||
137 | \f | |
138 | ;;; | |
139 | ;;; Option processing. | |
140 | ;;; | |
141 | ||
142 | (define %options | |
143 | (list (option '(#\h "help") #f #f | |
144 | (lambda args | |
145 | (show-help) | |
146 | (exit 0))) | |
147 | (option '(#\r "reference") #t #f | |
148 | (lambda (opt name arg result) | |
149 | (alist-cons 'reference-environment arg | |
150 | (alist-delete 'reference-environment result | |
151 | eq?)))) | |
152 | (option '(#\b "bdw-gc") #t #f | |
153 | (lambda (opt name arg result) | |
154 | (alist-cons 'bdwgc-environment arg | |
155 | (alist-delete 'bdwgc-environment result | |
156 | eq?)))) | |
157 | (option '(#\d "benchmark-dir") #t #f | |
158 | (lambda (opt name arg result) | |
159 | (alist-cons 'benchmark-directory arg | |
160 | (alist-delete 'benchmark-directory result | |
161 | eq?)))) | |
162 | (option '(#\p "profile-options") #t #f | |
163 | (lambda (opt name arg result) | |
164 | (let ((opts (assoc-ref result 'profile-options))) | |
165 | (alist-cons 'profile-options | |
166 | (string-append opts " " arg) | |
167 | (alist-delete 'profile-options result | |
168 | eq?))))) | |
169 | (option '(#\l "log-file") #t #f | |
170 | (lambda (opt name arg result) | |
171 | (alist-cons 'log-port (open-output-file arg) | |
172 | (alist-delete 'log-port result | |
173 | eq?)))))) | |
174 | ||
175 | (define %default-options | |
176 | `((reference-environment . "GUILE=guile") | |
177 | (benchmark-directory . "./gc-benchmarks") | |
178 | (log-port . ,(current-output-port)) | |
bf4200ca LC |
179 | (profile-options . "") |
180 | (input . ()))) | |
69ecc0ba LC |
181 | |
182 | (define (show-help) | |
183 | (format #t "Usage: run-benchmark [OPTIONS] BENCHMARKS... | |
184 | Run BENCHMARKS (a list of Scheme files) and display a performance | |
185 | comparison of standard Guile (1.9) and the BDW-GC-based Guile. | |
186 | ||
187 | -h, --help Show this help message | |
188 | ||
189 | -r, --reference=ENV | |
190 | -b, --bdw-gc=ENV | |
191 | Use ENV as the environment necessary to run the | |
192 | \"reference\" Guile (1.9) or the BDW-GC-based Guile, | |
193 | respectively. At a minimum, ENV should define the | |
194 | `GUILE' environment variable. For example: | |
195 | ||
196 | --reference='GUILE=/foo/bar/guile LD_LIBRARY_PATH=/foo' | |
197 | ||
198 | -p, --profile-options=OPTS | |
199 | Pass OPTS as additional options for `gc-profile.scm'. | |
200 | -l, --log-file=FILE | |
201 | Save output to FILE instead of the standard output. | |
202 | -d, --benchmark-dir=DIR | |
203 | Use DIR as the GC benchmark directory where `gc-profile.scm' | |
204 | lives (it is automatically determined by default). | |
205 | ||
206 | Report bugs to <bug-guile@gnu.org>.~%")) | |
207 | ||
208 | (define (parse-args args) | |
209 | (define (leave fmt . args) | |
210 | (apply format (current-error-port) (string-append fmt "~%") args) | |
211 | (exit 1)) | |
212 | ||
213 | (args-fold args %options | |
214 | (lambda (opt name arg result) | |
215 | (leave "~A: unrecognized option" opt)) | |
216 | (lambda (file result) | |
217 | (let ((files (or (assoc-ref result 'input) '()))) | |
218 | (alist-cons 'input (cons file files) | |
219 | (alist-delete 'input result eq?)))) | |
220 | %default-options)) | |
221 | ||
222 | \f | |
223 | ;;; | |
224 | ;;; The main program. | |
225 | ;;; | |
226 | ||
227 | (define (main . args) | |
228 | (let* ((args (parse-args args)) | |
229 | (benchmark-files (assoc-ref args 'input))) | |
230 | ||
231 | (let* ((log (assoc-ref args 'log-port)) | |
232 | (bench-dir (assoc-ref args 'benchmark-directory)) | |
233 | (ref-env (assoc-ref args 'reference-environment)) | |
234 | (bdwgc-env (or (assoc-ref args 'bdwgc-environment) | |
235 | (string-append "GUILE=" bench-dir | |
0b6d8fdc | 236 | "/../meta/guile"))) |
69ecc0ba LC |
237 | (prof-opts (assoc-ref args 'profile-options))) |
238 | (for-each (lambda (benchmark) | |
239 | (let ((ref (parse-result (run-reference-guile ref-env | |
240 | bench-dir | |
241 | prof-opts | |
242 | benchmark))) | |
243 | (bdwgc (map (lambda (fsd incremental? | |
244 | generational? parallel?) | |
245 | (let ((opts | |
246 | (list | |
247 | (cons 'free-space-divisor fsd) | |
248 | (cons 'incremental? incremental?) | |
249 | (cons 'generational? generational?) | |
250 | (cons 'parallel? parallel?)))) | |
251 | (append opts | |
252 | (parse-result | |
253 | (run-bdwgc-guile bdwgc-env | |
254 | bench-dir | |
255 | prof-opts | |
256 | opts | |
257 | benchmark))))) | |
258 | '( 3 6 9 3 3) | |
259 | '(#f #f #f #t #f) ;; incremental | |
260 | '(#f #f #f #f #t) ;; generational | |
261 | '(#f #f #f #f #f)))) ;; parallel | |
262 | ;;(format #t "ref=~A~%" ref) | |
263 | ;;(format #t "bdw-gc=~A~%" bdwgc) | |
264 | (with-output-to-port log | |
265 | (lambda () | |
266 | (pretty-print-result benchmark ref bdwgc) | |
267 | (newline) | |
268 | (force-output))))) | |
269 | benchmark-files)))) |