Implemented SBCL's extension EXT:*INVOKE-DEBUGGER-HOOK*

src/CHANGELOG

@@ -78,6 +78,8 @@ ECL 10.2.1:
     ;;;   (DEFMACRO WITH-COMPILATION-UNIT (OPTIONS &REST BODY) ...)
     ;;; The variable OPTIONS is not used.
 
+ - ECL now implements EXT:*INVOKE-DEBUGGER-HOOK*, which works like *DEBUGGER-HOOK*
+   but is also observed by BREAK. (SBCL extension adopted by ECL)
 
 ;;; Local Variables: ***
 ;;; mode:text ***

src/c/symbols_list.h

@@ -1866,5 +1866,7 @@ cl_symbols[] = {
 {SYS_ "CLOSE-WINDOWS-HANDLE", SI_ORDINARY, si_close_windows_handle, 1, OBJNULL},
 #endif
 
+{EXT_ "*INVOKE-DEBUGGER-HOOK*", EXT_SPECIAL, NULL, -1, Cnil},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

src/c/symbols_list2.h

@@ -1866,5 +1866,7 @@ cl_symbols[] = {
 {SYS_ "CLOSE-WINDOWS-HANDLE","si_close_windows_handle"},
 #endif
 
+{EXT_ "*INVOKE-DEBUGGER-HOOK*",NULL},
+
 /* Tag for end of list */
 {NULL,NULL}};

src/clos/conditions.lsp

@@ -894,8 +894,6 @@ strings."
       (format T "~A" (car p))
       (format T "~%"))))
 
-(defvar *debugger-hook* NIL)
-
 (defun invoke-debugger (&optional (datum "Debug") &rest arguments)
   (let ((condition
 	 (coerce-to-condition datum arguments 'simple-condition 'debug)))

src/doc/help.lsp

@@ -137,6 +137,13 @@ The value of the last top-level form.")
 (docfun * function (&rest numbers) "
 Returns the product of the args.  With no args, returns 1.")
 
+(docvar *debugger-hook* variable "
+This is either NIL or a function of two arguments, a condition and the value
+of *DEBUGGER-HOOK*. This function can either handle the condition or return
+which causes the standard debugger to execute. The system passes the value
+of this variable to the function because it binds *DEBUGGER-HOOK* to NIL
+around the invocation.")
+
 (docvar *debug-io* variable "
 The stream used by the ECL debugger.  The initial value is a synonym stream to
 *TERMINAL-IO*.")
@@ -206,6 +213,18 @@ If the value of SI::*INTERRUPT-ENABLE* is non-NIL, ECL signals an error on the
 terminal interrupt (this is the default case).  If it is NIL, ECL ignores the
 interrupt and assigns T to SI::*INTERRUPT-ENABLE*.")
 
+(docvar ext::*invoke-debugger-hook* variable "
+ECL specific.
+This is either NIL or a designator for a function of two arguments,
+to be run when the debugger is about to be entered.  The function is
+run with *INVOKE-DEBUGGER-HOOK* bound to NIL to minimize recursive
+errors, and receives as arguments the condition that triggered
+debugger entry and the previous value of *INVOKE-DEBUGGER-HOOK*
+
+This mechanism is an extension similar to the standard *DEBUGGER-HOOK*.
+In contrast to *DEBUGGER-HOOK*, it is observed by INVOKE-DEBUGGER even when
+called by BREAK.")
+
 #-boehm-gc
 (docvar si::*lisp-maxpages* variable "
 ECL specific.

src/lsp/top.lsp

@@ -1379,10 +1379,17 @@ package."
          (tpl :commands debug-commands)))))
 
 (defun invoke-debugger (condition)
-  (when *debugger-hook*
-    (let* ((old-hook *debugger-hook*)
-	   (*debugger-hook* nil))
-      (funcall old-hook condition old-hook)))
+  ;; call *INVOKE-DEBUGGER-HOOK* first, so that *DEBUGGER-HOOK* is not
+  ;; called when the debugger is disabled. We adopt this mechanism
+  ;; from SBCL.
+  (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))))
   (locally 
     (declare (notinline default-debugger))
     (if (<= 0 *tpl-level*) ;; Do we have a top-level REPL above us?
@@ -1390,6 +1397,7 @@ package."
         (let* (;; We do not have a si::top-level invocation above us
                ;; so we have to provide the environment for interactive use.
                (*break-enable* *break-enable*)
+               (*invoke-debugger-hook* *invoke-debugger-hook*)
                (*debugger-hook* *debugger-hook*)
                (*quit-tags* (cons *quit-tag* *quit-tags*))
                (*quit-tag* *quit-tags*)	; any unique new value