1.0.45.33: optimize CHARPOS on string-streams

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

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 165a874..c89794b 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -482,20 +482,24 @@ is how many frames to show."
                 (nreverse (mapcar #'cdr *debug-print-variable-alist*))
               (apply fun rest)))))))
 
+;;; This function is not inlined so it shows up in the backtrace; that
+;;; can be rather handy when one has to debug the interplay between
+;;; *INVOKE-DEBUGGER-HOOK* and *DEBUGGER-HOOK*.
+(declaim (notinline run-hook))
+(defun run-hook (variable condition)
+  (let ((old-hook (symbol-value variable)))
+    (when old-hook
+      (progv (list variable) (list nil)
+        (funcall old-hook condition old-hook)))))
+
 (defun invoke-debugger (condition)
   #!+sb-doc
   "Enter the debugger."
 
   ;; call *INVOKE-DEBUGGER-HOOK* first, so that *DEBUGGER-HOOK* is not
   ;; called when the debugger is disabled
-  (let ((old-hook *invoke-debugger-hook*))
-    (when old-hook
-      (let ((*invoke-debugger-hook* nil))
-        (funcall old-hook condition old-hook))))
-  (let ((old-hook *debugger-hook*))
-    (when old-hook
-      (let ((*debugger-hook* nil))
-        (funcall old-hook condition old-hook))))
+  (run-hook '*invoke-debugger-hook* condition)
+  (run-hook '*debugger-hook* condition)
 
   ;; We definitely want *PACKAGE* to be of valid type.
   ;;
@@ -663,6 +667,8 @@ reset to ~S."
 ;;; halt-on-failures and prompt-on-failures modes, suitable for
 ;;; noninteractive and interactive use respectively
 (defun disable-debugger ()
+  "When invoked, this function will turn off both the SBCL debugger
+and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
   ;; *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,
@@ -677,6 +683,7 @@ reset to ~S."
                                                  (function sb!alien:void))))
 
 (defun enable-debugger ()
+  "Restore the debugger if it has been turned off by DISABLE-DEBUGGER."
   (when (eql *invoke-debugger-hook* 'debugger-disabled-hook)
     (setf *invoke-debugger-hook* *old-debugger-hook*
           *old-debugger-hook* nil))
@@ -813,9 +820,14 @@ reset to ~S."
    forms that explicitly control this kind of evaluation.")
 
 (defun debug-eval (expr)
-  (if (and (fboundp 'compile) *auto-eval-in-frame*)
-      (sb!di:eval-in-frame *current-frame* expr)
-      (eval expr)))
+  (cond ((not (and (fboundp 'compile) *auto-eval-in-frame*))
+         (eval expr))
+        ((frame-has-debug-vars-p *current-frame*)
+         (sb!di:eval-in-frame *current-frame* expr))
+        (t
+         (format *debug-io* "; No debug variables for current frame: ~
+                               using EVAL instead of EVAL-IN-FRAME.~%")
+         (eval expr))))
 
 (defun debug-eval-print (expr)
   (/noshow "entering DEBUG-EVAL-PRINT" expr)
@@ -1542,6 +1554,11 @@ reset to ~S."
   #!-unwind-to-frame-and-call-vop
   (find 'sb!c:debug-catch-tag (sb!di::frame-catches frame) :key #'car))
 
+(defun frame-has-debug-vars-p (frame)
+  (sb!di:debug-var-info-available
+   (sb!di:code-location-debug-fun
+    (sb!di:frame-code-location frame))))
+
 ;; Hack: ensure that *U-T-F-F* has a tls index.
 #!+unwind-to-frame-and-call-vop
 (let ((sb!vm::*unwind-to-frame-function* (lambda ()))))