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
"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)))
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).
\f
/* 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. */
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))
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;
}
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)
{
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)
{
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. */
/* 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, 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)
{
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;
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
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);
/* 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);
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs;
+ int bytecode_offset;
} bt;
};
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);