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

benchmarks: allow specification of alternate executable

Browse Source
This commit is contained in:
Matthew Flatt 2019-10-27 10:28:50 -06:00
parent 0965e5ad6c
commit 2a9a901caa
6 changed files with 68 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkgs/racket-benchmarks/tests/racket/benchmarks/common/auto.rkt
View File

@ -26,10 +26,18 @@ exec racket -qu "$0" ${1+"$@"}
(define (bytes->number b) (define (bytes->number b)
(string->number (bytes->string/latin-1 b))) (string->number (bytes->string/latin-1 b)))
(define ((run-mk script) bm) (define (find-program name default)
(define s (hash-ref executables name default))
(define p (find-executable-path s))
(unless p
(error 'find-executable "not found: ~s" s))
p)
(define ((run-mk script name default) bm)
(when (file-exists? (symbol->string bm)) (when (file-exists? (symbol->string bm))
(delete-file (symbol->string bm))) (delete-file (symbol->string bm)))
(parameterize ([current-command-line-arguments (vector (symbol->string bm))]) (parameterize ([current-command-line-arguments (vector (symbol->string bm)
(path->string (find-program name default)))])
(namespace-require 'scheme) (namespace-require 'scheme)
(load script))) (load script)))
@ -262,10 +270,10 @@ exec racket -qu "$0" ${1+"$@"}
"(compile-file \"~a.sch\")\n(exit)\n" "(compile-file \"~a.sch\")\n(exit)\n"
bm))] bm))]
[current-output-port (open-output-nowhere)]) [current-output-port (open-output-nowhere)])
(system "scheme -q"))) (system* (find-program "chez" "scheme") "-q")))
(define (run-chez bm) (define (run-chez bm)
(system (format "scheme --script ~a.so" bm))) (system* (find-program "chez" "scheme") "--script" (format "~a.so" bm)))
(define (run-petite bm) (define (run-petite bm)
(parameterize ([current-input-port (parameterize ([current-input-port
@ -273,7 +281,7 @@ exec racket -qu "$0" ${1+"$@"}
(format (format
"(load \"petite-prelude.sch\")\n(load \"~a.sch\")\n(exit)\n" "(load \"petite-prelude.sch\")\n(load \"~a.sch\")\n(exit)\n"
bm))]) bm))])
(system "petite"))) (system* (find-program "petite" "petite"))))
(define (extract-chez-times bm str) (define (extract-chez-times bm str)
(let ([m (regexp-match #rx#"([0-9.]+)s elapsed cpu time(?:, including ([0-9.]+)s collecting)?[ \n]* ([0-9.]+)s elapsed real time" str)]) (let ([m (regexp-match #rx#"([0-9.]+)s elapsed cpu time(?:, including ([0-9.]+)s collecting)?[ \n]* ([0-9.]+)s elapsed real time" str)])
@ -424,7 +432,7 @@ exec racket -qu "$0" ${1+"$@"}
void void
mk-racket mk-racket
(lambda (bm) (lambda (bm)
(system* (find-exe) "-u" (compiled-path bm))) (system* (or (hash-ref executables "racket") (find-exe)) "-u" (compiled-path bm)))
extract-racket-times extract-racket-times
clean-up-zo clean-up-zo
racket-skip-progs) racket-skip-progs)
@ -526,7 +534,7 @@ exec racket -qu "$0" ${1+"$@"}
scheme-c scheme-i))) scheme-c scheme-i)))
(make-impl 'chicken (make-impl 'chicken
void void
(run-mk "mk-chicken.rktl") (run-mk "mk-chicken.rktl" "chicken" "csc")
run-exe run-exe
extract-chicken-times extract-chicken-times
clean-up-bin clean-up-bin
@ -534,7 +542,7 @@ exec racket -qu "$0" ${1+"$@"}
racket-specific-progs)) racket-specific-progs))
(make-impl 'bigloo (make-impl 'bigloo
void void
(run-mk "mk-bigloo.rktl") (run-mk "mk-bigloo.rktl" "bigloo" "bigloo")
run-exe run-exe
extract-bigloo-times extract-bigloo-times
clean-up-bin clean-up-bin
@ -542,7 +550,7 @@ exec racket -qu "$0" ${1+"$@"}
racket-specific-progs)) racket-specific-progs))
(make-impl 'gambit (make-impl 'gambit
void void
(run-mk "mk-gambit.rktl") (run-mk "mk-gambit.rktl" "gambit" "gsc")
run-gambit-exe run-gambit-exe
extract-gambit-times extract-gambit-times
clean-up-o1 clean-up-o1
@ -664,7 +672,7 @@ exec racket -qu "$0" ${1+"$@"}
i)) i))
impls)]) impls)])
(if (memq bm (impl-skips i)) (if (memq bm (impl-skips i))
(rprintf "[~a ~a ~s #f]\n" impl bm '(#f #f #f)) (rprintf "[~a ~a ~s #f]\n" (hash-ref names impl impl) bm '(#f #f #f))
(begin (begin
((impl-setup i) bm) ((impl-setup i) bm)
(let ([start (current-inexact-milliseconds)]) (let ([start (current-inexact-milliseconds)])
@ -678,7 +686,7 @@ exec racket -qu "$0" ${1+"$@"}
((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))
(rprintf "[~a ~a ~s ~a]\n" (rprintf "[~a ~a ~s ~a]\n"
impl (hash-ref names impl impl)
bm bm
((impl-extract-result i) bm (get-output-bytes out)) ((impl-extract-result i) bm (get-output-bytes out))
(inexact->exact (round (- end start))))) (inexact->exact (round (- end start)))))
@ -690,7 +698,9 @@ exec racket -qu "$0" ${1+"$@"}
(define-values (actual-benchmarks-to-run (define-values (actual-benchmarks-to-run
actual-implementations-to-run actual-implementations-to-run
num-iterations) num-iterations
executables
names)
(process-command-line benchmarks (process-command-line benchmarks
extra-benchmarks extra-benchmarks
(map impl-name impls) obsolete-impls (map impl-name impls) obsolete-impls

13
pkgs/racket-benchmarks/tests/racket/benchmarks/common/cmdline.rkt
View File

@ -1,4 +1,3 @@
(module cmdline mzscheme (module cmdline mzscheme
(require mzlib/process (require mzlib/process
mzlib/cmdline mzlib/cmdline
@ -33,12 +32,20 @@
(define default-benchmarks benchmarks) (define default-benchmarks benchmarks)
(define default-implementations (remq* non-default-implementations implementations)) (define default-implementations (remq* non-default-implementations implementations))
(define executables (make-hash-table 'equal))
(define names (make-hash-table))
;; Extract command-line arguments -------------------- ;; Extract command-line arguments --------------------
(define args (define args
(command-line (command-line
"auto" "auto"
(current-command-line-arguments) (current-command-line-arguments)
(multi
[("++exe") name path "Set executable for <name> to <path>"
(hash-table-put! executables name path)]
[("++name") name show-name "Log <name> as <show-name>"
(hash-table-put! names (string->symbol name) (string->symbol show-name))])
(once-each (once-each
[("--show") "show implementations and benchmarks" [("--show") "show implementations and benchmarks"
(printf "Implementations:\n") (printf "Implementations:\n")
@ -111,7 +118,9 @@
benchmarks) benchmarks)
(or run-implementations (or run-implementations
default-implementations) default-implementations)
num-iterations)) num-iterations
executables
names))
(define (rprintf . args) (define (rprintf . args)
(apply printf args) (apply printf args)

17
pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-bigloo.rktl
View File

@ -1,7 +1,7 @@
(require racket/system)
(require mzlib/process)
(define name (vector-ref (current-command-line-arguments) 0)) (define name (vector-ref (current-command-line-arguments) 0))
(define exe (vector-ref (current-command-line-arguments) 1))
(with-output-to-file (format "~a.scm" name) (with-output-to-file (format "~a.scm" name)
(lambda () (lambda ()
@ -11,7 +11,16 @@
(newline)) (newline))
#:exists 'truncate/replace) #:exists 'truncate/replace)
(when (system (format "bigloo -static-bigloo -w -o ~a -call/cc -copt -O3 -copt -fomit-frame-pointer -O6 ~a.scm" (when (system* exe
name name)) "-static-bigloo"
"-w"
"-o" name
"-call/cc"
"-copt"
"-O3"
"-copt"
"-fomit-frame-pointer"
"-O6"
(format "~a.scm" name))
(delete-file (format "~a.scm" name)) (delete-file (format "~a.scm" name))
(delete-file (format "~a.o" name))) (delete-file (format "~a.o" name)))

12
pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-chicken.rktl
View File

@ -1,6 +1,12 @@
(require mzlib/process) (require racket/system)
(define name (vector-ref (current-command-line-arguments) 0)) (define name (vector-ref (current-command-line-arguments) 0))
(define exe (vector-ref (current-command-line-arguments) 1))
(system (format "csc -no-warnings -no-trace -no-lambda-info -optimize-level 3 -block -d0 ~a.sch" (system* exe
name)) "-no-warnings"
"-no-trace"
"-no-lambda-info"
"-optimize-level" "3"
"-block" "-d0"
(format "~a.sch" name))

17
pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-gambit.rktl
View File

@ -1,13 +1,16 @@
(require racket/system)
(require mzlib/process)
(define name (vector-ref (current-command-line-arguments) 0)) (define name (vector-ref (current-command-line-arguments) 0))
(define exe (vector-ref (current-command-line-arguments) 1))
(when (file-exists? (format "~a.o1" name)) (when (file-exists? (format "~a.o1" name))
(delete-file (format "~a.o1" name))) (delete-file (format "~a.o1" name)))
(system (format "gsc -:m10000~a -dynamic -prelude '(include \"gambit-prelude.sch\")' ~a.sch" (system* exe
(if (memq (string->symbol name) '(nucleic2)) (format "-:m10000~a"
",s" (if (memq (string->symbol name) '(nucleic2))
"") ",s"
name)) ""))
"-dynamic"
"-prelude" "(include \"gambit-prelude.sch\")"
(format "~a.sch" name))

4
pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/auto.rkt
View File

@ -195,7 +195,9 @@ exec racket -qu "$0" ${1+"$@"}
(define-values (actual-benchmarks-to-run (define-values (actual-benchmarks-to-run
actual-implementations-to-run actual-implementations-to-run
num-iterations) num-iterations
executables
names)
(process-command-line benchmarks (process-command-line benchmarks
'() '()
(map impl-name impls) '() ; no obsolete implementations here (map impl-name impls) '() ; no obsolete implementations here