X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=8229b1ce720a4432ab7961548554c322add579c2;hb=01044af1b8d69fc3899dc0417064c1512223223d;hp=1f4f79332a980b1e2138d4cdbbe6c6cde94f600c;hpb=148e3820ad314a9b59d0133c1d60eaac4af9118b;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 1f4f793..8229b1c 100644
--- 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 @@
 
 ;;;; 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))))
@@ -228,7 +233,9 @@
       (string (let ((package (find-undeleted-package-or-lose name)))
 		(do-symbols (symbol package)
 		  (when (eq (symbol-package symbol) package)
-		    (when (fboundp symbol)
+		    (when (and (fboundp symbol)
+			       (not (macro-function symbol))
+			       (not (special-operator-p symbol)))
 		      (funcall function symbol))
 		    (let ((setf-name `(setf ,symbol)))
 		      (when (fboundp setf-name)