X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=05cef22c98a7355fc897cb0c951302160a3e630d;hb=71b57577217f8efce2077b8840cca6612c2777f8;hp=86bfc43d6012fda2f44b6816a26e3234c8b7ac83;hpb=73bb131bdfdae693f6c94ef5db98aba35f61bacf;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 86bfc43..05cef22 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -331,9 +331,7 @@ is how many frames to show."
       (multiple-value-bind (name args)
           (clean-name-and-args (sb!di:debug-fun-name debug-fun)
                                 (frame-args-as-list frame))
-        (values name args
-                (when *show-entry-point-details*
-                  (sb!di:debug-fun-kind debug-fun)))))))
+        (values name args (sb!di:debug-fun-kind debug-fun))))))
 
 (defun ensure-printable-object (object)
   (handler-case
@@ -484,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.
   ;;
@@ -665,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,
@@ -679,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))
@@ -808,9 +813,21 @@ reset to ~S."
                        (t
                         (funcall cmd-fun))))))))))))
 
+(defvar *auto-eval-in-frame* t
+  #!+sb-doc
+  "When set (the default), evaluations in the debugger's command loop occur
+   relative to the current frame's environment without the need of debugger
+   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)))
+
 (defun debug-eval-print (expr)
   (/noshow "entering DEBUG-EVAL-PRINT" expr)
-  (let ((values (multiple-value-list (interactive-eval expr))))
+  (let ((values (multiple-value-list
+                 (interactive-eval expr :eval #'debug-eval))))
     (/noshow "done with EVAL in DEBUG-EVAL-PRINT")
     (dolist (value values)
       (fresh-line *debug-io*)
@@ -1273,9 +1290,12 @@ reset to ~S."
         (values *cached-form-number-translations* *cached-toplevel-form*)
         (let* ((offset (sb!di:code-location-toplevel-form-offset location))
                (res
-                (ecase (sb!di:debug-source-from d-source)
-                  (:file (get-file-toplevel-form location))
-                  (:lisp (svref (sb!di:debug-source-name d-source) offset)))))
+                (cond ((sb!di:debug-source-namestring d-source)
+                       (get-file-toplevel-form location))
+                      ((sb!di:debug-source-form d-source)
+                       (sb!di:debug-source-form d-source))
+                      (t (bug "Don't know how to use a DEBUG-SOURCE without ~
+                               a namestring or a form.")))))
           (setq *cached-toplevel-form-offset* offset)
           (values (setq *cached-form-number-translations*
                         (sb!di:form-number-translations res offset))
@@ -1293,7 +1313,7 @@ reset to ~S."
           (aref (or (sb!di:debug-source-start-positions d-source)
                     (error "no start positions map"))
                 local-tlf-offset))
-         (name (sb!di:debug-source-name d-source)))
+         (name (sb!di:debug-source-namestring d-source)))
     (unless (eq d-source *cached-debug-source*)
       (unless (and *cached-source-stream*
                    (equal (pathname *cached-source-stream*)