56 lines
1.7 KiB
Common Lisp
56 lines
1.7 KiB
Common Lisp
;;; setup file for running cl-bench in CLISP
|
|
|
|
(load "defpackage")
|
|
(in-package :cl-bench)
|
|
|
|
|
|
(setq custom:*warn-on-floating-point-contagion* nil)
|
|
|
|
|
|
(defun bench-gc () (gc))
|
|
|
|
(defmacro with-spawned-thread (&body body)
|
|
`(progn ,@body))
|
|
|
|
|
|
|
|
(defun bench-time (fun times name)
|
|
(declare (ignore name))
|
|
(labels ((merge-2-values (val1 val2)
|
|
(if (< internal-time-units-per-second 1000000)
|
|
(dpb val1 (byte 16 16) val2) ; TIME_1: AMIGA, DOS, OS/2, UNIX_TIMES
|
|
(+ (* val1 internal-time-units-per-second) val2))) ; TIME_2: UNIX sonst, WIN32
|
|
(secs (v1 v2 v3 v4)
|
|
(/ (- (merge-2-values v1 v2)
|
|
(merge-2-values v3 v4))
|
|
internal-time-units-per-second)))
|
|
(multiple-value-bind (new-real1
|
|
new-real2
|
|
new-run1
|
|
new-run2
|
|
new-gc1
|
|
new-gc2
|
|
new-space1
|
|
new-space2
|
|
new-gccount)
|
|
(sys::%%time)
|
|
(dotimes (i times) (funcall fun))
|
|
(multiple-value-bind (old-real1
|
|
old-real2
|
|
old-run1
|
|
old-run2
|
|
old-gc1
|
|
old-gc2
|
|
old-space1
|
|
old-space2
|
|
old-gccount)
|
|
(sys::%%time)
|
|
;; returns real user sys consed
|
|
(values (secs old-real1 old-real2 new-real1 new-real2)
|
|
(secs old-run1 old-run2 new-run1 new-run2)
|
|
0.0
|
|
(- old-gccount new-gccount))))))
|
|
|
|
|
|
;; EOF
|