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")))
(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)
(system (symbol->string bm)))
@ -108,9 +109,10 @@ exec mzscheme -qu "$0" ${1+"$@"}
(make-impl 'mzc
mk-mzc
(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
'())
'(conform nucleic2 takr))
(make-impl 'mzscheme-j
mk-mzscheme
(lambda (bm)
@ -138,7 +140,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
extract-larceny-times
'())))
(define obsolte-impls '(mzscheme mzscheme-j))
(define obsolte-impls '(mzscheme mzscheme-j mzc))
(define benchmarks
'(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"
name))
(when (system (format "gcc -o ~a -O2 -D___SINGLE_HOST ~a.c ~a_.c -lgambc -lm -ldl -lutil"
name name name))
(delete-file (format "~a.c" name))
(delete-file (format "~a_.c" 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/libtuil.a")
" -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))])
(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)
(write-xml/content
(xexpr->xml
`(html
(head (title "Benchmark Results"))
(body
(table
(tr (td nbsp)
(td nbsp)
,@(map (lambda (impl)
`(td (b ,(symbol->string impl)) nbsp))
sorted-impls))
,@(map (lambda (bm-run)
(let ([fastest (apply min (map (lambda (run)
(or (caadr run) 1000000000))
`(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
,(format "~a ms" fastest) nbsp nbsp nbsp)
,@(map (lambda (impl)
(let* ([a (assq impl (cdr bm-run))]
[n (and a (caadr a))])
`(td ,(if n
(ratio->string (/ n fastest))
"-"))))
sorted-impls))))
sorted-runs))))))
`(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))