From ef71dc437fdcdf61d61519e5197c6e3016d8f3a5 Mon Sep 17 00:00:00 2001 From: Zach Shaftel Date: Fri, 1 May 2020 14:56:46 -0400 Subject: [PATCH] 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 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/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 1de13ed4c53..ed28997292f 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 1c98a516dbb..b4b5ef6e60a 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 0ebdd672679..bce2e53cfb6 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 82463c41747..4009b4fc1a0 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. */ @@ -1700,13 +1702,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) { @@ -1725,12 +1720,6 @@ xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2) xsignal (error_symbol, list2 (arg1, 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) { @@ -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 ff60dfa8f0d..4c8b4e08c3c 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); -- 2.39.5