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

try to make -lutil automatic

Browse Source 
svn: r4059
This commit is contained in:
Matthew Flatt 2006-08-13 13:48:50 +00:00
parent 329800478e
commit b69603ce03
3 changed files with 70 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,7 +30,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
(system "larceny"))) (system "larceny")))
(define (mk-mzc bm) (define (mk-mzc bm)
(system (format "mzc ~a.ss" bm))) (parameterize ([current-output-port (open-output-bytes)])
(system (format "mzc ~a.ss" bm))))
(define (run-exe bm) (define (run-exe bm)
(system (symbol->string bm))) (system (symbol->string bm)))
@ -108,9 +109,10 @@ exec mzscheme -qu "$0" ${1+"$@"}
(make-impl 'mzc (make-impl 'mzc
mk-mzc mk-mzc
(lambda (bm) (lambda (bm)
(system (format "mzscheme -mvqe '(load-extension \"~a.dylib\")'" bm))) (system (format "mzscheme -mvqee '(load-extension \"~a.dylib\")' '(require ~a)'"
bm bm)))
extract-mzscheme-times extract-mzscheme-times
'()) '(conform nucleic2 takr))
(make-impl 'mzscheme-j (make-impl 'mzscheme-j
mk-mzscheme mk-mzscheme
(lambda (bm) (lambda (bm)
@ -138,7 +140,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
extract-larceny-times extract-larceny-times
'()))) '())))
(define obsolte-impls '(mzscheme mzscheme-j)) (define obsolte-impls '(mzscheme mzscheme-j mzc))
(define benchmarks (define benchmarks
'(conform '(conform

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

@ -5,7 +5,10 @@
(when (system (format "gsc -prelude '(include \"gambit-prelude.sch\")' ~a.sch" (when (system (format "gsc -prelude '(include \"gambit-prelude.sch\")' ~a.sch"
name)) name))
(when (system (format "gcc -o ~a -O2 -D___SINGLE_HOST ~a.c ~a_.c -lgambc -lm -ldl -lutil" (when (system (format "gcc -o ~a -O2 -D___SINGLE_HOST ~a.c ~a_.c -lgambc -lm -ldl~a"
name name name)) name name name
(delete-file (format "~a.c" name)) (if (file-exists? "/usr/lib/libtuil.a")
(delete-file (format "~a_.c" name)))) " -lutil"
"")))
(delete-file (format "~a.c" name))
(delete-file (format "~a_.c" name))))

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

@ -59,33 +59,65 @@
(let ([s (format "~a00" (exact->inexact r))]) (let ([s (format "~a00" (exact->inexact r))])
(car (regexp-match #rx"^[0-9]*[.].." s))))) (car (regexp-match #rx"^[0-9]*[.].." s)))))
(define (small s)
`(font ((color "gray")
(size "-2"))
,s))
(define (lookup-color impl)
(let loop ([impls sorted-impls][odd? #f])
(if (eq? (car impls) impl)
(if odd?
"#EEEEFF"
"#DDFFDD")
(loop (cdr impls) (not odd?)))))
(empty-tag-shorthand html-empty-tags) (empty-tag-shorthand html-empty-tags)
(write-xml/content (write-xml/content
(xexpr->xml (xexpr->xml
`(html `(table
(head (title "Benchmark Results")) (tr (td nbsp)
(body (td ((colspan "2") (align "right")) "Fastest")
(table ,@(map (lambda (impl)
(tr (td nbsp) `(td ((colspan "2") (align "right")) (b ,(symbol->string impl)) nbsp))
(td nbsp) sorted-impls))
,@(map (lambda (impl) ,@(map (lambda (bm-run)
`(td (b ,(symbol->string impl)) nbsp)) (let ([fastest (apply min (map (lambda (run)
sorted-impls)) (or (caadr run) 1000000000))
,@(map (lambda (bm-run) (cdr bm-run)))]
(let ([fastest (apply min (map (lambda (run) [c-fastest (apply min (map (lambda (run)
(or (caadr run) 1000000000)) (let ([v (caddr run)])
(if (zero? v)
1000000000
v)))
(cdr bm-run)))]) (cdr bm-run)))])
`(tr (td (a ((href ,(format "~a.sch" (car bm-run)))) `(tr (td (a ((href ,(format "~a.sch" (car bm-run))))
,(symbol->string (car bm-run)))) ,(symbol->string (car bm-run))))
(td ((align "right")) (td ((align "right"))
nbsp nbsp
,(format "~a ms" fastest) nbsp nbsp nbsp) ,(small (number->string c-fastest))
,@(map (lambda (impl) nbsp)
(let* ([a (assq impl (cdr bm-run))] (td ((align "right"))
[n (and a (caadr a))]) ,(format "~a ms" fastest)
`(td ,(if n nbsp nbsp)
(ratio->string (/ n fastest)) ,@(apply
"-")))) append
sorted-impls)))) (map (lambda (impl)
sorted-runs)))))) (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)) (newline))