From f3c4f1a384aee2157a3a2f78a7eefba19ffa9c73 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Sat, 19 Mar 1994 23:48:52 +0000
Subject: [PATCH] Enhancement from Harris to not abort printing of a frame when
 printing one arg gets an error.

---
 code/debug.lisp | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/code/debug.lisp b/code/debug.lisp
index ae8c4a76d..bc5e18720 100644
--- a/code/debug.lisp
+++ b/code/debug.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.40 1994/02/14 13:21:57 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.41 1994/03/19 23:48:52 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -536,6 +536,7 @@ See the CMU Common Lisp User's Manual for more information.
 				       (unprintable-object-string x)))))
   string)
 
+
 ;;; PRINT-FRAME-CALL-1 -- Internal.
 ;;;
 ;;; This prints frame with verbosity level 1.  If we hit a rest-arg, 
@@ -568,18 +569,28 @@ See the CMU Common Lisp User's Manual for more information.
       (di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda-list-unavailable") results)))
-    (prin1 (nreverse results))
+    (prin1 (mapcar #'ensure-printable-object (nreverse results)))
     (when (di:debug-function-kind d-fun)
       (write-char #\[)
       (prin1 (di:debug-function-kind d-fun))
       (write-char #\]))))
-;;;
+
+(defun ensure-printable-object (object)
+  (handler-case
+      (with-open-stream (out (make-broadcast-stream))
+	(prin1 object out)
+	object)
+    (error (cond)
+      (declare (ignore cond))
+      (make-unprintable-object "error printing object"))))
+
 (defun frame-call-arg (var location frame)
   (lambda-var-dispatch var location
     (make-unprintable-object "unused-arg")
     (di:debug-variable-value var frame)
     (make-unprintable-object "unavailable-arg")))
 
+
 ;;; PRINT-FRAME-CALL -- Interface
 ;;;
 ;;; This prints a representation of the function call causing frame to exist.
-- 
GitLab