/* FIXME: We should probably get rid of this! */
Lisp_Object Vsignaling_function;
-/* If non-nil, Lisp code must not be run since some part of Emacs is
- in an inconsistent state. Currently, x-create-frame uses this to
- avoid triggering window-configuration-change-hook while the new
- frame is half-initialized. */
+/* If non-nil, Lisp code must not be run since some part of Emacs is in
+ an inconsistent state. Currently unused. */
Lisp_Object inhibit_lisp_code;
/* These would ordinarily be static, but they need to be visible to GDB. */
union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
-static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
+static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t);
static Lisp_Object
specpdl_symbol (union specbinding *pdl)
/* Functions to modify slots of backtrace records. */
static void
-set_backtrace_args (union specbinding *pdl, Lisp_Object *args)
+set_backtrace_args (union specbinding *pdl, Lisp_Object *args, ptrdiff_t nargs)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
pdl->bt.args = args;
-}
-
-static void
-set_backtrace_nargs (union specbinding *pdl, ptrdiff_t n)
-{
- eassert (pdl->kind == SPECPDL_BACKTRACE);
- pdl->bt.nargs = n;
+ pdl->bt.nargs = nargs;
}
static void
}
static void
-do_debug_on_call (Lisp_Object code)
+do_debug_on_call (Lisp_Object code, ptrdiff_t count)
{
debug_on_next_call = 0;
- set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
+ set_backtrace_debug_on_exit (specpdl + count, true);
call_debugger (list1 (code));
}
\f
{ /* The first clause is the one that should be checked first, so it should
be added to handlerlist last. So we build in `clauses' a table that
- contains `handlers' but in reverse order. */
- Lisp_Object *clauses = alloca (clausenb * sizeof (Lisp_Object *));
+ contains `handlers' but in reverse order. SAFE_ALLOCA won't work
+ here due to the setjmp, so impose a MAX_ALLOCA limit. */
+ if (MAX_ALLOCA / word_size < clausenb)
+ memory_full (SIZE_MAX);
+ Lisp_Object *clauses = alloca (clausenb * sizeof *clauses);
Lisp_Object *volatile clauses_volatile = clauses;
int i = clausenb;
for (val = handlers; CONSP (val); val = XCDR (val))
return val;
}
}
- }
+ }
val = eval_sub (bodyform);
handlerlist = oldhandlerlist;
}
}
-void
+ptrdiff_t
record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
eassert (nargs >= UNEVALLED);
specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
specpdl_ptr->bt.debug_on_exit = false;
specpdl_ptr->bt.args = args;
specpdl_ptr->bt.nargs = nargs;
grow_specpdl ();
+
+ return count;
}
/* Eval a sub-expression of the current expression (i.e. in the same
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
struct gcpro gcpro1, gcpro2, gcpro3;
+ ptrdiff_t count;
if (SYMBOLP (form))
{
original_args = XCDR (form);
/* This also protects them from gc. */
- record_in_backtrace (original_fun, &original_args, UNEVALLED);
+ count = record_in_backtrace (original_fun, &original_args, UNEVALLED);
if (debug_on_next_call)
- do_debug_on_call (Qt);
+ do_debug_on_call (Qt, count);
/* At this point, only original_fun and original_args
have values that will be used below. */
gcpro3.nvars = argnum;
}
- set_backtrace_args (specpdl_ptr - 1, vals);
- set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
+ set_backtrace_args (specpdl + count, vals, XINT (numargs));
val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
UNGCPRO;
UNGCPRO;
- set_backtrace_args (specpdl_ptr - 1, argvals);
- set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
+ set_backtrace_args (specpdl + count, argvals, XINT (numargs));
switch (i)
{
}
}
else if (COMPILEDP (fun))
- val = apply_lambda (fun, original_args);
+ val = apply_lambda (fun, original_args, count);
else
{
if (NILP (fun))
}
if (EQ (funcar, Qmacro))
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
Lisp_Object exp;
/* Bind lexical-binding during expansion of the macro, so the
macro can know reliably if the code it outputs will be
specbind (Qlexical_binding,
NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
exp = apply1 (Fcdr (fun), original_args);
- unbind_to (count, Qnil);
+ unbind_to (count1, Qnil);
val = eval_sub (exp);
}
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
- val = apply_lambda (fun, original_args);
+ val = apply_lambda (fun, original_args, count);
else
xsignal1 (Qinvalid_function, original_fun);
}
check_cons_list ();
lisp_eval_depth--;
- if (backtrace_debug_on_exit (specpdl_ptr - 1))
+ if (backtrace_debug_on_exit (specpdl + count))
val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- EMACS_INT numargs;
+ ptrdiff_t i, numargs, funcall_nargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
- struct gcpro gcpro1;
USE_SAFE_ALLOCA;
fun = args [0];
/* Avoid making funcall cons up a yet another new vector of arguments
by explicitly supplying nil's for optional values. */
SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
- for (i = numargs; i < XSUBR (fun)->max_args;)
+ for (i = numargs; i < XSUBR (fun)->max_args; /* nothing */)
funcall_args[++i] = Qnil;
- GCPRO1 (*funcall_args);
- gcpro1.nvars = 1 + XSUBR (fun)->max_args;
+ funcall_nargs = 1 + XSUBR (fun)->max_args;
}
}
funcall:
if (!funcall_args)
{
SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
- GCPRO1 (*funcall_args);
- gcpro1.nvars = 1 + numargs;
+ funcall_nargs = 1 + numargs;
}
memcpy (funcall_args, args, nargs * word_size);
spread_arg = XCDR (spread_arg);
}
- /* By convention, the caller needs to gcpro Ffuncall's args. */
- retval = Ffuncall (gcpro1.nvars, funcall_args);
- UNGCPRO;
- SAFE_FREE ();
+ /* Ffuncall gcpro's all of its args. */
+ retval = Ffuncall (funcall_nargs, funcall_args);
+ SAFE_FREE ();
return retval;
}
\f
void
run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
{
- Lisp_Object temp[3];
- temp[0] = hook;
- temp[1] = arg1;
- temp[2] = arg2;
-
- Frun_hook_with_args (3, temp);
+ Frun_hook_with_args (3, ((Lisp_Object []) { hook, arg1, arg2 }));
}
-\f
+
/* Apply fn to arg. */
Lisp_Object
apply1 (Lisp_Object fn, Lisp_Object arg)
{
- struct gcpro gcpro1;
-
- GCPRO1 (fn);
- if (NILP (arg))
- RETURN_UNGCPRO (Ffuncall (1, &fn));
- gcpro1.nvars = 2;
- {
- Lisp_Object args[2];
- args[0] = fn;
- args[1] = arg;
- gcpro1.var = args;
- RETURN_UNGCPRO (Fapply (2, args));
- }
+ return (NILP (arg) ? Ffuncall (1, &fn)
+ : Fapply (2, ((Lisp_Object []) { fn, arg })));
}
/* Call function fn on no arguments. */
Lisp_Object
call0 (Lisp_Object fn)
{
- struct gcpro gcpro1;
-
- GCPRO1 (fn);
- RETURN_UNGCPRO (Ffuncall (1, &fn));
+ return Ffuncall (1, &fn);
}
/* Call function fn with 1 argument arg1. */
Lisp_Object
call1 (Lisp_Object fn, Lisp_Object arg1)
{
- struct gcpro gcpro1;
- Lisp_Object args[2];
-
- args[0] = fn;
- args[1] = arg1;
- GCPRO1 (args[0]);
- gcpro1.nvars = 2;
- RETURN_UNGCPRO (Ffuncall (2, args));
+ return Ffuncall (2, ((Lisp_Object []) { fn, arg1 }));
}
/* Call function fn with 2 arguments arg1, arg2. */
Lisp_Object
call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
- struct gcpro gcpro1;
- Lisp_Object args[3];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- GCPRO1 (args[0]);
- gcpro1.nvars = 3;
- RETURN_UNGCPRO (Ffuncall (3, args));
+ return Ffuncall (3, ((Lisp_Object []) { fn, arg1, arg2 }));
}
/* Call function fn with 3 arguments arg1, arg2, arg3. */
Lisp_Object
call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
- struct gcpro gcpro1;
- Lisp_Object args[4];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- GCPRO1 (args[0]);
- gcpro1.nvars = 4;
- RETURN_UNGCPRO (Ffuncall (4, args));
+ return Ffuncall (4, ((Lisp_Object []) { fn, arg1, arg2, arg3 }));
}
/* Call function fn with 4 arguments 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];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- GCPRO1 (args[0]);
- gcpro1.nvars = 5;
- RETURN_UNGCPRO (Ffuncall (5, args));
+ return Ffuncall (5, ((Lisp_Object []) { fn, arg1, arg2, arg3, arg4 }));
}
/* Call function fn with 5 arguments 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];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- args[5] = arg5;
- GCPRO1 (args[0]);
- gcpro1.nvars = 6;
- RETURN_UNGCPRO (Ffuncall (6, args));
+ return Ffuncall (6, ((Lisp_Object []) { fn, arg1, arg2, arg3, arg4, arg5 }));
}
/* Call function fn with 6 arguments 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];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- args[5] = arg5;
- args[6] = arg6;
- GCPRO1 (args[0]);
- gcpro1.nvars = 7;
- RETURN_UNGCPRO (Ffuncall (7, args));
+ return Ffuncall (7, ((Lisp_Object [])
+ { fn, arg1, arg2, arg3, arg4, arg5, arg6 }));
}
/* Call function fn with 7 arguments 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];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- args[5] = arg5;
- args[6] = arg6;
- args[7] = arg7;
- GCPRO1 (args[0]);
- gcpro1.nvars = 8;
- RETURN_UNGCPRO (Ffuncall (8, args));
+ return Ffuncall (8, ((Lisp_Object [])
+ { fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7 }));
}
/* The caller should GCPRO all the elements of ARGS. */
Lisp_Object lisp_numargs;
Lisp_Object val;
register Lisp_Object *internal_args;
- ptrdiff_t i;
+ ptrdiff_t i, count;
QUIT;
}
/* This also GCPROs them. */
- record_in_backtrace (args[0], &args[1], nargs - 1);
+ count = record_in_backtrace (args[0], &args[1], nargs - 1);
/* Call GC after setting up the backtrace, so the latter GCPROs the args. */
maybe_gc ();
if (debug_on_next_call)
- do_debug_on_call (Qlambda);
+ do_debug_on_call (Qlambda, count);
check_cons_list ();
val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
else
{
+ Lisp_Object internal_argbuf[8];
if (XSUBR (fun)->max_args > numargs)
{
- internal_args = alloca (XSUBR (fun)->max_args
- * sizeof *internal_args);
+ eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
+ internal_args = internal_argbuf;
memcpy (internal_args, args + 1, numargs * word_size);
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
check_cons_list ();
lisp_eval_depth--;
- if (backtrace_debug_on_exit (specpdl_ptr - 1))
+ if (backtrace_debug_on_exit (specpdl + count))
val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
return val;
}
\f
static Lisp_Object
-apply_lambda (Lisp_Object fun, Lisp_Object args)
+apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
{
Lisp_Object args_left;
ptrdiff_t i;
UNGCPRO;
- set_backtrace_args (specpdl_ptr - 1, arg_vector);
- set_backtrace_nargs (specpdl_ptr - 1, i);
+ set_backtrace_args (specpdl + count, arg_vector, i);
tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
- if (backtrace_debug_on_exit (specpdl_ptr - 1))
+ if (backtrace_debug_on_exit (specpdl + count))
{
/* Don't do it again when we return to eval. */
- set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
+ set_backtrace_debug_on_exit (specpdl + count, false);
tem = call_debugger (list2 (Qexit, tem));
}
SAFE_FREE ();