From e5734bef9074fa8b1c80c35aa9bf528e31d966a4 Mon Sep 17 00:00:00 2001 From: rocky Date: Mon, 27 Apr 2020 15:14:12 -0400 Subject: Experiment giving bytecode in traceback... This commit only changes the behavior when `(cdr)` when it is not given a `cons` node, in order to give some quick idea of how adding more traceback information might work. Here's how to see/use. Build this code. Byte-compile this buggy function in `/tmp/foo.el` with (byte-compile-file) ```lisp (defun foo() (setq x 5) (cdr 'b) ) ``` ``` (load-file "/tmp/foo.elc") (foo) ``` You should see: ``` Debugger entered--Lisp error: (wrong-type-argument listp b 3) this is the offset ^ foo() eval((foo) nil) elisp--eval-last-sexp(nil) eval-last-sexp(nil) funcall-interactively(eval-last-sexp nil) call-interactively(eval-last-sexp nil nil) command-execute(eval-last-sexp) ``` Compare against disassembly: ``` byte code for foo: args: nil 0 constant 5 1 varset x 2 constant b 3 cdr ^^^ offset from above 4 return ``` You can try with other offsets such as by removing the `(setq x 5)` and you'll see offset 1 instead. Right now, we just pass to `signal` bytecode offset. More elaborate would be to pass the code object and its offset. Even more elaborate schemes could be imagined. --- src/bytecode.c | 8 +++++--- src/data.c | 8 ++++++++ src/eval.c | 6 ++++++ src/lisp.h | 5 +++++ 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index 3c90544f3f2..8ef84682035 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -286,12 +286,13 @@ enum byte_code_op /* Fetch the next byte from the bytecode stream. */ -#define FETCH (*pc++) +#define FETCH (last_pc = pc, *pc++) +#define FETCH_NORECORD (*pc++) /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ -#define FETCH2 (op = FETCH, op + (FETCH << 8)) +#define FETCH2 (op = FETCH, op + (FETCH_NORECORD << 8)) /* Push X onto the execution stack. The expression X should not contain TOP, to avoid competing side effects. */ @@ -375,6 +376,7 @@ 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)) @@ -535,7 +537,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 (Qlistp, TOP); + wrong_type_argument_new (Qlistp, TOP, last_pc - bytestr_data); NEXT; } diff --git a/src/data.c b/src/data.c index bce2e53cfb6..0ebdd672679 100644 --- a/src/data.c +++ b/src/data.c @@ -149,6 +149,14 @@ 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 014905ce6df..4251c3e3304 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1713,6 +1713,12 @@ 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) { diff --git a/src/lisp.h b/src/lisp.h index b4ac017dcf5..c9b069b56ca 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -603,6 +603,7 @@ 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); @@ -3284,6 +3285,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; @@ -4107,6 +4111,7 @@ 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); -- cgit v1.2.1 From 11b403cb230f7f447fa7b988412b9f07b89ac3b6 Mon Sep 17 00:00:00 2001 From: Zach Shaftel Date: Wed, 29 Apr 2020 13:13:44 -0400 Subject: Print byte offset of error in backtrace --- lisp/emacs-lisp/debug.el | 6 ++++-- src/bytecode.c | 5 +++-- src/eval.c | 14 +++++++++++++- src/lisp.h | 1 + 4 files changed, 21 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index ed28997292f..db2943b6e73 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -335,8 +335,10 @@ 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 () - (debugger--insert-header args)) + backtrace-insert-header-function + (lambda () + (insert (format "Byte-code offset of error: %d\n" (car (last args)))) + (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 8ef84682035..1c98a516dbb 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 4251c3e3304..82463c41747 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; @@ -335,7 +337,10 @@ 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 @@ -1695,6 +1700,13 @@ 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) { diff --git a/src/lisp.h b/src/lisp.h index c9b069b56ca..ff60dfa8f0d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4089,6 +4089,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: -- cgit v1.2.1 From 077acd3a5f9cc49d034c11e048181d12791aa3a7 Mon Sep 17 00:00:00 2001 From: Zach Shaftel Date: Wed, 29 Apr 2020 13:54:29 -0400 Subject: Only print offset for byte-compiled functions --- lisp/emacs-lisp/debug.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index db2943b6e73..1de13ed4c53 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -337,7 +337,11 @@ That buffer should be current already and in debugger-mode." (setq backtrace-view (plist-put backtrace-view :show-flags t) backtrace-insert-header-function (lambda () - (insert (format "Byte-code offset of error: %d\n" (car (last args)))) + (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-print-function debugger-print-function) (backtrace-print) -- cgit v1.2.1 From ef71dc437fdcdf61d61519e5197c6e3016d8f3a5 Mon Sep 17 00:00:00 2001 From: Zach Shaftel Date: Fri, 1 May 2020 14:56:46 -0400 Subject: 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); -- cgit v1.2.1