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