benchmark-suite/guile-benchmark

   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 ;;;;
   8 ;;;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc.
   9 ;;;;
  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.
  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
  18 ;;;; GNU Lesser General Public License for more details.
  19 ;;;;
  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
  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)
 151                      (if (string-suffix? ".bm" file)
 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: