/* Evaluator for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
#include "dispextern.h"
#include <setjmp.h>
+#if HAVE_X_WINDOWS
+#include "xterm.h"
+#endif
+
/* This definition is duplicated in alloc.c and keyboard.c */
/* Putting it in lisp.h makes cc bomb out! */
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
/* Pointer to first unused element in specpdl. */
-volatile struct specbinding *specpdl_ptr;
+struct specbinding *specpdl_ptr;
/* Maximum size allowed for specpdl allocation */
Lisp_Object Vmacro_declaration_function;
+extern Lisp_Object Qrisky_local_variable;
static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
-
+static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
+
+#if __GNUC__
+/* "gcc -O3" enables automatic function inlining, which optimizes out
+ the arguments for the invocations of these functions, whereas they
+ expect these values on the stack. */
+Lisp_Object apply1 () __attribute__((noinline));
+Lisp_Object call2 () __attribute__((noinline));
+#endif
+\f
void
init_eval_once ()
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl;
+ /* Don't forget to update docs (lispref node "Local Variables"). */
max_specpdl_size = 1000;
- max_lisp_eval_depth = 300;
+ max_lisp_eval_depth = 400;
Vrun_hooks = Qnil;
}
doc: /* Eval args until one of them yields non-nil, then return that value.
The remaining args are not evalled at all.
If all args return nil, return nil.
-usage: (or CONDITIONS ...) */)
+usage: (or CONDITIONS...) */)
(args)
Lisp_Object args;
{
doc: /* Eval args until one of them yields nil, then return nil.
The remaining args are not evalled at all.
If no arg yields nil, return the last arg's value.
-usage: (and CONDITIONS ...) */)
+usage: (and CONDITIONS...) */)
(args)
Lisp_Object args;
{
DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
-usage: (progn BODY ...) */)
+usage: (progn BODY...) */)
(args)
Lisp_Object args;
{
The second VAL is not computed until after the first SYM is set, and so on;
each VAL can use the new value of variables set earlier in the `setq'.
The return value of the `setq' form is the value of the last VAL.
-usage: (setq SYM VAL SYM VAL ...) */)
+usage: (setq [SYM VAL]...) */)
(args)
Lisp_Object args;
{
/* If this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p. If so, skip it. */
- fun = Findirect_function (*btp->function);
+ fun = Findirect_function (*btp->function, Qnil);
if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
|| XSUBR (fun) == &Scalled_interactively_p))
btp = btp->next;
a special form, ignoring frames for Finteractive_p and/or
Fbytecode at the top. If this frame is for a built-in function
(such as load or eval-region) return nil. */
- fun = Findirect_function (*btp->function);
+ fun = Findirect_function (*btp->function, Qnil);
if (exclude_subrs_p && SUBRP (fun))
return 0;
DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
-Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE,
- and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has.
+Aliased variables always have the same value; setting one sets the other.
Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
+ Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
return sym;
}
if (SYMBOLP (elt))
specbind (elt, Qnil);
else if (! NILP (Fcdr (Fcdr (elt))))
- Fsignal (Qerror,
- Fcons (build_string ("`let' bindings can have only one value-form"),
- elt));
+ signal_error ("`let' bindings can have only one value-form", elt);
else
{
val = Feval (Fcar (Fcdr (elt)));
if (SYMBOLP (elt))
temps [argnum++] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
- Fsignal (Qerror,
- Fcons (build_string ("`let' bindings can have only one value-form"),
- elt));
+ signal_error ("`let' bindings can have only one value-form", elt);
else
temps [argnum++] = Feval (Fcar (Fcdr (elt)));
gcpro2.nvars = argnum;
TAG is evalled to get the tag to use; it must not be nil.
Then the BODY is executed.
-Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
+Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
If no throw happens, `catch' returns the value of the last BODY form.
If a throw happens, it specifies the value to return from `catch'.
usage: (catch TAG BODY...) */)
}
while (! last_time);
+#if HAVE_X_WINDOWS
+ /* If x_catch_errors was done, turn it off now.
+ (First we give unbind_to a chance to do that.) */
+#if 0 /* This would disable x_catch_errors after x_connection_closed.
+ * The catch must remain in effect during that delicate
+ * state. --lorentey */
+ x_fully_uncatch_errors ();
+#endif
+#endif
+
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
{
register struct catchtag *c;
- while (1)
- {
- if (!NILP (tag))
- for (c = catchlist; c; c = c->next)
- {
- if (EQ (c->tag, tag))
- unwind_to_catch (c, value);
- }
- tag = Fsignal (Qno_catch, Fcons (tag, Fcons (value, Qnil)));
- }
+ if (!NILP (tag))
+ for (c = catchlist; c; c = c->next)
+ {
+ if (EQ (c->tag, tag))
+ unwind_to_catch (c, value);
+ }
+ xsignal2 (Qno_catch, tag, value);
}
struct catchtag c;
struct handler h;
-#if 0 /* We now handle interrupt_input_blocked properly.
- What we still do not handle is exiting a signal handler. */
+ /* Since Fsignal will close off all calls to x_catch_errors,
+ we will get the wrong results if some are not closed now. */
+#if 0 /* Fsignal doesn't do that anymore. --lorentey */
+#if HAVE_X_WINDOWS
+ if (x_catching_errors ())
abort ();
+#endif
#endif
c.tag = Qnil;
struct catchtag c;
struct handler h;
+ /* Since Fsignal will close off all calls to x_catch_errors,
+ we will get the wrong results if some are not closed now. */
+#if 0 /* Fsignal doesn't do that anymore. --lorentey */
+#if HAVE_X_WINDOWS
+ if (x_catching_errors ())
+ abort ();
+#endif
+#endif
+
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
struct catchtag c;
struct handler h;
+ /* Since Fsignal will close off all calls to x_catch_errors,
+ we will get the wrong results if some are not closed now. */
+#if 0 /* Fsignal doesn't do that anymore. --lorentey */
+#if HAVE_X_WINDOWS
+ if (x_catching_errors ())
+ abort ();
+#endif
+#endif
+
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
\f
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.
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;
register Lisp_Object clause;
clause = find_handler_clause (handlerlist->handler, conditions,
- error_symbol, data, &debugger_value);
+ error_symbol, data);
if (EQ (clause, Qlambda))
{
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);
fatal ("%s", SDATA (string), 0);
}
-/* Return nonzero iff LIST is a non-nil atom or
+/* Internal version of Fsignal that never returns.
+ Used for anything but Qquit (which can return from Fsignal). */
+
+void
+xsignal (error_symbol, data)
+ Lisp_Object error_symbol, data;
+{
+ Fsignal (error_symbol, data);
+ abort ();
+}
+
+/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
+
+void
+xsignal0 (error_symbol)
+ Lisp_Object error_symbol;
+{
+ xsignal (error_symbol, Qnil);
+}
+
+void
+xsignal1 (error_symbol, arg)
+ Lisp_Object error_symbol, arg;
+{
+ xsignal (error_symbol, list1 (arg));
+}
+
+void
+xsignal2 (error_symbol, arg1, arg2)
+ Lisp_Object error_symbol, arg1, arg2;
+{
+ xsignal (error_symbol, list2 (arg1, arg2));
+}
+
+void
+xsignal3 (error_symbol, arg1, arg2, arg3)
+ Lisp_Object error_symbol, arg1, arg2, arg3;
+{
+ xsignal (error_symbol, list3 (arg1, arg2, arg3));
+}
+
+/* Signal `error' with message S, and additional arg ARG.
+ If ARG is not a genuine list, make it a one-element list. */
+
+void
+signal_error (s, arg)
+ char *s;
+ Lisp_Object arg;
+{
+ Lisp_Object tortoise, hare;
+
+ hare = tortoise = arg;
+ while (CONSP (hare))
+ {
+ hare = XCDR (hare);
+ if (!CONSP (hare))
+ break;
+
+ hare = XCDR (hare);
+ tortoise = XCDR (tortoise);
+
+ if (EQ (hare, tortoise))
+ break;
+ }
+
+ if (!NILP (hare))
+ arg = Fcons (arg, Qnil); /* Make it a list. */
+
+ xsignal (Qerror, Fcons (build_string (s), arg));
+}
+
+
+/* Return nonzero if LIST is a non-nil atom or
a list containing one of CONDITIONS. */
static int
= 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
- && (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))
{
return Qt;
}
}
+
for (h = handlers; CONSP (h); h = Fcdr (h))
{
Lisp_Object handler, condit;
/* 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 */
if (allocated)
xfree (buffer);
- Fsignal (Qerror, Fcons (string, Qnil));
- abort ();
+ xsignal1 (Qerror, string);
}
\f
DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
{
register Lisp_Object fun;
register Lisp_Object funcar;
+ Lisp_Object if_prop = Qnil;
fun = function;
- fun = indirect_function (fun);
- if (EQ (fun, Qunbound))
+ fun = indirect_function (fun); /* Check cycles. */
+ if (NILP (fun) || EQ (fun, Qunbound))
return Qnil;
+ /* Check an `interactive-form' property if present, analogous to the
+ function-documentation property. */
+ fun = function;
+ while (SYMBOLP (fun))
+ {
+ Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
+ if (!NILP (tmp))
+ if_prop = Qt;
+ fun = Fsymbol_function (fun);
+ }
+
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
if (SUBRP (fun))
- {
- if (XSUBR (fun)->prompt)
- return Qt;
- else
- return Qnil;
- }
+ return XSUBR (fun)->prompt ? Qt : if_prop;
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
else if (COMPILEDP (fun))
return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
- ? Qt : Qnil);
+ ? Qt : if_prop);
/* Strings and vectors are keyboard macros. */
- if (NILP (for_call_interactively) && (STRINGP (fun) || VECTORP (fun)))
- return Qt;
+ if (STRINGP (fun) || VECTORP (fun))
+ return NILP (for_call_interactively) ? Qt : Qnil;
/* Lists may represent commands. */
if (!CONSP (fun))
return Qnil;
funcar = XCAR (fun);
if (EQ (funcar, Qlambda))
- return Fassq (Qinteractive, Fcdr (XCDR (fun)));
+ return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
if (EQ (funcar, Qautoload))
- return Fcar (Fcdr (Fcdr (XCDR (fun))));
+ return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
else
return Qnil;
}
second = Fcdr (first);
first = Fcar (first);
- if (CONSP (second) && EQ (XCAR (second), Qautoload))
+ if (SYMBOLP (first) && CONSP (second) && EQ (XCAR (second), Qautoload))
Fput (first, Qautoload, (XCDR (second)));
queue = XCDR (queue);
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- fun = Findirect_function (fun);
+ fun = Findirect_function (fun, Qnil);
if (!NILP (Fequal (fun, fundef)))
error ("Autoloading failed to define function %s",
/* At this point, only original_fun and original_args
have values that will be used below */
retry:
- fun = Findirect_function (original_fun);
+
+ /* Optimize for no indirection. */
+ fun = original_fun;
+ if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ fun = indirect_function (fun);
if (SUBRP (fun))
{
if (XINT (numargs) < XSUBR (fun)->min_args ||
(XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
- return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
+ xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
if (XSUBR (fun)->max_args == UNEVALLED)
{
val = apply_lambda (fun, original_args, 1);
else
{
+ if (EQ (fun, Qunbound))
+ xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
- funcar = Fcar (fun);
+ xsignal1 (Qinvalid_function, original_fun);
+ funcar = XCAR (fun);
if (!SYMBOLP (funcar))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qautoload))
{
do_autoload (fun, original_fun);
else if (EQ (funcar, Qlambda))
val = apply_lambda (fun, original_args, 1);
else
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, original_fun);
}
done:
CHECK_CONS_LIST ();
numargs += nargs - 2;
- fun = indirect_function (fun);
+ /* Optimize for no indirection. */
+ if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ fun = indirect_function (fun);
if (EQ (fun, Qunbound))
{
/* Let funcall get the error */
int nargs;
Lisp_Object *args;
{
- Lisp_Object fun;
+ Lisp_Object fun, original_fun;
Lisp_Object funcar;
int numargs = nargs - 1;
Lisp_Object lisp_numargs;
CHECK_CONS_LIST ();
- retry:
+ original_fun = args[0];
- fun = args[0];
+ retry:
- fun = Findirect_function (fun);
+ /* Optimize for no indirection. */
+ fun = original_fun;
+ if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ fun = indirect_function (fun);
if (SUBRP (fun))
{
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
{
XSETFASTINT (lisp_numargs, numargs);
- return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
+ xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
}
if (XSUBR (fun)->max_args == UNEVALLED)
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, original_fun);
if (XSUBR (fun)->max_args == MANY)
{
val = funcall_lambda (fun, numargs, args + 1);
else
{
+ if (EQ (fun, Qunbound))
+ xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
- funcar = Fcar (fun);
+ xsignal1 (Qinvalid_function, original_fun);
+ funcar = XCAR (fun);
if (!SYMBOLP (funcar))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
- do_autoload (fun, args[0]);
+ do_autoload (fun, original_fun);
CHECK_CONS_LIST ();
goto retry;
}
else
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, original_fun);
}
done:
CHECK_CONS_LIST ();
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
else
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, fun);
}
else if (COMPILEDP (fun))
syms_left = AREF (fun, COMPILED_ARGLIST);
QUIT;
next = XCAR (syms_left);
- while (!SYMBOLP (next))
- next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ if (!SYMBOLP (next))
+ xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
rest = 1;
else if (i < nargs)
specbind (next, arg_vector[i++]);
else if (!optional)
- return Fsignal (Qwrong_number_of_arguments,
- Fcons (fun, Fcons (make_number (nargs), Qnil)));
+ xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
else
specbind (next, Qnil);
}
if (!NILP (syms_left))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ xsignal1 (Qinvalid_function, fun);
else if (i < nargs)
- return Fsignal (Qwrong_number_of_arguments,
- Fcons (fun, Fcons (make_number (nargs), Qnil)));
+ xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
if (max_specpdl_size < 400)
max_specpdl_size = 400;
if (specpdl_size >= max_specpdl_size)
- Fsignal (Qerror,
- Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
+ signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
specpdl_size *= 2;
if (specpdl_size > max_specpdl_size)
Lisp_Object (*function) P_ ((Lisp_Object));
Lisp_Object arg;
{
+ eassert (!handling_signal);
+
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
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