1.0.39.3: support building on darwin x86 and x86-64 without the dlshim

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

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index ecbf3e8..16607b5 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.
   ;;
@@ -806,9 +810,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*)