1.0.6.34: AVER that the GF lock is held during SET-DFUN
[sbcl/simd.git] / src / code / dyncount.lisp
blobfb723cf25ced725e4604796ca49cf6eb50c8dc94
1 ;;;; runtime support for dynamic VOP statistics collection
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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")
15 comments from CMU CL:
16 Make sure multi-cycle instruction costs are plausible.
17 VOP classification.
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.")))
27 ;;;; hash utilities
29 (defun make-hash-table-like (table)
30 #!+sb-doc
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)
36 #!+sb-doc
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 (dohash (k v table1)
41 (unless (nth-value 1 (gethash k table2))
42 (setf (gethash k res) v)))
43 res))
45 (defun hash-list (table)
46 #!+sb-doc
47 "Return a list of the values in Table."
48 (declare (type hash-table table))
49 (collect ((res))
50 (dohash (k v table)
51 (declare (ignore k))
52 (res v))
53 (res)))
55 ;;; Read (or write) a hashtable from (or to) a file.
56 (defun read-hash-table (file)
57 (with-open-file (s file :direction :input)
58 (dotimes (i 3)
59 (format t "~%; ~A" (read-line s)))
60 (let* ((eof '(nil))
61 (test (read s))
62 (reader (read s))
63 (res (make-hash-table :test test)))
64 (read s); Discard writer...
65 (loop
66 (let ((key (read s nil eof)))
67 (when (eq key eof) (return))
68 (setf (gethash key res)
69 (funcall reader s key))))
70 res)))
71 (defun write-hash-table (table file &key
72 (comment (format nil "Contents of ~S" table))
73 (reader 'read) (writer 'prin1) (test 'equal))
74 (with-open-file (s file :direction :output :if-exists :new-version)
75 (with-standard-io-syntax
76 (let ((*print-readably* nil))
77 (format s
78 "~A~%~A version ~A on ~A~%"
79 comment
80 (lisp-implementation-type)
81 (lisp-implementation-version)
82 (machine-instance))
83 (format-universal-time s (get-universal-time))
84 (terpri s)
85 (format s "~S ~S ~S~%" test reader writer)
86 (dohash (k v table)
87 (prin1 k s)
88 (write-char #\space s)
89 (funcall writer v s)
90 (terpri s)))))
91 table)
93 ;;;; info accumulation
95 ;;; Used to accumulate info about the usage of a single VOP. Cost and count
96 ;;; are kept as double-floats, which lets us get more bits and avoid annoying
97 ;;; overflows.
98 (deftype count-vector () '(simple-array double-float (2)))
99 (defstruct (vop-stats
100 (:constructor %make-vop-stats (name))
101 (:constructor make-vop-stats-key)
102 (:copier nil))
103 (name (missing-arg) :type simple-string)
104 (data (make-array 2 :element-type 'double-float) :type count-vector))
106 (defmacro vop-stats-count (x) `(aref (vop-stats-data ,x) 0))
107 (defmacro vop-stats-cost (x) `(aref (vop-stats-data ,x) 1))
109 (defun make-vop-stats (&key name count cost)
110 (let ((res (%make-vop-stats name)))
111 (setf (vop-stats-count res) count)
112 (setf (vop-stats-cost res) cost)
113 res))
115 #!-sb-fluid (declaim (freeze-type dyncount-info vop-stats))
117 ;;; Add the Info into the cumulative result on the VOP name plist. We use
118 ;;; plists so that we will touch minimal system code outside of this file
119 ;;; (which may be compiled with profiling on.)
120 (defun note-dyncount-info (info)
121 (declare (type dyncount-info info) (inline get %put)
122 (optimize (speed 2)))
123 (let ((counts (dyncount-info-counts info))
124 (vops (dyncount-info-vops info)))
125 (dotimes (index (length counts))
126 (declare (type index index))
127 (let ((count (coerce (the (unsigned-byte 31)
128 (aref counts index))
129 'double-float)))
130 (when (minusp count)
131 (warn "Oops: overflow.")
132 (return-from note-dyncount-info nil))
133 (unless (zerop count)
134 (let* ((vop-info (svref vops index))
135 (length (length vop-info)))
136 (declare (simple-vector vop-info))
137 (do ((i 0 (+ i 4)))
138 ((>= i length))
139 (declare (type index i))
140 (let* ((name (svref vop-info i))
141 (entry (or (get name 'vop-stats)
142 (setf (get name 'vop-stats)
143 (%make-vop-stats (symbol-name name))))))
144 (incf (vop-stats-count entry)
145 (* (coerce (the index (svref vop-info (1+ i)))
146 'double-float)
147 count))
148 (incf (vop-stats-cost entry)
149 (* (coerce (the index (svref vop-info (+ i 2)))
150 'double-float)
151 count))))))))))
153 (defun clear-dyncount-info (info)
154 (declare (type dyncount-info info))
155 (declare (optimize (speed 3) (safety 0)))
156 (let ((counts (dyncount-info-counts info)))
157 (dotimes (i (length counts))
158 (setf (aref counts i) 0))))
160 ;;; Clear any VOP-COUNTS properties and the counts vectors for all code
161 ;;; objects. The latter loop must not call any random functions.
162 (defun clear-vop-counts (&optional (spaces '(:dynamic)))
163 #!+sb-doc
164 "Clear all dynamic VOP counts for code objects in the specified spaces."
165 (dohash (k v *backend-template-names*)
166 (declare (ignore v))
167 (remprop k 'vop-stats))
169 (locally
170 (declare (optimize (speed 3) (safety 0))
171 (inline sb!vm::map-allocated-objects))
172 (without-gcing
173 (dolist (space spaces)
174 (sb!vm::map-allocated-objects
175 (lambda (object type-code size)
176 (declare (ignore type-code size))
177 (when (dyncount-info-p object)
178 (clear-dyncount-info object)))
179 space)))))
181 ;;; Call NOTE-DYNCOUNT-INFO on all DYNCOUNT-INFO structure allocated in the
182 ;;; specified spaces. Return a hashtable describing the counts. The initial
183 ;;; loop must avoid calling any functions outside this file to prevent adding
184 ;;; noise to the data, since other files may be compiled with profiling.
185 (defun get-vop-counts (&optional (spaces '(:dynamic)) &key (clear nil))
186 #!+sb-doc
187 "Return a hash-table mapping string VOP names to VOP-STATS structures
188 describing the VOPs executed. If clear is true, then reset all counts to
189 zero as a side effect."
190 (locally
191 (declare (optimize (speed 3) (safety 0))
192 (inline sb!vm::map-allocated-objects))
193 (without-gcing
194 (dolist (space spaces)
195 (sb!vm::map-allocated-objects
196 (lambda (object type-code size)
197 (declare (ignore type-code size))
198 (when (dyncount-info-p object)
199 (note-dyncount-info object)
200 (when clear
201 (clear-dyncount-info object))))
202 space))))
204 (let ((counts (make-hash-table :test 'equal)))
205 (dohash (k v *backend-template-names*)
206 (declare (ignore v))
207 (let ((stats (get k 'vop-stats)))
208 (when stats
209 (setf (gethash (symbol-name k) counts) stats)
210 (when clear
211 (remprop k 'vop-stats)))))
212 counts))
214 ;;; Return the DYNCOUNT-INFO for FUNCTION.
215 (defun find-info-for (function)
216 (declare (type function function))
217 (let* ((function (%primitive closure-fun function))
218 (component (sb!di::fun-code-header function)))
219 (do ((end (get-header-data component))
220 (i sb!vm:code-constants-offset (1+ i)))
221 ((= end i))
222 (let ((constant (code-header-ref component i)))
223 (when (dyncount-info-p constant)
224 (return constant))))))
226 (defun vop-counts-apply (function args &key (spaces '(:dynamic)) by-space)
227 #!+sb-doc
228 "Apply Function to Args, collecting dynamic statistics on the running.
229 Spaces are the spaces to scan for counts. If By-Space is true, we return a
230 list of result tables, instead of a single table. In this case, specify
231 :READ-ONLY first."
232 (clear-vop-counts spaces)
233 (apply function args)
234 (if by-space
235 (mapcar (lambda (space)
236 (get-vop-counts (list space) :clear t))
237 spaces)
238 (get-vop-counts spaces)))
240 ;;;; adjustments
242 (defun get-vop-costs ()
243 #!+sb-doc
244 "Return a hash-table mapping string VOP names to the cost recorded in the
245 generator for all VOPs which are also the names of assembly routines."
246 (let ((res (make-hash-table :test 'equal)))
247 (dohash (name v *assembler-routines*)
248 (declare (ignore v))
249 (let ((vop (gethash name *backend-template-names*)))
250 (when vop
251 (setf (gethash (symbol-name name) res)
252 (template-cost (template-or-lose name))))))
253 res))
255 (defvar *native-costs* (get-vop-costs)
256 #!+sb-doc
257 "Costs of assember routines on this machine.")
259 ;;;; classification
261 (defparameter *basic-classes*
262 '(("Integer multiplication"
263 "*/FIXNUM" "*/SIGNED" "*/UNSIGNED" "SIGNED-*" "FIXNUM-*" "GENERIC-*")
264 ("Integer division" "TRUNCATE")
265 ("Generic arithmetic" "GENERIC" "TWO-ARG")
266 ("Inline EQL" "EQL")
267 ("Inline compare less/greater" "</" ">/" "<-C/" ">-C/")
268 ("Inline arith" "*/" "//" "+/" "-/" "NEGATE" "ABS" "+-C" "--C")
269 ("Inline logic" "-ASH" "$ASH" "LOG")
270 ("CAR/CDR" "CAR" "CDR")
271 ("Array type test" "ARRAYP" "VECTORP" "ARRAY-HEADER-P")
272 ;; FIXME: STRUCTUREP? This looks somewhat stale..
273 ("Simple type predicate" "STRUCTUREP" "LISTP" "FIXNUMP")
274 ("Simple type check" "CHECK-LIST" "CHECK-FIXNUM" "CHECK-STRUCTURE")
275 ("Array bounds check" "CHECK-BOUND")
276 ("Complex type check" "$CHECK-" "COERCE-TO-FUN")
277 ("Special read" "SYMBOL-VALUE")
278 ("Special bind" "BIND$")
279 ("Tagging" "MOVE-FROM")
280 ("Untagging" "MOVE-TO" "MAKE-FIXNUM")
281 ("Move" "MOVE")
282 ("Non-local exit" "CATCH" "THROW" "DYNAMIC-STATE" "NLX" "UNWIND")
283 ("Array write" "DATA-VECTOR-SET" "$SET-RAW-BITS$")
284 ("Array read" "DATA-VECTOR-REF" "$RAW-BITS$" "VECTOR-LENGTH"
285 "LENGTH/SIMPLE" "ARRAY-HEADER")
286 ("List/string utility" "LENGTH/LIST" "SXHASH" "BIT-BASH" "$LENGTH$")
287 ("Alien operations" "SAP" "ALLOC-NUMBER-STACK" "$CALL-OUT$")
288 ("Function call/return" "CALL" "RETURN" "ALLOCATE-FRAME"
289 "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARG-COUNT")
290 ("Allocation" "MAKE-" "ALLOC" "$CONS$" "$LIST$" "$LIST*$")
291 ("Float conversion" "%SINGLE-FLOAT" "%DOUBLE-FLOAT" "-BITS$")
292 ("Complex type predicate" "P$")))
294 ;;; Return true if Name patches a specified pattern. Pattern is a string
295 ;;; (or symbol) or a list of strings (or symbols). If any specified string
296 ;;; appears as a substring of name, the pattern is matched. #\$'s are wapped
297 ;;; around name, allowing the use of $ to force a match at the beginning or
298 ;;; end.
299 (defun matches-pattern (name pattern)
300 (declare (simple-string name))
301 (let ((name (concatenate 'string "$" name "$")))
302 (dolist (pat (if (listp pattern) pattern (list pattern)) nil)
303 (when (search (the simple-string (string pat))
304 name :test #'char=)
305 (return t)))))
307 ;;; Utilities for debugging classification rules. FIND-MATCHES returns a
308 ;;; list of all the VOP names in Table that match Pattern. WHAT-CLASS returns
309 ;;; the class that NAME would be placed in.
310 (defun find-matches (table pattern)
311 (collect ((res))
312 (dohash (key value table)
313 (declare (ignore value))
314 (when (matches-pattern key pattern) (res key)))
315 (res)))
316 (defun what-class (name classes)
317 (dolist (class classes nil)
318 (when (matches-pattern name (rest class)) (return (first class)))))
320 ;;; Given a VOP-STATS hash-table, return a new one with VOPs in the same
321 ;;; class merged into a single entry for that class. The classes are
322 ;;; represented as a list of lists: (class-name pattern*). Each pattern is a
323 ;;; string (or symbol) that can appear as a subsequence of the VOP name. A VOP
324 ;;; is placed in the first class that it matches, or is left alone if it
325 ;;; matches no class.
326 (defun classify-costs (table classes)
327 (let ((res (make-hash-table-like table)))
328 (dohash (key value table)
329 (let ((class (dolist (class classes nil)
330 (when (matches-pattern key (rest class))
331 (return (first class))))))
332 (if class
333 (let ((found (or (gethash class res)
334 (setf (gethash class res)
335 (%make-vop-stats class)))))
336 (incf (vop-stats-count found) (vop-stats-count value))
337 (incf (vop-stats-cost found) (vop-stats-cost value)))
338 (setf (gethash key res) value))))
339 res))
341 ;;;; analysis
343 ;;; Sum the count and costs.
344 (defun cost-summary (table)
345 (let ((total-count 0d0)
346 (total-cost 0d0))
347 (dohash (k v table)
348 (declare (ignore k))
349 (incf total-count (vop-stats-count v))
350 (incf total-cost (vop-stats-cost v)))
351 (values total-count total-cost)))
353 ;;; Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
354 ;;; according to the Costs table. Any VOPs in the list IGNORE are ignored.
355 (defun compensate-costs (table costs &optional ignore)
356 (let ((res (make-hash-table-like table)))
357 (dohash (key value table)
358 (unless (or (string= key "COUNT-ME")
359 (member key ignore :test #'string=))
360 (let ((cost (gethash key costs)))
361 (if cost
362 (let* ((count (vop-stats-count value))
363 (sum (+ (* cost count)
364 (vop-stats-cost value))))
365 (setf (gethash key res)
366 (make-vop-stats :name key :count count :cost sum)))
367 (setf (gethash key res) value)))))
368 res))
370 ;;; Take two tables of vop-stats and return a table of entries where the
371 ;;; entries have been compared. The counts are normalized to Compared. The
372 ;;; costs are the difference of the costs adjusted by the difference in counts:
373 ;;; the cost for Original is modified to correspond to the count in Compared.
374 (defun compare-stats (original compared)
375 (declare (type hash-table original compared))
376 (let ((res (make-hash-table-like original)))
377 (dohash (k cv compared)
378 (let ((ov (gethash k original)))
379 (when ov
380 (let ((norm-cnt (/ (vop-stats-count ov) (vop-stats-count cv))))
381 (setf (gethash k res)
382 (make-vop-stats
383 :name k
384 :count norm-cnt
385 :cost (- (/ (vop-stats-cost ov) norm-cnt)
386 (vop-stats-cost cv))))))))
387 res))
389 (defun combine-stats (&rest tables)
390 #!+sb-doc
391 "Sum the VOP stats for the specified tables, returning a new table with the
392 combined results."
393 (let ((res (make-hash-table-like (first tables))))
394 (dolist (table tables)
395 (dohash (k v table)
396 (let ((found (or (gethash k res)
397 (setf (gethash k res) (%make-vop-stats k)))))
398 (incf (vop-stats-count found) (vop-stats-count v))
399 (incf (vop-stats-cost found) (vop-stats-cost v)))))
400 res))
402 ;;;; report generation
404 (defun sort-result (table by)
405 (sort (hash-list table) #'>
406 :key (lambda (x)
407 (abs (ecase by
408 (:count (vop-stats-count x))
409 (:cost (vop-stats-cost x)))))))
411 ;;; Report about VOPs in the list of stats structures.
412 (defun entry-report (entries cut-off compensated compare total-cost)
413 (let ((counter (if (and cut-off (> (length entries) cut-off))
414 cut-off
415 most-positive-fixnum)))
416 (dolist (entry entries)
417 (let* ((cost (vop-stats-cost entry))
418 (name (vop-stats-name entry))
419 (entry-count (vop-stats-count entry))
420 (comp-entry (if compare (gethash name compare) entry))
421 (count (vop-stats-count comp-entry)))
422 (format t "~30<~A~>: ~:[~13:D~;~13,2F~] ~9,2F ~5,2,2F%~%"
423 (vop-stats-name entry)
424 compare
425 (if compare entry-count (round entry-count))
426 (/ cost count)
427 (/ (if compare
428 (- (vop-stats-cost (gethash name compensated))
429 (vop-stats-cost comp-entry))
430 cost)
431 total-cost))
432 (when (zerop (decf counter))
433 (format t "[End of top ~W]~%" cut-off))))))
435 ;;; Divide SORTED into two lists, the first CUT-OFF elements long. Any VOP
436 ;;; names that match one of the report strings are moved into the REPORT list
437 ;;; even if they would otherwise fall below the CUT-OFF.
438 (defun find-cut-off (sorted cut-off report)
439 (if (or (not cut-off) (<= (length sorted) cut-off))
440 (values sorted ())
441 (let ((not-cut (subseq sorted 0 cut-off)))
442 (collect ((select)
443 (reject))
444 (dolist (el (nthcdr cut-off sorted))
445 (let ((name (vop-stats-name el)))
446 (if (matches-pattern name report)
447 (select el)
448 (reject el))))
449 (values (append not-cut (select)) (reject))))))
451 ;;; Display information about entries that were not displayed due to the
452 ;;; cut-off. Note: if compare, we find the total cost delta and the geometric
453 ;;; mean of the normalized counts.
454 (defun cut-off-report (other compare total-cost)
455 (let ((rest-cost 0d0)
456 (rest-count 0d0)
457 (rest-entry-count (if compare 1d0 0d0)))
458 (dolist (entry other)
459 (incf rest-cost (vop-stats-cost entry))
460 (incf rest-count
461 (vop-stats-count
462 (if compare
463 (gethash (vop-stats-name entry) compare)
464 entry)))
465 (if compare
466 (setq rest-entry-count
467 (* rest-entry-count (vop-stats-count entry)))
468 (incf rest-entry-count (vop-stats-count entry))))
470 (let ((count (if compare
471 (expt rest-entry-count
472 (/ (coerce (length other) 'double-float)))
473 (round rest-entry-count))))
474 (format t "~30<Other~>: ~:[~13:D~;~13,2F~] ~9,2F ~@[~5,2,2F%~]~%"
475 compare count
476 (/ rest-cost rest-count)
477 (unless compare
478 (/ rest-cost total-cost))))))
480 ;;; Report summary information about the difference between the comparison
481 ;;; and base data sets.
482 (defun compare-report (total-count total-cost compare-total-count
483 compare-total-cost compensated compare)
484 (format t "~30<Relative total~>: ~13,2F ~9,2F~%"
485 (/ total-count compare-total-count)
486 (/ total-cost compare-total-cost))
487 (flet ((frob (a b sign wot)
488 (multiple-value-bind (cost count)
489 (cost-summary (hash-difference a b))
490 (unless (zerop count)
491 (format t "~30<~A~>: ~13:D ~9,2F ~5,2,2F%~%"
492 wot (* sign (round count))
493 (* sign (/ cost count))
494 (* sign (/ cost compare-total-cost)))))))
495 (frob compensated compare 1 "Not in comparison")
496 (frob compare compensated -1 "Only in comparison"))
497 (format t "~30<Comparison total~>: ~13,2E ~9,2E~%"
498 compare-total-count compare-total-cost))
500 ;;; The fraction of system time that we guess happened during GC.
501 (defparameter *gc-system-fraction* 2/3)
503 ;;; Estimate CPI from CPU time and cycles accounted in profiling information.
504 (defun find-cpi (total-cost user system gc clock)
505 (let ((adj-time (if (zerop gc)
506 user
507 (- user (- gc (* system *gc-system-fraction*))))))
508 (/ (* adj-time clock) total-cost)))
510 ;;; Generate a report from the specified table.
511 (defun generate-report (table &key (cut-off 15) (sort-by :cost)
512 (costs *native-costs*)
513 ((:compare uncomp-compare))
514 (compare-costs costs)
515 ignore report
516 (classes *basic-classes*)
517 user (system 0d0) (gc 0d0)
518 (clock 25d6))
519 (let* ((compensated
520 (classify-costs
521 (if costs
522 (compensate-costs table costs ignore)
523 table)
524 classes))
525 (compare
526 (when uncomp-compare
527 (classify-costs
528 (if compare-costs
529 (compensate-costs uncomp-compare compare-costs ignore)
530 uncomp-compare)
531 classes)))
532 (compared (if compare
533 (compare-stats compensated compare)
534 compensated)))
535 (multiple-value-bind (total-count total-cost) (cost-summary compensated)
536 (multiple-value-bind (compare-total-count compare-total-cost)
537 (when compare (cost-summary compare))
538 (format t "~2&~30<Vop~> ~13<Count~> ~9<Cost~> ~6:@<Percent~>~%")
539 (let ((sorted (sort-result compared sort-by))
540 (base-total (if compare compare-total-cost total-cost)))
541 (multiple-value-bind (report other)
542 (find-cut-off sorted cut-off report)
543 (entry-report report cut-off compensated compare base-total)
544 (when other
545 (cut-off-report other compare base-total))))
547 (when compare
548 (compare-report total-count total-cost compare-total-count
549 compare-total-cost compensated compare))
551 (format t "~30<Total~>: ~13,2E ~9,2E~%" total-count total-cost)
552 (when user
553 (format t "~%Cycles per instruction = ~,2F~%"
554 (find-cpi total-cost user system gc clock))))))
555 (values))
557 ;;; Read & write VOP stats using hash IO utility.
558 (defun stats-reader (stream key)
559 (make-vop-stats :name key :count (read stream) :cost (read stream)))
560 (defun stats-writer (object stream)
561 (format stream "~S ~S" (vop-stats-count object) (vop-stats-cost object)))