src/code/profile.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB-PROFILE") ; (SB-, not SB!, since we're built in warm load.)
  11 \f
  12 ;;;; reading internal run time with high resolution and low overhead
  13
  14 ;;; FIXME: It might make sense to replace this with something
  15 ;;; with finer resolution, e.g. milliseconds or microseconds.
  16 ;;; For that matter, maybe we should boost the internal clock
  17 ;;; up to something faster, like milliseconds.
  18
  19 (defconstant +ticks-per-second+ internal-time-units-per-second)
  20
  21 (declaim (inline get-internal-ticks))
  22 (defun get-internal-ticks () (get-internal-run-time))
  23 \f
  24 ;;;; PCOUNTER
  25
  26 ;;; a PCOUNTER is used to represent an unsigned integer quantity which
  27 ;;; can grow bigger than a fixnum, but typically does so, if at all,
  28 ;;; in many small steps, where we don't want to cons on every step.
  29 ;;; (Total system consing, time spent in a profiled function, and
  30 ;;; bytes consed in a profiled function are all examples of such
  31 ;;; quantities.)
  32 (defstruct (pcounter (:copier nil))
  33   (integer 0);; :type unsigned-byte)
  34   (fixnum 0));; :type (and fixnum unsigned-byte)))
  35
  36 ;;;(declaim (ftype (function (pcounter unsigned-byte) pcounter) incf-pcounter))
  37 ;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable
  38 (defun incf-pcounter (pcounter delta)
  39   (aver (typep delta 'unsigned-byte))
  40   (let ((sum (+ (pcounter-fixnum pcounter) delta)))
  41     (aver (typep sum 'unsigned-byte))
  42     ;;(declare (type unsigned-byte sum))
  43     (cond ((typep sum 'fixnum)
  44            (setf (pcounter-fixnum pcounter) sum))
  45           (t
  46            (incf (pcounter-integer pcounter) sum)
  47            (setf (pcounter-fixnum pcounter) 0))))
  48   pcounter)
  49
  50 (declaim (ftype (function (pcounter) integer) pcounter->integer))
  51 ;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
  52 (defun pcounter->integer (pcounter)
  53   (+ (pcounter-integer pcounter)
  54      (pcounter-fixnum pcounter)))
  55 \f
  56 ;;;; operations on (OR PCOUNTER FIXNUM)
  57 ;;;;
  58 ;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
  59 ;;;; start with a FIXNUM counter and only create a PCOUNTER if the
  60 ;;;; FIXNUM overflows.
  61
  62 (declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum))
  63 ;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable
  64 (defun %incf-pcounter-or-fixnum (x delta)
  65   (etypecase x
  66     (fixnum
  67      (let ((sum (+ x delta)))
  68        (if (typep sum 'fixnum)
  69            sum
  70            (make-pcounter :integer sum))))
  71     (pcounter
  72      (incf-pcounter x delta))))
  73
  74 (define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
  75
  76 ;;; Trade off space for execution time by handling the common fast
  77 ;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
  78 ;;; arithmetic as a last resort.
  79 (defmacro fastbig-incf-pcounter-or-fixnum (x delta)
  80   (let ((delta-sym (gensym "DELTA")))
  81     `(let ((,delta-sym ,delta))
  82        (aver (typep ,delta-sym 'unsigned-byte))
  83        ;;(declare (type unsigned-byte ,delta-sym))
  84        (if (typep ,delta-sym 'fixnum)
  85            (incf-pcounter-or-fixnum ,x ,delta)
  86            (incf-pcounter-or-fixnum ,x ,delta)))))
  87
  88 (declaim (ftype (function ((or pcounter fixnum)) integer) pcounter-or-fixnum->integer))
  89 (declaim (maybe-inline pcounter-or-fixnum->integer))
  90 (defun pcounter-or-fixnum->integer (x)
  91   (etypecase x
  92     (fixnum x)
  93     (pcounter (pcounter->integer x))))
  94 \f
  95 ;;;; implementation-dependent interfaces
  96
  97 #|
  98 ;;; To avoid unnecessary consing in the "encapsulation" code, we want
  99 ;;; find out the number of required arguments, and use &REST to
 100 ;;; capture only non-required arguments. This function returns (VALUES
 101 ;;; MIN-ARGS OPTIONALS-P), where MIN-ARGS is the number of required
 102 ;;; arguments and OPTIONALS-P is true iff there are any non-required
 103 ;;; arguments (such as &OPTIONAL, &REST, or &KEY).
 104 (declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature))
 105 (defun fun-signature (name)
 106   (let ((type (info :function :type name)))
 107     (cond ((not (function-type-p type))
 108            (values 0 t))
 109           (t
 110            (values (length (function-type-required type))
 111                    (or (function-type-optional type)
 112                        (function-type-keyp type)
 113                        (function-type-rest type)))))))
 114 |#
 115 \f
 116 ;;;; global data structures
 117
 118 ;;; We associate a PROFILE-INFO structure with each profiled function
 119 ;;; name. This holds the functions that we call to manipulate the
 120 ;;; closure which implements the encapsulation.
 121 (defvar *profiled-function-name->info* (make-hash-table))
 122 (defstruct (profile-info (:copier nil))
 123   (name              (required-argument) :read-only t)
 124   (encapsulated-fun  (required-argument) :type function :read-only t)
 125   (encapsulation-fun (required-argument) :type function :read-only t)
 126   (read-stats-fun    (required-argument) :type function :read-only t)
 127   (clear-stats-fun   (required-argument) :type function :read-only t))
 128
 129 ;;; These variables are used to subtract out the time and consing for
 130 ;;; recursive and other dynamically nested profiled calls. The total
 131 ;;; resource consumed for each nested call is added into the
 132 ;;; appropriate variable. When the outer function returns, these
 133 ;;; amounts are subtracted from the total.
 134 (defvar *enclosed-ticks* 0)
 135 (defvar *enclosed-consing* 0)
 136 (declaim (type (or pcounter fixnum) *enclosed-ticks* *enclosed-consing*))
 137
 138 ;;; This variable is also used to subtract out time for nested
 139 ;;; profiled calls. The time inside the profile wrapper call --
 140 ;;; between its two calls to GET-INTERNAL-TICKS -- is accounted
 141 ;;; for by the *ENCLOSED-TIME* variable. However, there's also extra
 142 ;;; overhead involved, before we get to the first call to
 143 ;;; GET-INTERNAL-TICKS, and after we get to the second call. By
 144 ;;; keeping track of the count of enclosed profiled calls, we can try
 145 ;;; to compensate for that.
 146 (defvar *enclosed-profiles* 0)
 147 (declaim (type (or pcounter fixnum) *enclosed-profiles*))
 148
 149 ;;; the encapsulated function we're currently computing profiling data
 150 ;;; for, recorded so that we can detect the problem of
 151 ;;; PROFILE-computing machinery calling a function which has itself
 152 ;;; been PROFILEd
 153 (defvar *computing-profiling-data-for*)
 154
 155 ;;; the components of profiling overhead
 156 (defstruct (overhead (:copier nil))
 157   ;; the number of ticks a bare function call takes. This is
 158   ;; factored into the other overheads, but not used for itself.
 159   (call (required-argument) :type single-float :read-only t)
 160   ;; the number of ticks that will be charged to a profiled
 161   ;; function due to the profiling code
 162   (internal (required-argument) :type single-float :read-only t)
 163   ;; the number of ticks of overhead for profiling that a single
 164   ;; profiled call adds to the total runtime for the program
 165   (total (required-argument) :type single-float :read-only t))
 166 (defvar *overhead*)
 167 (declaim (type overhead *overhead*))
 168 \f
 169 ;;;; profile encapsulations
 170
 171 ;;; Trade off space for time by handling the usual all-FIXNUM cases
 172 ;;; inline.
 173 (defmacro fastbig- (x y)
 174   (once-only ((x x) (y y))
 175     `(if (and (typep ,x 'fixnum)
 176               (typep ,y 'fixnum))
 177          (- ,x ,y)
 178          (- ,x ,y))))
 179 (defmacro fastbig-1+ (x)
 180   (once-only ((x x))
 181     `(if (typep ,x 'index)
 182          (1+ ,x)
 183          (1+ ,x))))
 184
 185 ;;; Return a collection of closures over the same lexical context,
 186 ;;;   (VALUES ENCAPSULATION-FUN READ-STATS-FUN CLEAR-STATS-FUN).
 187 ;;;
 188 ;;; ENCAPSULATION-FUN is a plug-in replacement for ENCAPSULATED-FUN,
 189 ;;; which updates statistics whenver it's called.
 190 ;;;
 191 ;;; READ-STATS-FUN returns the statistics:
 192 ;;;   (VALUES COUNT TIME CONSING PROFILE).
 193 ;;; COUNT is the count of calls to ENCAPSULATION-FUN. TICKS is
 194 ;;; the total number of ticks spent in ENCAPSULATED-FUN.
 195 ;;; CONSING is the total consing of ENCAPSULATION-FUN. PROFILE is the
 196 ;;; number of calls to the profiled function, stored for the purposes
 197 ;;; of trying to estimate that part of profiling overhead which occurs
 198 ;;; outside the interval between the profile wrapper function's timer
 199 ;;; calls.
 200 ;;;
 201 ;;; CLEAR-STATS-FUN clears the statistics.
 202 ;;;
 203 ;;; (The reason for implementing this as coupled closures, with the
 204 ;;; counts built into the lexical environment, is that we hope this
 205 ;;; will minimize profiling overhead.)
 206 (defun profile-encapsulation-lambdas (encapsulated-fun)
 207   (declare (type function encapsulated-fun))
 208   (let* ((count 0)
 209          (ticks 0)
 210          (consing 0)
 211          (profiles 0))
 212     (declare (type (or pcounter fixnum) count ticks consing profiles))
 213     (values
 214      ;; ENCAPSULATION-FUN
 215      (lambda (sb-c:&more arg-context arg-count)
 216        (declare (optimize speed safety))
 217        ;; Make sure that we're not recursing infinitely.
 218        (when (boundp '*computing-profiling-data-for*)
 219          (unprofile-all) ; to avoid further recursion
 220          (error "~@<When computing profiling data for ~S, the profiled function ~S was called. To get out of this infinite recursion, all functions have been unprofiled. (Since the profiling system evidently uses ~S in its computations, it looks as though it's a bad idea to profile it.)~:@>"
 221                 *computing-profiling-data-for*
 222                 encapsulated-fun
 223                 encapsulated-fun))
 224        ;; FIXME: Probably when this is stable, we should optimize (SAFETY 0).
 225        (fastbig-incf-pcounter-or-fixnum count 1)
 226        (let ((dticks 0)
 227              (dconsing 0)
 228              (inner-enclosed-profiles 0))
 229          ;;(declare (type unsigned-byte dticks dconsing))
 230          ;;(declare (type unsigned-byte inner-enclosed-profiles))
 231          (aver (typep dticks 'unsigned-byte))
 232          (aver (typep dconsing 'unsigned-byte))
 233          (aver (typep inner-enclosed-profiles 'unsigned-byte))
 234          (multiple-value-prog1
 235              (let ((start-ticks (get-internal-ticks))
 236                    ;; KLUDGE: We add (THE UNSIGNED-BYTE ..) wrappers
 237                    ;; around GET-BYTES-CONSED because as of
 238                    ;; sbcl-0.6.4, at the time that the FTYPE of
 239                    ;; GET-BYTES-CONSED is DECLAIMed, the
 240                    ;; cross-compiler's type system isn't mature enough
 241                    ;; to do anything about it. -- WHN 20000503
 242                    (start-consing (the unsigned-byte (get-bytes-consed)))
 243                    (*enclosed-ticks* 0)
 244                    (*enclosed-consing* 0)
 245                    (*enclosed-profiles* 0))
 246                (declare (inline pcounter-or-fixnum->integer))
 247                (multiple-value-prog1
 248                    (multiple-value-call encapsulated-fun
 249                                         (sb-c:%more-arg-values arg-context
 250                                                                0
 251                                                                arg-count))
 252                  (let ((*computing-profiling-data-for* encapsulated-fun))
 253                    (setf dticks (fastbig- (get-internal-ticks) start-ticks)
 254                          dconsing (fastbig- (the unsigned-byte
 255                                               (get-bytes-consed))
 256                                             start-consing))
 257                    (setf inner-enclosed-profiles
 258                          (pcounter-or-fixnum->integer *enclosed-profiles*))
 259                    (when (minusp dticks) ; REMOVEME
 260                      (unprofile-all)
 261                      (error "huh? (GET-INTERNAL-TICKS)=~S START-TICKS=~S"
 262                             (get-internal-ticks) start-ticks))
 263                    (aver (not (minusp dconsing))) ; REMOVEME
 264                    (aver (not (minusp inner-enclosed-profiles))) ; REMOVEME
 265                    (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
 266                      (when (minusp net-dticks) ; REMOVEME
 267                        (unprofile-all)
 268                        (error "huh? DTICKS=~S, *ENCLOSED-TICKS*=~S"
 269                               dticks *enclosed-ticks*))
 270                      (fastbig-incf-pcounter-or-fixnum ticks net-dticks))
 271                    (let ((net-dconsing (fastbig- dconsing *enclosed-consing*)))
 272                      (when (minusp net-dconsing) ; REMOVEME
 273                        (unprofile-all)
 274                        (error "huh? DCONSING=~S, *ENCLOSED-CONSING*=~S"
 275                               dticks *enclosed-ticks*))
 276                      (fastbig-incf-pcounter-or-fixnum consing net-dconsing))
 277                    (fastbig-incf-pcounter-or-fixnum profiles
 278                                                     inner-enclosed-profiles))))
 279            (fastbig-incf-pcounter-or-fixnum *enclosed-ticks* dticks)
 280            (fastbig-incf-pcounter-or-fixnum *enclosed-consing* dconsing)
 281            (fastbig-incf-pcounter-or-fixnum *enclosed-profiles*
 282                                             (fastbig-1+
 283                                              inner-enclosed-profiles)))))
 284      ;; READ-STATS-FUN
 285      (lambda ()
 286        (values (pcounter-or-fixnum->integer count)
 287                (pcounter-or-fixnum->integer ticks)
 288                (pcounter-or-fixnum->integer consing)
 289                (pcounter-or-fixnum->integer profiles)))
 290      ;; CLEAR-STATS-FUN
 291      (lambda ()
 292        (setf count 0
 293              ticks 0
 294              consing 0
 295              profiles 0)))))
 296 \f
 297 ;;;; interfaces
 298
 299 ;;; A symbol or (SETF FOO) list names a function, a string names all
 300 ;;; the functions named by symbols in the named package.
 301 (defun mapc-on-named-functions (function names)
 302   (dolist (name names)
 303     (etypecase name
 304       (symbol (funcall function name))
 305       (list
 306        ;; We call this just for the side effect of checking that
 307        ;; NAME is a legal function name:
 308        (function-name-block-name name)
 309        ;; Then we map onto it.
 310        (funcall function name))
 311       (string (let ((package (find-undeleted-package-or-lose name)))
 312                 (do-symbols (symbol package)
 313                   (when (eq (symbol-package symbol) package)
 314                     (when (fboundp symbol)
 315                       (funcall function symbol))
 316                     (let ((setf-name `(setf ,symbol)))
 317                       (when (fboundp setf-name)
 318                         (funcall function setf-name)))))))))
 319   (values))
 320
 321 ;;; Profile the named function, which should exist and not be profiled
 322 ;;; already.
 323 (defun profile-1-unprofiled-function (name)
 324   (declare #.*optimize-byte-compilation*)
 325   (let ((encapsulated-fun (fdefinition name)))
 326     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
 327         (profile-encapsulation-lambdas encapsulated-fun)
 328       (setf (fdefinition name)
 329             encapsulation-fun)
 330       (setf (gethash name *profiled-function-name->info*)
 331             (make-profile-info :name name
 332                                :encapsulated-fun encapsulated-fun
 333                                :encapsulation-fun encapsulation-fun
 334                                :read-stats-fun read-stats-fun
 335                                :clear-stats-fun clear-stats-fun))
 336       (values))))
 337
 338 ;;; Profile the named function. If already profiled, unprofile first.
 339 (defun profile-1-function (name)
 340   (declare #.*optimize-byte-compilation*)
 341   (cond ((fboundp name)
 342          (when (gethash name *profiled-function-name->info*)
 343            (warn "~S is already profiled, so unprofiling it first." name)
 344            (unprofile-1-function name))
 345          (profile-1-unprofiled-function name))
 346         (t
 347          (warn "ignoring undefined function ~S" name)))
 348   (values))
 349
 350 ;;; Unprofile the named function, if it is profiled.
 351 (defun unprofile-1-function (name)
 352   (declare #.*optimize-byte-compilation*)
 353   (let ((pinfo (gethash name *profiled-function-name->info*)))
 354     (cond (pinfo
 355            (remhash name *profiled-function-name->info*)
 356            (if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
 357                (setf (fdefinition name) (profile-info-encapsulated-fun pinfo))
 358                (warn "preserving current definition of redefined function ~S"
 359                      name)))
 360           (t
 361            (warn "~S is not a profiled function." name))))
 362   (values))
 363
 364 (defmacro profile (&rest names)
 365   #+sb-doc
 366   "PROFILE Name*
 367
 368    If no names are supplied, return the list of profiled functions.
 369
 370    If names are supplied, wrap profiling code around the named functions.
 371    As in TRACE, the names are not evaluated. A symbol names a function.
 372    A string names all the functions named by symbols in the named
 373    package. If a function is already profiled, then unprofile and
 374    reprofile (useful to notice function redefinition.)  If a name is
 375    undefined, then we give a warning and ignore it. See also
 376    UNPROFILE, REPORT and RESET."
 377   (declare #.*optimize-byte-compilation*)
 378   (if (null names)
 379       `(loop for k being each hash-key in *profiled-function-name->info*
 380              collecting k)
 381       `(mapc-on-named-functions #'profile-1-function ',names)))
 382
 383 (defmacro unprofile (&rest names)
 384   #+sb-doc
 385   "Unwrap any profiling code around the named functions, or if no names
 386   are given, unprofile all profiled functions. A symbol names
 387   a function. A string names all the functions named by symbols in the
 388   named package. NAMES defaults to the list of names of all currently
 389   profiled functions."
 390   (declare #.*optimize-byte-compilation*)
 391   (if names
 392       `(mapc-on-named-functions #'unprofile-1-function ',names)
 393       `(unprofile-all)))
 394
 395 (defun unprofile-all ()
 396   (declare #.*optimize-byte-compilation*)
 397   (dohash (name profile-info *profiled-function-name->info*)
 398     (declare (ignore profile-info))
 399     (unprofile-1-function name)))
 400
 401 (defun reset ()
 402   "Reset the counters for all profiled functions."
 403   (dohash (name profile-info *profiled-function-name->info*)
 404     (declare (ignore name))
 405     (funcall (profile-info-clear-stats-fun profile-info))))
 406 \f
 407 ;;;; reporting results
 408
 409 (defstruct (time-info (:copier nil))
 410   name
 411   calls
 412   seconds
 413   consing)
 414
 415 ;;; Return our best guess for the run time in a function, subtracting
 416 ;;; out factors for profiling overhead. We subtract out the internal
 417 ;;; overhead for each call to this function, since the internal
 418 ;;; overhead is the part of the profiling overhead for a function that
 419 ;;; is charged to that function.
 420 ;;;
 421 ;;; We also subtract out a factor for each call to a profiled function
 422 ;;; within this profiled function. This factor is the total profiling
 423 ;;; overhead *minus the internal overhead*. We don't subtract out the
 424 ;;; internal overhead, since it was already subtracted when the nested
 425 ;;; profiled functions subtracted their running time from the time for
 426 ;;; the enclosing function.
 427 (defun compensate-time (calls ticks profile)
 428   (let ((raw-compensated
 429          (- (/ (float ticks) (float +ticks-per-second+))
 430             (* (overhead-internal *overhead*) (float calls))
 431             (* (- (overhead-total *overhead*)
 432                   (overhead-internal *overhead*))
 433                (float profile)))))
 434     (max raw-compensated 0.0)))
 435
 436 (defun report ()
 437   "Report results from profiling. The results are
 438 approximately adjusted for profiling overhead, but when RAW is true
 439 the unadjusted results are reported. The compensation may be somewhat
 440 inaccurate when bignums are involved in runtime calculation, as in
 441 a very-long-running Lisp process."
 442   (declare #.*optimize-external-despite-byte-compilation*)
 443   (unless (boundp '*overhead*)
 444     (setf *overhead*
 445           (compute-overhead)))
 446   (let ((time-info-list ())
 447         (no-call-name-list ()))
 448     (dohash (name pinfo *profiled-function-name->info*)
 449       (unless (eq (fdefinition name)
 450                   (profile-info-encapsulation-fun pinfo))
 451         (warn "Function ~S has been redefined, so times may be inaccurate.~@
 452                PROFILE it again to record calls to the new definition."
 453               name))
 454       (multiple-value-bind (calls ticks consing profile)
 455           (funcall (profile-info-read-stats-fun pinfo))
 456         (if (zerop calls)
 457             (push name no-call-name-list)
 458             (push (make-time-info :name name
 459                                   :calls calls
 460                                   :seconds (compensate-time calls
 461                                                             ticks
 462                                                             profile)
 463                                   :consing consing)
 464                   time-info-list))))
 465
 466     (setf time-info-list
 467           (sort time-info-list
 468                 #'>=
 469                 :key #'time-info-seconds))
 470
 471     (format *trace-output*
 472             "~&  seconds  |  consed   |  calls  |  sec/call  |  name~@
 473                ------------------------------------------------------~%")
 474
 475     (let ((total-time 0.0)
 476           (total-consed 0)
 477           (total-calls 0))
 478       (dolist (time-info time-info-list)
 479         (incf total-time (time-info-seconds time-info))
 480         (incf total-calls (time-info-calls time-info))
 481         (incf total-consed (time-info-consing time-info))
 482         (format *trace-output*
 483                 "~10,3F | ~9:D | ~7:D | ~10,6F | ~S~%"
 484                 (time-info-seconds time-info)
 485                 (time-info-consing time-info)
 486                 (time-info-calls time-info)
 487                 (/ (time-info-seconds time-info)
 488                    (float (time-info-calls time-info)))
 489                 (time-info-name time-info)))
 490       (format *trace-output*
 491               "------------------------------------------------------~@
 492               ~10,3F | ~9:D | ~7:D |        | Total~%"
 493               total-time total-consed total-calls)
 494       (format *trace-output*
 495               "~%estimated total profiling overhead: ~4,2F seconds~%"
 496               (* (overhead-total *overhead*) (float total-calls)))
 497       (format *trace-output*
 498               "~&overhead estimation parameters:~%  ~Ss/call, ~Ss total profiling, ~Ss internal profiling~%"
 499               (overhead-call *overhead*)
 500               (overhead-total *overhead*)
 501               (overhead-internal *overhead*)))
 502
 503     (when no-call-name-list
 504       (format *trace-output*
 505               "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
 506               (sort no-call-name-list #'string<
 507                     :key (lambda (name)
 508                            (symbol-name (function-name-block-name name))))))
 509
 510     (values)))
 511 \f
 512 ;;;; overhead estimation
 513
 514 ;;; We average the timing overhead over this many iterations.
 515 (defconstant +timer-overhead-iterations+
 516   50 ; REMOVEME
 517   ;;50000
 518   )
 519
 520 ;;; a dummy function that we profile to find profiling overhead
 521 (declaim (notinline compute-overhead-aux))
 522 (defun compute-overhead-aux (x)
 523   (declare (ignore x)))
 524
 525 ;;; Return a newly computed OVERHEAD object.
 526 (defun compute-overhead ()
 527   (flet ((frob ()
 528            (let ((start (get-internal-ticks))
 529                  (fun (symbol-function 'compute-overhead-aux)))
 530              (dotimes (i +timer-overhead-iterations+)
 531                (funcall fun fun))
 532              (/ (float (- (get-internal-ticks) start))
 533                 (float +ticks-per-second+)
 534                 (float +timer-overhead-iterations+)))))
 535     (let (;; Measure unprofiled calls to estimate call overhead.
 536           (call-overhead (frob))
 537           total-overhead
 538           internal-overhead)
 539       ;; Measure profiled calls to estimate profiling overhead.
 540       (unwind-protect
 541           (progn
 542             (profile compute-overhead-aux)
 543             (setf total-overhead
 544                   (- (frob) call-overhead)))
 545         (let* ((pinfo (gethash 'compute-overhead-aux
 546                                *profiled-function-name->info*))
 547                (read-stats-fun (profile-info-read-stats-fun pinfo))
 548                (time (nth-value 1 (funcall read-stats-fun))))
 549           (setf internal-overhead
 550                 (/ (float time)
 551                    (float +ticks-per-second+)
 552                    (float +timer-overhead-iterations+))))
 553         (unprofile compute-overhead-aux))
 554       (make-overhead :call call-overhead
 555                      :total total-overhead
 556                      :internal internal-overhead))))
 557
 558 ;;; It would be bad to compute *OVERHEAD*, save it into a .core file,
 559 ;;; then load old *OVERHEAD* value from the .core file into a
 560 ;;; different machine running at a different speed. We avoid this by
 561 ;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
 562 (pushnew (lambda ()
 563            (makunbound '*overhead*))
 564          *before-save-initializations*)