diff --git a/collects/tests/mzscheme/benchmarks/common/README.txt b/collects/tests/mzscheme/benchmarks/common/README.txt index 8711a9281c..69341a6fe1 100644 --- a/collects/tests/mzscheme/benchmarks/common/README.txt +++ b/collects/tests/mzscheme/benchmarks/common/README.txt @@ -1,29 +1,35 @@ -To run a benchmark: - mzscheme -qu auto.ss ... +To run a benchmark, assuming you have `mzscheme' in your path: + ./auto.ss ... where 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 -. +. To see a complete list of implementations +and benchmarks, run + ./auto.ss --show -Naming no implementation/benchmark causes all of them to be run, -except ones omitted by default. Similarly, if the first named +Naming no implementation/benchmark causes a standard of them to be run +(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 [ ( ) ] +where #f means that the information is unavailable, or that the +benchmark wasn't run due to an implementation limitation. The + and 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 .sch directly with Gambit, Bigloo, or Chicken: - mzscheme -qr mk-gambit.ss - mzscheme -qr mk-bigloo.ss - mzscheme -qr mk-chicken.ss + mzscheme -qr mk-gambit.ss ; gsi -:m10000 .o1 + mzscheme -qr mk-bigloo.ss ; + mzscheme -qr mk-chicken.ss ; -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. diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index 9ddc8f5a79..664f68c6ca 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/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))))))) - ((impl-clean-up i) bm))) + (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 - benchmarks))) - (or run-implementations - default-implementations))) + actual-benchmarks-to-run )) + actual-implementations-to-run)) diff --git a/collects/tests/mzscheme/benchmarks/common/conform.sch b/collects/tests/mzscheme/benchmarks/common/conform.sch index bb088270c5..dadcc5d91f 100644 --- a/collects/tests/mzscheme/benchmarks/common/conform.sch +++ b/collects/tests/mzscheme/benchmarks/common/conform.sch @@ -612,8 +612,12 @@ ;(go) ;(exit) -(define (conform-benchmark . rest) - (time (go))) +(time (let loop ((n 10)) + (if (zero? n) + 'done + (begin + (go) + (loop (- n 1)))))) + -(conform-benchmark) diff --git a/collects/tests/mzscheme/benchmarks/common/destruct.sch b/collects/tests/mzscheme/benchmarks/common/destruct.sch index d401409cc3..bbc4473e81 100644 --- a/collects/tests/mzscheme/benchmarks/common/destruct.sch +++ b/collects/tests/mzscheme/benchmarks/common/destruct.sch @@ -60,5 +60,11 @@ (set-car! a i)))))))))))) ;;; 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)))))) + diff --git a/collects/tests/mzscheme/benchmarks/common/div.sch b/collects/tests/mzscheme/benchmarks/common/div.sch index c9e8a3650d..cbdaeb0850 100644 --- a/collects/tests/mzscheme/benchmarks/common/div.sch +++ b/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*) - (test-2 *ll*))) +(let ((input (with-input-from-file "input.txt" read))) + (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* '())))))))) diff --git a/collects/tests/mzscheme/benchmarks/common/mk-gambit.ss b/collects/tests/mzscheme/benchmarks/common/mk-gambit.ss index d3f3e1424b..3fe4cf1bad 100644 --- a/collects/tests/mzscheme/benchmarks/common/mk-gambit.ss +++ b/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" - 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)))) +(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)) diff --git a/collects/tests/mzscheme/benchmarks/common/nestedloop.sch b/collects/tests/mzscheme/benchmarks/common/nestedloop.sch index 745b2a62fd..64c6c0569c 100644 --- a/collects/tests/mzscheme/benchmarks/common/nestedloop.sch +++ b/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)) -(time (list - (loops cnt) - (func-loops cnt))) +(let ((cnt (if (with-input-from-file "input.txt" read) 18 1))) + (time (list + (loops cnt) + (func-loops cnt)))) diff --git a/collects/tests/mzscheme/benchmarks/common/nfa.sch b/collects/tests/mzscheme/benchmarks/common/nfa.sch index 5f35c0d528..2b3aa06d3a 100644 --- a/collects/tests/mzscheme/benchmarks/common/nfa.sch +++ b/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) @@ -34,12 +37,12 @@ (not (null? (cdr input))) (char=? (cadr input) #\c) 'state4)) - - (or (state0 (string->list input)) + + (or (state0 input) 'fail)) -(time (let ((input (string-append (make-string 133 #\a) "bc"))) - (let loop ((n 10000)) +(time (let ((input (string->list (string-append (make-string 133 #\a) "bc")))) + (let loop ((n 50000)) (if (zero? n) 'done (begin diff --git a/collects/tests/mzscheme/benchmarks/common/tabulate.ss b/collects/tests/mzscheme/benchmarks/common/tabulate.ss old mode 100644 new mode 100755 index 6edc7ccaf1..61fc586659 --- a/collects/tests/mzscheme/benchmarks/common/tabulate.ss +++ b/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,52 +89,108 @@ "#DDFFDD") (loop (cdr impls) (not odd?))))) - (empty-tag-shorthand html-empty-tags) - (write-xml/content - (xexpr->xml - `(table - (tr (td nbsp) - (td ((colspan "2") (align "right")) "Fastest") - ,@(map (lambda (impl) - `(td ((colspan "2") (align "right")) (b ,(symbol->string impl)) nbsp)) - sorted-impls)) - ,@(map (lambda (bm-run) - (let ([fastest (apply min (map (lambda (run) - (or (caadr run) 1000000000)) - (cdr bm-run)))] - [c-fastest (apply min (map (lambda (run) - (let ([v (caddr run)]) - (if (zero? v) - 1000000000 - v))) - (cdr bm-run)))]) - `(tr (td (a ((href ,(format "~a.sch" (car bm-run)))) - ,(symbol->string (car bm-run)))) - (td ((align "right")) - nbsp - ,(small (number->string c-fastest)) - nbsp) - (td ((align "right")) - ,(format "~a ms" fastest) - nbsp nbsp) - ,@(apply - append - (map (lambda (impl) - (let* ([a (assq impl (cdr bm-run))] - [n (and a (caadr a))]) - `((td ((align "right") - (bgcolor ,(lookup-color impl))) - ,(if n - (small (ratio->string (/ (caddr a) c-fastest))) - '"-") - nbsp) - (td ((bgcolor ,(lookup-color impl))) - ,(if n - (if (= n fastest) - '(font ((color "blue")) (b "1")) - (ratio->string (/ n fastest))) - "-") - nbsp)))) - sorted-impls))))) - sorted-runs)))) - (newline)) + (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")) + ,(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 ,(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) + (or (caadr run) 1000000000)) + (cdr bm-run)))] + [c-fastest (apply min (map (lambda (run) + (let ([v (caddr run)]) + (or (and v (positive? v) v) + 1000000000))) + (cdr 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 + ,(small (number->string c-fastest)) + nbsp) + (td ((align "right")) + ,(format "~a ms" fastest) + nbsp nbsp) + ,@(apply + append + (map (lambda (impl) + (let* ([a (assq impl (cdr bm-run))] + [n (and a (caadr a))]) + `((td ((align "right") + (bgcolor ,(lookup-color impl))) + ,(if (and n c-base (positive? c-base)) + (small (ratio->string (/ (caddr a) c-base))) + '"-") + nbsp) + (td ((bgcolor ,(lookup-color impl))) + ,(if (and n base) + (if (= n base) + '(font ((color "forestgreen")) (b "1")) + (ratio->string (/ n base))) + "-") + nbsp)))) + sorted-impls)))))) + 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))) + diff --git a/collects/tests/mzscheme/benchmarks/common/tak.sch b/collects/tests/mzscheme/benchmarks/common/tak.sch index 38179fca9a..a795edcea0 100644 --- a/collects/tests/mzscheme/benchmarks/common/tak.sch +++ b/collects/tests/mzscheme/benchmarks/common/tak.sch @@ -19,5 +19,10 @@ (tak (- z 1) x y)))) ;;; 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))))))) diff --git a/collects/tests/mzscheme/benchmarks/common/takl.sch b/collects/tests/mzscheme/benchmarks/common/takl.sch index d7f3082abd..7ea451e2f4 100644 --- a/collects/tests/mzscheme/benchmarks/common/takl.sch +++ b/collects/tests/mzscheme/benchmarks/common/takl.sch @@ -37,5 +37,7 @@ (cdr y))))) ;;; 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))) diff --git a/collects/tests/mzscheme/benchmarks/common/takr.sch b/collects/tests/mzscheme/benchmarks/common/takr.sch index 3d3dcd51db..ef46d38794 100644 --- a/collects/tests/mzscheme/benchmarks/common/takr.sch +++ b/collects/tests/mzscheme/benchmarks/common/takr.sch @@ -516,6 +516,10 @@ (tak0 (- z 1) x y))))) ;;; 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))))))) diff --git a/collects/tests/mzscheme/benchmarks/common/wrap.ss b/collects/tests/mzscheme/benchmarks/common/wrap.ss index be0d9d0af0..cc5b87f400 100644 --- a/collects/tests/mzscheme/benchmarks/common/wrap.ss +++ b/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))))))