- (let* ((*debug-condition* condition)
- (*debug-restarts* (compute-restarts condition))
- ;; FIXME: The next two bindings seem flaky, violating the
- ;; principle of least surprise. But in order to fix them,
- ;; we'd need to go through all the i/o statements in the
- ;; debugger, since a lot of them do their thing on
- ;; *STANDARD-INPUT* and *STANDARD-OUTPUT* instead of
- ;; *DEBUG-IO*.
- (*standard-input* *debug-io*) ; in case of setq
- (*standard-output* *debug-io*) ; '' '' '' ''
- ;; We want the i/o subsystem to be in a known, useful
- ;; state, regardless of where the debugger was invoked in
- ;; the program. WITH-STANDARD-IO-SYNTAX does some of that,
- ;; but
- ;; 1. It doesn't affect our internal special variables
- ;; like *CURRENT-LEVEL*.
- ;; 2. It isn't customizable.
- ;; 3. It doesn't set *PRINT-READABLY* or *PRINT-PRETTY*
- ;; to the same value as the toplevel default.
- ;; 4. It sets *PACKAGE* to COMMON-LISP-USER, which is not
- ;; helpful behavior for a debugger.
- ;; We try to remedy all these problems with explicit
- ;; rebindings here.
- (sb!kernel:*current-level* 0)
- (*print-length* *debug-print-length*)
- (*print-level* *debug-print-level*)
- (*readtable* *debug-readtable*)
- (*print-readably* nil)
- (*print-pretty* t)
- (*package* original-package))
- #!+sb-show (sb!conditions::show-condition *debug-condition*
- *error-output*)
- (format *error-output*
- "~2&debugger invoked on ~S of type ~S:~% "
- '*debug-condition*
- (type-of *debug-condition*))
- (princ-debug-condition-carefully *error-output*)
- (terpri *error-output*)
- (let (;; FIXME: like the bindings of *STANDARD-INPUT* and
- ;; *STANDARD-OUTPUT* above..
+ (let ((*debug-condition* condition)
+ (*debug-restarts* (compute-restarts condition))
+ (*nested-debug-condition* nil)
+ ;; We want the printer and reader to be in a useful state,
+ ;; regardless of where the debugger was invoked in the
+ ;; program. WITH-STANDARD-IO-SYNTAX did much of what we
+ ;; want, but
+ ;; * It doesn't affect our internal special variables
+ ;; like *CURRENT-LEVEL-IN-PRINT*.
+ ;; * It isn't customizable.
+ ;; * It doesn't set *PRINT-READABLY* to the same value
+ ;; as the toplevel default.
+ ;; * It sets *PACKAGE* to COMMON-LISP-USER, which is not
+ ;; helpful behavior for a debugger.
+ ;; * There's no particularly good debugger default for
+ ;; *PRINT-PRETTY*, since T is usually what you want
+ ;; -- except absolutely not what you want when you're
+ ;; debugging failures in PRINT-OBJECT logic.
+ ;; We try to address all these issues with explicit
+ ;; rebindings here.
+ (sb!kernel:*current-level-in-print* 0)
+ (*print-length* *debug-print-length*)
+ (*print-level* *debug-print-level*)
+ (*readtable* *debug-readtable*)
+ (*print-readably* nil)
+ (*package* original-package)
+ (*print-pretty* original-print-pretty))
+
+ ;; Before we start our own output, finish any pending output.
+ ;; Otherwise, if the user tried to track the progress of his
+ ;; program using PRINT statements, he'd tend to lose the last
+ ;; line of output or so, which'd be confusing.
+ (flush-standard-output-streams)
+
+ ;; (The initial output here goes to *ERROR-OUTPUT*, because the
+ ;; initial output is not interactive, just an error message,
+ ;; and when people redirect *ERROR-OUTPUT*, they could
+ ;; reasonably expect to see error messages logged there,
+ ;; regardless of what the debugger does afterwards.)
+ (handler-case
+ (format *error-output*
+ "~2&~@<debugger invoked on condition of type ~S: ~
+ ~2I~_~A~:>~%"
+ (type-of *debug-condition*)
+ *debug-condition*)
+ (error (condition)
+ (setf *nested-debug-condition* condition)
+ (let ((ndc-type (type-of *nested-debug-condition*)))
+ (format *error-output*
+ "~&~@<(A ~S was caught when trying to print ~S when ~
+ entering the debugger. Printing was aborted and the ~
+ ~S was stored in ~S.)~@:>~%"
+ ndc-type
+ '*debug-condition*
+ ndc-type
+ '*nested-debug-condition*))
+ (when (typep condition 'cell-error)
+ ;; what we really want to know when it's e.g. an UNBOUND-VARIABLE:
+ (format *error-output*
+ "~&(CELL-ERROR-NAME ~S) = ~S~%"
+ '*debug-condition*
+ (cell-error-name *debug-condition*)))))
+
+ ;; After the initial error/condition/whatever announcement to
+ ;; *ERROR-OUTPUT*, we become interactive, and should talk on
+ ;; *DEBUG-IO* from now on. (KLUDGE: This is a normative
+ ;; statement, not a description of reality.:-| There's a lot of
+ ;; older debugger code which was written to do i/o on whatever
+ ;; stream was in fashion at the time, and not all of it has
+ ;; been converted to behave this way. -- WHN 2000-11-16)
+ (let (;; FIXME: Rebinding *STANDARD-OUTPUT* here seems wrong,
+ ;; violating the principle of least surprise, and making
+ ;; it impossible for the user to do reasonable things
+ ;; like using PRINT at the debugger prompt to send output
+ ;; to the program's ordinary (possibly
+ ;; redirected-to-a-file) *STANDARD-OUTPUT*. (CMU CL
+ ;; used to rebind *STANDARD-INPUT* here too, but that's
+ ;; been fixed already.)
+ (*standard-output* *debug-io*)
+ ;; This seems reasonable: e.g. if the user has redirected
+ ;; *ERROR-OUTPUT* to some log file, it's probably wrong
+ ;; to send errors which occur in interactive debugging to
+ ;; that file, and right to send them to *DEBUG-IO*.