From 335cf6acff157c26cc5b0902819985825e130e4f Mon Sep 17 00:00:00 2001
From: pw <pw>
Date: Sat, 27 Jan 2001 14:18:14 +0000
Subject: [PATCH] Handle the case of lisp running on a remote system and the
 network connection breaks. Previously the remote lisp would enter an infinite
 loop in debug-loop because of trying to read the now dead *debug-io* stream.

---
 code/debug.lisp | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/code/debug.lisp b/code/debug.lisp
index 99c3e8eab..5df012ae8 100644
--- a/code/debug.lisp
+++ b/code/debug.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/debug.lisp,v 1.49 1999/08/13 16:41:55 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.50 2001/01/27 14:18:14 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -716,6 +716,28 @@ See the CMU Common Lisp User's Manual for more information.
   "When non-NIL, becomes the system *READTABLE* in the debugger
    read-eval-print loop")
 
+(defun maybe-handle-dead-input-stream (condition)
+  ;; Scenario: "xon <remote-box> cmucl -edit"
+  ;; Then close the display with the window manager or shutdown the
+  ;; local computer. The remote lisp goes into infinite error loop.
+  (labels ((real-stream (stream)
+	     (etypecase stream
+	       (system:fd-stream
+		(values stream (system:fd-stream-fd stream)))
+	       (synonym-stream
+		(real-stream (symbol-value (synonym-stream-symbol stream))))
+	       (two-way-stream
+		(real-stream (two-way-stream-input-stream stream))))))
+
+    (when (typep condition 'stream-error)
+      (let* ((stream-with-error (stream-error-stream condition))
+	     (real-stream-with-error (real-stream stream-with-error))
+	     (real-debug-io  (real-stream *debug-io*)))
+	(when (and (eq real-stream-with-error real-debug-io)
+		   (not (unix:unix-isatty (system:fd-stream-fd real-debug-io))))
+	  ;; Probably running on a remote processor and lost the connection.
+	  (ext:quit))))))
+
 (defun debug-loop ()
   (let* ((*debug-command-level* (1+ *debug-command-level*))
 	 (*real-stack-top* (di:top-frame))
@@ -731,6 +753,7 @@ See the CMU Common Lisp User's Manual for more information.
       (loop
 	(catch 'debug-loop-catcher
 	  (handler-bind ((error #'(lambda (condition)
+				    (maybe-handle-dead-input-stream condition)
 				    (when *flush-debug-errors*
 				      (clear-input *debug-io*)
 				      (princ condition)
-- 
GitLab