;;; 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)
\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))
(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)
(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
(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))))
(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)