- (show-restarts *debug-restarts* *error-output*))
- (internal-debug))))))
-
-(defun show-restarts (restarts &optional (s *error-output*))
- (when restarts
- (format s "~&restarts:~%")
- (let ((count 0)
- (names-used '(nil))
- (max-name-len 0))
- (dolist (restart restarts)
- (let ((name (restart-name restart)))
- (when name
- (let ((len (length (princ-to-string name))))
- (when (> len max-name-len)
- (setf max-name-len len))))))
- (unless (zerop max-name-len)
- (incf max-name-len 3))
- (dolist (restart restarts)
- (let ((name (restart-name restart)))
- (cond ((member name names-used)
- (format s "~& ~2D: ~@VT~A~%" count max-name-len restart))
- (t
- (format s "~& ~2D: [~VA] ~A~%"
- count (- max-name-len 3) name restart)
- (push name names-used))))
- (incf count)))))
-
-;;; This calls DEBUG-LOOP, performing some simple initializations before doing
-;;; so. INVOKE-DEBUGGER calls this to actually get into the debugger.
-;;; SB!CONDITIONS::ERROR-ERROR calls this in emergencies to get into a debug
-;;; prompt as quickly as possible with as little risk as possible for stepping
-;;; on whatever is causing recursive errors.
+ (when *debug-beginner-help-p*
+ (format *debug-io*
+ "~%~@<Within the debugger, you can type HELP for help. ~
+ At any command prompt (within the debugger or not) you ~
+ can type (SB-EXT:QUIT) to terminate the SBCL ~
+ executable. The condition which caused the debugger to ~
+ be entered is bound to ~S. You can suppress this ~
+ message by clearing ~S.~:@>~2%"
+ '*debug-condition*
+ '*debug-beginner-help-p*))
+ (show-restarts *debug-restarts* *debug-io*))
+ (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 (invokable by number or by ~
+ possibly-abbreviated name):~%")
+ (let ((count 0)
+ (names-used '(nil))
+ (max-name-len 0))
+ (dolist (restart restarts)
+ (let ((name (restart-name restart)))
+ (when name
+ (let ((len (length (princ-to-string name))))
+ (when (> len max-name-len)
+ (setf max-name-len len))))))
+ (unless (zerop max-name-len)
+ (incf max-name-len 3))
+ (dolist (restart restarts)
+ (let ((name (restart-name restart)))
+ (cond ((member name names-used)
+ (format s "~& ~2D: ~V@T~A~%" count max-name-len restart))
+ (t
+ (format s "~& ~2D: [~VA] ~A~%"
+ count (- max-name-len 3) name restart)
+ (push name names-used))))
+ (incf count))))))
+
+;;; This calls DEBUG-LOOP, performing some simple initializations
+;;; before doing so. INVOKE-DEBUGGER calls this to actually get into
+;;; the debugger. SB!KERNEL::ERROR-ERROR calls this in emergencies
+;;; to get into a debug prompt as quickly as possible with as little
+;;; risk as possible for stepping on whatever is causing recursive
+;;; errors.