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

even more benchmark scaffolding

Browse Source 
svn: r17884
This commit is contained in:
Matthew Flatt 2010-01-29 16:33:15 +00:00
parent d634beb1eb
commit 42e68c8ff1
8 changed files with 297 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -157,6 +157,89 @@ exec mzscheme -qu "$0" ${1+"$@"}
(clean-up-sps bm)
(system "rm -rf ~/.ikarus"))
(define (run-scheme48 bm)
(parameterize ([current-input-port
(open-input-string
(format
",bench on\n,open time bitwise\n,load \"scheme48-prelude.sch\"\n,load \"~a.sch\"\n,exit\n"
bm))])
(system "scheme48 -h 20000000")))
(define (extract-scheme48-times bm str)
(let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+)" str)]
;; `time' result is 10s of milliseconds? OS ticks, maybe?
[msec/tick 10])
(list (bytes->number (cadr m))
(bytes->number (caddr m))
0)))
(define (mk-mit bm)
(with-output-to-file (format "~a.scm" bm)
#:exists 'truncate
(lambda ()
(printf "(declare (usual-integrations))\n")
(call-with-input-file "mit-prelude.sch"
(lambda (in) (copy-port in (current-output-port))))
(call-with-input-file (format "~a.sch" bm)
(lambda (in) (copy-port in (current-output-port))))))
(parameterize ([current-input-port
(open-input-string
(format "(cf \"~a\")\n" bm))]
[current-output-port (open-output-nowhere)])
(system "mit-scheme")))
(define (run-mit bm)
(parameterize ([current-input-port
(open-input-string
(format "(load \"~a\")\n(exit)\ny\n" bm))])
(system "mit-scheme --heap 12000")))
(define (clean-up-mit bm)
(delete-file (format "~a.com" bm))
(delete-file (format "~a.ext" bm))
(delete-file (format "~a.bci" bm))
(delete-file (format "~a.bin" bm))
(delete-file (format "~a.scm" bm)))
(define (extract-mit-times bm str)
(let ([m (regexp-match #rx#"cpu: ([0-9]+) real: ([0-9]+) gc: ([0-9]+)" str)]
;; `time' result is 10s of milliseconds? OS ticks, maybe?
[msec/tick 10])
(list (bytes->number (cadr m))
(bytes->number (caddr m))
(bytes->number (cadddr m)))))
(define (run-petite bm)
(parameterize ([current-input-port
(open-input-string
(format
"(load \"petite-prelude.sch\")\n(load \"~a.sch\")\n(exit)\n"
bm))])
(system "petite")))
(define (extract-petite-times bm str)
(let ([m (regexp-match #rx#"([0-9]+) ms elapsed cpu time(?:, including ([0-9]+) ms collecting)?[ \n]* ([0-9]+) ms elapsed real time" str)])
(list (bytes->number (cadr m))
(bytes->number (cadddr m))
(if (caddr m) (bytes->number (caddr m)) 0))))
(define (run-guile bm)
(parameterize ([current-input-port
(open-input-string
(format
"(load \"guile-prelude.sch\")\n(load \"~a.sch\")\n"
bm))])
(system "guile")))
(define (extract-guile-times bm str)
(let ([m (regexp-match #rx#"user: ([0-9]+) system: ([0-9]+) real: ([0-9]+) gc: ([0-9]+)" str)]
;; `time' result is 10s of milliseconds? OS ticks, maybe?
[msec/tick 10])
(list (+ (bytes->number (cadr m))
(bytes->number (caddr m)))
(bytes->number (cadddr m))
(bytes->number (cadddr (cdr m))))))
(define (extract-times bm str)
str)
@ -345,7 +428,36 @@ exec mzscheme -qu "$0" ${1+"$@"}
run-ikarus
extract-ikarus-times
clean-up-ikarus
'(takr))))
'(takr))
(make-impl 'mit
void
mk-mit
run-mit
extract-mit-times
clean-up-mit
'(nucleic2 puzzle takr2))
(make-impl 'scheme48
void
void
run-scheme48
extract-scheme48-times
void
'())
(make-impl 'petite
void
void
run-petite
extract-petite-times
void
'())
(make-impl 'guile
void
void
run-guile
extract-guile-times
void
'(dynamic dynamic2))
))
(define obsolte-impls '(mzscheme3m mzschemecgc mzscheme-j mzschemecgc-j mzschemecgc-tl mzc mz-old))

29
collects/tests/mzscheme/benchmarks/common/guile-prelude.sch Normal file
View File

@ -0,0 +1,29 @@
(use-syntax (ice-9 syncase))
(define (msecs v)
(quotient (* v 1000) internal-time-units-per-second))
(define (time* thunk)
(let ((start (times))
(start-gc (gc-run-time)))
(let ((v (thunk)))
(let ((end (times))
(end-gc (gc-run-time)))
(display "user: ")
(display (msecs (- (tms:utime end) (tms:utime start))))
(display " system: ")
(display (msecs (- (tms:stime end) (tms:stime start))))
(display " real: ")
(display (msecs (- (tms:stime end) (tms:stime start))))
(display " gc: ")
(display (msecs (- end-gc start-gc)))
(newline)))))
(define-syntax time
(syntax-rules ()
((_ expr) (time* (lambda () expr)))))
(define bitwise-and logand)
(define bitwise-ior logior)
(define bitwise-not lognot)

16
collects/tests/mzscheme/benchmarks/common/index-template.html
View File

@ -1,11 +1,14 @@
<html>
<head><title>Some Scheme Benchmarks</title></head>
<head><title>Some Scheme Benchmarks: Compilers</title></head>
<body>
<H1>About the Benchmarks</H1>
<p>The <a href="Benchmarks.html">benchmark page</a> shows some benchmark results on a collection of fairly standard
(mostly Gabriel) Scheme benchmarks.</p>
<p>The <a href="Benchmarks.html">benchmark page</a> shows some
benchmark results on a collection of fairly standard (mostly
Gabriel) Scheme benchmarks. (See also the
extended <a href="../log3/Benchmarks.html">compilers and
interepreters</a> results.)</p>
<p>Tables show relative performance, with the actual time for the
fastest run shown on the left. So, by
@ -22,7 +25,7 @@ time.</font></p>
<p>Run times are averaged over three runs. All reported times are CPU time (system plus user).
The times are based on the output of the implementation's <tt>time</tt>
syntactic form for function.</p>
syntactic form or similar functions.</p>
<p>Machine:
<ul>
@ -31,12 +34,13 @@ time.</font></p>
<p>Compiler configurations:
<ul>
<li> Bigloo (3.3a): <tt>-06 -call/cc -copt -O3 -copt -fomit-frame-pointer</tt></il>
<li> Chicken (4.3.0): <tt>-no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift</tt></il>
<li> Bigloo (3.3a): <tt>-06 -call/cc -copt -O3 -copt -fomit-frame-pointer</tt></li>
<li> Chicken (4.3.0): <tt>-no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift</tt></li>
<li> Gambit (4.6.0): <tt>(declare (block) (standard-bindings) (extended-bindings) (safe) (interrupts-enabled))</tt>,
compiled and run with <tt>-:m10000</tt></li>
<li> Ikarus (0.0.4-rc1+ rev 1870): in R6RS library</li>
<li> Larceny (0.97): in R6RS library</li>
<li> MIT (7.7.90+): <tt>(declare (usual-integrations))</tt>; run with <tt>--heap 12000</tt></li>
<li> PLT (4.2.4): in <tt>module</tt>; for benchmarks that use <tt>set-car!</tt> and <tt>set-cdr!</tt>,
PLT's R5RS support is used</li>
</ul>

31
collects/tests/mzscheme/benchmarks/common/mit-prelude.sch Normal file
View File

@ -0,0 +1,31 @@
(declare (usual-integrations))
(define-syntax time
(syntax-rules ()
((_ expr)
(with-timings
(lambda () expr)
(lambda (run-time gc-time real-time)
(display "cpu: ")
(display run-time)
(display " real: ")
(display real-time)
(display " gc: ")
(display gc-time)
(newline))))))
(define-integrable (bitwise-and a b)
(if (and (fix:fixnum? a)
(fix:fixnum? b))
(fix:and a b)
0))
(define-integrable (bitwise-ior a b)
(if (and (fix:fixnum? a)
(fix:fixnum? b))
(fix:or a b)
0))
(define-integrable (bitwise-not a)
(if (fix:fixnum? a)
(fix:not a)
0))

2
collects/tests/mzscheme/benchmarks/common/nucleic2.sch
View File

@ -3505,4 +3505,4 @@
; To run program, evaluate: (run)
(time (let loop ([i 10]) (if (zero? i) 'done (begin (run) (loop (- i 1))))))
(time (let loop ((i 10)) (if (zero? i) 'done (begin (run) (loop (- i 1))))))

4
collects/tests/mzscheme/benchmarks/common/petite-prelude.sch Normal file
View File

@ -0,0 +1,4 @@
(define bitwise-and logand)
(define bitwise-ior logior)
(define bitwise-not lognot)

22
collects/tests/mzscheme/benchmarks/common/scheme48-prelude.sch Normal file
View File

@ -0,0 +1,22 @@
(define (time* thunk)
(let ((start-cpu (run-time))
(start-real (real-time)))
(let ((result (thunk)))
(let ((end-cpu (run-time))
(end-real (real-time)))
(let ((cpu (- end-cpu start-cpu))
(real (- end-real start-real)))
(display "cpu time: ")
(display cpu)
(display " real time: ")
(display real)
(newline)
result)))))
(define-syntax time
(syntax-rules ()
((_ expr) (time* (lambda () expr)))))
(define (error . args) (+ 1 args))

100
collects/tests/mzscheme/benchmarks/common/tabulate.ss
View File

@ -26,6 +26,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(define nongc (make-parameter #f))
(define subtract-nothing (make-parameter #f))
(define generate-graph (make-parameter #f))
(define no-compile-time (make-parameter #f))
(command-line
"tabulate"
@ -37,6 +38,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
(include-links #t)]
[("--multi") name "generate multiple pages for different views of data"
(base-link-filename name)]
[("--no-compile-time") "do not show compile times"
(no-compile-time #t)]
[("--nongc") "show times not including GC"
(nongc #t)]
[("--index") "generate full page with an index.html link"
@ -87,7 +90,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(car runs)
#f)])
(if a
(cadadr a)
(cadar a)
0))
0)])
(max (- (or (cadadr runs) 0)
@ -266,6 +269,27 @@ exec mzscheme -qu "$0" ${1+"$@"}
(proc fastest n-fastest c-fastest relative-to
base n-base c-base))))
(define (bar-group name content)
`(tr ((style "background-color: #eeeeee"))
(td ((valign "top")) ,(symbol->string name))
(td
(table
((style "border-spacing: 0px;"))
,@(content)))))
(define (bar-plot impl n ratio)
`(tr (td (span ((style "font-size: small;"))
,(symbol->string impl))
nbsp)
(td ((style "padding: 0em;"))
,(if (and n ratio)
(let ([col (darken (lookup-color impl))])
`(span ((style ,(format "background-color: ~a; color: ~a;" col col)))
,(format (make-string (max (floor (* 60 (if (zero? n) 1 ratio)))
1)
#\x))))
""))))
(define (generate-page relative-to grouping graph? has-other?)
(empty-tag-shorthand html-empty-tags)
(write-xml/content
@ -297,7 +321,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
0]
[else (add1 (loop (cdr impls)))]))])
(cons
`(td ((colspan ,(number->string (* 2 (+ 1 count))))
`(td ((colspan ,(number->string (* (if (no-compile-time) 1 2) (+ 1 count))))
(align "center")
(bgcolor "#DDDDFF"))
(b ,(if (equal? s relative-to)
@ -315,7 +339,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
,(if (eq? grouping 'mode)
"impl"
"mode")))))
(td ((colspan "2") (align "right"))
(td ((colspan ,(if (no-compile-time) "1" "2")) (align "right"))
,(if (and (base-link-filename)
relative-to)
`(a ((href ,(fixup-filename
@ -325,7 +349,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
"fastest")
"fastest"))
,@(map (lambda (impl)
`(td ((colspan "2") (align "right"))
`(td ((colspan ,(if (no-compile-time) "1" "2")) (align "right"))
(b ,(let ([s (extract-column impl (opposite grouping))])
(if (and (base-link-filename)
(not (eq? impl relative-to)))
@ -357,12 +381,14 @@ exec mzscheme -qu "$0" ${1+"$@"}
(car bm-run))))
,(symbol->string (car bm-run)))
(symbol->string (car bm-run))))
(td ((align "right"))
,@(if (no-compile-time)
null
`((td ((align "right"))
nbsp
,(small (if (= c-fastest forever)
" "
(number->string c-fastest)))
nbsp)
nbsp)))
(td ((align "right"))
,(format "~a ms" fastest)
nbsp nbsp)
@ -372,14 +398,17 @@ exec mzscheme -qu "$0" ${1+"$@"}
(let* ([a (assq impl (cdr bm-run))]
[n (and a (caadr a))]
[n2 (and a (ntime a))])
`(,(if (= c-fastest forever)
`(,@(if (no-compile-time)
null
(list
(if (= c-fastest forever)
`(td)
`(td ((align "right")
(bgcolor ,(lookup-color impl)))
,(if (and a (caddr a) c-base (positive? c-base))
(small (ratio->string (/ (caddr a) c-base)))
'"-")
nbsp))
nbsp))))
(td ((bgcolor ,(if (and n base (= n base)
(or (not orig-relative-to)
(and (string? orig-relative-to)
@ -421,6 +450,36 @@ exec mzscheme -qu "$0" ${1+"$@"}
,@(if has-other?
`(nbsp nbsp (a ((href ,(output-name #f 'impl #f))) "Back to tables"))
null)))
,(let* ([bm-runs (filter (lambda (bm-run)
(andmap (lambda (impl)
(let ([a (assq impl (cdr bm-run))])
(and a (caadr a))))
sorted-impls))
sorted-runs)]
[rel-vals (map (lambda (bm-run)
(call-with-bm-info
bm-run
relative-to
grouping
(lambda (fastest n-fastest c-fastest relative-to
base n-base c-base)
(map (lambda (impl)
(let* ([a (assq impl (cdr bm-run))]
[n (and a (caadr a))])
(list impl (if (zero? n) 1 (/ base n)))))
sorted-impls))))
bm-runs)]
[avgs (map (lambda (impl)
(let ([vals (map (lambda (rel-val) (cadr (assq impl rel-val)))
rel-vals)])
(sqrt (apply + (map (lambda (x) (* x x)) vals)))))
sorted-impls)]
[max-avg (apply max avgs)])
(bar-group 'geometric-mean
(lambda ()
(map (lambda (impl avg)
(bar-plot impl 1 (inexact->exact (/ avg max-avg))))
sorted-impls avgs))))
,@(map (lambda (bm-run)
(call-with-bm-info
bm-run
@ -428,27 +487,16 @@ exec mzscheme -qu "$0" ${1+"$@"}
grouping
(lambda (fastest n-fastest c-fastest relative-to
base n-base c-base)
`(tr ((style "background-color: #eeeeee"))
(td ((valign "top")) ,(symbol->string (car bm-run)))
(td
(table
((style "border-spacing: 0px;"))
,@(map (lambda (impl)
(bar-group
(car bm-run)
(lambda ()
(map (lambda (impl)
(let* ([a (assq impl (cdr bm-run))]
[n (and a (caadr a))]
[n2 (and a (ntime a))])
`(tr (td (span ((style "font-size: small;"))
,(symbol->string impl))
nbsp)
(td ((style "padding: 0em;"))
,(if (and n base)
(let ([col (darken (lookup-color impl))])
`(span ((style ,(format "background-color: ~a; color: ~a;" col col)))
,(format (make-string (max (floor (* 60 (if (zero? n) 1 (/ base n))))
1)
#\x))))
"")))))
sorted-impls)))))))
(bar-plot impl n (and n base (not (zero? n))
(/ base n)))))
sorted-impls))))))
sorted-runs))))))
(newline))