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

Improve Guile benchmarking.

Browse Source 
Thanks to Andy Wingo for pointers.
This commit is contained in:
Vincent St-Amour 2011-10-13 12:21:30 -04:00
parent 7e4eb501c5
commit a0b987bc1e
1 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/tests/racket/benchmarks/common/auto.rkt
View File

@ -17,7 +17,8 @@ exec racket -qu "$0" ${1+"$@"}
mzlib/file mzlib/file
dynext/file dynext/file
syntax/toplevel syntax/toplevel
scheme/runtime-path) scheme/runtime-path
racket/port)
;; Implementaton-specific control functions ------------------------------ ;; Implementaton-specific control functions ------------------------------
@ -245,18 +246,28 @@ exec racket -qu "$0" ${1+"$@"}
(bytes->number (cadddr m)) (bytes->number (cadddr m))
(if (caddr m) (bytes->number (caddr m)) 0)))) (if (caddr m) (bytes->number (caddr m)) 0))))
;; requires guile 2.0.2 or higher
(define (mk-guile bm)
(with-output-to-file (format "~a.scm" bm)
#:exists 'truncate
(lambda ()
(call-with-input-file "guile-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-output-port (open-output-nowhere)]
[current-error-port (open-output-nowhere)])
(system (format "guild compile ~a.scm" bm))))
(define (run-guile bm) (define (run-guile bm)
(parameterize ([current-input-port (system (format "guile ~a.scm" bm)))
(open-input-string
(format (define (clean-up-guile bm)
"(load \"guile-prelude.sch\")\n(load \"~a.sch\")\n" ;; compiled files are in a cache directory, which is hard to get to
bm))]) (delete-file (format "~a.scm" bm)))
(system "guile")))
(define (extract-guile-times bm str) (define (extract-guile-times bm str)
(let ([m (regexp-match #rx#"user: ([0-9]+) system: ([0-9]+) real: ([0-9]+) gc: ([0-9]+)" 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)) (list (+ (bytes->number (cadr m))
(bytes->number (caddr m))) (bytes->number (caddr m)))
(bytes->number (cadddr m)) (bytes->number (cadddr m))
@ -497,12 +508,11 @@ exec racket -qu "$0" ${1+"$@"}
racket-specific-progs) racket-specific-progs)
(make-impl 'guile (make-impl 'guile
void void
void mk-guile
run-guile run-guile
extract-guile-times extract-guile-times
void clean-up-guile
(append '(ctak) racket-specific-progs)
racket-specific-progs))
)) ))
(define obsolete-impls '(racket3m racketcgc racket-j racketcgc-j racketcgc-tl mzc mz-old)) (define obsolete-impls '(racket3m racketcgc racket-j racketcgc-j racketcgc-tl mzc mz-old))