procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(backtrace-on-redisplay-error): Use handler-bind

Browse source 
Reimplement `backtrace-on-redisplay-error` using `push_handler_bind`.
This moves the code from `signal_or_quit` to `xdisp.c` and
`debug-early.el`.

* lisp/emacs-lisp/debug-early.el (debug-early-backtrace):
Add `base` arg to strip "internal" frames.
(debug--early): New function, extracted from `debug-early`.
(debug-early, debug-early--handler): Use it.
(debug-early--muted): New function, extracted (translated) from
`signal_or_quit`; trim the buffer to a max of 10 backtraces.

* src/xdisp.c (funcall_with_backtraces): New function.
(dsafe_calln): Use it.
(syms_of_xdisp): Defsym `Qdebug_early__muted`.

* src/eval.c (redisplay_deep_handler): Delete var.
(init_eval, internal_condition_case_n): Don't set it any more.
(backtrace_yet): Delete var.
(signal_or_quit): Remove special case for `backtrace_on_redisplay_error`.
* src/keyboard.c (command_loop_1): Don't set `backtrace_yet` any more.
* src/lisp.h (backtrace_yet): Don't declare.
This commit is contained in:
Stefan Monnier 2023-12-25 21:41:08 -05:00
parent 2ef6e40da8
commit 391c208aec
5 changed files with 83 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
lisp/emacs-lisp/debug-early.el
View file

@ -27,14 +27,17 @@
;; This file dumps a backtrace on stderr when an error is thrown. It
;; has no dependencies on any Lisp libraries and is thus used for
;; generating backtraces for bugs in the early parts of bootstrapping.
;; It is also always used in batch model. It was introduced in Emacs
;; It is also always used in batch mode. It was introduced in Emacs
;; 29, before which there was no backtrace available during early
;; bootstrap.
;;; Code:
;; For bootstrap reasons, we cannot use any macros here since they're
;; not defined yet.
(defalias 'debug-early-backtrace
#'(lambda ()
#'(lambda (&optional base)
"Print a trace of Lisp function calls currently active.
The output stream used is the value of `standard-output'.
@ -51,26 +54,39 @@ of the build process."
(require 'cl-print)
(error nil)))
#'cl-prin1
#'prin1)))
#'prin1))
(first t))
(mapbacktrace
#'(lambda (evald func args _flags)
(let ((args args))
(if evald
(if first
;; The first is the debug-early entry point itself.
(setq first nil)
(let ((args args))
(if evald
(progn
(princ " ")
(funcall prin1 func)
(princ "("))
(progn
(princ " ")
(funcall prin1 func)
(princ "("))
(progn
(princ " (")
(setq args (cons func args))))
(if args
(while (progn
(funcall prin1 (car args))
(setq args (cdr args)))
(princ " ")))
(princ ")\n")))))))
(princ " (")
(setq args (cons func args))))
(if args
(while (progn
(funcall prin1 (car args))
(setq args (cdr args)))
(princ " ")))
(princ ")\n"))))
base))))
(defalias 'debug-early
(defalias 'debug--early
#'(lambda (error base)
(princ "\nError: ")
(prin1 (car error)) ; The error symbol.
(princ " ")
(prin1 (cdr error)) ; The error data.
(debug-early-backtrace base)))
(defalias 'debug-early ;Called from C.
#'(lambda (&rest args)
"Print an error message with a backtrace of active Lisp function calls.
The output stream used is the value of `standard-output'.
@ -88,14 +104,31 @@ support the latter, except in batch mode which always uses
\(In versions of Emacs prior to Emacs 29, no backtrace was
available before `debug' was usable.)"
(princ "\nError: ")
(prin1 (car (car (cdr args)))) ; The error symbol.
(princ " ")
(prin1 (cdr (car (cdr args)))) ; The error data.
(debug-early-backtrace)))
(debug--early (car (cdr args)) #'debug-early))) ; The error object.
(defalias 'debug-early--handler ;Called from C.
#'(lambda (err)
(if backtrace-on-error-noninteractive (debug-early 'error err))))
(if backtrace-on-error-noninteractive
(debug--early err #'debug-early--handler))))
(defalias 'debug-early--muted ;Called from C.
#'(lambda (err)
(save-current-buffer
(set-buffer (get-buffer-create "*Redisplay-trace*"))
(goto-char (point-max))
(if (bobp) nil
(let ((separator "\n\n\n\n"))
(save-excursion
;; The C code tested `backtrace_yet', instead we
;; keep a max of 10 backtraces.
(if (search-backward separator nil t 10)
(delete-region (point-min) (match-end 0))))
(insert separator)))
(insert "-- Caught at " (current-time-string) "\n")
(let ((standard-output (current-buffer)))
(debug--early err #'debug-early--muted))
(setq delayed-warnings-list
(cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*")
delayed-warnings-list)))))
;;; debug-early.el ends here.

67
src/eval.c
View file

