make benchmark durations more consistent, clean up p anti-specialization wrappers, clean up infrastructure, and support per-implementation normalization

svn: r4109

collects/tests/mzscheme/benchmarks/common/README.txt

@@ -1,29 +1,35 @@
-To run a benchmark:
+To run a benchmark, assuming you have `mzscheme' in your path:
- mzscheme -qu auto.ss <impl-or-benchmark> ...
+ ./auto.ss <impl-or-benchmark> ...
 where <impl-or-benchmark> names an implementation as one of
    mzscheme3m
    bigloo
    chicken
    gambit
    larceny
-   mzscheme    [omitted by default]
+   ...
-   mzscheme-j  [omitted by default]
-   mzscheme-tl [omitted by default]
 or a benchmark as one of
    conform
    cpstack
    ctak
    ...
 or any of the above prefixed by "no-" to skip the corresponding
-<impl-or-benchmark>.
+<impl-or-benchmark>. To see a complete list of implementations
+and benchmarks, run
+ ./auto.ss --show
 
-Naming no implementation/benchmark causes all of them to be run,
+Naming no implementation/benchmark causes a standard of them to be run
-except ones omitted by default. Similarly, if the first named
+(as reported by --show). Similarly, if the first named
 implementation/benchmak starts with "no-", the default set is used
 minus the "no-"-specified implementation/benchmark.
 
 The output is series of lines of the form
   [<impl> <benchmark> (<cpu-msec> <real-msec> <gc-msec>) <compile-msec>]
+where #f means that the information is unavailable, or that the
+benchmark wasn't run due to an implementation limitation. The
+<cpu-msec> and <compile-msec> parts are #f only when the benchmark
+wasn't run.
+
+All benchmarks must be run from the directory containing this file.
 
 Most bechmarks were obtained from
  http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/code/bench/gabriel/
@@ -33,8 +39,9 @@ Files that end in ".sch" are supposed to be standard Scheme plus `time'.
 Files that end in ".ss" are MzScheme wrapper modules or helper scripts.
 
 To build <benchmark>.sch directly with Gambit, Bigloo, or Chicken:
-  mzscheme -qr mk-gambit.ss <banchmark>
+  mzscheme -qr mk-gambit.ss <benchmark> ; gsi -:m10000 <benchmark>.o1
-  mzscheme -qr mk-bigloo.ss <banchmark>
+  mzscheme -qr mk-bigloo.ss <benchmark> ; <benchmark>
-  mzscheme -qr mk-chicken.ss <banchmark>
+  mzscheme -qr mk-chicken.ss <benchmark> ; <benchmark>
 
-Unpack "dynamic-input.txt.gz" if you want to run the "dynamic" benchmark.
+Unpack "dynamic-input.txt.gz" if you want to run the "dynamic" benchmark,
+but the auto.ss script will do that for you.

collects/tests/mzscheme/benchmarks/common/auto.ss

@@ -8,8 +8,11 @@ exec mzscheme -qu "$0" ${1+"$@"}
            (lib "cmdline.ss")
            (lib "list.ss")
            (lib "compile.ss")
+           (lib "inflate.ss")
            (lib "file.ss" "dynext"))
 
+  ;; Implementaton-specific control functions ------------------------------
+
   (define (bytes->number b)
     (string->number (bytes->string/latin-1 b)))
 
@@ -22,6 +25,9 @@ exec mzscheme -qu "$0" ${1+"$@"}
   (define (clean-up-bin bm)
     (delete-file (symbol->string bm)))
 
+  (define (clean-up-o1 bm)
+    (delete-file (format "~a.o1" bm)))
+
   (define (mk-mzscheme bm)
     ;; To get compilation time:
     (parameterize ([current-namespace (make-namespace)])
@@ -65,7 +71,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
     (system (format "time ~a" bm)))
 
   (define (run-gambit-exe bm)
-    (system (format "~a -:d-" bm)))
+    (system (format "gsi -:d-,m10000 ~a.o1" bm)))
 
   (define (run-larceny bm)
     (parameterize ([current-input-port (open-input-string
@@ -115,6 +121,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
             [sys (ms->milliseconds (cadddr m))])
         (list (+ user sys) real #f))))
 
+  ;; Table of implementatons and benchmarks ------------------------------
+
   (define-struct impl (name make run extract-result clean-up skips))
 
   (define impls
@@ -172,7 +180,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
                 (run-mk "mk-gambit.ss")
                 run-gambit-exe
                 extract-gambit-times
-                clean-up-bin
+                clean-up-o1
                 '(nucleic2))
      (make-impl 'larceny
                 mk-larceny
@@ -214,7 +222,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
                            i))
                     impls)])
       (if (memq bm (impl-skips i))
-          (printf "[~a ~a ~s 0]\n" impl bm '(#f #f #f))
+          (printf "[~a ~a ~s #f]\n" impl bm '(#f #f #f))
           (let ([start (current-inexact-milliseconds)])
             ((impl-make i) bm)
             (let ([end (current-inexact-milliseconds)])
@@ -230,8 +238,9 @@ exec mzscheme -qu "$0" ${1+"$@"}
                             bm
                             ((impl-extract-result i) bm (get-output-bytes out))
                             (inexact->exact (round (- end start)))))
-                  (loop (sub1 n)))))))
+                  (loop (sub1 n)))))
             ((impl-clean-up i) bm)))
