bug#42499: [PATCH] Add Bytecode Offset information to Backtrace

[Zach Shaftel <zshaftel@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1701 bytes --]

This patch adds the offset in a bytecode function's execution where an
error occurs to the *Backtrace* buffer, like this:

Debugger entered--Lisp error: (wrong-type-argument stringp t)
       string-match(t t nil)
    13 test-condition-case()
       load("/home/zach/.repos/bench-compare.el/test/test-debug...")
    78 byte-recompile-file("/home/zach/.repos/bench-compare.el/test/test-debug..." nil 0 t)
    35 emacs-lisp-byte-compile-and-load()
       funcall-interactively(emacs-lisp-byte-compile-and-load)
       call-interactively(emacs-lisp-byte-compile-and-load record nil)
   101 command-execute(emacs-lisp-byte-compile-and-load record)


If you disassemble one of the annotated functions, you can find the
instruction where the error occured.

A 'bytecode_offset' field is added to the 'specbinding.bt' struct, which
holds the offset in the execution of that frame's bytecode function. The
offset for the function being executed is stored in a field of the
'thread_state' struct, and updated from within 'exec_byte_code' before a
funcall. Then 'record_in_backtrace', called by Ffuncall, finds the last
frame and stores the offset there. The frame's offset is added to the
FLAGS plist argument passed by 'mapbacktrace'.

See further discussion about the limitations of the attached
implementation here:
https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00365.html

My copyright assignment is still pending so I assume this can't be
merged until I hear back from copyright-clerk. The patch attached is a
simple diff without commit messages. I can add NEWS and Changelog
entries/commit messages if this ends up going through, but I may not be
able to get to that until next week.

-Zach


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bytecode-offset-in-backtrace.patch --]
[-- Type: text/x-patch, Size: 5158 bytes --]

diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 37dad8db16..f67e1dd72a 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -257,7 +257,7 @@ backtrace-mode-map
     map)
   "Local keymap for `backtrace-mode' buffers.")
 
-(defconst backtrace--flags-width 2
+(defconst backtrace--flags-width 7
   "Width in characters of the flags for a backtrace frame.")
 
 ;;; Navigation and Text Properties
@@ -746,11 +746,16 @@ backtrace--print-flags
   "Print the flags of a backtrace FRAME if enabled in VIEW."
   (let ((beg (point))
         (flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))
-        (source (plist-get (backtrace-frame-flags frame) :source-available)))
+        (source (plist-get (backtrace-frame-flags frame) :source-available))
+        (offset (plist-get (backtrace-frame-flags frame) :bytecode-offset))
+        ;; right justify and pad the offset (or the empty string)
+        (offset-format (format "%%%ds " (- backtrace--flags-width 3)))
+        (fun (ignore-errors (indirect-function (backtrace-frame-fun frame)))))
     (when (plist-get view :show-flags)
-      (when source (insert ">"))
-      (when flag (insert "*")))
-    (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
+      (insert (if source ">" " "))
+      (insert (if flag "*" " "))
+      (insert (format offset-format
+                      (or (and (byte-code-function-p fun) offset) ""))))
     (put-text-property beg (point) 'backtrace-section 'func)))
 
 (defun backtrace--print-func-and-args (frame _view)
diff --git a/src/bytecode.c b/src/bytecode.c
index 5ac30aa101..c6766a38cf 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -311,6 +311,10 @@ #define DISCARD(n) (top -= (n))
 
 #define TOP (*top)
 
+/* Update the thread's bytecode offset, just before NEXT. */
+
+#define UPDATE_OFFSET (backtrace_byte_offset = pc - bytestr_data - 1)
+
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
@@ -618,6 +622,7 @@ #define DEFINE(name, value) LABEL (name) ,
 	  op -= Bcall;
 	docall:
 	  {
+	    UPDATE_OFFSET;
 	    DISCARD (op);
 #ifdef BYTE_CODE_METER
 	    if (byte_metering_on && SYMBOLP (TOP))
@@ -1448,7 +1453,7 @@ #define DEFINE(name, value) LABEL (name) ,
 	unbind_to (count, Qnil);
       error ("binding stack not balanced (serious byte compiler bug)");
     }
-
+  backtrace_byte_offset = -1;
   Lisp_Object result = TOP;
   SAFE_FREE ();
   return result;
diff --git a/src/eval.c b/src/eval.c
index 959adea646..e4451aa96c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -137,6 +137,13 @@ backtrace_args (union specbinding *pdl)
   return pdl->bt.args;
 }
 
+static int
+backtrace_bytecode_offset (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  return pdl->bt.bytecode_offset;
+}
+
 static bool
 backtrace_debug_on_exit (union specbinding *pdl)
 {
@@ -2149,6 +2156,11 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
   specpdl_ptr->bt.function = function;
   current_thread->stack_top = specpdl_ptr->bt.args = args;
   specpdl_ptr->bt.nargs = nargs;
+  if (backtrace_byte_offset > 0) {
+    union specbinding *nxt = backtrace_top ();
+    if (backtrace_p (nxt) && nxt->kind == SPECPDL_BACKTRACE)
+      nxt->bt.bytecode_offset = backtrace_byte_offset;
+  }
   grow_specpdl ();
 
   return count;
@@ -3650,6 +3662,10 @@ backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
   if (backtrace_debug_on_exit (pdl))
     flags = list2 (QCdebug_on_exit, Qt);
 
+  int off = backtrace_bytecode_offset (pdl);
+  if (off > 0)
+    flags = Fcons (QCbytecode_offset, Fcons (make_fixnum (off), flags));
+
   if (backtrace_nargs (pdl) == UNEVALLED)
     return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
   else
@@ -4237,6 +4253,7 @@ syms_of_eval (void)
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
   DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  DEFSYM (QCbytecode_offset, ":bytecode-offset");
   defsubr (&Smapbacktrace);
   defsubr (&Sbacktrace_frame_internal);
   defsubr (&Sbacktrace_frames_from_thread);
diff --git a/src/lisp.h b/src/lisp.h
index 3442699088..e92300f4f7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3230,6 +3230,7 @@ #define DEFVAR_KBOARD(lname, vname, doc)			\
       Lisp_Object function;
       Lisp_Object *args;
       ptrdiff_t nargs;
+      int bytecode_offset;
     } bt;
   };
 
diff --git a/src/thread.h b/src/thread.h
index a09929fa44..b5e3f0f9c5 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -103,6 +103,11 @@ #define specpdl (current_thread->m_specpdl)
   union specbinding *m_specpdl_ptr;
 #define specpdl_ptr (current_thread->m_specpdl_ptr)
 
+  /* The offset of the current op of the byte-code function being
+     executed. */
+  int m_backtrace_byte_offset;
+#define backtrace_byte_offset (current_thread->m_backtrace_byte_offset)
+
   /* Depth in Lisp evaluations and function calls.  */
   intmax_t m_lisp_eval_depth;
 #define lisp_eval_depth (current_thread->m_lisp_eval_depth)