Commit 8b6572f1 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

support: bench-run-1: implement function

parent ecb78e52
...@@ -98,6 +98,25 @@ ...@@ -98,6 +98,25 @@
(setf (fdefinition 'filter) #'remove-if-not) (setf (fdefinition 'filter) #'remove-if-not)
(defun bench-run-1 (benchmark &key force)
(multiple-value-bind (real user sys consed)
(if (and (not force)
(some #'(lambda (bench)
(member bench *features*))
(benchmark-disabled-for benchmark)))
(progn
(format t "~&=== skipping disabled ~a~%" benchmark))
(progn
(bench-gc)
(with-slots (setup function runs) benchmark
(when setup (funcall setup))
(format t "~&=== running ~a~%" benchmark)
(bench-time function runs))))
(push (list (slot-value benchmark 'short) real user sys consed)
*benchmark-results*)))
#+ (or)
(defun bench-run-1 (&key names groups (defun bench-run-1 (&key names groups
&aux &aux
(names (ensure-list names)) (names (ensure-list names))
...@@ -120,15 +139,8 @@ ...@@ -120,15 +139,8 @@
(*compile-print* nil)) (*compile-print* nil))
(bench-report-header) (bench-report-header)
(dolist (b (reverse *benchmarks*)) (dolist (b (reverse *benchmarks*))
(if (some #'(lambda (bench) (member bench *features*)) (bench-run-1 b)
(benchmark-disabled-for b)) (bench-report (car *benchmark-results*)))
(format t "~&=== skipping disabled ~a~%" b)
(progn
(bench-gc)
(with-slots (setup function short runs) b
(when setup (funcall setup))
(format t "~&=== running ~a~%" b)
(bench-report function short runs)))))
(bench-report-footer)))) (bench-report-footer))))
(defun benchmark-report-file () (defun benchmark-report-file ()
...@@ -152,24 +164,19 @@ ...@@ -152,24 +164,19 @@
(format *benchmark-output* "~%~s~%" (format *benchmark-output* "~%~s~%"
(cons +implementation+ *benchmark-results*))) (cons +implementation+ *benchmark-results*)))
;; generate a report to *benchmark-output* on the calling of FUNCTION ;; generate a report to *benchmark-output* on the benchmark result
(defun bench-report (function name times) (defun bench-report (bench-result)
(multiple-value-bind (real user sys consed) (destructuring-bind (name real user sys consed) bench-result
(bench-time function times name)
(format *benchmark-output* (format *benchmark-output*
";; ~25a ~8,2f ~8,2f ~8,2f ~12d" ";; ~25a ~8,2f ~8,2f ~8,2f ~12d"
name real user sys consed) name real user sys consed)
(terpri *benchmark-output*) (terpri *benchmark-output*)
(force-output *benchmark-output*) (force-output *benchmark-output*)))
(push (cons name (list real user sys consed))
*benchmark-results*)))
;; a generic timing function, that depends on GET-INTERNAL-RUN-TIME ;; a generic timing function, that depends on GET-INTERNAL-RUN-TIME
;; and GET-INTERNAL-REAL-TIME returning sensible results. If a version ;; and GET-INTERNAL-REAL-TIME returning sensible results. If a version
;; was defined in sysdep/setup-<impl>, we use that instead ;; was defined in sysdep/setup-<impl>, we use that instead
(defun generic-bench-time (fun times name) (defun generic-bench-time (fun times)
(declare (ignore name))
(let (before-real after-real before-user after-user) (let (before-real after-real before-user after-user)
(setq before-user (get-internal-run-time)) (setq before-user (get-internal-run-time))
(setq before-real (get-internal-real-time)) (setq before-real (get-internal-real-time))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment