X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=b3876e87cca2b372b8f155bf64b150dc5db41135;hb=2da80a5263e44a824675283340b2253db2348f5e;hp=927ba8842811debcb47ca93dd4d548f7cad22f07;hpb=f06a378c741965a906b6a042c9420efb9c51198f;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 927ba88..b3876e8 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -644,7 +644,9 @@ Other commands:
 (defvar *debug-condition*)
 (defvar *nested-debug-condition*)
 
-(defun invoke-debugger (condition)
+;;; the ordinary ANSI case of INVOKE-DEBUGGER, when not suppressed by
+;;; command-line --disable-debugger option
+(defun invoke-debugger/enabled (condition)
   #!+sb-doc
   "Enter the debugger."
   (let ((old-hook *debugger-hook*))
@@ -786,13 +788,82 @@ reset to ~S."
 	      (internal-debug))
 	 (when background-p (sb!thread::release-foreground)))))))
 
+;;; the degenerate case of INVOKE-DEBUGGER, when ordinary ANSI behavior
+;;; has been suppressed by command-line --disable-debugger option
+(defun invoke-debugger/disabled (condition)
+  ;; There is no one there to interact with, so report the
+  ;; condition and terminate the program.
+  (flet ((failure-quit (&key recklessly-p)
+           (/show0 "in FAILURE-QUIT (in --disable-debugger debugger hook)")
+	   (quit :unix-status 1 :recklessly-p recklessly-p)))
+    ;; This HANDLER-CASE is here mostly to stop output immediately
+    ;; (and fall through to QUIT) when there's an I/O error. Thus,
+    ;; when we're run under a shell script or something, we can die
+    ;; cleanly when the script dies (and our pipes are cut), instead
+    ;; of falling into ldb or something messy like that. Similarly, we
+    ;; can terminate cleanly even if BACKTRACE dies because of bugs in
+    ;; user PRINT-OBJECT methods.
+    (handler-case
+	(progn
+	  (format *error-output*
+		  "~&~@<unhandled condition (of type ~S): ~2I~_~A~:>~2%"
+		  (type-of condition)
+		  condition)
+	  ;; Flush *ERROR-OUTPUT* even before the BACKTRACE, so that
+	  ;; even if we hit an error within BACKTRACE (e.g. a bug in
+	  ;; the debugger's own frame-walking code, or a bug in a user
+	  ;; PRINT-OBJECT method) we'll at least have the CONDITION
+	  ;; printed out before we die.
+	  (finish-output *error-output*)
+	  ;; (Where to truncate the BACKTRACE is of course arbitrary, but
+	  ;; it seems as though we should at least truncate it somewhere.)
+	  (sb!debug:backtrace 128 *error-output*)
+	  (format
+	   *error-output*
+	   "~%unhandled condition in --disable-debugger mode, quitting~%")
+	  (finish-output *error-output*)
+	  (failure-quit))
+      (condition ()
+	;; We IGNORE-ERRORS here because even %PRIMITIVE PRINT can
+	;; fail when our output streams are blown away, as e.g. when
+	;; we're running under a Unix shell script and it dies somehow
+	;; (e.g. because of a SIGINT). In that case, we might as well
+	;; just give it up for a bad job, and stop trying to notify
+	;; the user of anything.
+        ;;
+        ;; Actually, the only way I've run across to exercise the
+	;; problem is to have more than one layer of shell script.
+	;; I have a shell script which does
+	;;   time nice -10 sh make.sh "$1" 2>&1 | tee make.tmp
+	;; and the problem occurs when I interrupt this with Ctrl-C
+	;; under Linux 2.2.14-5.0 and GNU bash, version 1.14.7(1).
+        ;; I haven't figured out whether it's bash, time, tee, Linux, or
+	;; what that is responsible, but that it's possible at all
+	;; means that we should IGNORE-ERRORS here. -- WHN 2001-04-24
+        (ignore-errors
+         (%primitive print
+		     "Argh! error within --disable-debugger error handling"))
+	(failure-quit :recklessly-p t)))))
+
+;;; halt-on-failures and prompt-on-failures modes, suitable for
+;;; noninteractive and interactive use respectively
+(defun disable-debugger ()
+  (setf (fdefinition 'invoke-debugger) #'invoke-debugger/disabled
+	*debug-io* *error-output*))
+(defun enable-debugger ()
+  (setf (fdefinition 'invoke-debugger) #'invoke-debugger/enabled
+	*debug-io* *query-io*))
+;;; The enabled mode is the ANSI default.
+(enable-debugger)
+
 (defun show-restarts (restarts s)
   (cond ((null restarts)
 	 (format s
 		 "~&(no restarts: If you didn't do this on purpose, ~
                   please report it as a bug.)~%"))
 	(t
-	 (format s "~&restarts:~%")
+	 (format s "~&restarts (invokable by number or by ~
+                    possibly-abbreviated name):~%")
 	 (let ((count 0)
 	       (names-used '(nil))
 	       (max-name-len 0))