1 ;;;; runtime support for dynamic VOP statistics collection
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!DYNCOUNT")
16 Make sure multi-cycle instruction costs are plausible.
18 Make tables of %cost for benchmark X class.
19 Could be represented as a sort of bar chart.
22 (eval-when (:compile-toplevel
)
23 (when *collect-dynamic-statistics
*
24 (error "Compiling this file with dynamic stat collection turned on would ~
25 be a very bad idea.")))
29 (defun make-hash-table-like (table)
31 "Make a hash-table with the same test as table."
32 (declare (type hash-table table
))
33 (make-hash-table :test
(sb!impl
::hash-table-kind table
)))
35 (defun hash-difference (table1 table2
)
37 "Return a hash-table containing only the entries in Table1 whose key is not
38 also a key in Table2." (declare (type hash-table table1 table2
))
39 (let ((res (make-hash-table-like table1
)))
40 (with-locked-hash-table (table2)
41 (dohash ((k v
) table1
:locked t
)
42 (unless (nth-value 1 (gethash k table2
))
43 (setf (gethash k res
) v
))))
46 (defun hash-list (table)
48 "Return a list of the values in Table."
49 (declare (type hash-table table
))
56 ;;; Read (or write) a hashtable from (or to) a file.
57 (defun read-hash-table (file)
58 (with-open-file (s file
:direction
:input
)
60 (format t
"~%; ~A" (read-line s
)))
64 (res (make-hash-table :test test
)))
65 (read s
); Discard writer...
67 (let ((key (read s nil eof
)))
68 (when (eq key eof
) (return))
69 (setf (gethash key res
)
70 (funcall reader s key
))))
72 (defun write-hash-table (table file
&key
73 (comment (format nil
"Contents of ~S" table
))
74 (reader 'read
) (writer 'prin1
) (test 'equal
))
75 (with-open-file (s file
:direction
:output
:if-exists
:new-version
)
76 (with-standard-io-syntax
77 (let ((*print-readably
* nil
))
79 "~A~%~A version ~A on ~A~%"
81 (lisp-implementation-type)
82 (lisp-implementation-version)
84 (format-universal-time s
(get-universal-time))
86 (format s
"~S ~S ~S~%" test reader writer
)
87 (dohash ((k v
) table
:locked t
)
89 (write-char #\space s
)
94 ;;;; info accumulation
96 ;;; Used to accumulate info about the usage of a single VOP. Cost and count
97 ;;; are kept as double-floats, which lets us get more bits and avoid annoying
99 (deftype count-vector
() '(simple-array double-float
(2)))
100 (defstruct (vop-stats
101 (:constructor %make-vop-stats
(name))
102 (:constructor make-vop-stats-key
)
104 (name (missing-arg) :type simple-string
)
105 (data (make-array 2 :element-type
'double-float
) :type count-vector
))
107 (defmacro vop-stats-count
(x) `(aref (vop-stats-data ,x
) 0))
108 (defmacro vop-stats-cost
(x) `(aref (vop-stats-data ,x
) 1))
110 (defun make-vop-stats (&key name count cost
)
111 (let ((res (%make-vop-stats name
)))
112 (setf (vop-stats-count res
) count
)
113 (setf (vop-stats-cost res
) cost
)
116 #!-sb-fluid
(declaim (freeze-type dyncount-info vop-stats
))
118 ;;; Add the Info into the cumulative result on the VOP name plist. We use
119 ;;; plists so that we will touch minimal system code outside of this file
120 ;;; (which may be compiled with profiling on.)
121 (defun note-dyncount-info (info)
122 (declare (type dyncount-info info
) (inline get %put
)
123 (optimize (speed 2)))
124 (let ((counts (dyncount-info-counts info
))
125 (vops (dyncount-info-vops info
)))
126 (dotimes (index (length counts
))
127 (declare (type index index
))
128 (let ((count (coerce (the (unsigned-byte 31)
132 (warn "Oops: overflow.")
133 (return-from note-dyncount-info nil
))
134 (unless (zerop count
)
135 (let* ((vop-info (svref vops index
))
136 (length (length vop-info
)))
137 (declare (simple-vector vop-info
))
140 (declare (type index i
))
141 (let* ((name (svref vop-info i
))
142 (entry (or (get name
'vop-stats
)
143 (setf (get name
'vop-stats
)
144 (%make-vop-stats
(symbol-name name
))))))
145 (incf (vop-stats-count entry
)
146 (* (coerce (the index
(svref vop-info
(1+ i
)))
149 (incf (vop-stats-cost entry
)
150 (* (coerce (the index
(svref vop-info
(+ i
2)))
154 (defun clear-dyncount-info (info)
155 (declare (type dyncount-info info
))
156 (declare (optimize (speed 3) (safety 0)))
157 (let ((counts (dyncount-info-counts info
)))
158 (dotimes (i (length counts
))
159 (setf (aref counts i
) 0))))
161 ;;; Clear any VOP-COUNTS properties and the counts vectors for all code
162 ;;; objects. The latter loop must not call any random functions.
163 (defun clear-vop-counts (&optional
(spaces '(:dynamic
)))
165 "Clear all dynamic VOP counts for code objects in the specified spaces."
166 (dohash ((k v
) *backend-template-names
* :locked t
)
168 (remprop k
'vop-stats
))
171 (declare (optimize (speed 3) (safety 0))
172 (inline sb
!vm
::map-allocated-objects
))
174 (dolist (space spaces
)
175 (sb!vm
::map-allocated-objects
176 (lambda (object type-code size
)
177 (declare (ignore type-code size
))
178 (when (dyncount-info-p object
)
179 (clear-dyncount-info object
)))
182 ;;; Call NOTE-DYNCOUNT-INFO on all DYNCOUNT-INFO structure allocated in the
183 ;;; specified spaces. Return a hashtable describing the counts. The initial
184 ;;; loop must avoid calling any functions outside this file to prevent adding
185 ;;; noise to the data, since other files may be compiled with profiling.
186 (defun get-vop-counts (&optional
(spaces '(:dynamic
)) &key
(clear nil
))
188 "Return a hash-table mapping string VOP names to VOP-STATS structures
189 describing the VOPs executed. If clear is true, then reset all counts to
190 zero as a side effect."
192 (declare (optimize (speed 3) (safety 0))
193 (inline sb
!vm
::map-allocated-objects
))
195 (dolist (space spaces
)
196 (sb!vm
::map-allocated-objects
197 (lambda (object type-code size
)
198 (declare (ignore type-code size
))
199 (when (dyncount-info-p object
)
200 (note-dyncount-info object
)
202 (clear-dyncount-info object
))))
205 (let ((counts (make-hash-table :test
'equal
)))
206 (dohash ((k v
) *backend-template-names
* :locked t
)
208 (let ((stats (get k
'vop-stats
)))
210 (setf (gethash (symbol-name k
) counts
) stats
)
212 (remprop k
'vop-stats
)))))
215 ;;; Return the DYNCOUNT-INFO for FUNCTION.
216 (defun find-info-for (function)
217 (declare (type function function
))
218 (let* ((function (%primitive closure-fun function
))
219 (component (sb!di
::fun-code-header function
)))
220 (do ((end (get-header-data component
))
221 (i sb
!vm
:code-constants-offset
(1+ i
)))
223 (let ((constant (code-header-ref component i
)))
224 (when (dyncount-info-p constant
)
225 (return constant
))))))
227 (defun vop-counts-apply (function args
&key
(spaces '(:dynamic
)) by-space
)
229 "Apply Function to Args, collecting dynamic statistics on the running.
230 Spaces are the spaces to scan for counts. If By-Space is true, we return a
231 list of result tables, instead of a single table. In this case, specify
233 (clear-vop-counts spaces
)
234 (apply function args
)
236 (mapcar (lambda (space)
237 (get-vop-counts (list space
) :clear t
))
239 (get-vop-counts spaces
)))
243 (defun get-vop-costs ()
245 "Return a hash-table mapping string VOP names to the cost recorded in the
246 generator for all VOPs which are also the names of assembly routines."
247 (let ((res (make-hash-table :test
'equal
)))
248 (dohash ((name v
) *assembler-routines
* :locked t
)
250 (let ((vop (gethash name
*backend-template-names
*)))
252 (setf (gethash (symbol-name name
) res
)
253 (template-cost (template-or-lose name
))))))
256 (defvar *native-costs
* (get-vop-costs)
258 "Costs of assember routines on this machine.")
262 (defparameter *basic-classes
*
263 '(("Integer multiplication"
264 "*/FIXNUM" "*/SIGNED" "*/UNSIGNED" "SIGNED-*" "FIXNUM-*" "GENERIC-*")
265 ("Integer division" "TRUNCATE")
266 ("Generic arithmetic" "GENERIC" "TWO-ARG")
268 ("Inline compare less/greater" "</" ">/" "<-C/" ">-C/")
269 ("Inline arith" "*/" "//" "+/" "-/" "NEGATE" "ABS" "+-C" "--C")
270 ("Inline logic" "-ASH" "$ASH" "LOG")
271 ("CAR/CDR" "CAR" "CDR")
272 ("Array type test" "ARRAYP" "VECTORP" "ARRAY-HEADER-P")
273 ;; FIXME: STRUCTUREP? This looks somewhat stale..
274 ("Simple type predicate" "STRUCTUREP" "LISTP" "FIXNUMP")
275 ("Simple type check" "CHECK-LIST" "CHECK-FIXNUM" "CHECK-STRUCTURE")
276 ("Array bounds check" "CHECK-BOUND")
277 ("Complex type check" "$CHECK-" "COERCE-TO-FUN")
278 ("Special read" "SYMBOL-VALUE")
279 ("Special bind" "BIND$")
280 ("Tagging" "MOVE-FROM")
281 ("Untagging" "MOVE-TO" "MAKE-FIXNUM")
283 ("Non-local exit" "CATCH" "THROW" "DYNAMIC-STATE" "NLX" "UNWIND")
284 ("Array write" "DATA-VECTOR-SET" "$SET-RAW-BITS$")
285 ("Array read" "DATA-VECTOR-REF" "$RAW-BITS$" "VECTOR-LENGTH"
286 "LENGTH/SIMPLE" "ARRAY-HEADER")
287 ("List/string utility" "LENGTH/LIST" "SXHASH" "BIT-BASH" "$LENGTH$")
288 ("Alien operations" "SAP" "ALLOC-NUMBER-STACK" "$CALL-OUT$")
289 ("Function call/return" "CALL" "RETURN" "ALLOCATE-FRAME"
290 "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARG-COUNT")
291 ("Allocation" "MAKE-" "ALLOC" "$CONS$" "$LIST$" "$LIST*$")
292 ("Float conversion" "%SINGLE-FLOAT" "%DOUBLE-FLOAT" "-BITS$")
293 ("Complex type predicate" "P$")))
295 ;;; Return true if Name patches a specified pattern. Pattern is a string
296 ;;; (or symbol) or a list of strings (or symbols). If any specified string
297 ;;; appears as a substring of name, the pattern is matched. #\$'s are wapped
298 ;;; around name, allowing the use of $ to force a match at the beginning or
300 (defun matches-pattern (name pattern
)
301 (declare (simple-string name
))
302 (let ((name (concatenate 'string
"$" name
"$")))
303 (dolist (pat (if (listp pattern
) pattern
(list pattern
)) nil
)
304 (when (search (the simple-string
(string pat
))
308 ;;; Utilities for debugging classification rules. FIND-MATCHES returns a
309 ;;; list of all the VOP names in Table that match Pattern. WHAT-CLASS returns
310 ;;; the class that NAME would be placed in.
311 (defun find-matches (table pattern
)
313 (dohash ((key value
) table
:locked t
)
314 (declare (ignore value
))
315 (when (matches-pattern key pattern
) (res key
)))
317 (defun what-class (name classes
)
318 (dolist (class classes nil
)
319 (when (matches-pattern name
(rest class
)) (return (first class
)))))
321 ;;; Given a VOP-STATS hash-table, return a new one with VOPs in the same
322 ;;; class merged into a single entry for that class. The classes are
323 ;;; represented as a list of lists: (class-name pattern*). Each pattern is a
324 ;;; string (or symbol) that can appear as a subsequence of the VOP name. A VOP
325 ;;; is placed in the first class that it matches, or is left alone if it
326 ;;; matches no class.
327 (defun classify-costs (table classes
)
328 (let ((res (make-hash-table-like table
)))
329 (dohash ((key value
) table
:locked t
)
330 (let ((class (dolist (class classes nil
)
331 (when (matches-pattern key
(rest class
))
332 (return (first class
))))))
334 (let ((found (or (gethash class res
)
335 (setf (gethash class res
)
336 (%make-vop-stats class
)))))
337 (incf (vop-stats-count found
) (vop-stats-count value
))
338 (incf (vop-stats-cost found
) (vop-stats-cost value
)))
339 (setf (gethash key res
) value
))))
344 ;;; Sum the count and costs.
345 (defun cost-summary (table)
346 (let ((total-count 0d0
)
348 (dohash ((k v
) table
:locked t
)
350 (incf total-count
(vop-stats-count v
))
351 (incf total-cost
(vop-stats-cost v
)))
352 (values total-count total-cost
)))
354 ;;; Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
355 ;;; according to the Costs table. Any VOPs in the list IGNORE are ignored.
356 (defun compensate-costs (table costs
&optional ignore
)
357 (let ((res (make-hash-table-like table
)))
358 (dohash ((key value
) table
:locked t
)
359 (unless (or (string= key
"COUNT-ME")
360 (member key ignore
:test
#'string
=))
361 (let ((cost (gethash key costs
)))
363 (let* ((count (vop-stats-count value
))
364 (sum (+ (* cost count
)
365 (vop-stats-cost value
))))
366 (setf (gethash key res
)
367 (make-vop-stats :name key
:count count
:cost sum
)))
368 (setf (gethash key res
) value
)))))
371 ;;; Take two tables of vop-stats and return a table of entries where the
372 ;;; entries have been compared. The counts are normalized to Compared. The
373 ;;; costs are the difference of the costs adjusted by the difference in counts:
374 ;;; the cost for Original is modified to correspond to the count in Compared.
375 (defun compare-stats (original compared
)
376 (declare (type hash-table original compared
))
377 (let ((res (make-hash-table-like original
)))
378 (dohash ((k cv
) compared
:locked t
)
379 (let ((ov (gethash k original
)))
381 (let ((norm-cnt (/ (vop-stats-count ov
) (vop-stats-count cv
))))
382 (setf (gethash k res
)
386 :cost
(- (/ (vop-stats-cost ov
) norm-cnt
)
387 (vop-stats-cost cv
))))))))
390 (defun combine-stats (&rest tables
)
392 "Sum the VOP stats for the specified tables, returning a new table with the
394 (let ((res (make-hash-table-like (first tables
))))
395 (dolist (table tables
)
396 (dohash ((k v
) table
:locked t
)
397 (let ((found (or (gethash k res
)
398 (setf (gethash k res
) (%make-vop-stats k
)))))
399 (incf (vop-stats-count found
) (vop-stats-count v
))
400 (incf (vop-stats-cost found
) (vop-stats-cost v
)))))
403 ;;;; report generation
405 (defun sort-result (table by
)
406 (sort (hash-list table
) #'>
409 (:count
(vop-stats-count x
))
410 (:cost
(vop-stats-cost x
)))))))
412 ;;; Report about VOPs in the list of stats structures.
413 (defun entry-report (entries cut-off compensated compare total-cost
)
414 (let ((counter (if (and cut-off
(> (length entries
) cut-off
))
416 most-positive-fixnum
)))
417 (dolist (entry entries
)
418 (let* ((cost (vop-stats-cost entry
))
419 (name (vop-stats-name entry
))
420 (entry-count (vop-stats-count entry
))
421 (comp-entry (if compare
(gethash name compare
) entry
))
422 (count (vop-stats-count comp-entry
)))
423 (format t
"~30<~A~>: ~:[~13:D~;~13,2F~] ~9,2F ~5,2,2F%~%"
424 (vop-stats-name entry
)
426 (if compare entry-count
(round entry-count
))
429 (- (vop-stats-cost (gethash name compensated
))
430 (vop-stats-cost comp-entry
))
433 (when (zerop (decf counter
))
434 (format t
"[End of top ~W]~%" cut-off
))))))
436 ;;; Divide SORTED into two lists, the first CUT-OFF elements long. Any VOP
437 ;;; names that match one of the report strings are moved into the REPORT list
438 ;;; even if they would otherwise fall below the CUT-OFF.
439 (defun find-cut-off (sorted cut-off report
)
440 (if (or (not cut-off
) (<= (length sorted
) cut-off
))
442 (let ((not-cut (subseq sorted
0 cut-off
)))
445 (dolist (el (nthcdr cut-off sorted
))
446 (let ((name (vop-stats-name el
)))
447 (if (matches-pattern name report
)
450 (values (append not-cut
(select)) (reject))))))
452 ;;; Display information about entries that were not displayed due to the
453 ;;; cut-off. Note: if compare, we find the total cost delta and the geometric
454 ;;; mean of the normalized counts.
455 (defun cut-off-report (other compare total-cost
)
456 (let ((rest-cost 0d0
)
458 (rest-entry-count (if compare
1d0
0d0
)))
459 (dolist (entry other
)
460 (incf rest-cost
(vop-stats-cost entry
))
464 (gethash (vop-stats-name entry
) compare
)
467 (setq rest-entry-count
468 (* rest-entry-count
(vop-stats-count entry
)))
469 (incf rest-entry-count
(vop-stats-count entry
))))
471 (let ((count (if compare
472 (expt rest-entry-count
473 (/ (coerce (length other
) 'double-float
)))
474 (round rest-entry-count
))))
475 (format t
"~30<Other~>: ~:[~13:D~;~13,2F~] ~9,2F ~@[~5,2,2F%~]~%"
477 (/ rest-cost rest-count
)
479 (/ rest-cost total-cost
))))))
481 ;;; Report summary information about the difference between the comparison
482 ;;; and base data sets.
483 (defun compare-report (total-count total-cost compare-total-count
484 compare-total-cost compensated compare
)
485 (format t
"~30<Relative total~>: ~13,2F ~9,2F~%"
486 (/ total-count compare-total-count
)
487 (/ total-cost compare-total-cost
))
488 (flet ((frob (a b sign wot
)
489 (multiple-value-bind (cost count
)
490 (cost-summary (hash-difference a b
))
491 (unless (zerop count
)
492 (format t
"~30<~A~>: ~13:D ~9,2F ~5,2,2F%~%"
493 wot
(* sign
(round count
))
494 (* sign
(/ cost count
))
495 (* sign
(/ cost compare-total-cost
)))))))
496 (frob compensated compare
1 "Not in comparison")
497 (frob compare compensated -
1 "Only in comparison"))
498 (format t
"~30<Comparison total~>: ~13,2E ~9,2E~%"
499 compare-total-count compare-total-cost
))
501 ;;; The fraction of system time that we guess happened during GC.
502 (defparameter *gc-system-fraction
* 2/3)
504 ;;; Estimate CPI from CPU time and cycles accounted in profiling information.
505 (defun find-cpi (total-cost user system gc clock
)
506 (let ((adj-time (if (zerop gc
)
508 (- user
(- gc
(* system
*gc-system-fraction
*))))))
509 (/ (* adj-time clock
) total-cost
)))
511 ;;; Generate a report from the specified table.
512 (defun generate-report (table &key
(cut-off 15) (sort-by :cost
)
513 (costs *native-costs
*)
514 ((:compare uncomp-compare
))
515 (compare-costs costs
)
517 (classes *basic-classes
*)
518 user
(system 0d0
) (gc 0d0
)
523 (compensate-costs table costs ignore
)
530 (compensate-costs uncomp-compare compare-costs ignore
)
533 (compared (if compare
534 (compare-stats compensated compare
)
536 (multiple-value-bind (total-count total-cost
) (cost-summary compensated
)
537 (multiple-value-bind (compare-total-count compare-total-cost
)
538 (when compare
(cost-summary compare
))
539 (format t
"~2&~30<Vop~> ~13<Count~> ~9<Cost~> ~6:@<Percent~>~%")
540 (let ((sorted (sort-result compared sort-by
))
541 (base-total (if compare compare-total-cost total-cost
)))
542 (multiple-value-bind (report other
)
543 (find-cut-off sorted cut-off report
)
544 (entry-report report cut-off compensated compare base-total
)
546 (cut-off-report other compare base-total
))))
549 (compare-report total-count total-cost compare-total-count
550 compare-total-cost compensated compare
))
552 (format t
"~30<Total~>: ~13,2E ~9,2E~%" total-count total-cost
)
554 (format t
"~%Cycles per instruction = ~,2F~%"
555 (find-cpi total-cost user system gc clock
))))))
558 ;;; Read & write VOP stats using hash IO utility.
559 (defun stats-reader (stream key
)
560 (make-vop-stats :name key
:count
(read stream
) :cost
(read stream
)))
561 (defun stats-writer (object stream
)
562 (format stream
"~S ~S" (vop-stats-count object
) (vop-stats-cost object
)))