aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
authorRichard M. Stallman <[email protected]>2007-07-14 18:43:58 +0000
committerRichard M. Stallman <[email protected]>2007-07-14 18:43:58 +0000
commitf01cbfdda1a3bc60da7b22d7ee19cc3ae2927f1d (patch)
treef707be83dfc57630e0fa01ac27859e96c37fb790 /src/eval.c
parentbe44b862badaad8cc0a498c0f5dc9cce2a352e61 (diff)
(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.
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c119
1 files changed, 69 insertions, 50 deletions
diff --git a/src/eval.c b/src/eval.c
index 355ed30066..cd0d0fc1c5 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
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 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
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 @@ See also the function `condition-case'. */)
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 @@ See also the function `condition-case'. */)
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 @@ See also the function `condition-case'. */)
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 @@ skip_debugger (conditions, data)
= 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;
+ int debugger_called = 0;
+ int debugger_considered = 0;
- if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */
+ /* 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 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
return Qt;
}
}
+
for (h = handlers; CONSP (h); h = Fcdr (h))
{
Lisp_Object handler, condit;
@@ -1948,18 +1927,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
/* 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 @@ before making `inhibit-quit' nil. */);
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