0.8.0.24:

[sbcl.git] / src / code / profile.lisp

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 47414e0..0a257b3 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -7,7 +7,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 

-(in-package "SB-PROFILE")
+(in-package "SB-PROFILE") ; (SB-, not SB!, since we're built in warm load.)

 \f
 ;;;; reading internal run time with high resolution and low overhead
 
 \f
 ;;;; reading internal run time with high resolution and low overhead
 

@@ -21,71 +21,6 @@
 (declaim (inline get-internal-ticks))
 (defun get-internal-ticks () (get-internal-run-time))
 \f
 (declaim (inline get-internal-ticks))
 (defun get-internal-ticks () (get-internal-run-time))
 \f

-;;;; PCOUNTER
-
-;;; a PCOUNTER is used to represent an unsigned integer quantity which
-;;; can grow bigger than a fixnum, but typically does so, if at all,
-;;; in many small steps, where we don't want to cons on every step.
-;;; (Total system consing, time spent in a profiled function, and
-;;; bytes consed in a profiled function are all examples of such
-;;; quantities.)
-(defstruct (pcounter (:copier nil))
-  (integer 0 :type unsigned-byte)
-  (fixnum 0 :type (and fixnum unsigned-byte)))
-
-(declaim (ftype (function (pcounter integer) pcounter) incf-pcounter))
-;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable
-(defun incf-pcounter (pcounter delta)
-  (let ((sum (+ (pcounter-fixnum pcounter) delta)))
-    (cond ((typep sum 'fixnum)
-          (setf (pcounter-fixnum pcounter) sum))
-         (t
-          (incf (pcounter-integer pcounter) sum)
-          (setf (pcounter-fixnum pcounter) 0))))
-  pcounter)
-
-(declaim (ftype (function (pcounter) integer) pcounter->integer))
-;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
-(defun pcounter->integer (pcounter)
-  (+ (pcounter-integer pcounter)
-     (pcounter-fixnum pcounter)))
-\f
-;;;; operations on (OR PCOUNTER FIXNUM)
-;;;;
-;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
-;;;; start with a FIXNUM counter and only create a PCOUNTER if the
-;;;; FIXNUM overflows.
-
-(declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum))
-;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable
-(defun %incf-pcounter-or-fixnum (x delta)
-  (etypecase x
-    (fixnum
-     (let ((sum (+ x delta)))
-       (if (typep sum 'fixnum)
-          sum
-          (make-pcounter :integer sum))))
-    (pcounter
-     (incf-pcounter x delta))))
-  
-(define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
-
-;;; Trade off space for execution time by handling the common fast
-;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
-;;; arithmetic as a last resort.
-(defmacro fastbig-incf-pcounter-or-fixnum (x delta)
-  (once-only ((delta delta))
-    `(etypecase ,delta
-       (fixnum (incf-pcounter-or-fixnum ,x ,delta))
-       (integer (incf-pcounter-or-fixnum ,x ,delta)))))
-
-(declaim (ftype (function ((or pcounter fixnum)) integer) pcounter-or-fixnum->integer))
-(declaim (maybe-inline pcounter-or-fixnum->integer))
-(defun pcounter-or-fixnum->integer (x)
-  (etypecase x
-    (fixnum x)
-    (pcounter (pcounter->integer x))))
-\f

 ;;;; implementation-dependent interfaces
 
 #|
 ;;;; implementation-dependent interfaces
 
 #|

@@ -98,13 +33,13 @@
 (declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature))
 (defun fun-signature (name)
   (let ((type (info :function :type name)))
 (declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature))
 (defun fun-signature (name)
   (let ((type (info :function :type name)))

-    (cond ((not (function-type-p type))
+    (cond ((not (fun-type-p type))

           (values 0 t))
          (t
           (values 0 t))
          (t

-          (values (length (function-type-required type))
-                  (or (function-type-optional type)
-                      (function-type-keyp type)
-                      (function-type-rest type)))))))
+          (values (length (fun-type-required type))
+                  (or (fun-type-optional type)
+                      (fun-type-keyp type)
+                      (fun-type-rest type)))))))

 |#
 \f
 ;;;; global data structures
 |#
 \f
 ;;;; global data structures

@@ -112,13 +47,17 @@
 ;;; We associate a PROFILE-INFO structure with each profiled function
 ;;; name. This holds the functions that we call to manipulate the
 ;;; closure which implements the encapsulation.
 ;;; We associate a PROFILE-INFO structure with each profiled function
 ;;; name. This holds the functions that we call to manipulate the
 ;;; closure which implements the encapsulation.

-(defvar *profiled-function-name->info* (make-hash-table))
+(defvar *profiled-fun-name->info*
+  (make-hash-table
+   ;; EQL testing isn't good enough for generalized function names
+   ;; like (SETF FOO).
+   :test 'equal))

 (defstruct (profile-info (:copier nil))
 (defstruct (profile-info (:copier nil))

-  (name              (required-argument) :read-only t)
-  (encapsulated-fun  (required-argument) :type function :read-only t)
-  (encapsulation-fun (required-argument) :type function :read-only t)
-  (read-stats-fun    (required-argument) :type function :read-only t)
-  (clear-stats-fun   (required-argument) :type function :read-only t))
+  (name              (missing-arg) :read-only t)
+  (encapsulated-fun  (missing-arg) :type function :read-only t)
+  (encapsulation-fun (missing-arg) :type function :read-only t)
+  (read-stats-fun    (missing-arg) :type function :read-only t)
+  (clear-stats-fun   (missing-arg) :type function :read-only t))

 
 ;;; These variables are used to subtract out the time and consing for
 ;;; recursive and other dynamically nested profiled calls. The total
 
 ;;; These variables are used to subtract out the time and consing for
 ;;; recursive and other dynamically nested profiled calls. The total

@@ -140,29 +79,38 @@
 (defvar *enclosed-profiles* 0)
 (declaim (type (or pcounter fixnum) *enclosed-profiles*))
 
 (defvar *enclosed-profiles* 0)
 (declaim (type (or pcounter fixnum) *enclosed-profiles*))
 

+;;; the encapsulated function we're currently computing profiling data
+;;; for, recorded so that we can detect the problem of
+;;; PROFILE-computing machinery calling a function which has itself
+;;; been PROFILEd
+(defvar *computing-profiling-data-for*)
+

 ;;; the components of profiling overhead
 (defstruct (overhead (:copier nil))
   ;; the number of ticks a bare function call takes. This is
   ;; factored into the other overheads, but not used for itself.
 ;;; the components of profiling overhead
 (defstruct (overhead (:copier nil))
   ;; the number of ticks a bare function call takes. This is
   ;; factored into the other overheads, but not used for itself.

-  (call (required-argument) :type single-float :read-only t)
+  (call (missing-arg) :type single-float :read-only t)

   ;; the number of ticks that will be charged to a profiled
   ;; function due to the profiling code
   ;; the number of ticks that will be charged to a profiled
   ;; function due to the profiling code

-  (internal (required-argument) :type single-float :read-only t)
+  (internal (missing-arg) :type single-float :read-only t)

   ;; the number of ticks of overhead for profiling that a single
   ;; profiled call adds to the total runtime for the program
   ;; the number of ticks of overhead for profiling that a single
   ;; profiled call adds to the total runtime for the program

-  (total (required-argument) :type single-float :read-only t))
+  (total (missing-arg) :type single-float :read-only t))

 (defvar *overhead*)
 (declaim (type overhead *overhead*))
 (defvar *overhead*)
 (declaim (type overhead *overhead*))

+(makunbound '*overhead*) ; in case we reload this file when tweaking

 \f
 ;;;; profile encapsulations
 
 \f
 ;;;; profile encapsulations
 

-;;; Trade off space for time by handling the usual all-FIXNUM cases
-;;; inline.
+;;; Trade off space for time by handling the usual all-FIXNUM cases inline.

 (defmacro fastbig- (x y)
   (once-only ((x x) (y y))
 (defmacro fastbig- (x y)
   (once-only ((x x) (y y))

-    `(if (and (typep ,x 'fixnum)
-             (typep ,y 'fixnum))
+    `(if (and (typep ,x '(and fixnum unsigned-byte))
+             (typep ,y '(and fixnum unsigned-byte)))
+        ;; special case: can use fixnum arithmetic and be guaranteed
+        ;; the result is also a fixnum

         (- ,x ,y)
         (- ,x ,y)

+        ;; general case

         (- ,x ,y))))
 (defmacro fastbig-1+ (x)
   (once-only ((x x))
         (- ,x ,y))))
 (defmacro fastbig-1+ (x)
   (once-only ((x x))

@@ -193,7 +141,6 @@
 ;;; will minimize profiling overhead.)
 (defun profile-encapsulation-lambdas (encapsulated-fun)
   (declare (type function encapsulated-fun))
 ;;; will minimize profiling overhead.)
 (defun profile-encapsulation-lambdas (encapsulated-fun)
   (declare (type function encapsulated-fun))

-  (declare (optimize speed safety))

   (let* ((count 0)
         (ticks 0)
         (consing 0)
   (let* ((count 0)
         (ticks 0)
         (consing 0)

@@ -201,47 +148,58 @@
     (declare (type (or pcounter fixnum) count ticks consing profiles))
     (values
      ;; ENCAPSULATION-FUN
     (declare (type (or pcounter fixnum) count ticks consing profiles))
     (values
      ;; ENCAPSULATION-FUN

-     (lambda (sb-c:&more arg-context arg-count)
-       #+nil (declare (optimize (speed 3) (safety 0))) ; FIXME: remove #+NIL?
+     (lambda (&more arg-context arg-count)
+       (declare (optimize speed safety))
+       ;; Make sure that we're not recursing infinitely.
+       (when (boundp '*computing-profiling-data-for*)
+        (unprofile-all) ; to avoid further recursion
+        (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.)~:@>"
+               *computing-profiling-data-for*
+               encapsulated-fun
+               encapsulated-fun))
+       ;; FIXME: Probably when this is stable, we should optimize (SAFETY 0).

        (fastbig-incf-pcounter-or-fixnum count 1)
        (let ((dticks 0)
             (dconsing 0)
             (inner-enclosed-profiles 0))
         (declare (type unsigned-byte dticks dconsing))
         (declare (type unsigned-byte inner-enclosed-profiles))
        (fastbig-incf-pcounter-or-fixnum count 1)
        (let ((dticks 0)
             (dconsing 0)
             (inner-enclosed-profiles 0))
         (declare (type unsigned-byte dticks dconsing))
         (declare (type unsigned-byte inner-enclosed-profiles))

-        (multiple-value-prog1
-            (let ((start-ticks (get-internal-ticks))
-                  ;; KLUDGE: We add (THE UNSIGNED-BYTE ..) wrappers
-                  ;; around GET-BYTES-CONSED because as of
-                  ;; sbcl-0.6.4, at the time that the FTYPE of
-                  ;; GET-BYTES-CONSED is DECLAIMed, the
-                  ;; cross-compiler's type system isn't mature enough
-                  ;; to do anything about it. -- WHN 20000503
-                  (start-consing (the unsigned-byte (get-bytes-consed)))
-                  (*enclosed-ticks* 0)
-                  (*enclosed-consing* 0)
-                  (*enclosed-profiles* 0))
+        (aver (typep dticks 'unsigned-byte))
+        (aver (typep dconsing 'unsigned-byte))
+        (aver (typep inner-enclosed-profiles 'unsigned-byte))
+        (unwind-protect
+            (let* ((start-ticks (get-internal-ticks))
+                   (*enclosed-ticks* 0)
+                   (*enclosed-consing* 0)
+                   (*enclosed-profiles* 0)
+                   (nbf0 *n-bytes-freed-or-purified*)
+                   (dynamic-usage-0 (sb-kernel:dynamic-usage)))

               (declare (inline pcounter-or-fixnum->integer))
               (declare (inline pcounter-or-fixnum->integer))

-              (multiple-value-prog1
+              (unwind-protect

                   (multiple-value-call encapsulated-fun
                                        (sb-c:%more-arg-values arg-context
                                                               0
                                                               arg-count))
                   (multiple-value-call encapsulated-fun
                                        (sb-c:%more-arg-values arg-context
                                                               0
                                                               arg-count))

-                (setf dticks (fastbig- (get-internal-ticks) start-ticks)
-                      dconsing (fastbig- (the unsigned-byte
-                                              (get-bytes-consed))
-                                         start-consing))
-                (setf inner-enclosed-profiles
-                      (pcounter-or-fixnum->integer *enclosed-profiles*))
-                (fastbig-incf-pcounter-or-fixnum ticks (fastbig-
-                                                        dticks
-                                                        *enclosed-ticks*))
-                (fastbig-incf-pcounter-or-fixnum consing
-                                                 (fastbig-
-                                                  dconsing
-                                                  *enclosed-consing*))
-                (fastbig-incf-pcounter-or-fixnum profiles
-                                                 inner-enclosed-profiles)))
+                (let ((*computing-profiling-data-for* encapsulated-fun)
+                      (dynamic-usage-1 (sb-kernel:dynamic-usage)))
+                  (setf dticks (fastbig- (get-internal-ticks) start-ticks))
+                  (setf dconsing
+                        (if (eql *n-bytes-freed-or-purified* nbf0)
+                            ;; common special case where we can avoid
+                            ;; bignum arithmetic
+                            (- dynamic-usage-1 dynamic-usage-0)
+                            ;; general case
+                            (- (get-bytes-consed) nbf0 dynamic-usage-0)))
+                  (setf inner-enclosed-profiles
+                        (pcounter-or-fixnum->integer *enclosed-profiles*))
+                  (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
+                    (fastbig-incf-pcounter-or-fixnum ticks net-dticks))
+                  (let ((net-dconsing (fastbig- dconsing
+                                                (pcounter-or-fixnum->integer
+                                                 *enclosed-consing*))))
+                    (fastbig-incf-pcounter-or-fixnum consing net-dconsing))
+                  (fastbig-incf-pcounter-or-fixnum profiles
+                                                   inner-enclosed-profiles))))

           (fastbig-incf-pcounter-or-fixnum *enclosed-ticks* dticks)
           (fastbig-incf-pcounter-or-fixnum *enclosed-consing* dconsing)
           (fastbig-incf-pcounter-or-fixnum *enclosed-profiles*
           (fastbig-incf-pcounter-or-fixnum *enclosed-ticks* dticks)
           (fastbig-incf-pcounter-or-fixnum *enclosed-consing* dconsing)
           (fastbig-incf-pcounter-or-fixnum *enclosed-profiles*

@@ -260,18 +218,16 @@
             consing 0
             profiles 0)))))
 \f
             consing 0
             profiles 0)))))
 \f

-;;; interfaces
+;;;; interfaces

 
 ;;; A symbol or (SETF FOO) list names a function, a string names all
 ;;; the functions named by symbols in the named package.
 
 ;;; A symbol or (SETF FOO) list names a function, a string names all
 ;;; the functions named by symbols in the named package.

-(defun mapc-on-named-functions (function names)
+(defun mapc-on-named-funs (function names)

   (dolist (name names)
     (etypecase name
       (symbol (funcall function name))
       (list
   (dolist (name names)
     (etypecase name
       (symbol (funcall function name))
       (list

-       ;; We call this just for the side effect of checking that
-       ;; NAME is a legal function name:
-       (function-name-block-name name)
+       (legal-fun-name-or-type-error name)

        ;; Then we map onto it.
        (funcall function name))
       (string (let ((package (find-undeleted-package-or-lose name)))
        ;; Then we map onto it.
        (funcall function name))
       (string (let ((package (find-undeleted-package-or-lose name)))

@@ -286,13 +242,13 @@
 
 ;;; Profile the named function, which should exist and not be profiled
 ;;; already.
 
 ;;; Profile the named function, which should exist and not be profiled
 ;;; already.

-(defun profile-1-unprofiled-function (name)
+(defun profile-1-unprofiled-fun (name)

   (let ((encapsulated-fun (fdefinition name)))
     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
        (profile-encapsulation-lambdas encapsulated-fun)
       (setf (fdefinition name)
            encapsulation-fun)
   (let ((encapsulated-fun (fdefinition name)))
     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
        (profile-encapsulation-lambdas encapsulated-fun)
       (setf (fdefinition name)
            encapsulation-fun)

-      (setf (gethash name *profiled-function-name->info*)
+      (setf (gethash name *profiled-fun-name->info*)

            (make-profile-info :name name
                               :encapsulated-fun encapsulated-fun
                               :encapsulation-fun encapsulation-fun
            (make-profile-info :name name
                               :encapsulated-fun encapsulated-fun
                               :encapsulation-fun encapsulation-fun

@@ -301,21 +257,21 @@
       (values))))
 
 ;;; Profile the named function. If already profiled, unprofile first.
       (values))))
 
 ;;; Profile the named function. If already profiled, unprofile first.

-(defun profile-1-function (name)
+(defun profile-1-fun (name)

   (cond ((fboundp name)
   (cond ((fboundp name)

-        (when (gethash name *profiled-function-name->info*)
+        (when (gethash name *profiled-fun-name->info*)

           (warn "~S is already profiled, so unprofiling it first." name)
           (warn "~S is already profiled, so unprofiling it first." name)

-          (unprofile-1-function name))
-        (profile-1-unprofiled-function name))
+          (unprofile-1-fun name))
+        (profile-1-unprofiled-fun name))

        (t
         (warn "ignoring undefined function ~S" name)))
   (values))
 
 ;;; Unprofile the named function, if it is profiled.
        (t
         (warn "ignoring undefined function ~S" name)))
   (values))
 
 ;;; Unprofile the named function, if it is profiled.

-(defun unprofile-1-function (name)
-  (let ((pinfo (gethash name *profiled-function-name->info*)))
+(defun unprofile-1-fun (name)
+  (let ((pinfo (gethash name *profiled-fun-name->info*)))

     (cond (pinfo
     (cond (pinfo

-          (remhash name *profiled-function-name->info*)
+          (remhash name *profiled-fun-name->info*)

           (if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
               (setf (fdefinition name) (profile-info-encapsulated-fun pinfo))
               (warn "preserving current definition of redefined function ~S"
           (if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
               (setf (fdefinition name) (profile-info-encapsulated-fun pinfo))
               (warn "preserving current definition of redefined function ~S"

@@ -338,9 +294,9 @@
    undefined, then we give a warning and ignore it. See also
    UNPROFILE, REPORT and RESET."
   (if (null names)
    undefined, then we give a warning and ignore it. See also
    UNPROFILE, REPORT and RESET."
   (if (null names)

-      `(loop for k being each hash-key in *profiled-function-name->info*
+      `(loop for k being each hash-key in *profiled-fun-name->info*

             collecting k)
             collecting k)

-      `(mapc-on-named-functions #'profile-1-function ',names)))
+      `(mapc-on-named-funs #'profile-1-fun ',names)))

 
 (defmacro unprofile (&rest names)
   #+sb-doc
 
 (defmacro unprofile (&rest names)
   #+sb-doc

@@ -350,17 +306,17 @@
   named package. NAMES defaults to the list of names of all currently 
   profiled functions."
   (if names
   named package. NAMES defaults to the list of names of all currently 
   profiled functions."
   (if names

-      `(mapc-on-named-functions #'unprofile-1-function ',names)
+      `(mapc-on-named-funs #'unprofile-1-fun ',names)

       `(unprofile-all)))
 
 (defun unprofile-all ()
       `(unprofile-all)))
 
 (defun unprofile-all ()

-  (dohash (name profile-info *profiled-function-name->info*)
+  (dohash (name profile-info *profiled-fun-name->info*)

     (declare (ignore profile-info))
     (declare (ignore profile-info))

-    (unprofile-1-function name)))
+    (unprofile-1-fun name)))

 
 (defun reset ()
   "Reset the counters for all profiled functions."
 
 (defun reset ()
   "Reset the counters for all profiled functions."

-  (dohash (name profile-info *profiled-function-name->info*)
+  (dohash (name profile-info *profiled-fun-name->info*)

     (declare (ignore name))
     (funcall (profile-info-clear-stats-fun profile-info))))
 \f
     (declare (ignore name))
     (funcall (profile-info-clear-stats-fun profile-info))))
 \f

@@ -394,18 +350,16 @@
     (max raw-compensated 0.0)))
 
 (defun report ()
     (max raw-compensated 0.0)))
 
 (defun report ()

-  "Report results from profiling. The results are
-approximately adjusted for profiling overhead, but when RAW is true
-the unadjusted results are reported. The compensation may be somewhat
-inaccurate when bignums are involved in runtime calculation, as in
-a very-long-running Lisp process."
-  (declare (optimize (speed 0)))
+  "Report results from profiling. The results are approximately adjusted
+for profiling overhead. The compensation may be rather inaccurate when
+bignums are involved in runtime calculation, as in a very-long-running
+Lisp process."

   (unless (boundp '*overhead*)
     (setf *overhead*
          (compute-overhead)))
   (let ((time-info-list ())
        (no-call-name-list ()))
   (unless (boundp '*overhead*)
     (setf *overhead*
          (compute-overhead)))
   (let ((time-info-list ())
        (no-call-name-list ()))

-    (dohash (name pinfo *profiled-function-name->info*)
+    (dohash (name pinfo *profiled-fun-name->info*)

       (unless (eq (fdefinition name)
                  (profile-info-encapsulation-fun pinfo))
        (warn "Function ~S has been redefined, so times may be inaccurate.~@
       (unless (eq (fdefinition name)
                  (profile-info-encapsulation-fun pinfo))
        (warn "Function ~S has been redefined, so times may be inaccurate.~@

@@ -465,14 +419,21 @@ a very-long-running Lisp process."
              "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
              (sort no-call-name-list #'string<
                    :key (lambda (name)
              "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
              (sort no-call-name-list #'string<
                    :key (lambda (name)

-                          (symbol-name (function-name-block-name name))))))
+                          (symbol-name (fun-name-block-name name))))))

 
     (values)))
 \f
 ;;;; overhead estimation
 
 ;;; We average the timing overhead over this many iterations.
 
     (values)))
 \f
 ;;;; overhead estimation
 
 ;;; We average the timing overhead over this many iterations.

-(defconstant +timer-overhead-iterations+ 50000)
+;;;
+;;; (This is a variable, not a constant, so that it can be set in
+;;; .sbclrc if desired. Right now, that's an unsupported extension
+;;; that I (WHN) use for my own experimentation, but it might
+;;; become supported someday. Comments?)
+(declaim (type unsigned-byte *timer-overhead-iterations*))
+(defparameter *timer-overhead-iterations*
+  500000)

 
 ;;; a dummy function that we profile to find profiling overhead
 (declaim (notinline compute-overhead-aux))
 
 ;;; a dummy function that we profile to find profiling overhead
 (declaim (notinline compute-overhead-aux))

@@ -481,14 +442,16 @@ a very-long-running Lisp process."
 
 ;;; Return a newly computed OVERHEAD object.
 (defun compute-overhead ()
 
 ;;; Return a newly computed OVERHEAD object.
 (defun compute-overhead ()

+  (format *debug-io* "~&measuring PROFILE overhead..")

   (flet ((frob ()
           (let ((start (get-internal-ticks))
                 (fun (symbol-function 'compute-overhead-aux)))
   (flet ((frob ()
           (let ((start (get-internal-ticks))
                 (fun (symbol-function 'compute-overhead-aux)))

-            (dotimes (i +timer-overhead-iterations+)
+             (declare (type function fun))
+            (dotimes (i *timer-overhead-iterations*)

               (funcall fun fun))
             (/ (float (- (get-internal-ticks) start))
                (float +ticks-per-second+)
               (funcall fun fun))
             (/ (float (- (get-internal-ticks) start))
                (float +ticks-per-second+)

-               (float +timer-overhead-iterations+)))))
+               (float *timer-overhead-iterations*)))))

     (let (;; Measure unprofiled calls to estimate call overhead.
          (call-overhead (frob))
          total-overhead
     (let (;; Measure unprofiled calls to estimate call overhead.
          (call-overhead (frob))
          total-overhead

@@ -500,20 +463,22 @@ a very-long-running Lisp process."
            (setf total-overhead
                  (- (frob) call-overhead)))
        (let* ((pinfo (gethash 'compute-overhead-aux
            (setf total-overhead
                  (- (frob) call-overhead)))
        (let* ((pinfo (gethash 'compute-overhead-aux

-                              *profiled-function-name->info*))
+                              *profiled-fun-name->info*))

               (read-stats-fun (profile-info-read-stats-fun pinfo))
               (time (nth-value 1 (funcall read-stats-fun))))
          (setf internal-overhead
                (/ (float time)
                   (float +ticks-per-second+)
               (read-stats-fun (profile-info-read-stats-fun pinfo))
               (time (nth-value 1 (funcall read-stats-fun))))
          (setf internal-overhead
                (/ (float time)
                   (float +ticks-per-second+)

-                  (float +timer-overhead-iterations+))))
+                  (float *timer-overhead-iterations*))))

        (unprofile compute-overhead-aux))
        (unprofile compute-overhead-aux))

-      (make-overhead :call call-overhead
-                    :total total-overhead
-                    :internal internal-overhead))))
+      (prog1
+         (make-overhead :call call-overhead
+                        :total total-overhead
+                        :internal internal-overhead)
+       (format *debug-io* "done~%")))))

 
 ;;; It would be bad to compute *OVERHEAD*, save it into a .core file,
 
 ;;; It would be bad to compute *OVERHEAD*, save it into a .core file,

-;;; then load old *OVERHEAD* value from the .core file into a
+;;; then load the old *OVERHEAD* value from the .core file into a

 ;;; different machine running at a different speed. We avoid this by
 ;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
 (pushnew (lambda ()
 ;;; different machine running at a different speed. We avoid this by
 ;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
 (pushnew (lambda ()