suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
svn: r4109
This commit is contained in:
Matthew Flatt 2006-08-22 05:14:18 +00:00
parent c0ce55afb4
commit 950c45c9ac
13 changed files with 249 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/tests/mzscheme/benchmarks/common/README.txt
View File

@ -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.

55
collects/tests/mzscheme/benchmarks/common/auto.ss
View File

@ -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
benchmarks)))
(or run-implementations
default-implementations)))
actual-benchmarks-to-run ))
actual-implementations-to-run))

10
collects/tests/mzscheme/benchmarks/common/conform.sch
View File

@ -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)

8
collects/tests/mzscheme/benchmarks/common/destruct.sch
View File

@ -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))))))

10
collects/tests/mzscheme/benchmarks/common/div.sch
View File

@ -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* '()))))))))

12
collects/tests/mzscheme/benchmarks/common/mk-gambit.ss
View File

@ -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))))

6
collects/tests/mzscheme/benchmarks/common/nestedloop.sch
View File

@ -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
(let ((cnt (if (with-input-from-file "input.txt" read) 18 1)))
(time (list
(loops cnt)
(func-loops cnt)))
(func-loops cnt))))

9
collects/tests/mzscheme/benchmarks/common/nfa.sch
View File

@ -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")))
(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

103
collects/tests/mzscheme/benchmarks/common/tabulate.ss Normal file → Executable file
View 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,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)
1000000000
v)))
(or (and v (positive? v) v)
1000000000)))
(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
(small (ratio->string (/ (caddr a) c-fastest)))
,(if (and n c-base (positive? c-base))
(small (ratio->string (/ (caddr a) c-base)))
'"-")
nbsp)
(td ((bgcolor ,(lookup-color impl)))
,(if n
(if (= n fastest)
'(font ((color "blue")) (b "1"))
(ratio->string (/ n fastest)))
,(if (and n base)
(if (= n base)
'(font ((color "forestgreen")) (b "1"))
(ratio->string (/ n base)))
"-")
nbsp))))
sorted-impls)))))
sorted-runs))))
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)))

7
collects/tests/mzscheme/benchmarks/common/tak.sch
View File

@ -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)))))))

4
collects/tests/mzscheme/benchmarks/common/takl.sch
View File

@ -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)))

8
collects/tests/mzscheme/benchmarks/common/takr.sch
View File

@ -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)))))))

4
collects/tests/mzscheme/benchmarks/common/wrap.ss
View File

@ -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))))))