0.8.0.24:

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

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 837ff7e..0a257b3 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -47,7 +47,11 @@
 ;;; 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-fun-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))
   (name              (missing-arg) :read-only t)
   (encapsulated-fun  (missing-arg) :type function :read-only t)
@@ -98,8 +102,7 @@
 \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))
     `(if (and (typep ,x '(and fixnum unsigned-byte))
@@ -164,7 +167,7 @@
         (aver (typep dticks 'unsigned-byte))
         (aver (typep dconsing 'unsigned-byte))
         (aver (typep inner-enclosed-profiles 'unsigned-byte))
-        (multiple-value-prog1
+        (unwind-protect
             (let* ((start-ticks (get-internal-ticks))
                    (*enclosed-ticks* 0)
                    (*enclosed-consing* 0)
@@ -172,7 +175,7 @@
                    (nbf0 *n-bytes-freed-or-purified*)
                    (dynamic-usage-0 (sb-kernel:dynamic-usage)))
               (declare (inline pcounter-or-fixnum->integer))
-              (multiple-value-prog1
+              (unwind-protect
                   (multiple-value-call encapsulated-fun
                                        (sb-c:%more-arg-values arg-context
                                                               0
@@ -191,7 +194,9 @@
                         (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 *enclosed-consing*)))
+                  (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))))
@@ -222,9 +227,7 @@
     (etypecase name
       (symbol (funcall function name))
       (list
-       ;; We call this just for the side effect of checking that
-       ;; NAME is a legal function name:
-       (fun-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)))
@@ -443,6 +446,7 @@ Lisp process."
   (flet ((frob ()
           (let ((start (get-internal-ticks))
                 (fun (symbol-function 'compute-overhead-aux)))
+             (declare (type function fun))
             (dotimes (i *timer-overhead-iterations*)
               (funcall fun fun))
             (/ (float (- (get-internal-ticks) start))