/* 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,
+ 2011 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 (Lisp_Object, int, Lisp_Object*);
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
+static int interactive_p (int);
+static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
\f
void
init_eval_once (void)
specpdl_ptr = specpdl;
/* Don't forget to update docs (lispref node "Local Variables"). */
max_specpdl_size = 1000;
- max_lisp_eval_depth = 500;
+ max_lisp_eval_depth = 600;
Vrun_hooks = Qnil;
}
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. */
EXCLUDE_SUBRS_P non-zero means always return 0 if the function
called is a built-in. */
-int
+static int
interactive_p (int exclude_subrs_p)
{
struct backtrace *btp;
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))
{
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);
}
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;
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];
while (1)
{
- int used;
+ EMACS_INT used;
used = doprnt (buffer, size, m, m + mlen, ap);
if (used < size)
break;
(XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
- if (XSUBR (fun)->max_args == UNEVALLED)
+ else if (XSUBR (fun)->max_args == UNEVALLED)
{
backtrace.evalargs = 0;
- val = (XSUBR (fun)->function.a1) (args_left);
- goto done;
+ val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
}
-
- if (XSUBR (fun)->max_args == MANY)
+ else if (XSUBR (fun)->max_args == MANY)
{
/* 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.am) (XINT (numargs), vals);
+ val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
UNGCPRO;
- goto done;
+ SAFE_FREE ();
}
-
- GCPRO3 (args_left, fun, fun);
- gcpro3.var = argvals;
- gcpro3.nvars = 0;
-
- maxargs = XSUBR (fun)->max_args;
- for (i = 0; i < maxargs; args_left = Fcdr (args_left))
+ else
{
- argvals[i] = Feval (Fcar (args_left));
- gcpro3.nvars = ++i;
- }
+ GCPRO3 (args_left, fun, fun);
+ gcpro3.var = argvals;
+ gcpro3.nvars = 0;
- UNGCPRO;
+ maxargs = XSUBR (fun)->max_args;
+ for (i = 0; i < maxargs; args_left = Fcdr (args_left))
+ {
+ argvals[i] = Feval (Fcar (args_left));
+ gcpro3.nvars = ++i;
+ }
- backtrace.args = argvals;
- backtrace.nargs = XINT (numargs);
+ UNGCPRO;
- switch (i)
- {
- case 0:
- val = (XSUBR (fun)->function.a0) ();
- goto done;
- case 1:
- val = (XSUBR (fun)->function.a1) (argvals[0]);
- goto done;
- case 2:
- val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]);
- goto done;
- case 3:
- val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1],
- argvals[2]);
- goto done;
- case 4:
- val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1],
- argvals[2], argvals[3]);
- goto done;
- case 5:
- val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4]);
- goto done;
- case 6:
- 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.a7) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5],
- argvals[6]);
- goto done;
-
- case 8:
- val = (XSUBR (fun)->function.a8) (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
- subr to use a different argument protocol, or add more
- cases to this switch. */
- abort ();
+ backtrace.args = argvals;
+ backtrace.nargs = XINT (numargs);
+
+ switch (i)
+ {
+ case 0:
+ val = (XSUBR (fun)->function.a0 ());
+ break;
+ case 1:
+ val = (XSUBR (fun)->function.a1 (argvals[0]));
+ break;
+ case 2:
+ val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1]));
+ break;
+ case 3:
+ val = (XSUBR (fun)->function.a3
+ (argvals[0], argvals[1], argvals[2]));
+ break;
+ case 4:
+ val = (XSUBR (fun)->function.a4
+ (argvals[0], argvals[1], argvals[2], argvals[3]));
+ break;
+ case 5:
+ val = (XSUBR (fun)->function.a5
+ (argvals[0], argvals[1], argvals[2], argvals[3],
+ argvals[4]));
+ break;
+ case 6:
+ val = (XSUBR (fun)->function.a6
+ (argvals[0], argvals[1], argvals[2], argvals[3],
+ argvals[4], argvals[5]));
+ break;
+ case 7:
+ val = (XSUBR (fun)->function.a7
+ (argvals[0], argvals[1], argvals[2], argvals[3],
+ argvals[4], argvals[5], argvals[6]));
+ break;
+
+ case 8:
+ val = (XSUBR (fun)->function.a8
+ (argvals[0], argvals[1], argvals[2], argvals[3],
+ argvals[4], argvals[5], argvals[6], argvals[7]));
+ break;
+
+ default:
+ /* Someone has created a subr that takes more arguments than
+ is supported by this code. We need to either rewrite the
+ subr to use a different argument protocol, or add more
+ cases to this switch. */
+ abort ();
+ }
}
}
- if (COMPILEDP (fun))
+ else if (COMPILEDP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
else
xsignal1 (Qinvalid_function, original_fun);
}
- done:
CHECK_CONS_LIST ();
lisp_eval_depth--;
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;
}
}
/* 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. */
}
}
-/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
- present value of that symbol.
- Call each element of FUNLIST,
- passing each of them the rest of ARGS.
- The caller (or its caller, etc) must gcpro all of ARGS,
- except that it isn't necessary to gcpro ARGS[0]. */
-
-Lisp_Object
-run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
-{
- Lisp_Object sym;
- Lisp_Object val;
- Lisp_Object globals;
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- sym = args[0];
- globals = Qnil;
- GCPRO3 (sym, val, globals);
-
- for (val = funlist; CONSP (val); val = XCDR (val))
- {
- if (EQ (XCAR (val), Qt))
- {
- /* t indicates this hook has a local binding;
- it means to run the global binding too. */
-
- for (globals = Fdefault_value (sym);
- CONSP (globals);
- globals = XCDR (globals))
- {
- args[0] = XCAR (globals);
- /* In a global value, t should not occur. If it does, we
- must ignore it to avoid an endless loop. */
- if (!EQ (args[0], Qt))
- Ffuncall (nargs, args);
- }
- }
- else
- {
- args[0] = XCAR (val);
- Ffuncall (nargs, args);
- }
- }
- UNGCPRO;
- return Qnil;
-}
-
/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
void
if (SUBRP (fun))
{
- if (numargs < XSUBR (fun)->min_args
+ if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
{
XSETFASTINT (lisp_numargs, numargs);
xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
}
- if (XSUBR (fun)->max_args == UNEVALLED)
+ else if (XSUBR (fun)->max_args == UNEVALLED)
xsignal1 (Qinvalid_function, original_fun);
- if (XSUBR (fun)->max_args == MANY)
- {
- val = (XSUBR (fun)->function.am) (numargs, args + 1);
- goto done;
- }
-
- if (XSUBR (fun)->max_args > numargs)
- {
- internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * 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;
- }
+ else if (XSUBR (fun)->max_args == MANY)
+ val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
else
- internal_args = args + 1;
- switch (XSUBR (fun)->max_args)
{
- case 0:
- val = (XSUBR (fun)->function.a0) ();
- goto done;
- case 1:
- val = (XSUBR (fun)->function.a1) (internal_args[0]);
- goto done;
- case 2:
- val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]);
- goto done;
- case 3:
- val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1],
- internal_args[2]);
- goto done;
- case 4:
- 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.a5) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4]);
- goto done;
- case 6:
- 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.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.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:
-
- /* 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 ();
+ if (XSUBR (fun)->max_args > numargs)
+ {
+ internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * 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;
+ }
+ else
+ internal_args = args + 1;
+ switch (XSUBR (fun)->max_args)
+ {
+ case 0:
+ val = (XSUBR (fun)->function.a0 ());
+ break;
+ case 1:
+ val = (XSUBR (fun)->function.a1 (internal_args[0]));
+ break;
+ case 2:
+ val = (XSUBR (fun)->function.a2
+ (internal_args[0], internal_args[1]));
+ break;
+ case 3:
+ val = (XSUBR (fun)->function.a3
+ (internal_args[0], internal_args[1], internal_args[2]));
+ break;
+ case 4:
+ val = (XSUBR (fun)->function.a4
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3]));
+ break;
+ case 5:
+ val = (XSUBR (fun)->function.a5
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4]));
+ break;
+ case 6:
+ val = (XSUBR (fun)->function.a6
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4], internal_args[5]));
+ break;
+ case 7:
+ 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]));
+ break;
+
+ case 8:
+ 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]));
+ break;
+
+ default:
+
+ /* 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 ();
+ }
}
}
- if (COMPILEDP (fun))
+ else if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
else
xsignal1 (Qinvalid_function, original_fun);
}
- done:
CHECK_CONS_LIST ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
return val;
}
\f
-Lisp_Object
+static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
{
Lisp_Object args_left;
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;
}
register int i;
Lisp_Object tail;
Lisp_Object tem;
- extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
+ Lisp_Object old_print_level = Vprint_level;
- XSETFASTINT (Vprint_level, 3);
+ if (NILP (Vprint_level))
+ XSETFASTINT (Vprint_level, 8);
tail = Qnil;
GCPRO1 (tail);
backlist = backlist->next;
}
- Vprint_level = Qnil;
+ Vprint_level = old_print_level;
UNGCPRO;
return Qnil;
}
defsubr (&Sbacktrace_frame);
}
-/* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff