diff --git a/collects/tests/racket/benchmarks/shootout/README.txt b/collects/tests/racket/benchmarks/shootout/README.txt index 92f473aa75..07fc9cc716 100644 --- a/collects/tests/racket/benchmarks/shootout/README.txt +++ b/collects/tests/racket/benchmarks/shootout/README.txt @@ -2,4 +2,4 @@ The program "run" should know how to run each benchmark with its standard input value. So run like this: - racket run.rkt + racket run.rkt [racket|typed-scheme|typed-scheme-optimizing] diff --git a/collects/tests/racket/benchmarks/shootout/typed/auto.rkt b/collects/tests/racket/benchmarks/shootout/auto.rkt similarity index 90% rename from collects/tests/racket/benchmarks/shootout/typed/auto.rkt rename to collects/tests/racket/benchmarks/shootout/auto.rkt index 8724475ed2..6fb2940d01 100755 --- a/collects/tests/racket/benchmarks/shootout/typed/auto.rkt +++ b/collects/tests/racket/benchmarks/shootout/auto.rkt @@ -9,7 +9,7 @@ exec racket -qu "$0" ${1+"$@"} (module auto scheme/base (require (for-syntax scheme/base) mzlib/process - "../../common/cmdline.rkt" + "../common/cmdline.rkt" mzlib/list mzlib/compile mzlib/inflate @@ -33,38 +33,38 @@ exec racket -qu "$0" ${1+"$@"} (load script))) (define (mk-racket bm) - (unless (directory-exists? "../compiled") - (make-directory "../compiled")) + (unless (directory-exists? "compiled") + (make-directory "compiled")) (parameterize ([current-namespace (make-base-namespace)] [read-accept-reader #t]) (let ([name (format "~a.rkt" bm)]) - (compile-file (format "../~a" name) - (build-path "../compiled" (path-add-suffix name #".zo")))))) + (compile-file name + (build-path "compiled" (path-add-suffix name #".zo")))))) (define (clean-up-zo bm) - (when (directory-exists? "../compiled") - (delete-directory/files "../compiled"))) + (when (directory-exists? "compiled") + (delete-directory/files "compiled"))) (define (mk-typed-scheme bm) - (unless (directory-exists? "compiled") - (make-directory "compiled")) + (unless (directory-exists? "typed/compiled") + (make-directory "typed/compiled")) (parameterize ([current-namespace (make-base-namespace)] [read-accept-reader #t]) (let ([name (format "~a-non-optimizing.rkt" bm)]) - (compile-file name - (build-path "compiled" (path-add-suffix name #".zo")))))) + (compile-file (format "typed/~a" name) + (build-path "typed/compiled" (path-add-suffix name #".zo")))))) (define (mk-typed-scheme-optimizing bm) - (unless (directory-exists? "compiled") - (make-directory "compiled")) + (unless (directory-exists? "typed/compiled") + (make-directory "typed/compiled")) (parameterize ([current-namespace (make-base-namespace)] [read-accept-reader #t]) (let ([name (format "~a-optimizing.rkt" bm)]) - (compile-file name - (build-path "compiled" (path-add-suffix name #".zo")))))) + (compile-file (format "typed/~a" name) + (build-path "typed/compiled" (path-add-suffix name #".zo")))))) (define (clean-up-typed bm) - (when (directory-exists? "compiled") - (delete-directory/files "compiled"))) + (when (directory-exists? "typed/compiled") + (delete-directory/files "typed/compiled"))) (define (extract-racket-times bm str) (let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+) gc time: ([0-9]+)" str)]) @@ -136,7 +136,6 @@ exec racket -qu "$0" ${1+"$@"} pidigits1 random recursive - regexmatch regexpdna reversecomplement reversefile @@ -148,7 +147,8 @@ exec racket -qu "$0" ${1+"$@"} wordfreq)) (define without-input-benchmarks - '(spellcheck)) + '(regexmatch + spellcheck)) (define (run-benchmark impl bm) (let ([i (ormap (lambda (i) diff --git a/collects/tests/racket/benchmarks/shootout/run.rkt b/collects/tests/racket/benchmarks/shootout/run.rkt index 0a7d88ca31..a9669b7f73 100644 --- a/collects/tests/racket/benchmarks/shootout/run.rkt +++ b/collects/tests/racket/benchmarks/shootout/run.rkt @@ -1,52 +1,53 @@ (module run mzscheme - (require (only scheme/runtime-path define-runtime-path)) + (require (only scheme/runtime-path define-runtime-path) + racket/port) (define input-map `( - ("ackermann.rkt" "11") - ("ary.rkt" "9000") - ("binarytrees.rkt" "16") - ("chameneos.rkt" "1000000") - ("cheapconcurrency.rkt" "15000") - ("echo.rkt" "150000") - ("except.rkt" "2500000") - ("fannkuch.rkt" "10") - ("fasta.rkt" "25000000") - ("fibo.rkt" "32") - ("hash.rkt" "100000") - ("hash2.rkt" "200") - ("heapsort.rkt" "100000") - ("lists.rkt" "18") - ("mandelbrot.rkt" "3000") - ("matrix.rkt" "600") - ("moments.rkt" #f ,(lambda () (mk-sumcol-input))) - ("nbody.rkt" "20000000") - ("nestedloop.rkt" "18") - ("nsieve.rkt" "9") - ("nsievebits.rkt" "11") - ("partialsums.rkt" "2500000") - ("pidigits.rkt" "2500") - ("pidigits1.rkt" "2500") - ("random.rkt" "900000") - ("recursive.rkt" "11") - ("regexmatch.rkt") - ("regexpdna.rkt" #f ,(lambda () (mk-regexpdna-input))) - ("reversecomplement.rkt" #f ,(lambda () (mk-revcomp-input))) - ("k-nucleotide.rkt" #f ,(lambda () (mk-knuc-input))) - ("reversefile.rkt" #f ,(lambda () (mk-sumcol-input))) - ("sieve.rkt" "1200") - ("spellcheck.rkt") - ("spectralnorm.rkt" "5500") - ("spectralnorm-unsafe.rkt" "5500") - ("strcat.rkt" "40000") - ("sumcol.rkt" #f ,(lambda () (mk-sumcol-input))) - ("wc.rkt" #f ,(lambda () (mk-sumcol-input))) - ("wordfreq.rkt" #f ,(lambda () (mk-sumcol-input))) + ("ackermann" "11") + ("ary" "9000") + ("binarytrees" "16") + ("chameneos" "1000000") + ("cheapconcurrency" "15000") + ("echo" "150000") + ("except" "2500000") + ("fannkuch" "10") + ("fasta" "25000000") + ("fibo" "32") + ("hash" "100000") + ("hash2" "200") + ("heapsort" "100000") + ("lists" "18") + ("mandelbrot" "3000") + ("matrix" "600") + ("moments" #f ,(lambda () (mk-sumcol-input))) + ("nbody" "20000000") + ("nestedloop" "18") + ("nsieve" "9") + ("nsievebits" "11") + ("partialsums" "2500000") + ("pidigits" "2500") + ("pidigits1" "2500") + ("random" "900000") + ("recursive" "11") + ("regexmatch") + ("regexpdna" #f ,(lambda () (mk-regexpdna-input))) + ("reversecomplement" #f ,(lambda () (mk-revcomp-input))) + ("k-nucleotide" #f ,(lambda () (mk-knuc-input))) + ("reversefile" #f ,(lambda () (mk-sumcol-input))) + ("sieve" "1200") + ("spellcheck") + ("spectralnorm" "5500") + ("strcat" "40000") + ("sumcol" #f ,(lambda () (mk-sumcol-input))) + ("wc" #f ,(lambda () (mk-sumcol-input))) + ("wordfreq" #f ,(lambda () (mk-sumcol-input))) )) (define-runtime-path here ".") (define (dynreq f) - (parameterize ([current-load-relative-directory here]) + (parameterize ([current-load-relative-directory here] + [current-output-port (open-output-nowhere)]) (dynamic-require f #f))) (define (mk-fasta n suffix) @@ -89,20 +90,28 @@ (define iters (let ([len (vector-length (current-command-line-arguments))]) - (unless (<= 1 len 2) - (printf "provide ~athe name of a benchmark on the command line and an optional iteration count\n" + (unless (<= 1 len 3) + (printf "provide ~athe name of a benchmark on the command line, an optional version of the benchmark to run, and an optional iteration count\n" (if (zero? len) "" "ONLY ")) (exit)) - (if (= len 2) - (string->number (vector-ref (current-command-line-arguments) 1)) + (if (= len 3) + (string->number (vector-ref (current-command-line-arguments) 2)) 1))) - (let ([prog (vector-ref (current-command-line-arguments) 0)]) - (let ([m (assoc prog input-map)]) + (let* ([version (if (< (vector-length (current-command-line-arguments)) 2) + "racket" + (vector-ref (current-command-line-arguments) 1))] + [bench (vector-ref (current-command-line-arguments) 0)] + [prog (cond + ((string=? version "racket") (format "~a.rkt" bench)) + ((string=? version "typed-scheme") (format "typed/~a-non-optimizing.rkt" bench)) + ((string=? version "typed-scheme-optimizing") (format "typed/~a-optimizing.rkt" bench)) + (else (error 'run "unknown version ~a" version)))]) + (let ([m (assoc bench input-map)]) (unless m - (error 'run "cannot find input for ~a" prog)) + (error 'run "cannot find input for ~a" bench)) (when (null? (cdr m)) - (error 'run "don't know input for ~a" prog)) + (error 'run "don't know input for ~a" bench)) (let loop ([n iters]) (parameterize ([current-command-line-arguments (if (cadr m) diff --git a/collects/tests/racket/benchmarks/shootout/typed/run.rkt b/collects/tests/racket/benchmarks/shootout/typed/run.rkt deleted file mode 100644 index c5b136dcd4..0000000000 --- a/collects/tests/racket/benchmarks/shootout/typed/run.rkt +++ /dev/null @@ -1,128 +0,0 @@ -(module run mzscheme - (require (only scheme/runtime-path define-runtime-path) - racket/port) - (define input-map - `( - ("ackermann" "11") - ("ary" "9000") - ("binarytrees" "16") - ("chameneos" "1000000") - ("cheapconcurrency" "15000") - ("echo" "150000") - ("except" "2500000") - ("fannkuch" "10") - ("fasta" "25000000") - ("fibo" "32") - ("hash" "100000") - ("hash2" "200") - ("heapsort" "100000") - ("lists" "18") - ("mandelbrot" "3000") - ("matrix" "600") - ("moments" #f ,(lambda () (mk-sumcol-input))) - ("nbody" "20000000") - ("nestedloop" "18") - ("nsieve" "9") - ("nsievebits" "11") - ("partialsums" "2500000") - ("pidigits" "2500") - ("pidigits1" "2500") - ("random" "900000") - ("recursive" "11") - ("regexmatch") - ("regexpdna" #f ,(lambda () (mk-regexpdna-input))) - ("reversecomplement" #f ,(lambda () (mk-revcomp-input))) - ("k-nucleotide" #f ,(lambda () (mk-knuc-input))) - ("reversefile" #f ,(lambda () (mk-sumcol-input))) - ("sieve" "1200") - ("spellcheck") - ("spectralnorm" "5500") - ("spectralnorm-unsafe" "5500") - ("strcat" "40000") - ("sumcol" #f ,(lambda () (mk-sumcol-input))) - ("wc" #f ,(lambda () (mk-sumcol-input))) - ("wordfreq" #f ,(lambda () (mk-sumcol-input))) - )) - - (define-runtime-path here ".") - - (define (dynreq f) - (parameterize ([current-load-relative-directory here] - [current-output-port (open-output-nowhere)]) - (dynamic-require f #f))) - - (define (mk-fasta n suffix) - (let ([f (build-path (find-system-path 'temp-dir) (string-append "fasta-" suffix))]) - (unless (file-exists? f) - (printf "Building FASTA ~a output for input: ~a\n" n f) - (with-output-to-file f - (lambda () - (parameterize ([current-command-line-arguments (vector n)]) - (dynreq "../fasta.rkt"))))) ; we can use the untyped version to generate inputs - f)) - - (define (mk-revcomp-input) - (mk-fasta "2500000" "2m5")) - - (define (mk-knuc-input) - (mk-fasta "1000000" "1m")) - - (define (mk-regexpdna-input) - (mk-fasta "5000000" "5m")) - - (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") - "racket" - "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 (<= 2 len 3) - (printf "provide ~athe name of a benchmark on the command line, which version of the benchmark to run, and an optional iteration count\n" - (if (<= len 1) "" "ONLY ")) - (exit)) - (if (= len 3) - (string->number (vector-ref (current-command-line-arguments) 2)) - 1))) - - (let* ([version (vector-ref (current-command-line-arguments) 1)] ; racket, typed-scheme, typed-scheme-optimizing - [bench (vector-ref (current-command-line-arguments) 0)] - [prog (cond - ((string=? version "racket") (format "../~a.rkt" bench)) - ((string=? version "typed-scheme") (format "~a-non-optimizing.rkt" bench)) - ((string=? version "typed-scheme-optimizing") (format "~a-optimizing.rkt" bench)) - (else (error 'run "unknown version ~a" version)))]) - (let ([m (assoc bench input-map)]) - (unless m - (error 'run "cannot find input for ~a" bench)) - (when (null? (cdr m)) - (error 'run "don't know input for ~a" bench)) - (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) - (collect-garbage) - (time (dynreq prog)))) - (unless (= n 1) - (loop (sub1 n)))))))