/* Evaluator for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
Lisp_Object Qdebug;
-extern Lisp_Object Qinteractive_form;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
/* Current number of specbindings allocated in specpdl. */
-int specpdl_size;
+EMACS_INT specpdl_size;
/* Pointer to beginning of specpdl. */
/* Depth in Lisp evaluations and function calls. */
-int lisp_eval_depth;
+EMACS_INT lisp_eval_depth;
/* Maximum allowed depth in Lisp evaluations and function calls. */
Lisp_Object Vmacro_declaration_function;
-extern Lisp_Object Qrisky_local_variable;
-
-extern Lisp_Object Qfunction;
-
-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
+static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
+static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
\f
void
-init_eval_once ()
+init_eval_once (void)
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
}
void
-init_eval ()
+init_eval (void)
{
specpdl_ptr = specpdl;
catchlist = 0;
/* unwind-protect function used by call_debugger. */
static Lisp_Object
-restore_stack_limits (data)
- Lisp_Object data;
+restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
/* Call the Lisp debugger, giving it argument ARG. */
Lisp_Object
-call_debugger (arg)
- Lisp_Object arg;
+call_debugger (Lisp_Object arg)
{
int debug_while_redisplaying;
int count = SPECPDL_INDEX ();
Lisp_Object val;
- int old_max = max_specpdl_size;
+ EMACS_INT old_max = max_specpdl_size;
/* Temporarily bump up the stack limits,
so the debugger won't run out of stack. */
}
void
-do_debug_on_call (code)
- Lisp_Object code;
+do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
backtrace_list->debug_on_exit = 1;
The remaining args are not evalled at all.
If all args return nil, return nil.
usage: (or CONDITIONS...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object val = Qnil;
struct gcpro gcpro1;
The remaining args are not evalled at all.
If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object val = Qt;
struct gcpro gcpro1;
THEN must be one expression, but ELSE... can be zero or more expressions.
If COND yields nil, and there are no ELSE's, the value is nil.
usage: (if COND THEN ELSE...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object cond;
struct gcpro gcpro1;
If a clause has one element, as in (CONDITION),
CONDITION's value if non-nil is returned from the cond-form.
usage: (cond CLAUSES...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object clause, val;
struct gcpro gcpro1;
DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object val = Qnil;
struct gcpro gcpro1;
The value of FIRST is saved during the evaluation of the remaining args,
whose values are discarded.
usage: (prog1 FIRST BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object val;
register Lisp_Object args_left;
do
{
if (!(argnum++))
- val = Feval (Fcar (args_left));
+ val = Feval (Fcar (args_left));
else
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
The value of FORM2 is saved during the evaluation of the
remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object val;
register Lisp_Object args_left;
do
{
if (!(argnum++))
- val = Feval (Fcar (args_left));
+ val = Feval (Fcar (args_left));
else
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
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]...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object args_left;
register Lisp_Object val, sym;
DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
usage: (quote ARG) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
if (!NILP (Fcdr (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
In byte compilation, `function' causes its argument to be compiled.
`quote' cannot do that.
usage: (function ARG) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
if (!NILP (Fcdr (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
either (i) add an extra optional argument and give it an `interactive'
spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
use `called-interactively-p'. */)
- ()
+ (void)
{
return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
}
cleaner to give your function an extra optional argument whose
`interactive' spec specifies non-nil unconditionally (\"p\" is a good
way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
- (kind)
- Lisp_Object kind;
+ (Lisp_Object kind)
{
return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
&& interactive_p (1)) ? Qt : Qnil;
called is a built-in. */
int
-interactive_p (exclude_subrs_p)
- int exclude_subrs_p;
+interactive_p (int exclude_subrs_p)
{
struct backtrace *btp;
Lisp_Object fun;
The definition is (lambda ARGLIST [DOCSTRING] BODY...).
See also the function `interactive'.
usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object fn_name;
register Lisp_Object defn;
Set NAME's `doc-string-elt' property to ELT.
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object fn_name;
register Lisp_Object defn;
tail = XCDR (tail);
}
- while (CONSP (Fcar (tail))
- && EQ (Fcar (Fcar (tail)), Qdeclare))
+ if (CONSP (Fcar (tail))
+ && EQ (Fcar (Fcar (tail)), Qdeclare))
{
if (!NILP (Vmacro_declaration_function))
{
itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
The return value is BASE-VARIABLE. */)
- (new_alias, base_variable, docstring)
- Lisp_Object new_alias, base_variable, docstring;
+ (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
{
struct Lisp_Symbol *sym;
for these variables. \(`defconst' and `defcustom' behave similarly in
this respect.)
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object sym, tem, tail;
value. However, you should normally not make local bindings for
variables defined with this form.
usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object sym, tem;
/* Error handler used in Fuser_variable_p. */
static Lisp_Object
-user_variable_p_eh (ignore)
- Lisp_Object ignore;
+user_variable_p_eh (Lisp_Object ignore)
{
return Qnil;
}
\(3) it is an alias for another user variable.
Return nil if VARIABLE is an alias and there is a loop in the
chain of symbols. */)
- (variable)
- Lisp_Object variable;
+ (Lisp_Object variable)
{
Lisp_Object documentation;
/* If indirect and there's an alias loop, don't check anything else. */
if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
&& NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
- Qt, user_variable_p_eh)))
+ Qt, user_variable_p_eh)))
return Qnil;
while (1)
{
documentation = Fget (variable, Qvariable_documentation);
if (INTEGERP (documentation) && XINT (documentation) < 0)
- return Qt;
+ return Qt;
if (STRINGP (documentation)
- && ((unsigned char) SREF (documentation, 0) == '*'))
- return Qt;
+ && ((unsigned char) SREF (documentation, 0) == '*'))
+ return Qt;
/* If it is (STRING . INTEGER), a negative integer means a user variable. */
if (CONSP (documentation)
- && STRINGP (XCAR (documentation))
- && INTEGERP (XCDR (documentation))
- && XINT (XCDR (documentation)) < 0)
- return Qt;
+ && STRINGP (XCAR (documentation))
+ && INTEGERP (XCDR (documentation))
+ && XINT (XCDR (documentation)) < 0)
+ return Qt;
/* Customizable? See `custom-variable-p'. */
if ((!NILP (Fget (variable, intern ("standard-value"))))
- || (!NILP (Fget (variable, intern ("custom-autoload")))))
- return Qt;
+ || (!NILP (Fget (variable, intern ("custom-autoload")))))
+ return Qt;
if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
- return Qnil;
+ return Qnil;
/* An indirect variable? Let's follow the chain. */
XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
Each VALUEFORM can refer to the symbols already bound by this VARLIST.
usage: (let* VARLIST BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object varlist, val, elt;
int count = SPECPDL_INDEX ();
or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
All the VALUEFORMs are evalled before any symbols are bound.
usage: (let VARLIST BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object *temps, tem;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
register int argnum;
struct gcpro gcpro1, gcpro2;
+ USE_SAFE_ALLOCA;
varlist = Fcar (args);
/* Make space to hold the values to give the bound variables */
elt = Flength (varlist);
- temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
/* Compute the values and store them in `temps' */
}
elt = Fprogn (Fcdr (args));
+ SAFE_FREE ();
return unbind_to (count, elt);
}
The order of execution is thus TEST, BODY, TEST, BODY and so on
until TEST returns nil.
usage: (while TEST BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object test, body;
struct gcpro gcpro1, gcpro2;
The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation. */)
- (form, environment)
- Lisp_Object form;
- Lisp_Object environment;
+ (Lisp_Object form, Lisp_Object environment)
{
/* With cleanups from Hallvard Furuseth. */
register Lisp_Object expander, sym, def, tem;
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...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object tag;
struct gcpro gcpro1;
This is how catches are done from within C code. */
Lisp_Object
-internal_catch (tag, func, arg)
- Lisp_Object tag;
- Lisp_Object (*func) ();
- Lisp_Object arg;
+internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* This structure is made part of the chain `catchlist'. */
struct catchtag c;
This is used for correct unwinding in Fthrow and Fsignal. */
static void
-unwind_to_catch (catch, value)
- struct catchtag *catch;
- Lisp_Object value;
+unwind_to_catch (struct catchtag *catch, Lisp_Object value)
{
register int last_time;
last_time = catchlist == catch;
/* Unwind the specpdl stack, and then restore the proper set of
- handlers. */
+ handlers. */
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
/* 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 */
+ The catch must remain in effect during that delicate
+ state. --lorentey */
x_fully_uncatch_errors ();
#endif
#endif
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
doc: /* Throw to the catch for TAG and return VALUE from it.
Both TAG and VALUE are evalled. */)
- (tag, value)
- register Lisp_Object tag, value;
+ (register Lisp_Object tag, Lisp_Object value)
{
register struct catchtag *c;
after executing the UNWINDFORMS.
If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
Lisp_Object val;
int count = SPECPDL_INDEX ();
When a handler handles an error, control returns to the `condition-case'
and it executes the handler's BODY...
with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
-(If VAR is nil, the handler can't access that information.)
+\(If VAR is nil, the handler can't access that information.)
Then the value of the last BODY form is returned from the `condition-case'
expression.
See also the function `signal' for more info.
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
register Lisp_Object bodyform, handlers;
volatile Lisp_Object var;
rather than passed in a list. Used by Fbyte_code. */
Lisp_Object
-internal_lisp_condition_case (var, bodyform, handlers)
- volatile Lisp_Object var;
- Lisp_Object bodyform, handlers;
+internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
+ Lisp_Object handlers)
{
Lisp_Object val;
struct catchtag c;
if (_setjmp (c.jmp))
{
if (!NILP (h.var))
- specbind (h.var, c.val);
+ specbind (h.var, c.val);
val = Fprogn (Fcdr (h.chosen_clause));
/* Note that this just undoes the binding of h.var; whoever
but allow the debugger to run if that is enabled. */
Lisp_Object
-internal_condition_case (bfun, handlers, hfun)
- Lisp_Object (*bfun) ();
- Lisp_Object handlers;
- Lisp_Object (*hfun) ();
+internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
struct catchtag c;
/* Like internal_condition_case but call BFUN with ARG as its argument. */
Lisp_Object
-internal_condition_case_1 (bfun, arg, handlers, hfun)
- Lisp_Object (*bfun) ();
- Lisp_Object arg;
- Lisp_Object handlers;
- Lisp_Object (*hfun) ();
+internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
+ Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
struct catchtag c;
}
\f
-static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object));
+static Lisp_Object find_handler_clause (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.
error message is constructed.
If the signal is handled, DATA is made available to the handler.
See also the function `condition-case'. */)
- (error_symbol, data)
- Lisp_Object error_symbol, data;
+ (Lisp_Object error_symbol, Lisp_Object data)
{
/* When memory is full, ERROR-SYMBOL is nil,
and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
That is a special case--don't do this in other situations. */
register struct handler *allhandlers = handlerlist;
Lisp_Object conditions;
- extern int gc_in_progress;
- extern int waiting_for_input;
Lisp_Object string;
Lisp_Object real_error_symbol;
struct backtrace *bp;
Used for anything but Qquit (which can return from Fsignal). */
void
-xsignal (error_symbol, data)
- Lisp_Object error_symbol, data;
+xsignal (Lisp_Object error_symbol, Lisp_Object 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;
+xsignal0 (Lisp_Object error_symbol)
{
xsignal (error_symbol, Qnil);
}
void
-xsignal1 (error_symbol, arg)
- Lisp_Object error_symbol, arg;
+xsignal1 (Lisp_Object error_symbol, Lisp_Object arg)
{
xsignal (error_symbol, list1 (arg));
}
void
-xsignal2 (error_symbol, arg1, arg2)
- Lisp_Object error_symbol, arg1, arg2;
+xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2)
{
xsignal (error_symbol, list2 (arg1, arg2));
}
void
-xsignal3 (error_symbol, arg1, arg2, arg3)
- Lisp_Object error_symbol, arg1, arg2, arg3;
+xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
xsignal (error_symbol, list3 (arg1, arg2, arg3));
}
If ARG is not a genuine list, make it a one-element list. */
void
-signal_error (s, arg)
- char *s;
- Lisp_Object arg;
+signal_error (const char *s, Lisp_Object arg)
{
Lisp_Object tortoise, hare;
a list containing one of CONDITIONS. */
static int
-wants_debugger (list, conditions)
- Lisp_Object list, conditions;
+wants_debugger (Lisp_Object list, Lisp_Object conditions)
{
if (NILP (list))
return 0;
according to debugger-ignored-errors. */
static int
-skip_debugger (conditions, data)
- Lisp_Object conditions, data;
+skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
Lisp_Object tail;
int first_string = 1;
SIG and DATA describe the signal, as in find_handler_clause. */
static int
-maybe_call_debugger (conditions, sig, data)
- Lisp_Object conditions, sig, data;
+maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
Lisp_Object combined_data;
a second error here in case we're handling specpdl overflow. */
static Lisp_Object
-find_handler_clause (handlers, conditions, sig, data)
- Lisp_Object handlers, conditions, sig, data;
+find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
+ Lisp_Object sig, Lisp_Object data)
{
register Lisp_Object h;
register Lisp_Object tem;
return Qnil;
}
-/* dump an error message; called like printf */
-/* VARARGS 1 */
+/* dump an error message; called like vprintf */
void
-error (m, a1, a2, a3)
- char *m;
- char *a1, *a2, *a3;
+verror (const char *m, va_list ap)
{
char buf[200];
- int size = 200;
+ EMACS_INT size = 200;
int mlen;
char *buffer = buf;
char *args[3];
int allocated = 0;
Lisp_Object string;
- args[0] = a1;
- args[1] = a2;
- args[2] = a3;
-
mlen = strlen (m);
while (1)
{
- int used = doprnt (buffer, size, m, m + mlen, 3, args);
+ EMACS_INT used;
+ used = doprnt (buffer, size, m, m + mlen, ap);
if (used < size)
break;
size *= 2;
xsignal1 (Qerror, string);
}
+
+
+/* dump an error message; called like printf */
+
+/* VARARGS 1 */
+void
+error (const char *m, ...)
+{
+ va_list ap;
+ va_start (ap, m);
+ verror (m, ap);
+ va_end (ap);
+}
\f
DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
then strings and vectors are not accepted. */)
- (function, for_call_interactively)
- Lisp_Object function, for_call_interactively;
+ (Lisp_Object function, Lisp_Object for_call_interactively)
{
register Lisp_Object fun;
register Lisp_Object funcar;
They default to nil.
If FUNCTION is already defined other than as an autoload,
this does nothing and returns nil. */)
- (function, file, docstring, interactive, type)
- Lisp_Object function, file, docstring, interactive, type;
+ (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type)
{
CHECK_SYMBOL (function);
CHECK_STRING (file);
}
Lisp_Object
-un_autoload (oldqueue)
- Lisp_Object oldqueue;
+un_autoload (Lisp_Object oldqueue)
{
register Lisp_Object queue, first, second;
FUNDEF is the autoload definition (a list). */
void
-do_autoload (fundef, funname)
- Lisp_Object fundef, funname;
+do_autoload (Lisp_Object fundef, Lisp_Object funname)
{
int count = SPECPDL_INDEX ();
Lisp_Object fun;
the function. We do this in the specific case of autoloading
because autoloading is not an explicit request "load this file",
but rather a request to "call this function".
-
+
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
\f
DEFUN ("eval", Feval, Seval, 1, 1, 0,
doc: /* Evaluate FORM and return its value. */)
- (form)
- Lisp_Object form;
+ (Lisp_Object form)
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
if (XSUBR (fun)->max_args == UNEVALLED)
{
backtrace.evalargs = 0;
- val = (*XSUBR (fun)->function) (args_left);
+ val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
goto done;
}
/* Pass a vector of evaluated arguments */
Lisp_Object *vals;
register int argnum = 0;
+ USE_SAFE_ALLOCA;
- vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (vals, XINT (numargs));
GCPRO3 (args_left, fun, fun);
gcpro3.var = vals;
backtrace.args = vals;
backtrace.nargs = XINT (numargs);
- val = (*XSUBR (fun)->function) (XINT (numargs), vals);
+ val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
UNGCPRO;
+ SAFE_FREE ();
goto done;
}
switch (i)
{
case 0:
- val = (*XSUBR (fun)->function) ();
+ val = (XSUBR (fun)->function.a0) ();
goto done;
case 1:
- val = (*XSUBR (fun)->function) (argvals[0]);
+ val = (XSUBR (fun)->function.a1) (argvals[0]);
goto done;
case 2:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
+ val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]);
goto done;
case 3:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
- argvals[2]);
+ val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1],
+ argvals[2]);
goto done;
case 4:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
- argvals[2], argvals[3]);
+ val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1],
+ argvals[2], argvals[3]);
goto done;
case 5:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4]);
+ val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4]);
goto done;
case 6:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5]);
+ val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5]);
goto done;
case 7:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5],
- argvals[6]);
+ val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ 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]);
+ val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ argvals[6], argvals[7]);
goto done;
default:
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
register int i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
- Lisp_Object fun;
+ Lisp_Object fun, retval;
struct gcpro gcpro1;
+ USE_SAFE_ALLOCA;
fun = args [0];
funcall_args = 0;
{
/* Avoid making funcall cons up a yet another new vector of arguments
by explicitly supplying nil's for optional values */
- funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
- * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
for (i = numargs; i < XSUBR (fun)->max_args;)
funcall_args[++i] = Qnil;
GCPRO1 (*funcall_args);
function itself as well as its arguments. */
if (!funcall_args)
{
- funcall_args = (Lisp_Object *) alloca ((1 + numargs)
- * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
GCPRO1 (*funcall_args);
gcpro1.nvars = 1 + numargs;
}
- bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
+ memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
/* Spread the last arg we got. Its first element goes in
the slot that it used to occupy, hence this value of I. */
i = nargs - 1;
}
/* By convention, the caller needs to gcpro Ffuncall's args. */
- RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
+ retval = Ffuncall (gcpro1.nvars, funcall_args);
+ UNGCPRO;
+ SAFE_FREE ();
+
+ return retval;
}
\f
/* Run hook variables in various ways. */
enum run_hooks_condition {to_completion, until_success, until_failure};
-static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
- enum run_hooks_condition));
+static Lisp_Object run_hook_with_args (int, Lisp_Object *,
+ enum run_hooks_condition);
DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
Lisp_Object hook[1];
register int i;
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args HOOK &rest ARGS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, to_completion);
}
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, until_success);
}
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, until_failure);
}
except that it isn't necessary to gcpro ARGS[0]. */
static Lisp_Object
-run_hook_with_args (nargs, args, cond)
- int nargs;
- Lisp_Object *args;
- enum run_hooks_condition cond;
+run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
{
Lisp_Object sym, val, ret;
struct gcpro gcpro1, gcpro2, gcpro3;
except that it isn't necessary to gcpro ARGS[0]. */
Lisp_Object
-run_hook_list_with_args (funlist, nargs, args)
- Lisp_Object funlist;
- int nargs;
- Lisp_Object *args;
+run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
{
Lisp_Object sym;
Lisp_Object val;
/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
void
-run_hook_with_args_2 (hook, arg1, arg2)
- Lisp_Object hook, arg1, arg2;
+run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
{
Lisp_Object temp[3];
temp[0] = hook;
\f
/* Apply fn to arg */
Lisp_Object
-apply1 (fn, arg)
- Lisp_Object fn, arg;
+apply1 (Lisp_Object fn, Lisp_Object arg)
{
struct gcpro gcpro1;
/* Call function fn on no arguments */
Lisp_Object
-call0 (fn)
- Lisp_Object fn;
+call0 (Lisp_Object fn)
{
struct gcpro gcpro1;
/* Call function fn with 1 argument arg1 */
/* ARGSUSED */
Lisp_Object
-call1 (fn, arg1)
- Lisp_Object fn, arg1;
+call1 (Lisp_Object fn, Lisp_Object arg1)
{
struct gcpro gcpro1;
Lisp_Object args[2];
/* Call function fn with 2 arguments arg1, arg2 */
/* ARGSUSED */
Lisp_Object
-call2 (fn, arg1, arg2)
- Lisp_Object fn, arg1, arg2;
+call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
struct gcpro gcpro1;
Lisp_Object args[3];
/* Call function fn with 3 arguments arg1, arg2, arg3 */
/* ARGSUSED */
Lisp_Object
-call3 (fn, arg1, arg2, arg3)
- Lisp_Object fn, arg1, arg2, arg3;
+call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
struct gcpro gcpro1;
Lisp_Object args[4];
/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
/* ARGSUSED */
Lisp_Object
-call4 (fn, arg1, arg2, arg3, arg4)
- Lisp_Object fn, arg1, arg2, arg3, arg4;
+call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4)
{
struct gcpro gcpro1;
Lisp_Object args[5];
/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
/* ARGSUSED */
Lisp_Object
-call5 (fn, arg1, arg2, arg3, arg4, arg5)
- Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
+call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5)
{
struct gcpro gcpro1;
Lisp_Object args[6];
/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
/* ARGSUSED */
Lisp_Object
-call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
- Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
+call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6)
{
struct gcpro gcpro1;
Lisp_Object args[7];
/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
/* ARGSUSED */
Lisp_Object
-call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
- Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7;
+call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7)
{
struct gcpro gcpro1;
Lisp_Object args[8];
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
+ (int nargs, Lisp_Object *args)
{
Lisp_Object fun, original_fun;
Lisp_Object funcar;
if (XSUBR (fun)->max_args == MANY)
{
- val = (*XSUBR (fun)->function) (numargs, args + 1);
+ val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
goto done;
}
if (XSUBR (fun)->max_args > numargs)
{
internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
- bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object));
+ memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
switch (XSUBR (fun)->max_args)
{
case 0:
- val = (*XSUBR (fun)->function) ();
+ val = (XSUBR (fun)->function.a0) ();
goto done;
case 1:
- val = (*XSUBR (fun)->function) (internal_args[0]);
+ val = (XSUBR (fun)->function.a1) (internal_args[0]);
goto done;
case 2:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
+ val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]);
goto done;
case 3:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2]);
+ val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1],
+ internal_args[2]);
goto done;
case 4:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3]);
+ val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3]);
goto done;
case 5:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4]);
+ val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4]);
goto done;
case 6:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4], internal_args[5]);
+ val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5]);
goto done;
case 7:
- 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]);
+ val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5],
+ 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]);
+ val = (XSUBR (fun)->function.a8) (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:
}
\f
Lisp_Object
-apply_lambda (fun, args, eval_flag)
- Lisp_Object fun, args;
- int eval_flag;
+apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
{
Lisp_Object args_left;
Lisp_Object numargs;
struct gcpro gcpro1, gcpro2, gcpro3;
register int i;
register Lisp_Object tem;
+ USE_SAFE_ALLOCA;
numargs = Flength (args);
- arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
args_left = args;
GCPRO3 (*arg_vector, args_left, fun);
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
/* Don't do it again when we return to eval. */
backtrace_list->debug_on_exit = 0;
+ SAFE_FREE ();
return tem;
}
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (fun, nargs, arg_vector)
- Lisp_Object fun;
- int nargs;
- register Lisp_Object *arg_vector;
+funcall_lambda (Lisp_Object fun, int nargs, register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next;
int count = SPECPDL_INDEX ();
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
1, 1, 0,
doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
- (object)
- Lisp_Object object;
+ (Lisp_Object object)
{
Lisp_Object tem;
}
\f
void
-grow_specpdl ()
+grow_specpdl (void)
{
register int count = SPECPDL_INDEX ();
if (specpdl_size >= max_specpdl_size)
specpdl_ptr = specpdl + count;
}
+/* specpdl_ptr->symbol is a field which describes which variable is
+ let-bound, so it can be properly undone when we unbind_to.
+ It can have the following two shapes:
+ - SYMBOL : if it's a plain symbol, it means that we have let-bound
+ a symbol that is not buffer-local (at least at the time
+ the let binding started). Note also that it should not be
+ aliased (i.e. when let-binding V1 that's aliased to V2, we want
+ to record V2 here).
+ - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
+ variable SYMBOL which can be buffer-local. WHERE tells us
+ which buffer is affected (or nil if the let-binding affects the
+ global value of the variable) and BUFFER tells us which buffer was
+ current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
+ BUFFER did not yet have a buffer-local value). */
+
void
-specbind (symbol, value)
- Lisp_Object symbol, value;
+specbind (Lisp_Object symbol, Lisp_Object value)
{
struct Lisp_Symbol *sym;
case SYMBOL_VARALIAS:
sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
case SYMBOL_PLAINVAL:
- { /* The most common case is that of a non-constant symbol with a
- trivial value. Make that as fast as we can. */
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = SYMBOL_VAL (sym);
- specpdl_ptr->func = NULL;
- ++specpdl_ptr;
- if (!sym->constant)
- SET_SYMBOL_VAL (sym, value);
- else
- set_internal (symbol, value, Qnil, 1);
- break;
- }
- case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
+ /* The most common case is that of a non-constant symbol with a
+ trivial value. Make that as fast as we can. */
+ specpdl_ptr->symbol = symbol;
+ specpdl_ptr->old_value = SYMBOL_VAL (sym);
+ specpdl_ptr->func = NULL;
+ ++specpdl_ptr;
+ if (!sym->constant)
+ SET_SYMBOL_VAL (sym, value);
+ else
+ set_internal (symbol, value, Qnil, 1);
+ break;
+ case SYMBOL_LOCALIZED:
+ if (SYMBOL_BLV (sym)->frame_local)
+ error ("Frame-local vars cannot be let-bound");
+ case SYMBOL_FORWARDED:
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
/* FIXME: The third value `current_buffer' is only used in
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
+ eassert (NILP (where) || EQ (where, cur_buf));
specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
/* If SYMBOL is a per-buffer variable which doesn't have a
}
void
-record_unwind_protect (function, arg)
- Lisp_Object (*function) P_ ((Lisp_Object));
- Lisp_Object arg;
+record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
eassert (!handling_signal);
}
Lisp_Object
-unbind_to (count, value)
- int count;
- Lisp_Object value;
+unbind_to (int count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
bound a variable that had a buffer-local or frame-local
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
- was current when the variable was bound. */
+ was current when the variable was bound. */
else if (CONSP (this_binding.symbol))
{
Lisp_Object symbol, where;
Fset_default (symbol, this_binding.old_value);
/* If `where' is non-nil, reset the value in the appropriate
local binding, but only if that binding still exists. */
- else if (BUFFERP (where))
- {
- if (BUFFERP (where)
- ? !NILP (Flocal_variable_p (symbol, where))
- : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
- set_internal (symbol, this_binding.old_value, where, 1);
- }
+ else if (BUFFERP (where)
+ ? !NILP (Flocal_variable_p (symbol, where))
+ : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
+ set_internal (symbol, this_binding.old_value, where, 1);
}
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
The debugger is entered when that frame exits, if the flag is non-nil. */)
- (level, flag)
- Lisp_Object level, flag;
+ (Lisp_Object level, Lisp_Object flag)
{
register struct backtrace *backlist = backtrace_list;
register int i;
DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
doc: /* Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'. */)
- ()
+ (void)
{
register struct backtrace *backlist = backtrace_list;
register int i;
Lisp_Object tail;
Lisp_Object tem;
- extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
XSETFASTINT (Vprint_level, 3);
FUNCTION is whatever was supplied as car of evaluated list,
or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil. */)
- (nframes)
- Lisp_Object nframes;
+ (Lisp_Object nframes)
{
register struct backtrace *backlist = backtrace_list;
register int i;
\f
void
-mark_backtrace ()
+mark_backtrace (void)
{
register struct backtrace *backlist;
register int i;
}
void
-syms_of_eval ()
+syms_of_eval (void)
{
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.