+      (flush-output)))
 
   (define no-implementations (map (lambda (s)
                                     (cons (string->symbol (format "no-~a" s))
@@ -249,11 +258,25 @@ exec mzscheme -qu "$0" ${1+"$@"}
   (define default-implementations (remq* obsolte-impls
                                          (map impl-name impls)))
 
+  ;; Extract command-line arguments --------------------
+
   (define args
     (command-line
      "auto"
      (current-command-line-arguments)
      (once-each
+      [("--show") "show implementations and benchmarks"
+       (printf "Implementations:\n")
+       (for-each (lambda (impl)
+                   (printf " ~a\n" impl))
+                 default-implementations)
+       (for-each (lambda (impl)
+                   (printf " ~a [skipped by default]\n" impl))
+                 obsolte-impls)
+       (printf "Benchmarks:\n")
+       (for-each (lambda (bm)
+                   (printf " ~a\n" bm))
+                 benchmarks)]
       [("-n" "--iters") n "set number of run iterations"
        (let ([v (string->number n)])
          (unless (and (number? v)
@@ -263,6 +286,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
          (set! num-iterations v))])
      (args impl-or-benchmark impl-or-benchmark)))
 
+  ;; Process arguments ------------------------------
+
   (for-each (lambda (arg)
               (let ([s (string->symbol arg)])
                 (cond
@@ -288,10 +313,24 @@ exec mzscheme -qu "$0" ${1+"$@"}
                   (error 'auto "mysterious argument: ~a" arg)])))
             args)
 
+  (define actual-benchmarks-to-run 
+    (or run-benchmarks
+        benchmarks))
+
+  (define actual-implementations-to-run 
+    (or run-implementations
+        default-implementations))
+  
+  ;; Benchmark-specific setup --------------------
+
+  (when (memq 'dynamic actual-benchmarks-to-run )
+    (unless (file-exists? "dynamic-input.txt")
+      (gunzip "dynamic-input.txt.gz")))
+
+  ;; Run benchmarks -------------------------------
+
   (map (lambda (impl)
          (map (lambda (bm)
                 (run-benchmark impl bm))
-              (or run-benchmarks
+              actual-benchmarks-to-run ))
-                  benchmarks)))
+       actual-implementations-to-run))
-       (or run-implementations
-           default-implementations)))

collects/tests/mzscheme/benchmarks/common/conform.sch

@@ -612,8 +612,12 @@
 ;(go)
 ;(exit)
 
-(define (conform-benchmark . rest)
+(time (let loop ((n 10))
-  (time (go)))
+        (if (zero? n)
+            'done
+            (begin
+              (go)
+              (loop (- n 1))))))
+
 
-(conform-benchmark)
 

collects/tests/mzscheme/benchmarks/common/destruct.sch

@@ -61,4 +61,10 @@
  
 ;;; call:  (destructive 600 50)
 
-(time (destructive 600 500))
+(let ((input (with-input-from-file "input.txt" read)))
+  (time (let loop ((n 10) (v 0))
+          (if (zero? n)
+              'v
+              (loop (- n 1)
+                    (destructive (if input 600 0) 500))))))
+

collects/tests/mzscheme/benchmarks/common/div.sch

@@ -47,5 +47,11 @@
 ;;; for the iterative test call: (test-1 *ll*)
 ;;; for the recursive test call: (test-2 *ll*)
  
-(time (cons (test-1 *ll*)
+(let ((input (with-input-from-file "input.txt" read)))
-            (test-2 *ll*)))
+  (time (let loop ((n 10) (v 0))
+          (if (zero? n)
+              v
+              (loop (- n 1)
+                    (cons
+                     (test-1 (if input *ll* '()))
+                     (test-2 (if input *ll* '()))))))))

collects/tests/mzscheme/benchmarks/common/mk-gambit.ss

@@ -3,12 +3,8 @@
 
 (define name (vector-ref (current-command-line-arguments) 0))
 
-(when (system (format "gsc -prelude '(include \"gambit-prelude.sch\")' ~a.sch"
+(when (file-exists? (format "~a.o1" name))
+  (delete-file (format "~a.o1" name)))
+
+(system (format "gsc -:m10000 -dynamic -prelude '(include \"gambit-prelude.sch\")' ~a.sch"
                 name))
- (when (system (format "gcc -o ~a -O2 -D___SINGLE_HOST ~a.c ~a_.c -lgambc -lm -ldl~a"
-                name name name
-                (if (file-exists? "/usr/lib/libutil.a")
-                    " -lutil" 
-                    "")))
-   (delete-file (format "~a.c" name))  
-   (delete-file (format "~a_.c" name))))

collects/tests/mzscheme/benchmarks/common/nestedloop.sch

@@ -57,8 +57,8 @@
                                         (loop5 (+ i5 1) result)
                                         (loop6 (+ i6 1) (+ result 1)))))))))))))))
 
-(define cnt (if (with-input-from-file "input.txt" read) 18 1))
+(let ((cnt (if (with-input-from-file "input.txt" read) 18 1)))
-(time (list
+  (time (list
          (loops cnt)
-        (func-loops cnt)))
+         (func-loops cnt))))
 

collects/tests/mzscheme/benchmarks/common/nfa.sch

@@ -1,5 +1,8 @@
 ; The recursive-nfa benchmark.  (Figure 45, page 143.)
 
+;; Changed by Matthew 2006/08/21 to move string->list out of the loop
+
+  
 (define (recursive-nfa input)
   
   (define (state0 input)
@@ -35,11 +38,11 @@
          (char=? (cadr input) #\c)
          'state4))
 
-  (or (state0 (string->list input))
+  (or (state0 input)
       'fail))
 
-(time (let ((input (string-append (make-string 133 #\a) "bc")))
+(time (let ((input (string->list (string-append (make-string 133 #\a) "bc"))))
-        (let loop ((n 10000))
+        (let loop ((n 50000))
           (if (zero? n)
               'done
               (begin

collects/tests/mzscheme/benchmarks/common/tabulate.ss

@@ -1,7 +1,24 @@
+#!/bin/sh
+#|
+exec mzscheme -qu "$0" ${1+"$@"}
+|#
 
 (module tabulate mzscheme
   (require (lib "list.ss")
-           (lib "xml.ss" "xml"))
+           (lib "xml.ss" "xml")
+           (lib "cmdline.ss"))
+
+  (define base-link-filename (make-parameter #f))
+  (define full-page-mode (make-parameter #f))
+
+  (command-line
+   "tabulate"
+   (current-command-line-arguments)
+   (once-each
+    [("--multi") name "generate multiple pages for different views of data"
+     (base-link-filename name)]
+    [("--index") "generate full page with an index.html link"
+     (full-page-mode #t)]))
   
   (define bm-table (make-hash-table))
   (define impls (make-hash-table))
@@ -72,14 +89,48 @@
               "#DDFFDD")
           (loop (cdr impls) (not odd?)))))
 
+  (define (wrap-page relative-to p)
+    (if (full-page-mode)
+        (let ([title (format "~a normalized to ~a"
+                             (or (base-link-filename)
+                                 "results")
+                             (or relative-to
+                                 "fastest"))])
+          `(html
+            (head (title ,title)
+                  (body
+                   (h1 ,title) 
+                   (p "See also " (a ((href "index.html"))
+                                     "about the benchmarks")
+                      ".")
+                   (p ,p)))))
+        p))
+
+  (define (generate-page relative-to)
     (empty-tag-shorthand html-empty-tags)
     (write-xml/content 
      (xexpr->xml
+      (wrap-page
+       relative-to
        `(table
          (tr (td nbsp) 
-          (td ((colspan "2") (align "right")) "Fastest")
+             (td ((colspan "2") (align "right")) 
+                 ,(if (and (base-link-filename)
+                           relative-to)
+                      `(a ((href ,(format "~a.html" (base-link-filename))))
+                          "fastest")
+                      "fastest"))
              ,@(map (lambda (impl)
-                   `(td ((colspan "2") (align "right")) (b ,(symbol->string impl)) nbsp))
+                      `(td ((colspan "2") (align "right")) 
+                           (b ,(let ([s (symbol->string impl)])
+                                 (if (and (base-link-filename)
+                                          (not (eq? impl relative-to)))
+                                     `(a ((href ,(format "~a-~a.html"
+                                                         (base-link-filename)
+                                                         impl)))
+                                         ,s)
+                                     s)))
+                           nbsp))
                     sorted-impls))
          ,@(map (lambda (bm-run)
                   (let ([fastest (apply min (map (lambda (run)
@@ -87,11 +138,19 @@
                                                  (cdr bm-run)))]
                         [c-fastest (apply min (map (lambda (run)
                                                      (let ([v (caddr run)])
-                                                    (if (zero? v) 
+                                                       (or (and v (positive? v) v)
-                                                        1000000000
+                                                           1000000000)))
-                                                        v)))
                                                    (cdr bm-run)))])
-                 `(tr (td (a ((href ,(format "~a.sch" (car bm-run))))
+                    (let-values ([(base c-base)
+                                  (if relative-to
+                                      (let ([a (assq relative-to (cdr bm-run))])
+                                        (if a
+                                            (values (caadr a) (caddr a))
+                                            (values #f #f)))
+                                      (values fastest c-fastest))])
+                      `(tr (td (a ((href ,(format (string-append "http://svn.plt-scheme.org/plt/trunk/collects/"
+                                                                 "tests/mzscheme/benchmarks/common/~a.sch")
+                                                  (car bm-run))))
                                   ,(symbol->string (car bm-run))))
                            (td ((align "right"))
                                nbsp
@@ -107,17 +166,31 @@
                                             [n (and a (caadr a))])
                                        `((td ((align "right")
                                               (bgcolor ,(lookup-color impl)))
-                                        ,(if n
+                                             ,(if (and n c-base (positive? c-base))
-                                             (small (ratio->string (/ (caddr a) c-fastest)))
+                                                  (small (ratio->string (/ (caddr a) c-base)))
                                                   '"-")
                                              nbsp)
                                          (td ((bgcolor ,(lookup-color impl)))
-                                        ,(if n
+                                             ,(if (and n base)
-                                             (if (= n fastest)
+                                                  (if (= n base)
-                                                 '(font ((color "blue")) (b "1"))
+                                                      '(font ((color "forestgreen")) (b "1"))
-                                                 (ratio->string (/ n fastest)))
+                                                      (ratio->string (/ n base)))
                                                   "-")
                                              nbsp))))
-                              sorted-impls)))))
+                                   sorted-impls))))))
-             sorted-runs))))
+                sorted-runs)))))
     (newline))
+
+  (if (base-link-filename)
+      (for-each (lambda (impl)
+                  (with-output-to-file (if impl
+                                           (format "~a-~a.html" 
+                                                   (base-link-filename)
+                                                   impl)
+                                           (format "~a.html"
+                                                   (base-link-filename)))
+                    (lambda () (generate-page impl))
+                    'truncate))
+                (cons #f sorted-impls))
+      (generate-page #f)))
+

collects/tests/mzscheme/benchmarks/common/tak.sch

@@ -20,4 +20,9 @@
  
 ;;; call: (tak 18 12 6)
 
-(time (tak 18 12 (if (with-input-from-file "input.txt" read) 2 0)))
+(let ((input (with-input-from-file "input.txt" read)))
+  (time
+   (let loop ((n 500) (v 0))
+     (if (zero? n)
+         v
+         (loop (- n 1) (tak 18 12 (if input 6 0)))))))

collects/tests/mzscheme/benchmarks/common/takl.sch

@@ -38,4 +38,6 @@
  
 ;;; call: (mas 18l 12l 6l)
 
-(time (mas 18l 12l 6l))
+
+(let ((v (if (with-input-from-file "input.txt" read) 6l '())))
+  (time (mas 18l 12l v)))

collects/tests/mzscheme/benchmarks/common/takr.sch

@@ -517,5 +517,9 @@
  
 ;;; call:  (tak0 18 12 6)
 
-(time (tak0 18 12 (if (with-input-from-file "input.txt" read) 2 0)))
+(let ((input (with-input-from-file "input.txt" read)))
-
+  (time
+   (let loop ((n 500) (v 0))
+     (if (zero? n)
+         v
+         (loop (- n 1) (tak0 18 12 (if input 6 0)))))))

collects/tests/mzscheme/benchmarks/common/wrap.ss

@@ -4,4 +4,6 @@
   (require (lib "include.ss"))
   (define-syntax (module-begin stx)
     (let ([name (syntax-property stx 'enclosing-module-name)])
-      #`(#%plain-module-begin (include #,(format "~a.sch" name))))))
+      #`(#%plain-module-begin 
+         (require "map.ss")
+         (include #,(format "~a.sch" name))))))