Changeset 12157


Ignore:
Timestamp:
09/20/09 08:57:46 (12 years ago)
Author:
Mark Evenson
Message:

*INVOKE-DEBUGGER-HOOK* now called before *DEBUGGER-HOOK* (Tobias Rittweiler)

Since ANSI requires BREAK to define to bind *DEBUGGER-HOOK* to NIL
which would always place calls to BREAK in the native debugger, we
define an additional hook *INVOKE-DEBUGGER-HOOK* which is called
before *DEBUGGER-HOOK* so that one has the possiblity to install a
customer debugger (such as the one provided in SLIME) to handle BREAK
conditions. This convention is taken from SBCL.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/debug.lisp

    r12105 r12157  
    100100        (simple-format *debug-io* "  ~A~%" condition)))))
    101101
     102(declaim (inline run-hook))
     103(defun run-hook (hook &rest args)
     104  (let ((hook-function (symbol-value hook)))
     105    (when hook-function
     106      (progv (list hook) (list nil)
     107        (apply hook-function args)))))
     108
     109(defvar *invoke-debugger-hook* nil
     110  "Like *DEBUGGER-HOOK* but observed by INVOKE-DEBUGGER even when
     111called by BREAK. This hook is run before *DEBUGGER-HOOK*.")
     112
     113;;; We run *INVOKE-DEBUGGER-HOOK* before *DEBUGGER-HOOK* because SBCL
     114;;; does so, too, and for good reason: This way, you can specify
     115;;; default debugger behaviour that trumps over whatever the users
     116;;; wants to do with *DEBUGGER-HOOK*.
    102117(defun invoke-debugger (condition)
    103118  (let ((*saved-backtrace* (sys:backtrace)))
    104     (when *debugger-hook*
    105       (let ((hook-function *debugger-hook*)
    106             (*debugger-hook* nil))
    107         (funcall hook-function condition hook-function)))
     119    (run-hook '*invoke-debugger-hook* condition *invoke-debugger-hook*)
     120    (run-hook '*debugger-hook*        condition *debugger-hook*)
    108121    (invoke-debugger-report-condition condition)
    109122    (unless (fboundp 'tpl::repl)
     
    112125      (with-standard-io-syntax
    113126        (let ((*package* original-package)
    114               (*print-readably* nil) ; Top-level default.
     127              (*print-readably* nil)    ; Top-level default.
    115128              (*print-structure* nil)
    116129              (*debug-condition* condition)
Note: See TracChangeset for help on using the changeset viewer.