3 (eval-when (:compile-toplevel
)
4 (declaim (optimize (speed 3) (safety 1))))
6 (defmacro with-measuring
((var measure-fn
) &body body
)
7 (let ((initial (gensym)))
8 `(let ((,initial
(,measure-fn
)))
10 (setf ,var
(- (,measure-fn
) ,initial
)))))
12 (defmacro measure-time
((var) &body body
)
14 (with-measuring (,var get-internal-real-time
)
16 (setf ,var
(coerce (/ ,var internal-time-units-per-second
)
19 (defmacro measure-conses
((var) &body body
)
20 `(with-measuring (,var total-bytes-allocated
)
23 (defun measure-fn (fn &rest args
)
24 (declare (dynamic-extent args
))
25 (let ((bytes 0) (seconds 0) result
)
26 (measure-time (seconds)
27 (measure-conses (bytes)
28 (setf result
(apply fn args
))))
29 (values seconds bytes result
)))
31 (defmacro measure
(seconds bytes
&body body
)
32 (let ((result (gensym)))
34 (measure-time (,seconds
)
35 (measure-conses (,bytes
)
36 (setf ,result
(progn ,@body
))))
39 (defmacro measure-time-and-conses
(&body body
)
40 (let ((seconds (gensym))
43 `(let ((,seconds
0) (,conses
0) ,results
)
44 (setf ,results
(multiple-value-list
45 (measure ,seconds
,conses
,@body
)))
46 (values-list (nconc (list ,seconds
,conses
)
50 ;; tries to handle multiple values (but fails since measure doesn't)
51 (defmacro measure-time-and-conses
(&body body
)
52 (let ((seconds (gensym))
54 `(let ((,seconds
0) (,conses
0))
55 (values-list (nconc (multiple-value-list
56 (measure ,seconds
,conses
,@body
))
57 (list ,seconds
,conses
))))))
59 (defvar *profile-extra
* nil
)
61 (defparameter *benchmark-log-path
*
62 (asdf:system-relative-pathname
63 'lift
"benchmark-data/benchmarks.log"))
65 (defvar *count-calls-p
* nil
)
67 (defvar *additional-markers
* nil
)
69 (defvar *profiling-threshold
* nil
)
71 (defmacro with-profile-report
72 ((name style
&key
(log-name *benchmark-log-path
* ln-supplied?
)
73 (count-calls-p *count-calls-p
* ccp-supplied?
)
74 (timeout nil timeout-supplied?
))
76 `(with-profile-report-fn
81 `(:count-calls-p
,count-calls-p
))
83 `(:log-name
,log-name
))
84 ,@(when timeout-supplied?
85 `(:timeout
,timeout
))))
88 (defun cancel-current-profile (&key force?
)
89 (when (prof::current-profile-actual prof
::*current-profile
*)
91 (assert (member (prof:profiler-status
) '(:inactive
))))
93 (setf prof
::*current-profile
* (prof::make-current-profile
))))
96 (defun current-profile-sample-count ()
97 (ecase (prof::profiler-status
:verbose nil
)
98 ((:inactive
:analyzed
) 0)
100 (slot-value (prof::current-profile-actual prof
::*current-profile
*)
102 (:sampling
(warn "Can't determine count while sampling"))))
105 (prof:with-profiling ...
110 (defun with-profile-report-fn
111 (name style fn
&key
(log-name *benchmark-log-path
*)
112 (count-calls-p *count-calls-p
*)
114 (assert (member style
'(:time
:space
:count-only
)))
115 (cancel-current-profile :force? t
)
116 (let* ((seconds 0.0) (conses 0)
120 (with-timeout (timeout)
123 (prof:with-profiling
(:type style
:count count-calls-p
)
124 (measure seconds conses
(funcall fn
))))))
127 (declare (ignore c
))))
128 ;; cleanup / ensure we get report
129 (ensure-directories-exist log-name
)
131 (with-open-file (output log-name
133 :if-does-not-exist
:create
135 (with-standard-io-syntax
136 (let ((*print-readably
* nil
))
138 (format output
"\(~11,d ~20,s ~10,s ~10,s ~{~s~^ ~} ~s ~s\)"
139 (date-stamp :include-time? t
) name
140 seconds conses
*additional-markers
*
141 results
(current-profile-sample-count)))))
142 (when (> (current-profile-sample-count) 0)
143 (let ((pathname (unique-filename
147 :name
(format nil
"~a-~a-" name style
))
149 (let ((prof:*significance-threshold
*
150 (or *profiling-threshold
* 0.01)))
151 (format t
"~&Profiling output being sent to ~a" pathname
)
152 (with-open-file (output pathname
154 :if-does-not-exist
:create
156 (format output
"~&Profile data for ~a" name
)
157 (format output
"~&Date: ~a"
158 (excl:locale-print-time
(get-universal-time)
159 :fmt
"%B %d, %Y %T" :stream nil
))
160 (format output
"~& Total time: ~,2F; Total space: ~:d \(~:*~d\)"
162 (format output
"~%~%")
163 (when (or (eq :time style
)
165 (prof:show-flat-profile
:stream output
)
166 (prof:show-call-graph
:stream output
)
168 (format output
"~%~%Call counts~%")
169 (let ((*standard-output
* output
))
170 (prof:show-call-counts
))))
171 (when *profile-extra
*
172 (loop for thing in
*profile-extra
* do
173 (format output
"~%~%")
174 (let ((*standard-output
* output
))
175 (prof:disassemble-profile thing
)))))))))
176 (values-list results
)))
178 (defmacro while-counting-repetitions
((period) &body body
)
179 "Returns the count of the number of times `body` was executed during
181 (let ((gevent-count (gensym "count")))
182 `(let ((,gevent-count
0))
183 (declare (type fixnum
,gevent-count
))
185 (with-timeout (,period
)
188 (incf ,gevent-count
)))
193 (defun count-repetitions (fn period
&rest args
)
194 (declare (dynamic-extent args
))
195 (let ((event-count 0))
197 (with-timeout (period)
199 (apply #'funcall fn args
)