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
  13 ;;;; COUNTER object
  14 ;;;;
  15 ;;;; Thread safe, and reasonably fast: in common case increment is just an
  16 ;;;; ATOMIC-INCF, in overflow case grab a lock and increment overflow counter.
  17
  18 (defconstant +most-positive-word+ (1- (expt 2 sb-vm:n-word-bits)))
  19
  20 (declaim (inline make-counter))
  21 (defstruct (counter (:constructor make-counter) (:copier nil))
  22   (word 0 :type sb-vm:word)
  23   (overflow 0 :type unsigned-byte))
  24
  25 (defun incf-counter (counter delta)
  26   ;; When running multi-threaded we can easily get negative numbers for the
  27   ;; cons-counter. Don't count them at all.
  28   (when (plusp delta)
  29     (labels ((%incf-overflow (&optional (n 1))
  30                ;; Overflow-counter can run into bignums... so we need to loop
  31                ;; around CAS till the increment succeeds.
  32                (loop for old = (counter-overflow counter)
  33                      until (eq old (compare-and-swap (counter-overflow counter)
  34                                                      old (+ old n)))))
  35              (%incf (d)
  36                ;; Increment the word-sized counter. If it overflows, record the
  37                ;; overflow.
  38                (let ((prev (atomic-incf (counter-word counter) d)))
  39                  (when (< (logand +most-positive-word+ (+ prev d)) prev)
  40                    (%incf-overflow)))))
  41       ;; DELTA can potentially be a bignum -- cut it down to word-size.
  42       (unless (typep delta 'sb-vm:word)
  43         (multiple-value-bind (n r) (truncate delta (1+ +most-positive-word+))
  44           (%incf-overflow n)
  45           (setf delta r)))
  46       ;; ATOMIC-INCF can at most handle SIGNED-WORD: if DELTA doesn't fit that,
  47       ;; DELTA/2 will.
  48       (if (typep delta 'sb-vm:signed-word)
  49           (%incf delta)
  50           ;; ...and if delta is still too big, split it into four parts: they
  51           ;; are guaranteed to fit into a signed word.
  52           (multiple-value-bind (n r) (truncate delta 2)
  53             (%incf n)
  54             (%incf n)
  55             (%incf r)))))
  56   counter)
  57
  58 (defun counter-count (counter)
  59   (+ (counter-word counter)
  60      (* (counter-overflow counter) (1+ +most-positive-word+))))
  61 \f
  62 ;;;; High resolution timer
  63
  64 ;;; FIXME: High resolution this is not. Build a microsecond-accuracy version
  65 ;;; on top of unix-getrusage, maybe.
  66
  67 (defconstant +ticks-per-second+ internal-time-units-per-second)
  68
  69 (declaim (inline get-internal-ticks))
  70 (defun get-internal-ticks ()
  71   (get-internal-run-time))
  72 \f
  73 ;;;; global data structures
  74
  75 ;;; We associate a PROFILE-INFO structure with each profiled function
  76 ;;; name. This holds the functions that we call to manipulate the
  77 ;;; closure which implements the encapsulation.
  78 (defvar *profiled-fun-name->info*
  79   (make-hash-table
  80    ;; EQL testing isn't good enough for generalized function names
  81    ;; like (SETF FOO).
  82    :test 'equal
  83    :synchronized t))
  84 (defstruct (profile-info (:copier nil))
  85   (name              (missing-arg) :read-only t)
  86   (encapsulated-fun  (missing-arg) :type function :read-only t)
  87   (encapsulation-fun (missing-arg) :type function :read-only t)
  88   (read-stats-fun    (missing-arg) :type function :read-only t)
  89   (clear-stats-fun   (missing-arg) :type function :read-only t))
  90
  91 ;;; These variables are used to subtract out the time and consing for
  92 ;;; recursive and other dynamically nested profiled calls. The total
  93 ;;; resource consumed for each nested call is added into the
  94 ;;; appropriate variable. When the outer function returns, these
  95 ;;; amounts are subtracted from the total.
  96 (declaim (counter *enclosed-ticks* *enclosed-consing*))
  97 (defvar *enclosed-ticks*)
  98 (defvar *enclosed-consing*)
  99
 100 ;;; This variable is also used to subtract out time for nested
 101 ;;; profiled calls. The time inside the profile wrapper call --
 102 ;;; between its two calls to GET-INTERNAL-TICKS -- is accounted
 103 ;;; for by the *ENCLOSED-TIME* variable. However, there's also extra
 104 ;;; overhead involved, before we get to the first call to
 105 ;;; GET-INTERNAL-TICKS, and after we get to the second call. By
 106 ;;; keeping track of the count of enclosed profiled calls, we can try
 107 ;;; to compensate for that.
 108 (declaim (counter *enclosed-profiles*))
 109 (defvar *enclosed-profiles*)
 110
 111 (declaim (counter *enclosed-gc-run-time*))
 112 (defvar *enclosed-gc-run-time*)
 113
 114 ;;; the encapsulated function we're currently computing profiling data
 115 ;;; for, recorded so that we can detect the problem of
 116 ;;; PROFILE-computing machinery calling a function which has itself
 117 ;;; been PROFILEd
 118 (defvar *computing-profiling-data-for*)
 119
 120 ;;; the components of profiling overhead
 121 (defstruct (overhead (:copier nil))
 122   ;; the number of ticks a bare function call takes. This is
 123   ;; factored into the other overheads, but not used for itself.
 124   (call (missing-arg) :type single-float :read-only t)
 125   ;; the number of ticks that will be charged to a profiled
 126   ;; function due to the profiling code
 127   (internal (missing-arg) :type single-float :read-only t)
 128   ;; the number of ticks of overhead for profiling that a single
 129   ;; profiled call adds to the total runtime for the program
 130   (total (missing-arg) :type single-float :read-only t))
 131 (defvar *overhead*)
 132 (declaim (type overhead *overhead*))
 133 (makunbound '*overhead*) ; in case we reload this file when tweaking
 134 \f
 135 ;;;; profile encapsulations
 136
 137 ;;; Return a collection of closures over the same lexical context,
 138 ;;;   (VALUES ENCAPSULATION-FUN READ-STATS-FUN CLEAR-STATS-FUN).
 139 ;;;
 140 ;;; ENCAPSULATION-FUN is a plug-in replacement for ENCAPSULATED-FUN,
 141 ;;; which updates statistics whenever it's called.
 142 ;;;
 143 ;;; READ-STATS-FUN returns the statistics:
 144 ;;;   (VALUES COUNT TIME CONSING PROFILE).
 145 ;;; COUNT is the count of calls to ENCAPSULATION-FUN. TICKS is
 146 ;;; the total number of ticks spent in ENCAPSULATED-FUN.
 147 ;;; CONSING is the total consing of ENCAPSULATION-FUN. PROFILE is the
 148 ;;; number of calls to the profiled function, stored for the purposes
 149 ;;; of trying to estimate that part of profiling overhead which occurs
 150 ;;; outside the interval between the profile wrapper function's timer
 151 ;;; calls.
 152 ;;;
 153 ;;; CLEAR-STATS-FUN clears the statistics.
 154 ;;;
 155 ;;; (The reason for implementing this as coupled closures, with the
 156 ;;; counts built into the lexical environment, is that we hope this
 157 ;;; will minimize profiling overhead.)
 158 (defun profile-encapsulation-lambdas (encapsulated-fun)
 159   (declare (type function encapsulated-fun))
 160   (let* ((count (make-counter))
 161          (ticks (make-counter))
 162          (consing (make-counter))
 163          (profiles (make-counter))
 164          (gc-run-time (make-counter)))
 165     (declare (counter count ticks consing profiles gc-run-time))
 166     (values
 167      ;; ENCAPSULATION-FUN
 168      (lambda (&more arg-context arg-count)
 169        (declare (optimize speed safety))
 170        ;; Make sure that we're not recursing infinitely.
 171        (when (boundp '*computing-profiling-data-for*)
 172          (unprofile-all) ; to avoid further recursion
 173          (error "~@<When computing profiling data for ~S, the profiled ~
 174                     function ~S was called. To get out of this infinite recursion, all ~
 175                     functions have been unprofiled. (Since the profiling system evidently ~
 176                     uses ~S in its computations, it looks as though it's a bad idea to ~
 177                     profile it.)~:@>"
 178                 *computing-profiling-data-for* encapsulated-fun
 179                 encapsulated-fun))
 180        (incf-counter count 1)
 181        (let ((dticks 0)
 182              (dconsing 0)
 183              (inner-enclosed-profiles 0)
 184              (dgc-run-time 0))
 185          (declare (truly-dynamic-extent dticks dconsing inner-enclosed-profiles))
 186          (unwind-protect
 187              (let* ((start-ticks (get-internal-ticks))
 188                     (start-gc-run-time *gc-run-time*)
 189                     (*enclosed-ticks* (make-counter))
 190                     (*enclosed-consing* (make-counter))
 191                     (*enclosed-profiles* (make-counter))
 192                     (nbf0 *n-bytes-freed-or-purified*)
 193                     (dynamic-usage-0 (sb-kernel:dynamic-usage))
 194                     (*enclosed-gc-run-time* (make-counter)))
 195                (declare (dynamic-extent *enclosed-ticks* *enclosed-consing* *enclosed-profiles* *enclosed-gc-run-time*))
 196                (unwind-protect
 197                    (multiple-value-call encapsulated-fun
 198                                         (sb-c:%more-arg-values arg-context
 199                                                                0
 200                                                                arg-count))
 201                  (let ((*computing-profiling-data-for* encapsulated-fun)
 202                        (dynamic-usage-1 (sb-kernel:dynamic-usage)))
 203                    (setf dticks (- (get-internal-ticks) start-ticks)
 204                          dconsing (if (eql *n-bytes-freed-or-purified* nbf0)
 205                                       ;; common special case where we can avoid
 206                                       ;; bignum arithmetic
 207                                       (- dynamic-usage-1 dynamic-usage-0)
 208                                       ;; general case
 209                                       (- (get-bytes-consed) nbf0 dynamic-usage-0))
 210                          inner-enclosed-profiles (counter-count *enclosed-profiles*)
 211                          dgc-run-time (- *gc-run-time* start-gc-run-time))
 212                    (incf-counter ticks (- dticks (counter-count *enclosed-ticks*)))
 213                    (incf-counter gc-run-time (- dgc-run-time (counter-count *enclosed-gc-run-time*)))
 214                    (incf-counter consing (- dconsing (counter-count *enclosed-consing*)))
 215                    (incf-counter profiles inner-enclosed-profiles))))
 216            (when (boundp '*enclosed-ticks*)
 217              (incf-counter *enclosed-ticks* dticks)
 218              (incf-counter *enclosed-consing* dconsing)
 219              (incf-counter *enclosed-profiles* (1+ inner-enclosed-profiles))
 220              (incf-counter *enclosed-gc-run-time* dgc-run-time)))))
 221      ;; READ-STATS-FUN
 222      (lambda ()
 223        (values (counter-count count)
 224                (counter-count ticks)
 225                (counter-count consing)
 226                (counter-count profiles)
 227                (counter-count gc-run-time)))
 228      ;; CLEAR-STATS-FUN
 229      (lambda ()
 230        (setf count (make-counter)
 231              ticks (make-counter)
 232              consing (make-counter)
 233              profiles (make-counter)
 234              gc-run-time (make-counter))))))
 235 \f
 236 ;;;; interfaces
 237
 238 ;;; A symbol or (SETF FOO) list names a function, a string names all
 239 ;;; the functions named by symbols in the named package.
 240 (defun mapc-on-named-funs (function names)
 241   (dolist (name names)
 242     (etypecase name
 243       (symbol (funcall function name))
 244       (list
 245        (legal-fun-name-or-type-error name)
 246        ;; Then we map onto it.
 247        (funcall function name))
 248       (string (let ((package (find-undeleted-package-or-lose name)))
 249                 (do-symbols (symbol package)
 250                   (when (eq (symbol-package symbol) package)
 251                     (when (and (fboundp symbol)
 252                                (not (macro-function symbol))
 253                                (not (special-operator-p symbol)))
 254                       (funcall function symbol))
 255                     (let ((setf-name `(setf ,symbol)))
 256                       (when (fboundp setf-name)
 257                         (funcall function setf-name)))))))))
 258   (values))
 259
 260 ;;; Profile the named function, which should exist and not be profiled
 261 ;;; already.
 262 (defun profile-1-unprofiled-fun (name)
 263   (let ((encapsulated-fun (fdefinition name)))
 264     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
 265         (profile-encapsulation-lambdas encapsulated-fun)
 266       (without-package-locks
 267        (setf (fdefinition name)
 268              encapsulation-fun))
 269       (setf (gethash name *profiled-fun-name->info*)
 270             (make-profile-info :name name
 271                                :encapsulated-fun encapsulated-fun
 272                                :encapsulation-fun encapsulation-fun
 273                                :read-stats-fun read-stats-fun
 274                                :clear-stats-fun clear-stats-fun))
 275       (values))))
 276
 277 ;;; Profile the named function. If already profiled, unprofile first.
 278 (defun profile-1-fun (name)
 279   (cond ((fboundp name)
 280          (when (gethash name *profiled-fun-name->info*)
 281            (warn "~S is already profiled, so unprofiling it first." name)
 282            (unprofile-1-fun name))
 283          (profile-1-unprofiled-fun name))
 284         (t
 285          (warn "ignoring undefined function ~S" name)))
 286   (values))
 287
 288 ;;; Unprofile the named function, if it is profiled.
 289 (defun unprofile-1-fun (name)
 290   (let ((pinfo (gethash name *profiled-fun-name->info*)))
 291     (cond (pinfo
 292            (remhash name *profiled-fun-name->info*)
 293            (if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
 294                (without-package-locks
 295                 (setf (fdefinition name) (profile-info-encapsulated-fun pinfo)))
 296                (warn "preserving current definition of redefined function ~S"
 297                      name)))
 298           (t
 299            (warn "~S is not a profiled function." name))))
 300   (values))
 301
 302 (defmacro profile (&rest names)
 303   #+sb-doc
 304   "PROFILE Name*
 305
 306    If no names are supplied, return the list of profiled functions.
 307
 308    If names are supplied, wrap profiling code around the named functions.
 309    As in TRACE, the names are not evaluated. A symbol names a function.
 310    A string names all the functions named by symbols in the named
 311    package. If a function is already profiled, then unprofile and
 312    reprofile (useful to notice function redefinition.)  If a name is
 313    undefined, then we give a warning and ignore it. See also
 314    UNPROFILE, REPORT and RESET."
 315   (if (null names)
 316       `(loop for k being each hash-key in *profiled-fun-name->info*
 317              collecting k)
 318       `(mapc-on-named-funs #'profile-1-fun ',names)))
 319
 320 (defmacro unprofile (&rest names)
 321   #+sb-doc
 322   "Unwrap any profiling code around the named functions, or if no names
 323   are given, unprofile all profiled functions. A symbol names
 324   a function. A string names all the functions named by symbols in the
 325   named package. NAMES defaults to the list of names of all currently
 326   profiled functions."
 327   (if names
 328       `(mapc-on-named-funs #'unprofile-1-fun ',names)
 329       `(unprofile-all)))
 330
 331 (defun unprofile-all ()
 332   (dohash ((name profile-info) *profiled-fun-name->info*
 333            :locked t)
 334     (declare (ignore profile-info))
 335     (unprofile-1-fun name)))
 336
 337 (defun reset ()
 338   "Reset the counters for all profiled functions."
 339   (dohash ((name profile-info) *profiled-fun-name->info* :locked t)
 340     (declare (ignore name))
 341     (funcall (profile-info-clear-stats-fun profile-info))))
 342 \f
 343 ;;;; reporting results
 344
 345 (defstruct (time-info (:copier nil))
 346   name
 347   calls
 348   seconds
 349   consing
 350   gc-run-time)
 351
 352 ;;; Return our best guess for the run time in a function, subtracting
 353 ;;; out factors for profiling overhead. We subtract out the internal
 354 ;;; overhead for each call to this function, since the internal
 355 ;;; overhead is the part of the profiling overhead for a function that
 356 ;;; is charged to that function.
 357 ;;;
 358 ;;; We also subtract out a factor for each call to a profiled function
 359 ;;; within this profiled function. This factor is the total profiling
 360 ;;; overhead *minus the internal overhead*. We don't subtract out the
 361 ;;; internal overhead, since it was already subtracted when the nested
 362 ;;; profiled functions subtracted their running time from the time for
 363 ;;; the enclosing function.
 364 (defun compensate-time (calls ticks profile)
 365   (let ((raw-compensated
 366          (- (/ (float ticks) (float +ticks-per-second+))
 367             (* (overhead-internal *overhead*) (float calls))
 368             (* (- (overhead-total *overhead*)
 369                   (overhead-internal *overhead*))
 370                (float profile)))))
 371     (max raw-compensated 0.0)))
 372
 373 (defun report ()
 374   "Report results from profiling. The results are approximately adjusted
 375 for profiling overhead. The compensation may be rather inaccurate when
 376 bignums are involved in runtime calculation, as in a very-long-running
 377 Lisp process."
 378   (unless (boundp '*overhead*)
 379     (setf *overhead*
 380           (compute-overhead)))
 381   (let ((time-info-list ())
 382         (no-call-name-list ()))
 383     (dohash ((name pinfo) *profiled-fun-name->info* :locked t)
 384       (unless (eq (fdefinition name)
 385                   (profile-info-encapsulation-fun pinfo))
 386         (warn "Function ~S has been redefined, so times may be inaccurate.~@
 387                PROFILE it again to record calls to the new definition."
 388               name))
 389       (multiple-value-bind (calls ticks consing profile gc-run-time)
 390           (funcall (profile-info-read-stats-fun pinfo))
 391         (if (zerop calls)
 392             (push name no-call-name-list)
 393             (push (make-time-info :name name
 394                                   :calls calls
 395                                   :seconds (compensate-time calls
 396                                                             ticks
 397                                                             profile)
 398                                   :consing consing
 399                                   :gc-run-time gc-run-time)
 400                   time-info-list))))
 401
 402     (setf time-info-list
 403           (sort time-info-list
 404                 #'>=
 405                 :key #'time-info-seconds))
 406     (print-profile-table time-info-list)
 407
 408     (when no-call-name-list
 409       (format *trace-output*
 410               "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
 411               (sort no-call-name-list #'string<
 412                     :key (lambda (name)
 413                            (symbol-name (fun-name-block-name name))))))
 414
 415     (values)))
 416
 417
 418 (defun print-profile-table (time-info-list)
 419   (let ((total-seconds 0.0)
 420         (total-consed 0)
 421         (total-calls 0)
 422         (total-gc-run-time 0)
 423         (seconds-width (length "seconds"))
 424         (consed-width (length "consed"))
 425         (calls-width (length "calls"))
 426         (sec/call-width 10)
 427         (gc-run-time-width (length "gc"))
 428         (name-width 6))
 429     (dolist (time-info time-info-list)
 430       (incf total-seconds (time-info-seconds time-info))
 431       (incf total-consed (time-info-consing time-info))
 432       (incf total-calls (time-info-calls time-info))
 433       (incf total-gc-run-time (time-info-gc-run-time time-info)))
 434     (setf seconds-width (max (length (format nil "~10,3F" total-seconds))
 435                              seconds-width)
 436           calls-width (max (length (format nil "~:D" total-calls))
 437                            calls-width)
 438           consed-width (max (length (format nil "~:D" total-consed))
 439                             consed-width)
 440           gc-run-time-width (max (length (format nil "~10,3F" (/ total-gc-run-time internal-time-units-per-second)))
 441                             gc-run-time-width))
 442
 443     (flet ((dashes ()
 444              (dotimes (i (+ seconds-width consed-width calls-width
 445                             sec/call-width name-width
 446                             (* 5 3)))
 447                (write-char #\- *trace-output*))
 448              (terpri *trace-output*)))
 449       (format *trace-output* "~&~@{ ~v:@<~A~>~^|~}~%"
 450               seconds-width "seconds"
 451               (1+ gc-run-time-width) "gc"
 452               (1+ consed-width) "consed"
 453               (1+ calls-width) "calls"
 454               (1+ sec/call-width) "sec/call"
 455               (1+ name-width) "name")
 456
 457       (dashes)
 458
 459       (dolist (time-info time-info-list)
 460         (format *trace-output* "~v,3F | ~v,3F | ~v:D | ~v:D | ~10,6F | ~S~%"
 461                 seconds-width (time-info-seconds time-info)
 462                 gc-run-time-width (/ (time-info-gc-run-time time-info) internal-time-units-per-second)
 463                 consed-width (time-info-consing time-info)
 464                 calls-width (time-info-calls time-info)
 465                 (/ (time-info-seconds time-info)
 466                    (float (time-info-calls time-info)))
 467                 (time-info-name time-info)))
 468
 469       (dashes)
 470
 471       (format *trace-output* "~v,3F | ~v,3F | ~v:D | ~v:D |            | Total~%"
 472                 seconds-width total-seconds
 473                 gc-run-time-width (/ total-gc-run-time internal-time-units-per-second)
 474                 consed-width total-consed
 475                 calls-width total-calls)
 476
 477       (format *trace-output*
 478               "~%estimated total profiling overhead: ~4,2F seconds~%"
 479               (* (overhead-total *overhead*) (float total-calls)))
 480       (format *trace-output*
 481               "~&overhead estimation parameters:~%  ~Ss/call, ~Ss total profiling, ~Ss internal profiling~%"
 482               (overhead-call *overhead*)
 483               (overhead-total *overhead*)
 484               (overhead-internal *overhead*)))))
 485
 486 \f
 487 ;;;; overhead estimation
 488
 489 ;;; We average the timing overhead over this many iterations.
 490 ;;;
 491 ;;; (This is a variable, not a constant, so that it can be set in
 492 ;;; .sbclrc if desired. Right now, that's an unsupported extension
 493 ;;; that I (WHN) use for my own experimentation, but it might
 494 ;;; become supported someday. Comments?)
 495 (declaim (type unsigned-byte *timer-overhead-iterations*))
 496 (defparameter *timer-overhead-iterations*
 497   500000)
 498
 499 ;;; a dummy function that we profile to find profiling overhead
 500 (declaim (notinline compute-overhead-aux))
 501 (defun compute-overhead-aux (x)
 502   (declare (ignore x)))
 503
 504 ;;; Return a newly computed OVERHEAD object.
 505 (defun compute-overhead ()
 506   (format *debug-io* "~&measuring PROFILE overhead..")
 507   (flet ((frob ()
 508            (let ((start (get-internal-ticks))
 509                  (fun (symbol-function 'compute-overhead-aux)))
 510              (declare (type function fun))
 511              (dotimes (i *timer-overhead-iterations*)
 512                (funcall fun fun))
 513              (/ (float (- (get-internal-ticks) start))
 514                 (float +ticks-per-second+)
 515                 (float *timer-overhead-iterations*)))))
 516     (let (;; Measure unprofiled calls to estimate call overhead.
 517           (call-overhead (frob))
 518           total-overhead
 519           internal-overhead)
 520       ;; Measure profiled calls to estimate profiling overhead.
 521       (unwind-protect
 522           (progn
 523             (profile compute-overhead-aux)
 524             (setf total-overhead
 525                   (- (frob) call-overhead)))
 526         (let* ((pinfo (gethash 'compute-overhead-aux
 527                                *profiled-fun-name->info*))
 528                (read-stats-fun (profile-info-read-stats-fun pinfo))
 529                (time (nth-value 1 (funcall read-stats-fun))))
 530           (setf internal-overhead
 531                 (/ (float time)
 532                    (float +ticks-per-second+)
 533                    (float *timer-overhead-iterations*))))
 534         (unprofile compute-overhead-aux))
 535       (prog1
 536           (make-overhead :call call-overhead
 537                          :total total-overhead
 538                          :internal internal-overhead)
 539         (format *debug-io* "done~%")))))
 540
 541 ;;; It would be bad to compute *OVERHEAD*, save it into a .core file,
 542 ;;; then load the old *OVERHEAD* value from the .core file into a
 543 ;;; different machine running at a different speed. We avoid this by
 544 ;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
 545 (defun profile-deinit ()
 546   (without-package-locks
 547     (makunbound '*overhead*)))