) ; EVAL-WHEN
-;;; This is used in constructing arg lists for debugger printing when
-;;; the arg list is unavailable, some arg is unavailable or unused, etc.
-(defstruct (unprintable-object
- (:constructor make-unprintable-object (string))
- (:print-object (lambda (x s)
- (print-unreadable-object (x s)
- (write-string (unprintable-object-string x)
- s))))
- (:copier nil))
- string)
-
;;; Extract the function argument values for a debug frame.
(defun frame-args-as-list (frame)
(let ((debug-fun (sb!di:frame-debug-fun frame))
(funcall-with-debug-io-syntax #'%invoke-debugger condition))
+(defun %print-debugger-invocation-reason (condition stream)
+ (format stream "~2&")
+ ;; Note: Ordinarily it's only a matter of taste whether to use
+ ;; FORMAT "~<...~:>" or to use PPRINT-LOGICAL-BLOCK directly, but
+ ;; until bug 403 is fixed, PPRINT-LOGICAL-BLOCK (STREAM NIL) is
+ ;; definitely preferred, because the FORMAT alternative was acting odd.
+ (pprint-logical-block (stream nil)
+ (format stream
+ "debugger invoked on a ~S~@[ in thread ~A~]: ~2I~_~A"
+ (type-of condition)
+ #!+sb-thread sb!thread:*current-thread*
+ #!-sb-thread nil
+ condition))
+ (terpri stream))
+
(defun %invoke-debugger (condition)
(let ((*debug-condition* condition)
;; 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~]: ~
- ~2I~_~A~:>~%"
- (type-of *debug-condition*)
- #!+sb-thread sb!thread:*current-thread*
- #!-sb-thread nil
- *debug-condition*)
+ (%print-debugger-invocation-reason condition *error-output*)
(error (condition)
(setf *nested-debug-condition* condition)
(let ((ndc-type (type-of *nested-debug-condition*)))
'*debug-condition*
ndc-type
'*nested-debug-condition*))
- (when (typep condition 'cell-error)
+ (when (typep *nested-debug-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*)))))
+ '*nested-debug-condition*
+ (cell-error-name *nested-debug-condition*)))))
(let ((background-p (sb!thread::debugger-wait-until-foreground-thread
*debug-io*)))
"Argh! error within --disable-debugger error handling"))
(failure-quit :recklessly-p t)))))
+(defvar *old-debugger-hook* nil)
+
;;; halt-on-failures and prompt-on-failures modes, suitable for
;;; noninteractive and interactive use respectively
(defun disable-debugger ()
- (when (eql *invoke-debugger-hook* nil)
- ;; *DEBUG-IO* used to be set here to *ERROR-OUTPUT* which is sort
- ;; of unexpected but mostly harmless, but then ENABLE-DEBUGGER had
- ;; to set it to a suitable value again and be very careful,
- ;; especially if the user has also set it. -- MG 2005-07-15
- (setf *invoke-debugger-hook* 'debugger-disabled-hook)))
+ ;; *DEBUG-IO* used to be set here to *ERROR-OUTPUT* which is sort
+ ;; of unexpected but mostly harmless, but then ENABLE-DEBUGGER had
+ ;; to set it to a suitable value again and be very careful,
+ ;; especially if the user has also set it. -- MG 2005-07-15
+ (unless (eq *invoke-debugger-hook* 'debugger-disabled-hook)
+ (setf *old-debugger-hook* *invoke-debugger-hook*
+ *invoke-debugger-hook* 'debugger-disabled-hook))
+ ;; This is not inside the UNLESS to ensure that LDB is disabled
+ ;; regardless of what the old value of *INVOKE-DEBUGGER-HOOK* was.
+ ;; This might matter for example when restoring a core.
+ (sb!alien:alien-funcall (sb!alien:extern-alien "disable_lossage_handler"
+ (function sb!alien:void))))
(defun enable-debugger ()
(when (eql *invoke-debugger-hook* 'debugger-disabled-hook)
- (setf *invoke-debugger-hook* nil)))
+ (setf *invoke-debugger-hook* *old-debugger-hook*
+ *old-debugger-hook* nil))
+ (sb!alien:alien-funcall (sb!alien:extern-alien "enable_lossage_handler"
+ (function sb!alien:void))))
(defun show-restarts (restarts s)
(cond ((null restarts)