diff --git a/code/profile.lisp b/code/profile.lisp index 56dd147e328e7cf29a368582d21b88b9a366f0e4..915719f278b0bc0c7b594847be9a5f13dd9be16a 100644 --- a/code/profile.lisp +++ b/code/profile.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.38 2004/05/04 14:29:13 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.39 2004/09/28 16:43:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -339,6 +339,7 @@ this, the functions are listed. If NIL, then always list the functions.") (def-profile-fwrapper 2) (def-profile-fwrapper 3)) +#+(or) (defun ensure-profile-fwrapper (nreq optionals-p) "Ensure that a profile fwrapper for functions with NREQ required arguments and optional arguments according to OPTIONALS-P exists. @@ -350,6 +351,21 @@ this, the functions are listed. If NIL, then always list the functions.") (compile name))) name)) +(defun ensure-profile-fwrapper (nreq optionals-p) + "Ensure that a profile fwrapper for functions with NREQ required + arguments and optional arguments according to OPTIONALS-P exists. + Return the name of that fwrapper." + (let ((name (make-profile-fwrapper-name nreq optionals-p))) + (unless (fboundp name) + (without-package-locks + ;; I (rtoy) do not know why the above version does not work, + ;; but this seems to work better. + (destructuring-bind (def name args &body body) + (macroexpand-1 (make-profile-fwrapper nreq optionals-p)) + (declare (ignore def)) + (compile name `(lambda ,args ,@body))))) + name)) + (defun find-profile-fwrapper (name) "Return the profile FWRAPPER object on function NAME, if any." (find-fwrapper name :type 'profile))