gc-benchmarks/run-benchmark.scm

   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 ;;;
   9 ;;; This program is free software; you can redistribute it and/or modify
  10 ;;; it under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 2, or (at your option)
  12 ;;; any later version.
  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
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with this software; see the file COPYING.  If not, write to
  21 ;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;;; Boston, MA 02110-1301 USA
  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))
 179     (profile-options       . "")
 180     (input                 . ())))
 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
 236                                          "/../meta/guile")))
 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))))