X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=0a257b35aa656dd51c0932cdb7abd674d6fc3cda;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=dbdc65e77263c321b50a0a2d569049de4c16bfd2;hpb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index dbdc65e..0a257b3 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))))
@@ -217,14 +222,12 @@
 
 ;;; 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
-       ;; 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)))
@@ -239,7 +242,7 @@
 
 ;;; 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)
@@ -254,18 +257,18 @@
       (values))))
 
 ;;; Profile the named function. If already profiled, unprofile first.
-(defun profile-1-function (name)
+(defun profile-1-fun (name)
   (cond ((fboundp name)
 	 (when (gethash name *profiled-fun-name->info*)
 	   (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.
-(defun unprofile-1-function (name)
+(defun unprofile-1-fun (name)
   (let ((pinfo (gethash name *profiled-fun-name->info*)))
     (cond (pinfo
 	   (remhash name *profiled-fun-name->info*)
@@ -293,7 +296,7 @@
   (if (null names)
       `(loop for k being each hash-key in *profiled-fun-name->info*
 	     collecting k)
-      `(mapc-on-named-functions #'profile-1-function ',names)))
+      `(mapc-on-named-funs #'profile-1-fun ',names)))
 
 (defmacro unprofile (&rest names)
   #+sb-doc
@@ -303,13 +306,13 @@
   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 ()
   (dohash (name profile-info *profiled-fun-name->info*)
     (declare (ignore profile-info))
-    (unprofile-1-function name)))
+    (unprofile-1-fun name)))
 
 (defun reset ()
   "Reset the counters for all profiled functions."
@@ -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))