Merge feature/zach-soc-bytecode-in-traceback

4 files changed, 31 insertions, 7 deletions

diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 37dad8db162..ac6b6492790 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/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 6
   "Width in characters of the flags for a backtrace frame.")
 
 ;;; Navigation and Text Properties
@@ -746,10 +746,12 @@ 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))
+        (off (plist-get (backtrace-frame-flags frame) :bytecode-offset)))
     (when (plist-get view :show-flags)
       (when source (insert ">"))
-      (when flag (insert "*")))
+      (when flag (insert "*"))
+      (when off (insert (number-to-string off))))
     (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
     (put-text-property beg (point) 'backtrace-section 'func)))
 
diff --git a/src/bytecode.c b/src/bytecode.c
index 5ac30aa1010..6b7e9cbc7b9 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -424,13 +424,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	 Threading provides a performance boost.  These macros are how
 	 we allow the code to be compiled both ways.  */
 #ifdef BYTE_CODE_THREADED
+#define UPDATE_OFFSET (backtrace_byte_offset = pc - bytestr_data);
       /* The CASE macro introduces an instruction's body.  It is
 	 either a label or a case label.  */
 #define CASE(OP) insn_ ## OP
       /* 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 +1449,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;
diff --git a/src/eval.c b/src/eval.c
index 959adea6467..5b43b81a6ca 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -56,6 +56,8 @@ Lisp_Object Vrun_hooks;
 /* FIXME: We should probably get rid of this!  */
 Lisp_Object Vsignaling_function;
 
+int backtrace_byte_offset = -1;
+
 /* These would ordinarily be static, but they need to be visible to GDB.  */
 bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
 Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
@@ -137,6 +139,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 +344,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 +2156,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 +3661,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 +4252,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);
diff --git a/src/lisp.h b/src/lisp.h
index 34426990882..ef6302a4670 100644
--- a/src/lisp.h
+++ b/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;
 
@@ -4109,6 +4113,7 @@ extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vrun_hooks;
 extern Lisp_Object Vsignaling_function;
 extern Lisp_Object inhibit_lisp_code;
+extern int backtrace_byte_offset;
 
 /* To run a normal hook, use the appropriate function from the list below.
    The calling convention: