gc-benchmarks: Allow the iteration count to be passed to `gc-profile.scm'.

* gc-benchmarks/gc-profile.scm (*iteration-count*): New parameter.
  (run-benchmark): Moved from `twobit-compat.scm'.  Honor
  `*iteration-count*'.
  (%options): Add `--iterations'.
  (show-help): Document it.
  (main): Parameterize `*iteration-count*'.

2 files changed, 54 insertions, 60 deletions

diff --git a/gc-benchmarks/gc-profile.scm b/gc-benchmarks/gc-profile.scm
index da2a493f1..cc35242da 100755
--- a/gc-benchmarks/gc-profile.scm
+++ b/gc-benchmarks/gc-profile.scm
@@ -24,7 +24,8 @@ exec ${GUILE-guile} --no-debug -q -l "$0" \
              (ice-9 rdelim)
              (ice-9 regex)
              (srfi srfi-1)
-             (srfi srfi-37))
+             (srfi srfi-37)
+             (srfi srfi-39))
 
 
 ;;;
@@ -140,7 +141,36 @@ memory mapping of process @var{pid}.  This information is obtained by reading
 ;;; Larceny/Twobit benchmarking compability layer.
 ;;;
 
-(load "twobit-compat.scm")
+(define *iteration-count*
+  (make-parameter #f))
+
+(define (run-benchmark name . args)
+  "A @code{run-benchmark} procedure compatible with Larceny's GC benchmarking
+framework.  See
+@url{http://www.ccs.neu.edu/home/will/Twobit/benchmarksAbout.html} for
+details."
+
+  (define %concise-invocation?
+    ;; This procedure can be called with only two arguments, NAME and
+    ;; RUN-MAKER.
+    (procedure? (car args)))
+
+  (let ((count     (or (*iteration-count*)
+                       (if %concise-invocation? 0 (car args))))
+        (run-maker (if %concise-invocation? (car args) (cadr args)))
+        (ok?       (if %concise-invocation?
+                       (lambda (result) #t)
+                       (caddr args)))
+        (args      (if %concise-invocation? '() (cdddr args))))
+    (let loop ((i 0))
+      (and (< i count)
+           (let ((result (apply run-maker args)))
+             (if (not (ok? result))
+                 (begin
+                   (format (current-output-port) "invalid result for `~A'~%"
+                           name)
+                   (exit 1)))
+             (loop (1+ i)))))))
 
 (define (save-directory-excursion directory thunk)
   (let ((previous-dir (getcwd)))
@@ -187,7 +217,10 @@ memory mapping of process @var{pid}.  This information is obtained by reading
                   (exit 0)))
         (option '(#\l "larceny") #f #f
                 (lambda (opt name arg result)
-                  (alist-cons 'larceny? #t result)))))
+                  (alist-cons 'larceny? #t result)))
+        (option '(#\i "iterations") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'iterations (string->number arg) result)))))
 
 (define (show-help)
   (format #t "Usage: gc-profile [OPTIONS] FILE.SCM
@@ -198,6 +231,10 @@ final heap usage.
 
   -l, --larceny   Provide mechanisms compatible with the Larceny/Twobit
                   GC benchmark suite.
+  -i, --iterations=COUNT
+                  Run the given benchmark COUNT times, regardless of the
+                  iteration count passed to `run-benchmark' (for Larceny
+                  benchmarks).
 
 Report bugs to <bug-guile@gnu.org>.~%"))
 
@@ -226,16 +263,18 @@ Report bugs to <bug-guile@gnu.org>.~%"))
          (load    (if (assoc-ref options 'larceny?)
                       load-larceny-benchmark
                       load)))
-    (format #t "running `~a'...~%" prog)
 
-    (let ((start (gettimeofday)))
-      (dynamic-wind
-        (lambda ()
-          #t)
-        (lambda ()
-          (set! quit (lambda args args))
-          (load prog))
-        (lambda ()
-          (let ((end (gettimeofday)))
-            (format #t "done~%")
-            (display-stats start end)))))))
+    (parameterize ((*iteration-count* (assoc-ref options 'iterations)))
+      (format #t "running `~a'...~%" prog)
+
+      (let ((start (gettimeofday)))
+        (dynamic-wind
+          (lambda ()
+            #t)
+          (lambda ()
+            (set! quit (lambda args args))
+            (load prog))
+          (lambda ()
+            (let ((end (gettimeofday)))
+              (format #t "done~%")
+              (display-stats start end))))))))
diff --git a/gc-benchmarks/twobit-compat.scm b/gc-benchmarks/twobit-compat.scm
deleted file mode 100644
index 765b94f8b..000000000
--- a/gc-benchmarks/twobit-compat.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-;;; Copyright (C) 2008 Free Software Foundation, Inc.
-;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
-
-;;;
-;;; This file provides compatibility routines with the benchmarking framework
-;;; used in Larceny/Twobit.
-;;;
-;;; See http://www.ccs.neu.edu/home/will/Twobit/benchmarksAbout.html for details.
-;;;
-
-(define (run-benchmark name . args)
-  (define %concise-invocation?
-    ;; This procedure can be called with only two arguments, NAME and
-    ;; RUN-MAKER.
-    (procedure? (car args)))
-
-  (let ((count     (if %concise-invocation? 0 (car args)))
-        (run-maker (if %concise-invocation? (car args) (cadr args)))
-        (ok?       (if %concise-invocation?
-                       (lambda (result) #t)
-                       (caddr args)))
-        (args      (if %concise-invocation? '() (cdddr args))))
-    (let loop ((i 0))
-      (and (< i count)
-           (let ((result (apply run-maker args)))
-             (if (not (ok? result))
-                 (begin
-                   (format (current-output-port) "invalid result for `~A'~%"
-                           name)
-                   (exit 1)))
-             (loop (1+ i)))))))