application/octet-stream
•
8.28 KB
•
196 lines
#!/usr/bin/env nujel
#| This script generates JSON files to be used with the web-based benchmark viewer,
| any sort of analysis is deferred to the browser, here we just measure the date
| and capture as much data as possible. After a run a new file will be added to
| benchmarks/results/, which should then be uploaded to the server which can then
| use the benchmark-aggregate.nuj script to generate the single aggregate JSON
| file for the viewer.
|#
(import (blue green yellow) :ansi)
(import (serialize :as val->json) :serialization/json)
(def time-path (popen/trim "which time"))
(def single-runs 8)
(def nujel-runs 8)
(def git-head (popen/trim "git rev-parse HEAD"))
(def git-branch (popen/trim "git rev-parse --abbrev-ref HEAD"))
(def uname-a (popen/trim "uname -a"))
(def date (popen/trim "git show -s --format=%cI")) ; Would be nice if this could be done as easily in Nujel
(def rough-date (popen/trim "git show -s --format=%cs"))
(def hostname (popen/trim "uname -n"))
(defn bench/get-language (filename)
(case (lower-case (path/extension filename))
("lisp" :common-lisp)
("newlisp" :newlisp)
("el" :emacs-lisp)
("be" :berry)
("c" :c)
("dart" :dart)
("erl" :erlang)
("jnt" :janet)
("js" :javascript)
("krk" :kuroko)
("lua" :lua)
("jl" :julia)
("nuj" :nujel)
("pl" :perl)
("php" :php)
("py" :python)
("rkt" :racket)
("zuo" :zuo)
("rby" :ruby)
("scm" :scheme)
(otherwise #nil)))
(defn bench/get-language-runtimes (language)
(case language
(:c '("tcc -run"))
(:berry '("berry"))
(:common-lisp '("ecl --shell" "clisp" "sbcl --script" "ccl -n -l"))
(:newlisp '("newlisp"))
(:emacs-lisp '("emacs -Q --script"))
(:dart '("dart"))
(:erlang '("escript"))
(:janet '("janet"))
(:javascript '("node" "qjs" "deno run" "duk" "mujs" "js78" "js91" "bun"))
(:kuroko '("kuroko"))
(:lua '("lua" "luajit" "luau"))
(:julia '("julia"))
(:nujel '("./nujel"))
(:perl '("perl"))
(:php '("php"))
(:python '("python" "pypy"))
(:racket '("racket"))
(:zuo '("zuo"))
(:ruby '("ruby" "mruby"))
(:scheme '("guile" "stklos -f" "chibi-scheme -q" "gosh" "chez --script" "scheme48" "s7" "mit-scheme-script"))
(otherwise '())))
(defn bench/get-runtime-version (runtime)
(case (car (split runtime " "))
("clisp" (popen/trim "bash -c \"clisp -q -norc --version 2>/dev/null\""))
("ecl" (popen/trim "bash -c \"ecl --version 2>&1\""))
("s9" (popen/trim "bash -c \"s9 -? 2>&1 | head -n 2\""))
("deno" (popen/trim "bash -c \"deno --version 2>&1\""))
("qjs" (popen/trim "bash -c \"qjs -h 2>&1\""))
("newlisp" (popen/trim "bash -c \"newlisp -v 2>&1\""))
("kuroko" (popen/trim "bash -c \"kuroko --version 2>&1\""))
("escript" (popen/trim "bash -c \"erl -version 2>&1\""))
("node" (popen/trim "bash -c \"node --version 2>&1\""))
(("lua" "luajit") (popen/trim (fmt "bash -c \"{runtime} -v 2>&1\"")))
("perl" (popen/trim "bash -c \"perl --version 2>&1\""))
("php" (popen/trim "bash -c \"php --version 2>&1\""))
("python" (popen/trim "bash -c \"python --version 2>&1\""))
("pypy" (popen/trim "bash -c \"pypy --version 2>&1\""))
("racket" (popen/trim "bash -c \"racket --version 2>&1\""))
("ruby" (popen/trim "bash -c \"ruby --version 2>&1\""))
("guile" (popen/trim "bash -c \"guile --version 2>&1\""))
("chibi-scheme" (popen/trim "bash -c \"chibi-scheme --version 2>&1\""))
("gosh" (popen/trim "bash -c \"gosh -V 2>&1\""))
("berry" (popen/trim "bash -c \"berry - 2>&1\""))
(otherwise (fmt "{runtime}-unknown"))))
(defn runtime/available? (runtime)
(def executable (car (split runtime " ")))
(zero? (car (popen (fmt "command -v {executable}")))))
(defn get-result (testcase)
(case testcase
("for" "49999995000000")
("hello" "Hello")
("euler1" "23333331666668")
("euler4" "906609")
("md5" "47afad6ea7d0515701d2b63472530971")
("crc32" "0936343A")
("compile-stdlib" "Image built")
("adler32" "E50BA232")
("recfib" "832040")
(otherwise "チーズスイートホーム")))
(def time-template "#@(:user %U :system %S :elapsed \\\"%E\\\" :cpu \\\"%P\\\" :text %X :data %D :max-resident %M :inputs %I :outputs %O :pagefaults-major %F :pagefaults-minor %R :swaps %W)")
(defn bench/single (filename runtime i)
(def language (bench/get-language filename))
(when-not (runtime/available? runtime)
(when (zero? i)
(pfmt "{} {} Runtime not found"
(blue (pad-end language 14))
(yellow (pad-end runtime 20))))
(return #nil))
(when (zero? i)
(def testname (cadr (split filename "/")))
(pfmt "{} {} {}"
(blue (pad-end language 14))
(green (pad-end runtime 20))
(yellow (pad-end testname 20))))
(when (>= i 0) (pfmt "{i} "))
(when-not (file/file? filename)
(exception :io-error "Can't open the following file to benchmark it:" filename))
(def result-file "nujel-benchmark.tmp")
(def measurements #nil)
(def testcase (cadr (split filename "/")))
(try (fn (err)
(rm result-file)
(print/error err)
(throw err))
(def ret (popen (fmt "{} -o {result-file} --format=\"{time-template}\" {runtime} {filename}" time-path)))
(when-not (zero? (car ret))
(exception :benchmark-error "Benchmark returned non-zero exit code" (cons filename ret)))
(when-not (>= (:index-of (cdr ret) (get-result testcase)) 0)
(exception :benchmark-error "Benchmark returned wrong result" (cons filename ret)))
(set! measurements (:clone (read/single (file/read result-file))))
(set! measurements :stdout (cdr ret))
(rm result-file))
(when-not measurements (return #nil))
(-> measurements
(set! :language (bench/get-language filename))
(set! :git-head git-head)
(set! :git-branch git-branch)
(set! :uname uname-a)
(set! :architecture System/Architecture)
(set! :hostname hostname)
(set! :os System/OS)
(set! :time (time))
(set! :triplet (fmt "{testcase}-{hostname}-{System/Architecture}"))
(set! :testcase testcase)
(set! :total (+ (ref measurements :user) (ref measurements :system)))
(set! :date date)
(set! :runtime runtime)
(set! :runtime-version (bench/get-runtime-version runtime))
(set! :filename filename)))
(defn bench/file (ret filename)
(when-not filename (return ret))
(def language (bench/get-language filename))
(and (:has? init/options :only-nujel)
(not= language :nujel)
(return ret))
(def cur-runs (if (= language :nujel)
nujel-runs
single-runs))
(doseq (runtime (bench/get-language-runtimes language))
(when-not runtime (return ret))
(when (> cur-runs 0)
(bench/single filename runtime -1) ; Ignore the first run as a warm-up
(dotimes (i cur-runs)
(set! ret (cons (bench/single filename runtime i) ret)))
(println "")))
ret)
(def res-name (fmt "{rough-date}-{hostname}-{git-head}"))
(def out-name (fmt "web/benchmark-results/{}.json" res-name))
(mkdir "web/benchmark-results")
(and (:has? init/options :no-overwrite)
(file/file? out-name)
(do (pfmtln "{out-name} exists already, exiting.")
(exit 0)))
(-> (directory/read-recursive "benchmark")
(sort)
(reduce bench/file #nil)
(val->json)
(file/write out-name))
