477 lines
21 KiB
Scheme
Executable File
477 lines
21 KiB
Scheme
Executable File
#!/bin/sh
|
|
#|
|
|
exec mzscheme -qu "$0" ${1+"$@"}
|
|
|#
|
|
|
|
;; Input format is a sequence of S-expression forms:
|
|
;; (<impl> <benchmark> (<cpu-msec> <real-msec> <gc-cpu-msec>) <compile-msec>)
|
|
;; where
|
|
;; * <impl> is a symbol for an implementation; it can optionally be of the form
|
|
;; <sys>@<mode>, where each <sys> is tried in each <mode>
|
|
;; * <benchmark> is a symbol for the benchmark
|
|
;; * <cpu-msec> and <real-msec> are the run times (CPU and real) in milliseconds
|
|
;; * <gc-cpu-msec> can be #f, or it can be a portion of <cpu-msec> spent GCing
|
|
;; * <compile-msec> should be the same for each entry of a particular <impl>
|
|
;; and <benchmark> combination; it is the time to compile the benchmark
|
|
|
|
(module tabulate mzscheme
|
|
(require mzlib/list
|
|
xml/xml
|
|
mzlib/cmdline
|
|
(only scheme/list argmin))
|
|
|
|
(define base-link-filename (make-parameter #f))
|
|
(define full-page-mode (make-parameter #f))
|
|
(define include-links (make-parameter #f))
|
|
(define nongc (make-parameter #f))
|
|
(define subtract-nothing (make-parameter #f))
|
|
(define generate-graph (make-parameter #f))
|
|
|
|
(command-line
|
|
"tabulate"
|
|
(current-command-line-arguments)
|
|
(once-each
|
|
[("--graph") "generate graphs instead of tables (unless --multi)"
|
|
(generate-graph #t)]
|
|
[("--links") "benchmark links to SVN"
|
|
(include-links #t)]
|
|
[("--multi") name "generate multiple pages for different views of data"
|
|
(base-link-filename name)]
|
|
[("--nongc") "show times not including GC"
|
|
(nongc #t)]
|
|
[("--index") "generate full page with an index.html link"
|
|
(full-page-mode #t)]
|
|
[("--nothing") "subtract compilation time of nothing benchmark"
|
|
(subtract-nothing #t)]))
|
|
|
|
(define bm-table (make-hash-table))
|
|
(define impls (make-hash-table))
|
|
|
|
(let loop ()
|
|
(let ([l (read)])
|
|
(unless (eof-object? l)
|
|
(hash-table-put! impls (car l) #t)
|
|
(let ([t (hash-table-get bm-table (cadr l)
|
|
(lambda ()
|
|
(let ([t (make-hash-table)])
|
|
(hash-table-put! bm-table (cadr l) t)
|
|
t)))])
|
|
(hash-table-put! t (car l)
|
|
(cons (cddr l)
|
|
(hash-table-get t (car l) null))))
|
|
(loop))))
|
|
|
|
(define bm-runs (hash-table-map bm-table cons))
|
|
|
|
(define (average sel l)
|
|
(if (andmap sel l)
|
|
(round (/ (apply + (map sel l)) (length l)))
|
|
(if (ormap sel l)
|
|
(error 'tabulate "inconsistent average info")
|
|
#f)))
|
|
|
|
(define average-runs
|
|
(map (lambda (bm-run)
|
|
(let* ([runss (hash-table-map (cdr bm-run) cons)])
|
|
(cons
|
|
(car bm-run)
|
|
(map (lambda (runs)
|
|
(list (car runs)
|
|
(list (average caar (cdr runs))
|
|
(average cadar (cdr runs))
|
|
(average caddar (cdr runs)))
|
|
(let ([nothing-compile-time
|
|
(if (subtract-nothing)
|
|
(let ([a (hash-table-get
|
|
(hash-table-get bm-table 'nothing #hash())
|
|
(car runs)
|
|
#f)])
|
|
(if a
|
|
(cadadr a)
|
|
0))
|
|
0)])
|
|
(max (- (or (cadadr runs) 0)
|
|
nothing-compile-time)
|
|
0))))
|
|
runss))))
|
|
(if (subtract-nothing)
|
|
(filter (lambda (v)
|
|
(not (eq? (car v) 'nothing)))
|
|
bm-runs)
|
|
bm-runs)))
|
|
|
|
(define (symbol<? a b)
|
|
(string<? (symbol->string a)
|
|
(symbol->string b)))
|
|
|
|
(define (mode<? a b)
|
|
(let ([am (extract-column a 'mode)]
|
|
[bm (extract-column b 'mode)])
|
|
(if (equal? am bm)
|
|
(symbol<? a b)
|
|
(string<? am bm))))
|
|
|
|
(define (extract-column impl grouping)
|
|
(let ([s (symbol->string impl)])
|
|
(cond
|
|
[(regexp-match #rx"^(.*)@(.*)" s)
|
|
=> (lambda (m)
|
|
(if (eq? grouping 'impl)
|
|
(cadr m)
|
|
(caddr m)))]
|
|
[else s])))
|
|
|
|
(define sorted-runs
|
|
(sort average-runs (lambda (a b)
|
|
(symbol<? (car a) (car b)))))
|
|
|
|
(define sorted-impls
|
|
(sort (hash-table-map impls (lambda (k v) k)) symbol<?))
|
|
|
|
(define mode-sorted-impls
|
|
(sort (hash-table-map impls (lambda (k v) k))
|
|
mode<?))
|
|
|
|
(define (opposite grouping)
|
|
(if (eq? grouping 'mode)
|
|
'impl
|
|
'mode))
|
|
|
|
(define (ratio->string r)
|
|
(if (integer? r)
|
|
(number->string r)
|
|
(let ([s (format "~a00" (exact->inexact r))])
|
|
(car (regexp-match #rx"^[0-9]*[.].." s)))))
|
|
|
|
(define (small s)
|
|
`(font ((color "gray")
|
|
(size "-2"))
|
|
,s))
|
|
|
|
(define (wrap-page relative-to . ps)
|
|
(if (full-page-mode)
|
|
(let ([title (format "~a normalized to ~a~a"
|
|
(or (base-link-filename)
|
|
"results")
|
|
(if (string? relative-to)
|
|
"fastest "
|
|
"")
|
|
(or relative-to
|
|
"fastest"))])
|
|
`(html
|
|
(head (title ,title)
|
|
(body
|
|
(p
|
|
(b ,title ".")
|
|
" See also " (a ((href "index.html"))
|
|
"about the benchmarks")
|
|
".")
|
|
,@(map (lambda (p) `(p ,p))
|
|
ps)))))
|
|
`(html (nbody ,@ps))))
|
|
|
|
(define forever 1000000000)
|
|
|
|
(define (ntime v)
|
|
(and (caadr v) (- (caadr v) (or (caddr (cadr v)) 0))))
|
|
|
|
(define (grouping->suffix grouping)
|
|
(if (eq? grouping 'impl)
|
|
""
|
|
(format "-~a" grouping)))
|
|
|
|
(define no-modes? (equal? mode-sorted-impls sorted-impls))
|
|
|
|
(define (fixup-filename s)
|
|
(regexp-replace* #rx"[^.a-zA-Z0-9-]" s (lambda (s)
|
|
(format "_~x" (char->integer (string-ref s 0))))))
|
|
|
|
(define (output-name impl grouping graph?)
|
|
(fixup-filename
|
|
(if impl
|
|
(format "~a-~a~a.html"
|
|
(base-link-filename)
|
|
impl
|
|
(grouping->suffix grouping))
|
|
(format "~a~a~a.html"
|
|
(base-link-filename)
|
|
(grouping->suffix grouping)
|
|
(if graph? "-plot" "")))))
|
|
|
|
(define (resolve-relative-to relative-to grouping runs)
|
|
(if (string? relative-to)
|
|
;; Find fastest among entries matching `relative-to':
|
|
(car (argmin (lambda (run)
|
|
(or (caadr run) forever))
|
|
(cons (list #f (list #f #f #f) #f)
|
|
(filter (lambda (run)
|
|
(equal? relative-to (extract-column (car run) grouping)))
|
|
runs))))
|
|
;; Nothing to resolve:
|
|
relative-to))
|
|
|
|
(define (extract-variants grouping impls)
|
|
(let ([ht (make-hash-table 'equal)])
|
|
(for-each (lambda (impl)
|
|
(hash-table-put! ht (extract-column impl grouping) #t))
|
|
impls)
|
|
(hash-table-map ht (lambda (k v) k))))
|
|
|
|
(define just-impls (sort (extract-variants 'impl sorted-impls) string<?))
|
|
(define all-colors (list "#EEEEDD" "#EEEEFF" "#EEDDEE" "#FFEEEE"
|
|
"#EEEEEE" "#DDEEEE"))
|
|
|
|
(define (lookup-color impl)
|
|
(let ([s (extract-column impl 'impl)])
|
|
(let loop ([impls just-impls]
|
|
[colors all-colors])
|
|
(cond
|
|
[(null? colors) (loop impls all-colors)]
|
|
[(null? impls) (car colors)]
|
|
[(equal? (car impls) s) (car colors)]
|
|
[else (loop (cdr impls) (cdr colors))]))))
|
|
|
|
(define (darken c)
|
|
(regexp-replace*
|
|
#rx"F"
|
|
(regexp-replace*
|
|
#rx"E"
|
|
(regexp-replace*
|
|
#rx"D"
|
|
c
|
|
"A")
|
|
"B")
|
|
"F"))
|
|
|
|
(define (call-with-bm-info bm-run relative-to grouping proc)
|
|
(let ([fastest (apply min (map (lambda (run)
|
|
(or (caadr run) forever))
|
|
(cdr bm-run)))]
|
|
[n-fastest (apply min (map (lambda (run)
|
|
(or (ntime run) forever))
|
|
(cdr bm-run)))]
|
|
[c-fastest (apply min (map (lambda (run)
|
|
(let ([v (caddr run)])
|
|
(or (and v (positive? v) v)
|
|
forever)))
|
|
(cdr bm-run)))]
|
|
[relative-to (resolve-relative-to relative-to grouping (cdr bm-run))])
|
|
(let-values ([(base n-base c-base)
|
|
(if relative-to
|
|
(let ([a (assq relative-to (cdr bm-run))])
|
|
(if a
|
|
(values (caadr a) (ntime a) (caddr a))
|
|
(values #f #f #f)))
|
|
(values fastest n-fastest c-fastest))])
|
|
(proc fastest n-fastest c-fastest relative-to
|
|
base n-base c-base))))
|
|
|
|
(define (generate-page relative-to grouping graph? has-other?)
|
|
(empty-tag-shorthand html-empty-tags)
|
|
(write-xml/content
|
|
(xexpr->xml
|
|
(wrap-page
|
|
relative-to
|
|
(if (not graph?)
|
|
`(table
|
|
,@(if no-modes?
|
|
null
|
|
(list
|
|
`(tr
|
|
(td (i ,(if (eq? grouping 'mode)
|
|
"mode"
|
|
"impl")))
|
|
(td nbsp)
|
|
(td nbsp)
|
|
,@(let loop ([impls (if (eq? grouping 'mode)
|
|
mode-sorted-impls
|
|
sorted-impls)])
|
|
(if (null? impls)
|
|
null
|
|
(let* ([impl (car impls)]
|
|
[s (extract-column impl grouping)]
|
|
[count (let loop ([impls (cdr impls)])
|
|
(cond
|
|
[(null? impls) 0]
|
|
[(not (equal? s (extract-column (car impls) grouping)))
|
|
0]
|
|
[else (add1 (loop (cdr impls)))]))])
|
|
(cons
|
|
`(td ((colspan ,(number->string (* 2 (+ 1 count))))
|
|
(align "center")
|
|
(bgcolor "#DDDDFF"))
|
|
(b ,(if (equal? s relative-to)
|
|
s
|
|
`(a ([href ,(fixup-filename
|
|
(format "~a-~a~a.html"
|
|
(base-link-filename)
|
|
s
|
|
(grouping->suffix grouping)))])
|
|
,s))))
|
|
(loop (list-tail impls (+ 1 count))))))))))
|
|
(tr (td ,(if no-modes?
|
|
'nbsp
|
|
`(i (a ([href ,(output-name #f (opposite grouping) #f)])
|
|
,(if (eq? grouping 'mode)
|
|
"impl"
|
|
"mode")))))
|
|
(td ((colspan "2") (align "right"))
|
|
,(if (and (base-link-filename)
|
|
relative-to)
|
|
`(a ((href ,(fixup-filename
|
|
(format "~a~a.html"
|
|
(base-link-filename)
|
|
(grouping->suffix grouping)))))
|
|
"fastest")
|
|
"fastest"))
|
|
,@(map (lambda (impl)
|
|
`(td ((colspan "2") (align "right"))
|
|
(b ,(let ([s (extract-column impl (opposite grouping))])
|
|
(if (and (base-link-filename)
|
|
(not (eq? impl relative-to)))
|
|
`(a ((href ,(fixup-filename
|
|
(format "~a-~a~a.html"
|
|
(base-link-filename)
|
|
impl
|
|
(grouping->suffix grouping)))))
|
|
,s)
|
|
s)))
|
|
nbsp))
|
|
(if (eq? grouping 'mode)
|
|
mode-sorted-impls
|
|
sorted-impls))
|
|
,@(if has-other?
|
|
`((td nbsp nbsp (a ((href ,(output-name #f 'impl #t))) "To plots")))
|
|
null))
|
|
,@(map (lambda (bm-run)
|
|
(define orig-relative-to relative-to)
|
|
(call-with-bm-info
|
|
bm-run
|
|
relative-to
|
|
grouping
|
|
(lambda (fastest n-fastest c-fastest relative-to
|
|
base n-base c-base)
|
|
`(tr (td ,(if (include-links)
|
|
`(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)))
|
|
(symbol->string (car bm-run))))
|
|
(td ((align "right"))
|
|
nbsp
|
|
,(small (if (= c-fastest forever)
|
|
" "
|
|
(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))]
|
|
[n2 (and a (ntime a))])
|
|
`(,(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))
|
|
(td ((bgcolor ,(if (and n base (= n base)
|
|
(or (not orig-relative-to)
|
|
(and (string? orig-relative-to)
|
|
(equal? (extract-column impl grouping)
|
|
orig-relative-to))))
|
|
"white"
|
|
(lookup-color impl)))
|
|
(align "right"))
|
|
,(if (and n base)
|
|
(let ([s (if (= n base)
|
|
"1"
|
|
(if (zero? base)
|
|
"*"
|
|
(ratio->string (/ n base))))])
|
|
(if (= n fastest)
|
|
`(font ((color "forestgreen")) (b ,s))
|
|
s))
|
|
"-")
|
|
,@(if (nongc)
|
|
`(" / "
|
|
,(if (and n2 n-base)
|
|
(let ([s (if (zero? base)
|
|
"*"
|
|
(ratio->string (/ n2 base)))])
|
|
(if (= n2 n-fastest)
|
|
`(font ((color "forestgreen")) (b ,s))
|
|
s))
|
|
"-"))
|
|
null)
|
|
nbsp))))
|
|
(if (eq? grouping 'mode)
|
|
mode-sorted-impls
|
|
sorted-impls)))))))
|
|
sorted-runs))
|
|
`(table
|
|
((style "border-spacing: 0px 3px;"))
|
|
(tr (td ((colspan "2"))
|
|
"Longer is better."
|
|
,@(if has-other?
|
|
`(nbsp nbsp (a ((href ,(output-name #f 'impl #f))) "Back to tables"))
|
|
null)))
|
|
,@(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)
|
|
`(tr ((style "background-color: #eeeeee"))
|
|
(td ((valign "top")) ,(symbol->string (car bm-run)))
|
|
(td
|
|
(table
|
|
((style "border-spacing: 0px;"))
|
|
,@(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)))))))
|
|
sorted-runs))))))
|
|
(newline))
|
|
|
|
(if (base-link-filename)
|
|
(begin
|
|
(for-each (lambda (grouping)
|
|
(for-each
|
|
(lambda (impl)
|
|
(let ([fn (output-name impl grouping #f)])
|
|
(fprintf (current-error-port) "Generating ~a\n" fn)
|
|
(with-output-to-file fn
|
|
(lambda () (generate-page impl grouping #f #t))
|
|
'truncate)))
|
|
(append (cons #f sorted-impls)
|
|
(if no-modes?
|
|
null
|
|
(extract-variants grouping sorted-impls)))))
|
|
(if no-modes?
|
|
'(impl)
|
|
'(impl mode)))
|
|
(with-output-to-file (output-name #f 'impl #t)
|
|
(lambda () (generate-page #f 'impl #t #t))
|
|
'truncate))
|
|
(generate-page #f 'impl (generate-graph) #f)))
|
|
|