debug.el: Straighten the code that find the "base" of the backtrace

Let the caller tell us clearly where is the base of the backtrace,
if it's not `debug`.  This is done by passing a new `:backtrace-base`
keyword argument to `debug`.

Then use this info systematically in all the places where we access
the real C-level backtrace, to try and avoid inconsistencies and brittle
code that tries to enumerate the expected frames we're in.

* src/eval.c (get_backtrace_starting_at): Add support for offsets in the
`base` argument.
(Fbacktrace_debug): Add optional `base` argument.

* lisp/emacs-lisp/debug.el (debug, debugger-frame, debugger-frame-clear):
Use `debugger--backtrace-base` when calling `backtrace-debug`.
(debugger-setup-buffer): Use `debugger--backtrace-base`
when calling `backtrace-get-frames`.
(debugger-frame-number): Drop `skip-base` arg, assume it's never nil.
Add sanity check.
(debugger--backtrace-base): Use the `:backtrace-base` info
in `debugger-args`.
(debugger-eval-expression): Adjust call to `debugger-frame-number`.
(debug--implement-debug-on-entry): Pass appropriate `:backtrace-base`.

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 5411088189df458896df9cd998e14081f567db6e..e0b6ca31b9e6968b55141b0411808937419d3992 100644 (file)
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -237,12 +237,11 @@ the debugger will not be entered."
          (unwind-protect
              (save-excursion
                (when (eq (car debugger-args) 'debug)
-                 ;; Skip the frames for backtrace-debug, byte-code,
-                 ;; debug--implement-debug-on-entry and the advice's `apply'.
-                 (backtrace-debug 4 t)
-                 ;; Place an extra debug-on-exit for macro's.
-                 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
-                   (backtrace-debug 5 t)))
+                 (let ((base (debugger--backtrace-base)))
+                   (backtrace-debug 1 t base) ;FIXME!
+                   ;; Place an extra debug-on-exit for macro's.
+                   (when (eq 'lambda (car-safe (cadr (backtrace-frame 1 base))))
+                     (backtrace-debug 2 t base))))
                 (with-current-buffer debugger-buffer
                   (unless (derived-mode-p 'debugger-mode)
                    (debugger-mode))
@@ -343,11 +342,10 @@ Make functions into cross-reference buttons if DO-XREFS is non-nil."
 (defun debugger-setup-buffer (args)
   "Initialize the `*Backtrace*' buffer for entry to the debugger.
 That buffer should be current already and in `debugger-mode'."
-  (setq backtrace-frames (nthcdr
-                          ;; Remove debug--implement-debug-on-entry and the
-                          ;; advice's `apply' frame.
-                          (if (eq (car args) 'debug) 3 1)
-                          (backtrace-get-frames 'debug)))
+  (setq backtrace-frames
+        ;; The `base' frame is the one that gets index 0 and it is the entry to
+        ;; the debugger, so drop it with `cdr'.
+        (cdr (backtrace-get-frames (debugger--backtrace-base))))
   (when (eq (car-safe args) 'exit)
     (setq debugger-value (nth 1 args))
     (setf (cl-getf (backtrace-frame-flags (car backtrace-frames))
@@ -477,26 +475,29 @@ removes itself from that hook."
   (setq debugger-jumping-flag nil)
   (remove-hook 'post-command-hook 'debugger-reenable))
 
-(defun debugger-frame-number (&optional skip-base)
+(defun debugger-frame-number ()
   "Return number of frames in backtrace before the one point points at."
-  (let ((index (backtrace-get-index))
-        (count 0))
+  (let ((index (backtrace-get-index)))
     (unless index
       (error "This line is not a function call"))
-    (unless skip-base
-        (while (not (eq (cadr (backtrace-frame count)) 'debug))
-          (setq count (1+ count)))
-        ;; Skip debug--implement-debug-on-entry frame.
-        (when (eq 'debug--implement-debug-on-entry
-                  (cadr (backtrace-frame (1+ count))))
-          (setq count (+ 2 count))))
-    (+ count index)))
+    ;; We have 3 representations of the backtrace: the real in C in `specpdl',
+    ;; the one stored in `backtrace-frames' and the textual version in
+    ;; the buffer.  Check here that the one from `backtrace-frames' is in sync
+    ;; with the one from `specpdl'.
+    (cl-assert (equal (backtrace-frame-fun (nth index backtrace-frames))
+                      (nth 1 (backtrace-frame (1+ index)
+                                              (debugger--backtrace-base)))))
+    ;; The `base' frame is the one that gets index 0 and it is the entry to
+    ;; the debugger, so the first non-debugger frame is 1.
+    ;; This `+1' skips the same frame as the `cdr' in
+    ;; `debugger-setup-buffer'.
+    (1+ index)))
 
 (defun debugger-frame ()
   "Request entry to debugger when this frame exits.
 Applies to the frame whose line point is on in the backtrace."
   (interactive)
-  (backtrace-debug (debugger-frame-number) t)
+  (backtrace-debug (debugger-frame-number) t (debugger--backtrace-base))
   (setf
    (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
             :debug-on-exit)
@@ -507,7 +508,7 @@ Applies to the frame whose line point is on in the backtrace."
   "Do not enter debugger when this frame exits.
 Applies to the frame whose line point is on in the backtrace."
   (interactive)
-  (backtrace-debug (debugger-frame-number) nil)
+  (backtrace-debug (debugger-frame-number) nil (debugger--backtrace-base))
   (setf
    (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
             :debug-on-exit)
@@ -526,10 +527,8 @@ Applies to the frame whose line point is on in the backtrace."
 (defun debugger--backtrace-base ()
   "Return the function name that marks the top of the backtrace.
 See `backtrace-frame'."
-  (cond ((eq 'debug--implement-debug-on-entry
-            (cadr (backtrace-frame 1 'debug)))
-        'debug--implement-debug-on-entry)
-       (t 'debug)))
+  (or (cadr (memq :backtrace-base debugger-args))
+      #'debug))
 
 (defun debugger-eval-expression (exp &optional nframe)
   "Eval an expression, in an environment like that outside the debugger.
@@ -537,7 +536,7 @@ The environment used is the one when entering the activation frame at point."
   (interactive
    (list (read--expression "Eval in stack frame: ")))
   (let ((nframe (or nframe
-                    (condition-case nil (1+ (debugger-frame-number 'skip-base))
+                    (condition-case nil (debugger-frame-number)
                       (error 0)))) ;; If on first line.
        (base (debugger--backtrace-base)))
     (debugger-env-macro
@@ -670,7 +669,10 @@ functions to break on entry."
   (if (or inhibit-debug-on-entry debugger-jumping-flag)
       nil
     (let ((inhibit-debug-on-entry t))
-      (funcall debugger 'debug))))
+      (funcall debugger 'debug :backtrace-base
+               ;; An offset of 1 because we need to skip the advice
+               ;; OClosure that called us.
+               '(1 . debug--implement-debug-on-entry)))))
 
 ;;;###autoload
 (defun debug-on-entry (function)

diff --git a/lisp/subr.el b/lisp/subr.el
index 7b52f4f68f9d4d85777ab80534f6dde5f66a1eb3..93428c4a518ce59b2d8cf20e54d3f2b02e866004 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6384,13 +6384,14 @@ If non-nil, BASE should be a function, and frames before its
 nearest activation frame are discarded."
   (let ((frames nil))
     (mapbacktrace (lambda (&rest frame) (push frame frames))
-                  (or base 'backtrace-frames))
+                  (or base #'backtrace-frames))
     (nreverse frames)))
 
 (defun backtrace-frame (nframes &optional base)
   "Return the function and arguments NFRAMES up from current execution point.
 If non-nil, BASE should be a function, and NFRAMES counts from its
-nearest activation frame.
+nearest activation frame.  BASE can also be of the form (OFFSET . FUNCTION)
+in which case OFFSET will be added to NFRAMES.
 If the frame has not evaluated the arguments yet (or is a special form),
 the value is (nil FUNCTION ARG-FORMS...).
 If the frame has evaluated its arguments and called its function already,
@@ -6401,7 +6402,7 @@ or a lambda expression for macro calls.
 If NFRAMES is more than the number of frames, the value is nil."
   (backtrace-frame--internal
    (lambda (evald func args _) `(,evald ,func ,@args))
-   nframes (or base 'backtrace-frame)))
+   nframes (or base #'backtrace-frame)))
 
 \f
 (defvar called-interactively-p-functions nil

diff --git a/src/eval.c b/src/eval.c
index 12e811ce2645b63fb4d0f158d72a02ff4929e459..419285eb69479ebeeb14ff546606b53bd11deb2b 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -3806,10 +3806,18 @@ get_backtrace_starting_at (Lisp_Object base)
 
   if (!NILP (base))
     { /* Skip up to `base'.  */
+      int offset = 0;
+      if (CONSP (base) && FIXNUMP (XCAR (base)))
+        {
+          offset = XFIXNUM (XCAR (base));
+          base = XCDR (base);
+        }
       base = Findirect_function (base, Qt);
       while (backtrace_p (pdl)
              && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
         pdl = backtrace_next (pdl);
+      while (backtrace_p (pdl) && offset-- > 0)
+        pdl = backtrace_next (pdl);
     }
 
   return pdl;
@@ -3849,13 +3857,14 @@ backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
     }
 }
 
-DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 3, 0,
        doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+LEVEL and BASE specify the activation frame to use, as in `backtrace-frame'.
 The debugger is entered when that frame exits, if the flag is non-nil.  */)
-  (Lisp_Object level, Lisp_Object flag)
+  (Lisp_Object level, Lisp_Object flag, Lisp_Object base)
 {
   CHECK_FIXNUM (level);
-  union specbinding *pdl = get_backtrace_frame(level, Qnil);
+  union specbinding *pdl = get_backtrace_frame (level, base);
 
   if (backtrace_p (pdl))
     set_backtrace_debug_on_exit (pdl, !NILP (flag));
@@ -4342,7 +4351,10 @@ If due to frame exit, args are `exit' and the value being returned;
  this function's value will be returned instead of that.
 If due to error, args are `error' and a list of the args to `signal'.
 If due to `apply' or `funcall' entry, one arg, `lambda'.
-If due to `eval' entry, one arg, t.  */);
+If due to `eval' entry, one arg, t.
+IF the desired entry point of the debugger is higher in the call stack,
+it can can be specified with the keyword argument `:backtrace-base'
+whose format should be the same as the BASE arg of `backtrace-frame'.  */);
   Vdebugger = Qdebug_early;
 
   DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function,