#include "commands.h"
#include "keyboard.h"
#include "dispextern.h"
+#include "buffer.h"
/* Chain of condition and catch handlers currently in effect. */
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
|| NILP (clause)
/* A `debug' symbol in the handler list disables the normal
suppression of the debugger. */
- || (CONSP (clause) && CONSP (clause)
- && !NILP (Fmemq (Qdebug, clause)))
+ || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause)))
/* Special handler that means "print a message and run debugger
if requested". */
|| EQ (h->tag_or_ch, Qerror)))
If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
in which case the function returns the new autoloaded function value.
If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
-it is defines a macro. */)
+it defines a macro. */)
(Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
ptrdiff_t count = SPECPDL_INDEX ();
}
}
-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--;
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t i, numargs, funcall_nargs;
- register Lisp_Object spread_arg;
- register Lisp_Object *funcall_args;
- Lisp_Object fun, retval;
+ register Lisp_Object *funcall_args = NULL;
+ register Lisp_Object spread_arg = args[nargs - 1];
+ Lisp_Object fun = args[0];
+ Lisp_Object retval;
USE_SAFE_ALLOCA;
- fun = args [0];
- funcall_args = 0;
- spread_arg = args [nargs - 1];
CHECK_LIST (spread_arg);
numargs = XINT (Flength (spread_arg));
/* Optimize for no indirection. */
if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
- fun = indirect_function (fun);
- if (NILP (fun))
{
- /* Let funcall get the error. */
- fun = args[0];
- goto funcall;
+ fun = indirect_function (fun);
+ if (NILP (fun))
+ /* Let funcall get the error. */
+ fun = args[0];
}
- if (SUBRP (fun))
+ if (SUBRP (fun) && XSUBR (fun)->max_args > numargs
+ /* Don't hide an error by adding missing arguments. */
+ && numargs >= XSUBR (fun)->min_args)
{
- if (numargs < XSUBR (fun)->min_args
- || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
- goto funcall; /* Let funcall get the error. */
- else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs)
- {
- /* 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; /* nothing */)
- funcall_args[++i] = Qnil;
- funcall_nargs = 1 + XSUBR (fun)->max_args;
- }
+ /* 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; /* nothing */)
+ funcall_args[++i] = Qnil;
+ funcall_nargs = 1 + XSUBR (fun)->max_args;
}
- funcall:
- /* We add 1 to numargs because funcall_args includes the
- function itself as well as its arguments. */
- if (!funcall_args)
- {
+ else
+ { /* We add 1 to numargs because funcall_args includes the
+ function itself as well as its arguments. */
SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
funcall_nargs = 1 + numargs;
}
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 ();
}
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 ();
for (; distance > 0; distance--)
{
tmp += step;
- /* */
switch (tmp->kind)
{
/* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
unwind_protect, but the problem is that we don't know how to
rewind them afterwards. */
case SPECPDL_UNWIND:
+ {
+ Lisp_Object oldarg = tmp->unwind.arg;
+ if (tmp->unwind.func == set_buffer_if_live)
+ tmp->unwind.arg = Fcurrent_buffer ();
+ else if (tmp->unwind.func == save_excursion_restore)
+ tmp->unwind.arg = save_excursion_save ();
+ else
+ break;
+ tmp->unwind.func (oldarg);
+ break;
+ }
+
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_VOID: