X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=16607b5750ff38673c8010d2f2f91235239a5faa;hb=371577a214ce2659c271279ad48e4c42e1c0c93e;hp=ecbf3e8e809c01c1bc54f9e4a2fa418962c92d17;hpb=f22ad70037030c07074327cf239bd84dc17b44b6;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index ecbf3e8..16607b5 100644 --- 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*)