feature/zach-soc-bytecode-in-traceback ef71dc4 3/3: Print offset of each backtrace frame

[Rocky Bernstein]

branch: feature/zach-soc-bytecode-in-traceback
commit ef71dc437fdcdf61d61519e5197c6e3016d8f3a5
Author: Zach Shaftel <zshaftel@gmail.com>
Commit: Zach Shaftel <zshaftel@gmail.com>

    Print offset of each backtrace frame
---
 lisp/emacs-lisp/backtrace.el |  8 +++++---
 lisp/emacs-lisp/debug.el     | 10 ++--------
 src/bytecode.c               |  8 +++-----
 src/data.c                   |  8 --------
 src/eval.c                   | 34 ++++++++++++++++------------------
 src/lisp.h                   |  3 +--
 6 files changed, 27 insertions(+), 44 deletions(-)

diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 37dad8d..ac6b649 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/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 1de13ed..ed28997 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -335,14 +335,8 @@ That buffer should be current already and in 
debugger-mode."
           nil))
 
   (setq backtrace-view (plist-put backtrace-view :show-flags t)
-        backtrace-insert-header-function
-        (lambda ()
-          (let ((final (car (last args)))
-                (fun (backtrace-frame-fun (car backtrace-frames))))
-            (and (byte-code-function-p (ignore-errors (indirect-function fun)))
-                 (integerp final)
-                 (insert (format "Byte-code offset of error: %d\n" final))))
-          (debugger--insert-header args))
+        backtrace-insert-header-function (lambda ()
+                                           (debugger--insert-header args))
         backtrace-print-function debugger-print-function)
   (backtrace-print)
   ;; Place point on "stack frame 0" (bug#15101).
diff --git a/src/bytecode.c b/src/bytecode.c
index 1c98a51..b4b5ef6 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -286,13 +286,12 @@ enum byte_code_op
 
 /* Fetch the next byte from the bytecode stream.  */
 
-#define FETCH (last_pc = pc, *pc++)
-#define FETCH_NORECORD (*pc++)
+#define FETCH (*pc++)
 
 /* Fetch two bytes from the bytecode stream and make a 16-bit number
    out of them.  */
 
-#define FETCH2 (op = FETCH, op + (FETCH_NORECORD << 8))
+#define FETCH2 (op = FETCH, op + (FETCH << 8))
 
 /* Push X onto the execution stack.  The expression X should not
    contain TOP, to avoid competing side effects.  */
@@ -376,7 +375,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
   bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length);
   memcpy (bytestr_data, SDATA (bytestr), bytestr_length);
   unsigned char const *pc = bytestr_data;
-  unsigned char const *last_pc = pc;
   ptrdiff_t count = SPECPDL_INDEX ();
 
   if (!NILP (args_template))
@@ -538,7 +536,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
            if (CONSP (TOP))
              TOP = XCDR (TOP);
            else if (!NILP (TOP))
-             wrong_type_argument_new (Qlistp, TOP, last_pc - bytestr_data);
+             wrong_type_argument (Qlistp, TOP);
            NEXT;
          }
 
diff --git a/src/data.c b/src/data.c
index 0ebdd67..bce2e53 100644
--- a/src/data.c
+++ b/src/data.c
@@ -149,14 +149,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object 
value)
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
 
-AVOID
-wrong_type_argument_new (Lisp_Object predicate, Lisp_Object value,
-                        int bytecode_offset)
-{
-  eassert (!TAGGEDP (value, Lisp_Type_Unused0));
-  xsignal2_new (Qwrong_type_argument, predicate, value, bytecode_offset);
-}
-
 void
 pure_write_error (Lisp_Object obj)
 {
diff --git a/src/eval.c b/src/eval.c
index 82463c4..4009b4f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -139,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)
 {
@@ -337,12 +344,7 @@ call_debugger (Lisp_Object arg)
         redisplay, which necessarily leads to display problems.  */
   specbind (Qinhibit_eval_during_redisplay, Qt);
 #endif
-  if (backtrace_byte_offset >= 0) {
-    arg = CALLN(Fappend, arg, list1(make_fixnum(backtrace_byte_offset)));
-    backtrace_byte_offset = -1;
-  }
   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.  */
@@ -1701,13 +1703,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool keyboard_quit)
 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */
 
 void
-xsignal_with_offset (Lisp_Object error_symbol, Lisp_Object data, int 
bytecode_offset)
-{
-  backtrace_byte_offset = bytecode_offset;
-  xsignal(error_symbol, data);
-}
-
-void
 xsignal0 (Lisp_Object error_symbol)
 {
   xsignal (error_symbol, Qnil);
@@ -1726,12 +1721,6 @@ xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, 
Lisp_Object arg2)
 }
 
 void
-xsignal2_new (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, 
int bytecode_offset)
-{
-  xsignal (error_symbol, list3 (arg1, arg2, make_fixnum(bytecode_offset)));
-}
-
-void
 xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, 
Lisp_Object arg3)
 {
   xsignal (error_symbol, list3 (arg1, arg2, arg3));
@@ -2167,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;
@@ -3666,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
@@ -4253,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);
diff --git a/src/lisp.h b/src/lisp.h
index ff60dfa..4c8b4e0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -603,7 +603,6 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object);
 /* Defined in data.c.  */
 extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
-extern AVOID wrong_type_argument_new (Lisp_Object, Lisp_Object, int 
bytecode_offset);
 extern Lisp_Object default_value (Lisp_Object symbol);
 
 
@@ -3235,6 +3234,7 @@ union specbinding
       Lisp_Object function;
       Lisp_Object *args;
       ptrdiff_t nargs;
+      int bytecode_offset;
     } bt;
   };
 
@@ -4112,7 +4112,6 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
 extern AVOID xsignal0 (Lisp_Object);
 extern AVOID xsignal1 (Lisp_Object, Lisp_Object);
 extern AVOID xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
-extern AVOID xsignal2_new (Lisp_Object, Lisp_Object, Lisp_Object, int 
bytecode_offset);
 extern AVOID xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
 extern AVOID signal_error (const char *, Lisp_Object);
 extern AVOID overflow_error (void);