Skip to content
Snippets Groups Projects
Commit a79a7c8a authored by emarsden's avatar emarsden
Browse files

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.
parent 9ef185c4
No related branches found
No related tags found
No related merge requests found
......@@ -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.
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment