Only print offset for byte-code functions

* lisp/emacs-lisp/backtrace.el (backtrace--print-flags): Check if the
function is compiled and only print the offset in that case.

lisp/emacs-lisp/backtrace.el

@@ -257,7 +257,7 @@ frames where the source code location is known.")
     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 @@ property for use by navigation."
   "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 ">"))
+      (insert (if source ">" " "))
-      (when flag (insert "*")))
+      (insert (if flag "*" " "))
-    (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
+      (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)

src/bytecode.c

@@ -311,6 +311,10 @@ enum byte_code_op
 
 #define TOP (*top)
 
+/* Update the thread's bytecode offset, just before NEXT. */
+
+#define UPDATE_OFFSET (backtrace_byte_offset = pc - bytestr_data)
+
 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;
@@ -430,7 +434,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
       /* NEXT is invoked at the end of an instruction to go to the
 	 next instruction.  It is either a computed goto, or a
 	 plain break.  */
-#define NEXT goto *(targets[op = FETCH])
+#define NEXT UPDATE_OFFSET; goto *(targets[op = FETCH])
       /* FIRST is like NEXT, but is only used at the start of the
 	 interpreter body.  In the switch-based interpreter it is the
 	 switch, so the threaded definition must include a semicolon.  */
@@ -1448,7 +1452,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	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;

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)
 {
@@ -335,9 +342,7 @@ call_debugger (Lisp_Object arg)
 	 redisplay, which necessarily leads to display problems.  */
   specbind (Qinhibit_eval_during_redisplay, Qt);
 #endif
-
   val = apply1 (Vdebugger, arg);
-
   /* Interrupting redisplay and resuming it later is not safe under
      all circumstances.  So, when the debugger returns, abort the
      interrupted redisplay by going back to the top-level.  */
@@ -2149,6 +2154,10 @@ 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;
+  union specbinding *nxt = specpdl_ptr;
+  nxt = backtrace_next(nxt);
+  if (nxt->kind == SPECPDL_BACKTRACE)
+    nxt->bt.bytecode_offset = backtrace_byte_offset;
   grow_specpdl ();
 
   return count;
@@ -3650,6 +3659,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 +4250,7 @@ alist of active lexical bindings.  */);
   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);

src/lisp.h

@@ -3230,6 +3230,7 @@ union specbinding
       Lisp_Object function;
       Lisp_Object *args;
       ptrdiff_t nargs;
+      int bytecode_offset;
     } bt;
   };
 
@@ -3280,6 +3281,9 @@ struct handler
   enum nonlocal_exit nonlocal_exit;
   Lisp_Object val;
 
+  /* The bytecode offset where the error occurred. */
+  int bytecode_offset;
+
   struct handler *next;
   struct handler *nextfree;
 

src/thread.h

@@ -103,6 +103,11 @@ struct thread_state
   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)