From 5d0c23a705a907acd253635f177a9d2deb61aaa7 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 13 Sep 1991 06:21:43 +0000
Subject: [PATCH] Added noise to output-random to check to see if code
 components have :bogus-lra for their debug-info.  If they do, then just print
 something to that effect, don't try to compiled-debug-info-name the thing.

---
 code/print.lisp | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/code/print.lisp b/code/print.lisp
index dbb029512..611023c35 100644
--- a/code/print.lisp
+++ b/code/print.lisp
@@ -7,11 +7,11 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.21 1991/07/18 13:51:31 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.22 1991/09/13 06:21:43 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.21 1991/07/18 13:51:31 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.22 1991/09/13 06:21:43 wlott Exp $
 ;;;
 ;;; CMU Common Lisp printer.
 ;;;
@@ -1340,11 +1340,15 @@
        (let ((type (get-type object)))
 	 (case type
 	   (#.vm:code-header-type
-	    (write-string "Code Object" stream)
 	    (let ((dinfo (code-header-ref object vm:code-debug-info-slot)))
-	      (when dinfo
-		(write-char #\space stream)
-		(output-object (c::compiled-debug-info-name dinfo) stream))))
+	      (cond ((eq dinfo :bogus-lra)
+		     (write-string "Bogus Code Object" stream))
+		    (t
+		     (write-string "Code Object" stream)
+		     (when dinfo)
+		     (write-char #\space stream)
+		     (output-object (c::compiled-debug-info-name dinfo)
+				    stream)))))
 	   ((#.vm:function-header-type #.vm:closure-function-header-type)
 	    (output-function-object object stream))
 	   (#.vm:return-pc-header-type
-- 
GitLab