From a79a7c8a9c815958ccbe515ca66698dee4e8ff16 Mon Sep 17 00:00:00 2001
From: emarsden <emarsden>
Date: Sun, 16 Feb 2003 19:05:19 +0000
Subject: [PATCH] Fix an assertion on function names when dumping minimal debug
 info to use VALID-FUNCTION-NAME-P, instead of checking for (setf xxx) names.

Declare two new valid function name classes: names of the form

   (:macro foo)
   (:compiler-macro foo)

that are now used to name lambda nodes in IR1.
---
 code/fdefinition.lisp    | 11 ++++++++++-
 compiler/debug-dump.lisp |  9 ++++++---
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/code/fdefinition.lisp b/code/fdefinition.lisp
index f4e7d0ae6..a0df30aad 100644
--- a/code/fdefinition.lisp
+++ b/code/fdefinition.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/fdefinition.lisp,v 1.20 2003/02/05 11:08:44 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fdefinition.lisp,v 1.21 2003/02/16 19:05:19 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -87,6 +87,15 @@
 	 (unless (eq 'setf (car fn))
 	   (valid-function-name-p fn)))))))
 
+(define-function-name-syntax :macro (name)
+  (when (eql 2 (length name))
+    (valid-function-name-p (second name))))
+
+(define-function-name-syntax :compiler-macro (name)
+  (when (eql 2 (length name))
+    (valid-function-name-p (second name))))
+
+
 
 ;;;; Fdefinition (fdefn) objects.
 
diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp
index cbe98e867..9db4b595d 100644
--- a/compiler/debug-dump.lisp
+++ b/compiler/debug-dump.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/compiler/debug-dump.lisp,v 1.43 2003/02/06 14:25:58 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.44 2003/02/16 19:05:19 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -651,7 +651,11 @@
   (let* ((name (compiled-debug-function-name dfun))
 	 (setf-p (and (consp name) (eq (car name) 'setf)
 		      (consp (cdr name)) (symbolp (cadr name))))
-	 (base-name (if setf-p (cadr name) name))
+         (base-name (if (stringp name) name
+                        (multiple-value-bind (valid block-name)
+                            (valid-function-name-p name)
+                          (assert valid)
+                          block-name)))
 	 (pkg (when (symbolp base-name)
 		(symbol-package base-name)))
 	 (name-rep
@@ -663,7 +667,6 @@
 		 minimal-debug-function-name-symbol)
 		(t
 		 minimal-debug-function-name-packaged))))
-    (assert (or (stringp name) (valid-function-name-p name)))
     (let ((options 0))
       (setf (ldb minimal-debug-function-name-style-byte options) name-rep)
       (setf (ldb minimal-debug-function-kind-byte options)
-- 
GitLab