diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index a532255f51..5c1c61b84e 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -157,6 +157,89 @@ exec mzscheme -qu "$0" ${1+"$@"} (clean-up-sps bm) (system "rm -rf ~/.ikarus")) + (define (run-scheme48 bm) + (parameterize ([current-input-port + (open-input-string + (format + ",bench on\n,open time bitwise\n,load \"scheme48-prelude.sch\"\n,load \"~a.sch\"\n,exit\n" + bm))]) + (system "scheme48 -h 20000000"))) + + (define (extract-scheme48-times bm str) + (let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+)" str)] + ;; `time' result is 10s of milliseconds? OS ticks, maybe? + [msec/tick 10]) + (list (bytes->number (cadr m)) + (bytes->number (caddr m)) + 0))) + + (define (mk-mit bm) + (with-output-to-file (format "~a.scm" bm) + #:exists 'truncate + (lambda () + (printf "(declare (usual-integrations))\n") + (call-with-input-file "mit-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-input-port + (open-input-string + (format "(cf \"~a\")\n" bm))] + [current-output-port (open-output-nowhere)]) + (system "mit-scheme"))) + + (define (run-mit bm) + (parameterize ([current-input-port + (open-input-string + (format "(load \"~a\")\n(exit)\ny\n" bm))]) + (system "mit-scheme --heap 12000"))) + + (define (clean-up-mit bm) + (delete-file (format "~a.com" bm)) + (delete-file (format "~a.ext" bm)) + (delete-file (format "~a.bci" bm)) + (delete-file (format "~a.bin" bm)) + (delete-file (format "~a.scm" bm))) + + (define (extract-mit-times bm str) + (let ([m (regexp-match #rx#"cpu: ([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)) + (bytes->number (caddr m)) + (bytes->number (cadddr m))))) + + (define (run-petite bm) + (parameterize ([current-input-port + (open-input-string + (format + "(load \"petite-prelude.sch\")\n(load \"~a.sch\")\n(exit)\n" + bm))]) + (system "petite"))) + + (define (extract-petite-times bm str) + (let ([m (regexp-match #rx#"([0-9]+) ms elapsed cpu time(?:, including ([0-9]+) ms collecting)?[ \n]* ([0-9]+) ms elapsed real time" str)]) + (list (bytes->number (cadr m)) + (bytes->number (cadddr m)) + (if (caddr m) (bytes->number (caddr m)) 0)))) + + (define (run-guile bm) + (parameterize ([current-input-port + (open-input-string + (format + "(load \"guile-prelude.sch\")\n(load \"~a.sch\")\n" + bm))]) + (system "guile"))) + + (define (extract-guile-times bm 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)) + (bytes->number (caddr m))) + (bytes->number (cadddr m)) + (bytes->number (cadddr (cdr m)))))) + (define (extract-times bm str) str) @@ -345,7 +428,36 @@ exec mzscheme -qu "$0" ${1+"$@"} run-ikarus extract-ikarus-times clean-up-ikarus - '(takr)))) + '(takr)) + (make-impl 'mit + void + mk-mit + run-mit + extract-mit-times + clean-up-mit + '(nucleic2 puzzle takr2)) + (make-impl 'scheme48 + void + void + run-scheme48 + extract-scheme48-times + void + '()) + (make-impl 'petite + void + void + run-petite + extract-petite-times + void + '()) + (make-impl 'guile + void + void + run-guile + extract-guile-times + void + '(dynamic dynamic2)) +)) (define obsolte-impls '(mzscheme3m mzschemecgc mzscheme-j mzschemecgc-j mzschemecgc-tl mzc mz-old)) diff --git a/collects/tests/mzscheme/benchmarks/common/guile-prelude.sch b/collects/tests/mzscheme/benchmarks/common/guile-prelude.sch new file mode 100644 index 0000000000..f9e61fb5d1 --- /dev/null +++ b/collects/tests/mzscheme/benchmarks/common/guile-prelude.sch @@ -0,0 +1,29 @@ + +(use-syntax (ice-9 syncase)) + +(define (msecs v) + (quotient (* v 1000) internal-time-units-per-second)) + +(define (time* thunk) + (let ((start (times)) + (start-gc (gc-run-time))) + (let ((v (thunk))) + (let ((end (times)) + (end-gc (gc-run-time))) + (display "user: ") + (display (msecs (- (tms:utime end) (tms:utime start)))) + (display " system: ") + (display (msecs (- (tms:stime end) (tms:stime start)))) + (display " real: ") + (display (msecs (- (tms:stime end) (tms:stime start)))) + (display " gc: ") + (display (msecs (- end-gc start-gc))) + (newline))))) + +(define-syntax time + (syntax-rules () + ((_ expr) (time* (lambda () expr))))) + +(define bitwise-and logand) +(define bitwise-ior logior) +(define bitwise-not lognot) \ No newline at end of file diff --git a/collects/tests/mzscheme/benchmarks/common/index-template.html b/collects/tests/mzscheme/benchmarks/common/index-template.html index 65db9ac8d1..03d1126c69 100644 --- a/collects/tests/mzscheme/benchmarks/common/index-template.html +++ b/collects/tests/mzscheme/benchmarks/common/index-template.html @@ -1,11 +1,14 @@ -Some Scheme Benchmarks +Some Scheme Benchmarks: Compilers

About the Benchmarks

-

The benchmark page shows some benchmark results on a collection of fairly standard - (mostly Gabriel) Scheme benchmarks.

+

The benchmark page shows some + benchmark results on a collection of fairly standard (mostly + Gabriel) Scheme benchmarks. (See also the + extended compilers and + interepreters results.)

Tables show relative performance, with the actual time for the fastest run shown on the left. So, by @@ -22,7 +25,7 @@ time.

Run times are averaged over three runs. All reported times are CPU time (system plus user). The times are based on the output of the implementation's time - syntactic form for function.

+ syntactic form or similar functions.

Machine: