From 747fd9ad8644c9eba1fcb33ff4e58d2160e9aefc Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 28 Sep 2004 16:43:26 +0000 Subject: [PATCH] Fix bug in profile-all not being able to profile all symbols because ensure-profile-fwrapper was not able to create profile fwrappers for 4 or more args. This is a hack; I don't know why the original version doesn't work. --- code/profile.lisp | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/code/profile.lisp b/code/profile.lisp index 56dd147e3..915719f27 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)) -- GitLab