make benchmark durations more consistent, clean up p anti-specialization wrappers, clean up infrastructure, and support per-implementation normalization
svn: r4109
This commit is contained in:
Matthew Flatt
parent
c0ce55afb4
commit
950c45c9ac
|
|
@ -1,29 +1,35 @@
|
|||
To run a benchmark:
|
||||
mzscheme -qu auto.ss <impl-or-benchmark> ...
|
||||
To run a benchmark, assuming you have `mzscheme' in your path:
|
||||
./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,
|
||||
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
|
||||
[<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-bigloo.ss <banchmark>
|
||||
mzscheme -qr mk-chicken.ss <banchmark>
|
||||
mzscheme -qr mk-gambit.ss <benchmark> ; gsi -:m10000 <benchmark>.o1
|
||||
mzscheme -qr mk-bigloo.ss <benchmark> ; <benchmark>
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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* '()))))))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
173
collects/tests/mzscheme/benchmarks/common/tabulate.ss
Normal file → Executable file
173
collects/tests/mzscheme/benchmarks/common/tabulate.ss
Normal file → Executable file
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user