0.9.13.50: Windows baby-steps

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index e50eb41..c829c18 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -507,6 +507,21 @@ reset to ~S."
 
   (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)
@@ -518,13 +533,7 @@ reset to ~S."
         ;; 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*)))
@@ -641,16 +650,21 @@ reset to ~S."
 ;;; halt-on-failures and prompt-on-failures modes, suitable for
 ;;; noninteractive and interactive use respectively
 (defun disable-debugger ()
+  ;; Why conditionally? Why not disable it even if user has frobbed
+  ;; this hook? We could just save the old value in case of a later
+  ;; ENABLE-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)))
+    (setf *invoke-debugger-hook* 'debugger-disabled-hook)
+    (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* nil)
+    (sb!alien:alien-funcall (sb!alien:extern-alien "enable_lossage_handler" (function sb!alien:void)))))
 
 (defun show-restarts (restarts s)
   (cond ((null restarts)