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)
(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))
(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)
(load script)))
@ -262,10 +270,10 @@ exec racket -qu "$0" ${1+"$@"}
"(compile-file \"~a.sch\")\n(exit)\n"
bm))]
[current-output-port (open-output-nowhere)])
(system "scheme -q")))
(system* (find-program "chez" "scheme") "-q")))
(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)
(parameterize ([current-input-port
@ -273,7 +281,7 @@ exec racket -qu "$0" ${1+"$@"}
(format
"(load \"petite-prelude.sch\")\n(load \"~a.sch\")\n(exit)\n"
bm))])
(system "petite")))
(system* (find-program "petite" "petite"))))
(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)])
@ -424,7 +432,7 @@ exec racket -qu "$0" ${1+"$@"}
void
mk-racket
(lambda (bm)
(system* (find-exe) "-u" (compiled-path bm)))
(system* (or (hash-ref executables "racket") (find-exe)) "-u" (compiled-path bm)))
extract-racket-times
clean-up-zo
racket-skip-progs)
@ -526,7 +534,7 @@ exec racket -qu "$0" ${1+"$@"}
scheme-c scheme-i)))
(make-impl 'chicken
void
(run-mk "mk-chicken.rktl")
(run-mk "mk-chicken.rktl" "chicken" "csc")
run-exe
extract-chicken-times
clean-up-bin
@ -534,7 +542,7 @@ exec racket -qu "$0" ${1+"$@"}
racket-specific-progs))
(make-impl 'bigloo
void
(run-mk "mk-bigloo.rktl")
(run-mk "mk-bigloo.rktl" "bigloo" "bigloo")
run-exe
extract-bigloo-times
clean-up-bin
@ -542,7 +550,7 @@ exec racket -qu "$0" ${1+"$@"}
racket-specific-progs))
(make-impl 'gambit
void
(run-mk "mk-gambit.rktl")
(run-mk "mk-gambit.rktl" "gambit" "gsc")
run-gambit-exe
extract-gambit-times
clean-up-o1
@ -664,7 +672,7 @@ exec racket -qu "$0" ${1+"$@"}
i))
impls)])
(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
((impl-setup i) bm)
(let ([start (current-inexact-milliseconds)])
@ -678,7 +686,7 @@ exec racket -qu "$0" ${1+"$@"}
((impl-run i) bm))
(error 'auto "~a\nrun failed ~a" (get-output-bytes out) bm))
(rprintf "[~a ~a ~s ~a]\n"
impl
(hash-ref names impl impl)
bm
((impl-extract-result i) bm (get-output-bytes out))
(inexact->exact (round (- end start)))))
@ -690,7 +698,9 @@ exec racket -qu "$0" ${1+"$@"}
(define-values (actual-benchmarks-to-run
actual-implementations-to-run
num-iterations)
num-iterations
executables
names)
(process-command-line benchmarks
extra-benchmarks
(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
(require mzlib/process
mzlib/cmdline
@ -33,12 +32,20 @@
(define default-benchmarks benchmarks)
(define default-implementations (remq* non-default-implementations implementations))
(define executables (make-hash-table 'equal))
(define names (make-hash-table))
;; Extract command-line arguments --------------------
(define args
(command-line
"auto"
(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
[("--show") "show implementations and benchmarks"
(printf "Implementations:\n")
@ -111,7 +118,9 @@
benchmarks)
(or run-implementations
default-implementations)
num-iterations))
num-iterations
executables
names))
(define (rprintf . args)
(apply printf args)

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

@ -1,7 +1,7 @@
(require mzlib/process)
(require racket/system)
(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)
(lambda ()
@ -11,7 +11,16 @@
(newline))
#:exists 'truncate/replace)
(when (system (format "bigloo -static-bigloo -w -o ~a -call/cc -copt -O3 -copt -fomit-frame-pointer -O6 ~a.scm"
name name))
(when (system* exe
"-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.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 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"
name))
(system* exe
"-no-warnings"
"-no-trace"
"-no-lambda-info"
"-optimize-level" "3"
"-block" "-d0"
(format "~a.sch" name))

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

@ -1,13 +1,16 @@
(require mzlib/process)
(require racket/system)
(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))
(delete-file (format "~a.o1" name)))
(system (format "gsc -:m10000~a -dynamic -prelude '(include \"gambit-prelude.sch\")' ~a.sch"
(system* exe
(format "-:m10000~a"
(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
actual-implementations-to-run
num-iterations)
num-iterations
executables
names)
(process-command-line benchmarks
'()
(map impl-name impls) '() ; no obsolete implementations here