#include <config.h>
+
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+
#include "lisp.h"
#include "blockinput.h"
is handled by the command loop's error handler. */
int debug_on_quit;
-/* The value of num_nonmacro_input_chars as of the last time we
+/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
- again when this is still equal to num_nonmacro_input_chars, then we
+ again when this is still equal to num_nonmacro_input_events, then we
know that the debugger itself has an error, and we should just
signal the error instead of entering an infinite loop of debugger
invocations. */
Lisp_Object funcall_lambda ();
extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
+void
init_eval_once ()
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl;
max_specpdl_size = 600;
- max_lisp_eval_depth = 200;
+ max_lisp_eval_depth = 300;
Vrun_hooks = Qnil;
}
+void
init_eval ()
{
specpdl_ptr = specpdl;
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
- /* This is less than the initial value of num_nonmacro_input_chars. */
+ /* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
}
if (specpdl_size + 40 > max_specpdl_size)
max_specpdl_size = specpdl_size + 40;
debug_on_next_call = 0;
- when_entered_debugger = num_nonmacro_input_chars;
+ when_entered_debugger = num_nonmacro_input_events;
return apply1 (Vdebugger, arg);
}
+void
do_debug_on_call (code)
Lisp_Object code;
{
{
Lisp_Object documentation;
+ if (!SYMBOLP (variable))
+ return Qnil;
+
documentation = Fget (variable, Qvariable_documentation);
if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
\f
DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
"(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
-TAG is evalled to get the tag to use. Then the BODY is executed.\n\
+TAG is evalled to get the tag to use; it must not be nil.\n\
+\n\
+Then the BODY is executed.\n\
Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
If no throw happens, `catch' returns the value of the last BODY form.\n\
If a throw happens, it specifies the value to return from `catch'.")
extern int waiting_for_input;
Lisp_Object debugger_value;
Lisp_Object string;
+ Lisp_Object real_error_symbol;
+ Lisp_Object combined_data;
quit_error_check ();
immediate_quit = 0;
if (gc_in_progress || waiting_for_input)
abort ();
-#ifdef HAVE_WINDOW_SYSTEM
TOTALLY_UNBLOCK_INPUT;
-#endif
+
+ if (NILP (error_symbol))
+ real_error_symbol = Fcar (data);
+ else
+ real_error_symbol = error_symbol;
/* This hook is used by edebug. */
if (! NILP (Vsignal_hook_function))
- Ffuncall (Vsignal_hook_function, error_symbol, data);
+ call2 (Vsignal_hook_function, error_symbol, data);
- conditions = Fget (error_symbol, Qerror_conditions);
+ conditions = Fget (real_error_symbol, Qerror_conditions);
for (; handlerlist; handlerlist = handlerlist->next)
{
{
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
- if (EQ (error_symbol, Qquit))
+ if (EQ (real_error_symbol, Qquit))
return Qnil;
else
error ("Cannot return from the debugger in an error");
struct handler *h = handlerlist;
handlerlist = allhandlers;
- if (EQ (data, memory_signal_data))
- unwind_data = memory_signal_data;
+
+ if (NILP (error_symbol))
+ unwind_data = data;
else
unwind_data = Fcons (error_symbol, data);
h->chosen_clause = clause;
if (catchlist != 0)
Fthrow (Qtop_level, Qt);
- if (! EQ (data, memory_signal_data))
+ if (! NILP (error_symbol))
data = Fcons (error_symbol, data);
string = Ferror_message_string (data);
}
/* Value of Qlambda means we have called debugger and user has continued.
+ There are two ways to pass SIG and DATA:
+ - SIG is the error symbol, and DATA is the rest of the data.
+ = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
+
Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
static Lisp_Object
{
int count = specpdl_ptr - specpdl;
int debugger_called = 0;
+ Lisp_Object sig_symbol, combined_data;
+
+ if (NILP (sig))
+ {
+ combined_data = data;
+ sig_symbol = Fcar (data);
+ }
+ else
+ {
+ combined_data = Fcons (sig, data);
+ sig_symbol = sig;
+ }
if (wants_debugger (Vstack_trace_on_error, conditions))
- internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
- if ((EQ (sig, Qquit)
+ {
+#ifdef __STDC__
+ internal_with_output_to_temp_buffer ("*Backtrace*",
+ (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
+ Qnil);
+#else
+ internal_with_output_to_temp_buffer ("*Backtrace*",
+ Fbacktrace, Qnil);
+#endif
+ }
+ if ((EQ (sig_symbol, Qquit)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
- && ! skip_debugger (conditions, Fcons (sig, data))
- && when_entered_debugger < num_nonmacro_input_chars)
+ && ! skip_debugger (conditions, combined_data)
+ && when_entered_debugger < num_nonmacro_input_events)
{
specbind (Qdebug_on_error, Qnil);
*debugger_value_ptr
= call_debugger (Fcons (Qerror,
- Fcons (Fcons (sig, data),
- Qnil)));
+ Fcons (combined_data, Qnil)));
debugger_called = 1;
}
/* If there is no handler, return saying whether we ran the debugger. */
FUNNAME is the symbol which is the function's name.
FUNDEF is the autoload definition (a list). */
+void
do_autoload (fundef, funname)
Lisp_Object fundef, funname;
{
/* Value saved here is to be restored into Vautoload_queue */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
+ Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);
/* Save the old autoloads, in case we ever do an unload. */
queue = Vautoload_queue;
if (SUBRP (fun))
{
Lisp_Object numargs;
- Lisp_Object argvals[7];
+ Lisp_Object argvals[8];
Lisp_Object args_left;
register int i, maxargs;
argvals[6]);
goto done;
+ case 8:
+ val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ argvals[6], argvals[7]);
+ goto done;
+
default:
/* Someone has created a subr that takes more arguments than
is supported by this code. We need to either rewrite the
internal_args[6]);
goto done;
+ case 8:
+ val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5],
+ internal_args[6], internal_args[7]);
+ goto done;
+
default:
- /* If a subr takes more than 6 arguments without using MANY
+ /* If a subr takes more than 8 arguments without using MANY
or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
abort ();
void
record_unwind_protect (function, arg)
- Lisp_Object (*function)();
+ Lisp_Object (*function) P_ ((Lisp_Object));
Lisp_Object arg;
{
if (specpdl_ptr == specpdl + specpdl_size)
}
}
\f
+void
syms_of_eval ()
{
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
- "Limit on number of Lisp variable bindings & unwind-protects before error.");
+ "*Limit on number of Lisp variable bindings & unwind-protects.\n\
+If Lisp code tries to make more than this many at once,\n\
+an error is signaled.");
DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
- "Limit on depth in `eval', `apply' and `funcall' before error.\n\
+ "*Limit on depth in `eval', `apply' and `funcall' before error.\n\
This limit is to catch infinite recursions for you before they cause\n\
actual stack overflow in C, which would be fatal for Emacs.\n\
You can safely make it considerably larger than its default value,\n\