;;; 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.
(defstruct (profile-info (:copier nil))
(name (required-argument) :read-only t)
(encapsulated-fun (required-argument) :type function :read-only t)
(defstruct (profile-info (:copier nil))
(name (required-argument) :read-only t)
(encapsulated-fun (required-argument) :type function :read-only t)
(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
;;; Profile the named function. If already profiled, unprofile first.
(defun profile-1-function (name)
(cond ((fboundp name)
;;; Profile the named function. If already profiled, unprofile first.
(defun profile-1-function (name)
(cond ((fboundp name)
(warn "~S is already profiled, so unprofiling it first." name)
(unprofile-1-function name))
(profile-1-unprofiled-function name))
(warn "~S is already profiled, so unprofiling it first." name)
(unprofile-1-function name))
(profile-1-unprofiled-function name))
;;; Unprofile the named function, if it is profiled.
(defun unprofile-1-function (name)
;;; Unprofile the named function, if it is profiled.
(defun unprofile-1-function (name)
(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"
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)
(declare (ignore profile-info))
(unprofile-1-function name)))
(defun reset ()
"Reset the counters for all profiled functions."
(declare (ignore profile-info))
(unprofile-1-function name)))
(defun reset ()
"Reset the counters for all profiled functions."
(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.~@