- (*readtable* *debug-readtable*)
- (*print-readably* nil)
- (*package* original-package)
- (background-p nil)
- (*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: ~
+ (*readtable* *debug-readtable*))
+ (progv
+ ;; (Why NREVERSE? PROGV makes the later entries have
+ ;; precedence over the earlier entries. *PRINT-VAR-ALIST*
+ ;; is called an alist, so it's expected that its earlier
+ ;; entries have precedence. And the earlier-has-precedence
+ ;; behavior is mostly more convenient, so that programmers
+ ;; can use PUSH or LIST* to customize *PRINT-VAR-ALIST*.)
+ (nreverse (mapcar #'car *debug-print-variable-alist*))
+ (nreverse (mapcar #'cdr *debug-print-variable-alist*))
+ (apply fun rest))))))
+
+;;; the ordinary ANSI case of INVOKE-DEBUGGER, when not suppressed by
+;;; command-line --disable-debugger option
+(defun invoke-debugger (condition)
+ #!+sb-doc
+ "Enter the debugger."
+
+ (let ((old-hook *debugger-hook*))
+ (when old-hook
+ (let ((*debugger-hook* nil))
+ (funcall old-hook condition old-hook))))
+ (let ((old-hook *invoke-debugger-hook*))
+ (when old-hook
+ (let ((*invoke-debugger-hook* nil))
+ (funcall old-hook condition old-hook))))
+
+ ;; Note: CMU CL had (SB-UNIX:UNIX-SIGSETMASK 0) here, to reset the
+ ;; signal state in the case that we wind up in the debugger as a
+ ;; result of something done by a signal handler. It's not
+ ;; altogether obvious that this is necessary, and indeed SBCL has
+ ;; not been doing it since 0.7.8.5. But nobody seems altogether
+ ;; convinced yet
+ ;; -- dan 2003.11.11, based on earlier comment of WHN 2002-09-28
+
+ ;; We definitely want *PACKAGE* to be of valid type.
+ ;;
+ ;; Elsewhere in the system, we use the SANE-PACKAGE function for
+ ;; this, but here causing an exception just as we're trying to handle
+ ;; an exception would be confusing, so instead we use a special hack.
+ (unless (and (packagep *package*)
+ (package-name *package*))
+ (setf *package* (find-package :cl-user))
+ (format *error-output*
+ "The value of ~S was not an undeleted PACKAGE. It has been
+reset to ~S."
+ '*package* *package*))
+
+ ;; 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)
+
+ (funcall-with-debug-io-syntax #'%invoke-debugger condition))
+
+(defun %invoke-debugger (condition)
+
+ (let ((*debug-condition* condition)
+ (*debug-restarts* (compute-restarts condition))
+ (*nested-debug-condition* nil))
+ (handler-case
+ ;; (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.)
+ (format *error-output*
+ "~2&~@<debugger invoked on a ~S in thread ~A: ~