From 604e34338f3b5a31439020c6704f9f9d07d17d69 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Dec 2023 23:31:39 -0500 Subject: [PATCH] Move batch backtrace code to `top_level_2` Move ad-hoc code meant to ease debugging of bootstrap (and batch mode) to `top_level_2` so it doesn't pollute `signal_or_quit`. * src/lisp.h (pop_handler, push_handler_bind): Declare. * src/keyboard.c (top_level_2): Setup an error handler to call `debug-early` when noninteractive. * src/eval.c (pop_handler): Not static any more. (signal_or_quit): Remove special case for noninteractive use. (push_handler_bind): New function, extracted from `Fhandler_bind_1`. (Fhandler_bind_1): Use it. (syms_of_eval): Declare `Qdebug_early__handler`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Weed out frames below `debug-early`. (debug-early--handler): New function. --- lisp/emacs-lisp/debug-early.el | 4 ++++ src/eval.c | 38 +++++++++++++--------------------- src/keyboard.c | 12 ++++++++++- src/lisp.h | 2 ++ 4 files changed, 31 insertions(+), 25 deletions(-) diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index f2eb8792bfa..464c2e96927 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -94,4 +94,8 @@ available before `debug' was usable.)" (prin1 (cdr (car (cdr args)))) ; The error data. (debug-early-backtrace))) +(defalias 'debug-early--handler ;Called from C. + #'(lambda (err) + (if backtrace-on-error-noninteractive (debug-early 'error err)))) + ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 595267f7686..7e578a1aa05 100644 --- a/src/eval.c +++ b/src/eval.c @@ -317,6 +317,7 @@ call_debugger (Lisp_Object 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. */ + /* FIXME: Move this to the redisplay code? */ if (debug_while_redisplaying && !EQ (Vdebugger, Qdebug_early)) Ftop_level (); @@ -1198,7 +1199,7 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) -static void +void pop_handler (void) { handlerlist = handlerlist->next; @@ -1367,6 +1368,16 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +void +push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip) +{ + if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = skip; +} + DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. @@ -1392,11 +1403,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object conditions = args[i], handler = args[i + 1]; if (NILP (conditions)) continue; - else if (!CONSP (conditions)) - conditions = Fcons (conditions, Qnil); - struct handler *c = push_handler (conditions, HANDLER_BIND); - c->val = handler; - c->bytecode_dest = count++; + push_handler_bind (conditions, handler, count++); } Lisp_Object ret = call0 (bodyfun); for (; count > 0; count--) @@ -1885,24 +1892,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) return Qnil; } - /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug-early' unconditionally - to not interfere with ERT or other packages that install custom - debuggers. */ - /* FIXME: This could be turned into a `handler-bind` at toplevel? */ - if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (clause, Qerror)) - && noninteractive && backtrace_on_error_noninteractive - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); - unbind_to (count, 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? */ @@ -4392,6 +4381,7 @@ before making `inhibit-quit' nil. */); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); + DEFSYM (Qdebug_early__handler, "debug-early--handler"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. diff --git a/src/keyboard.c b/src/keyboard.c index 4555b71abe7..816147c9130 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1163,7 +1163,17 @@ command_loop_2 (Lisp_Object handlers) static Lisp_Object top_level_2 (void) { - return Feval (Vtop_level, Qnil); + /* If we're in batch mode, print a backtrace unconditionally when + encountering an error, to help with debugging. */ + bool setup_handler = noninteractive; + if (setup_handler) + push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); + + Lisp_Object res = Feval (Vtop_level, Qnil); + + if (setup_handler) + pop_handler (); + return res; } static Lisp_Object diff --git a/src/lisp.h b/src/lisp.h index 2b30326abfc..0e082d14a40 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4570,6 +4570,8 @@ extern Lisp_Object internal_condition_case_n extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); extern struct handler *push_handler (Lisp_Object, enum handlertype) ATTRIBUTE_RETURNS_NONNULL; +extern void pop_handler (void); +extern void push_handler_bind (Lisp_Object, Lisp_Object, int); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); -- 2.39.5