@ -57,12 +57,6 @@ Lisp_Object Vrun_hooks;
/* FIXME: We should probably get rid of this! */
Lisp_Object Vsignaling_function;
/* The handler structure which will catch errors in Lisp hooks called
from redisplay. We do not use it for this; we compare it with the
handler which is about to be used in signal_or_quit, and if it
matches, cause a backtrace to be generated. */
static struct handler *redisplay_deep_handler;
/* 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;
@ -244,7 +238,6 @@ init_eval (void)
lisp_eval_depth = 0;
/* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
redisplay_deep_handler = NULL;
}
static void
@ -1611,16 +1604,12 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
ptrdiff_t nargs,
Lisp_Object *args))
{
struct handler *old_deep = redisplay_deep_handler;
struct handler *c = push_handler (handlers, CONDITION_CASE);
if (redisplaying_p)
redisplay_deep_handler = c;
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
redisplay_deep_handler = old_deep;
return hfun (val, nargs, args);
}
else
@ -1628,7 +1617,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
Lisp_Object val = bfun (nargs, args);
eassert (handlerlist == c);
handlerlist = c->next;
redisplay_deep_handler = old_deep;
return val;
}
}
@ -1766,11 +1754,6 @@ quit (void)
return signal_or_quit (Qquit, Qnil, true);
}
/* Has an error in redisplay giving rise to a backtrace occurred as
yet in the current command? This gets reset in the command
loop. */
bool backtrace_yet = false;
/* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal.
If CONTINUABLE, the caller allows this function to return
(presumably after calling the debugger);
@ -1897,51 +1880,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
return Qnil;
}
/* If an error is signaled during a Lisp hook in redisplay, write a
backtrace into the buffer *Redisplay-trace*. */
/* FIXME: Turn this into a `handler-bind` installed during redisplay? */
if (!debugger_called && !oom
&& backtrace_on_redisplay_error
&& (NILP (clause) || h == redisplay_deep_handler)
&& NILP (Vinhibit_debugger)
&& !NILP (Ffboundp (Qdebug_early)))
{
specpdl_ref count = SPECPDL_INDEX ();
max_ensure_room (100);
AUTO_STRING (redisplay_trace, "*Redisplay-trace*");
Lisp_Object redisplay_trace_buffer;
AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */
Lisp_Object delayed_warning;
redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil);
current_buffer = XBUFFER (redisplay_trace_buffer);
if (!backtrace_yet) /* Are we on the first backtrace of the command? */
Ferase_buffer ();
else
Finsert (1, &gap);
backtrace_yet = true;
specbind (Qstandard_output, redisplay_trace_buffer);
specbind (Qdebugger, Qdebug_early);
call_debugger (list2 (Qerror, error));
unbind_to (count, Qnil);
delayed_warning = make_string
("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61);
Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
Vdelayed_warnings_list);
}
if (!NILP (clause))
{
unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
}
else
{
if (handlerlist != handlerlist_sentinel)
/* FIXME: This will come right back here if there's no `top-level'
catcher. A better solution would be to abort here, and instead
add a catch-all condition handler so we never come here. */
Fthrow (Qtop_level, Qt);
}
unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
else if (handlerlist != handlerlist_sentinel)
/* FIXME: This will come right back here if there's no `top-level'
catcher. A better solution would be to abort here, and instead
add a catch-all condition handler so we never come here. */
Fthrow (Qtop_level, Qt);
string = Ferror_message_string (error);
fatal ("%s", SDATA (string));

4
src/keyboard.c
View file

@ -1167,9 +1167,10 @@ top_level_2 (void)
encountering an error, to help with debugging. */
bool setup_handler = noninteractive;
if (setup_handler)
/* FIXME: Should we (re)use `list_of_error` from `xdisp.c`? */
push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0);
Lisp_Object res = Feval (Vtop_level, Qnil);
Lisp_Object res = Feval (Vtop_level, Qt);
if (setup_handler)
pop_handler ();
@ -1365,7 +1366,6 @@ command_loop_1 (void)
display_malloc_warning ();
Vdeactivate_mark = Qnil;
backtrace_yet = false;
/* Don't ignore mouse movements for more than a single command
loop. (This flag is set in xdisp.c whenever the tool bar is

1
src/lisp.h
View file

@ -4529,7 +4529,6 @@ extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
extern bool signal_quit_p (Lisp_Object);
extern bool backtrace_yet;
/* To run a normal hook, use the appropriate function from the list below.
The calling convention:

20
src/xdisp.c
View file

@ -3072,10 +3072,24 @@ dsafe__call (bool inhibit_quit, Lisp_Object (f) (ptrdiff_t, Lisp_Object *),
return val;
}
static Lisp_Object
funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args)
{
/* If an error is signaled during a Lisp hook in redisplay, write a
backtrace into the buffer *Redisplay-trace*. */
push_handler_bind (list_of_error, Qdebug_early__muted, 0);
Lisp_Object res = Ffuncall (nargs, args);
pop_handler ();
return res;
}
#define SAFE_CALLMANY(inhibit_quit, f, array) \
dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array)
#define dsafe_calln(inhibit_quit, ...) \
SAFE_CALLMANY ((inhibit_quit), Ffuncall, ((Lisp_Object []) {__VA_ARGS__}))
#define dsafe_calln(inhibit_quit, ...) \
SAFE_CALLMANY ((inhibit_quit), \
backtrace_on_redisplay_error \
? funcall_with_backtraces : Ffuncall, \
((Lisp_Object []) {__VA_ARGS__}))
static Lisp_Object
dsafe_call1 (Lisp_Object f, Lisp_Object arg)
@ -37753,6 +37767,8 @@ cursor shapes. */);
DEFSYM (Qthin_space, "thin-space");
DEFSYM (Qzero_width, "zero-width");
DEFSYM (Qdebug_early__muted, "debug-early--muted");
DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function,
doc: /* Function run just before redisplay.
It is called with one argument, which is the set of windows that are to