# HG changeset patch # User Richard M. Stallman # Date 1184438633 0 # Node ID f533b796856e802d4aa8019f06c77f790e14b24f # Parent d51d516c783fe0ad0b7a809ea94ff52a7aad8b3b (maybe_call_debugger): New function. (find_handler_clause): Use maybe_call_debugger. Call it when the handler says `debug'. Eliminate DEBUGGER_VALUE_PTR. (Fsignal): Eliminate debugger_value. (Qdebug): New variable. (syms_of_eval): Initialize it. diff -r d51d516c783f -r f533b796856e src/eval.c --- a/src/eval.c Sat Jul 14 18:34:22 2007 +0000 +++ b/src/eval.c Sat Jul 14 18:43:53 2007 +0000 @@ -97,6 +97,7 @@ Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; +Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs @@ -1585,8 +1586,7 @@ static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object *)); + Lisp_Object, Lisp_Object)); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. @@ -1612,7 +1612,6 @@ Lisp_Object conditions; extern int gc_in_progress; extern int waiting_for_input; - Lisp_Object debugger_value; Lisp_Object string; Lisp_Object real_error_symbol; struct backtrace *bp; @@ -1670,7 +1669,7 @@ register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, - error_symbol, data, &debugger_value); + error_symbol, data); if (EQ (clause, Qlambda)) { @@ -1701,7 +1700,7 @@ handlerlist = allhandlers; /* If no handler is present now, try to run the debugger, and if that fails, throw to top level. */ - find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); + find_handler_clause (Qerror, conditions, error_symbol, data); if (catchlist != 0) Fthrow (Qtop_level, Qt); @@ -1853,75 +1852,54 @@ = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. - Store value returned from debugger into *DEBUGGER_VALUE_PTR. - We need to increase max_specpdl_size temporarily around anything we do that can push on the specpdl, so as not to get a second error here in case we're handling specpdl overflow. */ static Lisp_Object -find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) +find_handler_clause (handlers, conditions, sig, data) Lisp_Object handlers, conditions, sig, data; - Lisp_Object *debugger_value_ptr; { register Lisp_Object h; register Lisp_Object tem; - - if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ + int debugger_called = 0; + int debugger_considered = 0; + + /* t is used by handlers for all conditions, set up by C code. */ + if (EQ (handlers, Qt)) return Qt; + + /* Don't run the debugger for a memory-full error. + (There is no room in memory to do that!) */ + if (NILP (sig)) + debugger_considered = 1; + /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ if (EQ (handlers, Qerror) || !NILP (Vdebug_on_signal)) /* This says call debugger even if there is a handler. */ { - int debugger_called = 0; - Lisp_Object sig_symbol, combined_data; - /* This is set to 1 if we are handling a memory-full error, - because these must not run the debugger. - (There is no room in memory to do that!) */ - int no_debugger = 0; - - if (NILP (sig)) - { - combined_data = data; - sig_symbol = Fcar (data); - no_debugger = 1; - } - else - { - combined_data = Fcons (sig, data); - sig_symbol = sig; - } - - if (wants_debugger (Vstack_trace_on_error, conditions)) + if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) { max_specpdl_size++; -#ifdef PROTOTYPES + #ifdef PROTOTYPES internal_with_output_to_temp_buffer ("*Backtrace*", (Lisp_Object (*) (Lisp_Object)) Fbacktrace, Qnil); -#else + #else internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil); -#endif + #endif max_specpdl_size--; } - if (! no_debugger - /* Don't try to run the debugger with interrupts blocked. - The editing loop would return anyway. */ - && ! INPUT_BLOCKED_P - && (EQ (sig_symbol, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) - && when_entered_debugger < num_nonmacro_input_events) + + if (!debugger_considered) { - *debugger_value_ptr - = call_debugger (Fcons (Qerror, - Fcons (combined_data, Qnil))); - debugger_called = 1; + debugger_considered = 1; + debugger_called = maybe_call_debugger (conditions, sig, data); } + /* If there is no handler, return saying whether we ran the debugger. */ if (EQ (handlers, Qerror)) { @@ -1930,6 +1908,7 @@ return Qt; } } + for (h = handlers; CONSP (h); h = Fcdr (h)) { Lisp_Object handler, condit; @@ -1948,18 +1927,55 @@ /* Handle a list of condition names in handler HANDLER. */ else if (CONSP (condit)) { - while (CONSP (condit)) + Lisp_Object tail; + for (tail = condit; CONSP (tail); tail = XCDR (tail)) { - tem = Fmemq (Fcar (condit), conditions); + tem = Fmemq (Fcar (tail), conditions); if (!NILP (tem)) - return handler; - condit = XCDR (condit); + { + /* This handler is going to apply. + Does it allow the debugger to run first? */ + if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) + maybe_call_debugger (conditions, sig, data); + return handler; + } } } } + return Qnil; } +/* Call the debugger if calling it is currently enabled for CONDITIONS. + SIG and DATA describe the signal, as in find_handler_clause. */ + +int +maybe_call_debugger (conditions, sig, data) + Lisp_Object conditions, sig, data; +{ + Lisp_Object combined_data; + + combined_data = Fcons (sig, data); + + if ( + /* Don't try to run the debugger with interrupts blocked. + The editing loop would return anyway. */ + ! INPUT_BLOCKED_P + /* Does user wants to enter debugger for this kind of error? */ + && (EQ (sig, Qquit) + ? debug_on_quit + : wants_debugger (Vdebug_on_error, conditions)) + && ! skip_debugger (conditions, combined_data) + /* rms: what's this for? */ + && when_entered_debugger < num_nonmacro_input_events) + { + call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); + return 1; + } + + return 0; +} + /* dump an error message; called like printf */ /* VARARGS 1 */ @@ -3600,6 +3616,9 @@ Qand_optional = intern ("&optional"); staticpro (&Qand_optional); + Qdebug = intern ("debug"); + staticpro (&Qdebug); + DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, doc: /* *Non-nil means errors display a backtrace buffer. More precisely, this happens for any error that is handled