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

larceny

Browse Source 
svn: r4055
This commit is contained in:
Matthew Flatt 2006-08-13 12:13:51 +00:00
parent ff8b69cf70
commit 56c86466a3
1 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
(module auto mzscheme (module auto mzscheme
(require (lib "process.ss") (require (lib "process.ss")
(lib "cmdline.ss")) (lib "cmdline.ss")
(lib "list.ss"))
(define (bytes->number b) (define (bytes->number b)
(string->number (bytes->string/latin-1 b))) (string->number (bytes->string/latin-1 b)))
@ -21,6 +22,12 @@ exec mzscheme -qu "$0" ${1+"$@"}
(parameterize ([current-namespace (make-namespace)]) (parameterize ([current-namespace (make-namespace)])
(load (format "~a.ss" bm)))) (load (format "~a.ss" bm))))
(define (mk-larceny bm)
(parameterize ([current-input-port (open-input-string
(format "(compile-file \"~a.sch\")\n"
bm))])
(system "larceny")))
(define (mk-mzc bm) (define (mk-mzc bm)
(system (format "mzc ~a.ss" bm))) (system (format "mzc ~a.ss" bm)))
@ -33,6 +40,12 @@ exec mzscheme -qu "$0" ${1+"$@"}
(define (run-gambit-exe bm) (define (run-gambit-exe bm)
(system (format "~a -:d-" bm))) (system (format "~a -:d-" bm)))
(define (run-larceny bm)
(parameterize ([current-input-port (open-input-string
(format "(load \"~a.fasl\")\n"
bm))])
(system "larceny")))
(define (extract-times bm str) (define (extract-times bm str)
str) str)
@ -91,7 +104,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(system (format "mzscheme -mvqe '(load-extension \"~a.dylib\")'" bm))) (system (format "mzscheme -mvqe '(load-extension \"~a.dylib\")'" bm)))
extract-mzscheme-times extract-mzscheme-times
'()) '())
(make-impl 'mzscheme-no-jit (make-impl 'mzscheme-j
mk-mzscheme mk-mzscheme
(lambda (bm) (lambda (bm)
(system (format "mzscheme -jqu ~a.ss" bm))) (system (format "mzscheme -jqu ~a.ss" bm)))
@ -111,7 +124,14 @@ exec mzscheme -qu "$0" ${1+"$@"}
(run-mk "mk-gambit.ss") (run-mk "mk-gambit.ss")
run-gambit-exe run-gambit-exe
extract-gambit-times extract-gambit-times
'(nucleic2)))) '(nucleic2))
(make-impl 'larcency
mk-larceny
run-larceny
extract-larceny-times
'())))
(define obsolte-impls '(mzscheme mzscheme-j))
(define benchmarks (define benchmarks
'(conform '(conform
@ -149,11 +169,9 @@ exec mzscheme -qu "$0" ${1+"$@"}
(let ([end (current-inexact-milliseconds)]) (let ([end (current-inexact-milliseconds)])
(let loop ([n num-iterations]) (let loop ([n num-iterations])
(unless (zero? n) (unless (zero? n)
(let ([out (open-output-bytes)] (let ([out (open-output-bytes)])
[in (open-input-bytes #"0\n")])
(unless (parameterize ([current-output-port out] (unless (parameterize ([current-output-port out]
[current-error-port out] [current-error-port out])
[current-input-port in])
((impl-run i) bm)) ((impl-run i) bm))
(error 'auto "~a\nrun failed ~a" (get-output-bytes out) bm)) (error 'auto "~a\nrun failed ~a" (get-output-bytes out) bm))
(printf "[~a ~a ~s ~a]\n" (printf "[~a ~a ~s ~a]\n"
@ -201,4 +219,5 @@ exec mzscheme -qu "$0" ${1+"$@"}
(or run-benchmarks (or run-benchmarks
benchmarks))) benchmarks)))
(or run-implementations (or run-implementations
(map impl-name impls)))) (remq* obsolte-impls
(map impl-name impls)))))