From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 14 Oct 2010 04:42:21 +0000 (+0000)
Subject: Make the debugger robust to errors while printing.
X-Git-Tag: 20101212-Gtk~42
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d07d687eb3cb0c9a34bb39bd78c13a89960b840f;p=mit-scheme.git

Make the debugger robust to errors while printing.
---

diff --git a/src/runtime/dbgutl.scm b/src/runtime/dbgutl.scm
index 366c2630b..e1473694d 100644
--- a/src/runtime/dbgutl.scm
+++ b/src/runtime/dbgutl.scm
@@ -74,12 +74,23 @@ USA.
     (if (undefined-value? value)
 	(debugger-message port "No value")
 	(debugger-message port "Value: " value))))
-
+
 (define (output-to-string length thunk)
-  (let ((x (with-output-to-truncated-string length thunk)))
-    (if (and (car x) (> length 4))
-	(substring-move! " ..." 0 4 (cdr x) (- length 4)))
-    (cdr x)))
+  (let ((thunk
+	 (lambda ()
+	   (call-with-current-continuation
+	    (lambda (exit)
+	      (bind-condition-handler (list condition-type:error)
+		  (lambda (condition)
+		    (write-string "<Error while printing: ")
+		    (write-condition-report condition (current-output-port))
+		    (write-string ">")
+		    (exit unspecific))
+		thunk))))))
+    (let ((x (with-output-to-truncated-string length thunk)))
+      (if (and (car x) (> length 4))
+	  (substring-move! " ..." 0 4 (cdr x) (- length 4)))
+      (cdr x))))
 
 (define (show-frames environment depth port)
   (debugger-presentation port