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