mostly improvements to run.ss benchmark-running script

svn: r5423

collects/tests/mzscheme/benchmarks/shootout/reversecomplement.ss

@@ -43,7 +43,7 @@
 	(if (eof-object? l)
 	    (output accum)
 	    (cond
-	     [(regexp-match #rx#"^>" l)
+	     [(regexp-match? #rx#"^>" l)
 	      (output accum)
 	      (printf "~a\n" l)
 	      (loop null)]

collects/tests/mzscheme/benchmarks/shootout/run.ss

@@ -1,54 +1,102 @@
 (module run mzscheme
   (define input-map
-    '(
-      ("ackermann.ss" . "11")
-      ("ary.ss" . "9000")
-      ("binarytrees.ss" . "16")
+    `(
+      ("ackermann.ss" "11")
+      ("ary.ss" "9000")
+      ("binarytrees.ss" "16")
       ("chameneos.ss")
       ("cheapconcurrency.ss")
-      ("echo.ss" . "150000")
-      ("except.ss" . "2500000")
-      ("fannkuch.ss" . "10")
-      ("fasta.ss")
-      ("fibo.ss" . "32")
-      ("hash.ss" . "100000")
-      ("hash2.ss" . "200")
-      ("heapsort.ss" . "100000")
-      ("lists.ss" . "18")
+      ("echo.ss" "150000")
+      ("except.ss" "2500000")
+      ("fannkuch.ss" "10")
+      ("fasta.ss" "25000000")
+      ("fibo.ss" "32")
+      ("hash.ss" "100000")
+      ("hash2.ss" "200")
+      ("heapsort.ss" "100000")
+      ("lists.ss" "18")
       ("mandelbrot.ss")
-      ("matrix.ss" . "600")
-      ("moments.ss") 200 somethings...
+      ("matrix.ss" "600")
+      ("moments.ss") ; 200 somethings...
       ("nbody.ss")
-      ("nestedloop.ss" . "18")
+      ("nestedloop.ss" "18")
       ("nsieve.ss")
       ("nsievebits.ss")
       ("partialsums.ss")
       ("pidigits.ss")
       ("pidigits1.ss")
-      ("random.ss" . "900000")
+      ("random.ss" "900000")
       ("recursive.ss")
       ("regexmatch.ss")
       ("regexpdna.ss")
-      ("reversecomplement.ss")
+      ("reversecomplement.ss" #f ,(lambda () (mk-revcomp-input)))
       ("reversefile.ss")
-      ("sieve.ss" . "1200")
+      ("sieve.ss" "1200")
       ("spellcheck.ss")
-      ("strcat.ss" . "40000")
-      ("sumcol.ss")
+      ("strcat.ss" "40000")
+      ("sumcol.ss" #f ,(lambda () (mk-sumcol-input)))
       ("wc.ss")
       ("wordfreq.ss")
       ))
 
-  (let ([len (vector-length (current-command-line-arguments))])
-    (unless (= 1 len)
-      (error 'run "provide ~athe name of a benchmark on the command line"
-             (if (zero? len) "" "ONLY "))))
+  (define (dynreq f)
+    (dynamic-require `(lib ,f "tests" "mzscheme" "benchmarks" "shootout") #f))
 
+  (define (mk-revcomp-input)
+    (let ([f (build-path (find-system-path 'temp-dir) "fasta-2m5")])
+      (unless (file-exists? f)
+        (printf "Building FASTA 2,500,000 output for input: ~a\n" f)
+        (with-output-to-file f
+          (lambda ()
+            (parameterize ([current-command-line-arguments (vector "2500000")])
+              (dynreq "fasta.ss")))))
+      f))
+
+  (define (mk-sumcol-input)
+    (let ([f (build-path (find-system-path 'temp-dir) "sumcol-21k")])
+      (unless (file-exists? f)
+        (printf "Building sumcol 21000 input: ~a\n" f)
+        (let ([c (with-input-from-file (build-path (collection-path "tests")
+                                                   "mzscheme"
+                                                   "benchmarks"
+                                                   "shootout"
+                                                   "sumcol-input.txt")
+                   (lambda ()
+                     (read-bytes 10000)))])
+          (with-output-to-file f
+            (lambda ()
+              (let loop ([n 21000])
+                (unless (zero? n)
+                  (printf "~a" c)
+                  (loop (sub1 n))))))))
+      f))
+
+  (define iters
+    (let ([len (vector-length (current-command-line-arguments))])
+      (unless (<= 1 len 2)
+        (error 'run "provide ~athe name of a benchmark on the command line and an optional iteration count"
+               (if (zero? len) "" "ONLY ")))
+      (if (= len 2)
+          (string->number (vector-ref (current-command-line-arguments) 1))
+          1)))
+      
   (let ([prog (vector-ref (current-command-line-arguments) 0)])
     (let ([m (assoc prog input-map)])
       (unless m
         (error 'run "cannot find input for ~a" prog))
       (when (null? (cdr m))
         (error 'run "don't know input for ~a" prog))
-      (parameterize ([current-command-line-arguments (vector (cdr m))])
-        (time (dynamic-require prog #f))))))
+      (let loop ([n iters])
+        (parameterize ([current-command-line-arguments 
+                        (if (cadr m)
+                            (vector (cadr m))
+                            (vector))]
+                       [current-input-port
+                        (if (null? (cddr m))
+                            (current-input-port)
+                            (open-input-file ((caddr m))))])
+          (parameterize ([current-namespace (make-namespace)])
+            (collect-garbage)
+            (time (dynreq prog))))
+        (unless (= n 1)
+          (loop (sub1 n)))))))