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