- Qnil);
- }
- pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
- specpdl = pdlvec + 1;
- specpdl_size = pdlvecsize - 1;
- specpdl_ptr = specpdl + count;
- }
-}
-
-void
-record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
-{
- eassert (nargs >= UNEVALLED);
- specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
- specpdl_ptr->bt.debug_on_exit = false;
- specpdl_ptr->bt.function = function;
- specpdl_ptr->bt.args = args;
- specpdl_ptr->bt.nargs = nargs;
- grow_specpdl ();
-}
-
-/* Eval a sub-expression of the current expression (i.e. in the same
- lexical scope). */
-Lisp_Object
-eval_sub (Lisp_Object form)
-{
- Lisp_Object fun, val, original_fun, original_args;
- Lisp_Object funcar;
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- if (SYMBOLP (form))
- {
- /* Look up its binding in the lexical environment.
- We do not pay attention to the declared_special flag here, since we
- already did that when let-binding the variable. */
- Lisp_Object lex_binding
- = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- ? Fassq (form, Vinternal_interpreter_environment)
- : Qnil;
- if (CONSP (lex_binding))
- return XCDR (lex_binding);
- else
- return Fsymbol_value (form);
- }
-
- if (!CONSP (form))
- return form;
-
- QUIT;
-
- GCPRO1 (form);
- maybe_gc ();
- UNGCPRO;
-
- if (++lisp_eval_depth > max_lisp_eval_depth)
- {
- if (max_lisp_eval_depth < 100)
- max_lisp_eval_depth = 100;
- if (lisp_eval_depth > max_lisp_eval_depth)
- error ("Lisp nesting exceeds `max-lisp-eval-depth'");
- }
-
- original_fun = XCAR (form);
- original_args = XCDR (form);
-
- /* This also protects them from gc. */
- record_in_backtrace (original_fun, &original_args, UNEVALLED);
-
- if (debug_on_next_call)
- do_debug_on_call (Qt);
-
- /* At this point, only original_fun and original_args
- have values that will be used below. */
- retry:
-
- /* Optimize for no indirection. */
- fun = original_fun;
- if (!SYMBOLP (fun))
- fun = Ffunction (Fcons (fun, Qnil));
- else if (!NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
- fun = indirect_function (fun);
-
- if (SUBRP (fun))
- {
- Lisp_Object numargs;
- Lisp_Object argvals[8];
- Lisp_Object args_left;
- register int i, maxargs;
-
- args_left = original_args;
- numargs = Flength (args_left);
-
- check_cons_list ();
-
- if (XINT (numargs) < XSUBR (fun)->min_args
- || (XSUBR (fun)->max_args >= 0
- && XSUBR (fun)->max_args < XINT (numargs)))
- xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
-
- else if (XSUBR (fun)->max_args == UNEVALLED)
- val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- else if (XSUBR (fun)->max_args == MANY)
- {
- /* Pass a vector of evaluated arguments. */
- Lisp_Object *vals;
- ptrdiff_t argnum = 0;
- USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA_LISP (vals, XINT (numargs));
-
- GCPRO3 (args_left, fun, fun);
- gcpro3.var = vals;
- gcpro3.nvars = 0;
-
- while (!NILP (args_left))
- {
- vals[argnum++] = eval_sub (Fcar (args_left));
- args_left = Fcdr (args_left);
- gcpro3.nvars = argnum;
- }
-
- set_backtrace_args (specpdl_ptr - 1, vals);
- set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
-
- val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
- UNGCPRO;
- SAFE_FREE ();
- }
- else
- {
- 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))
- {
- argvals[i] = eval_sub (Fcar (args_left));
- gcpro3.nvars = ++i;
- }
-
- UNGCPRO;
-
- set_backtrace_args (specpdl_ptr - 1, argvals);
- set_backtrace_nargs (specpdl_ptr - 1, 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. */
- emacs_abort ();
- }
- }
- }
- else if (COMPILEDP (fun))
- val = apply_lambda (fun, original_args);
- else
- {
- if (NILP (fun))
- xsignal1 (Qvoid_function, original_fun);
- if (!CONSP (fun))
- xsignal1 (Qinvalid_function, original_fun);
- funcar = XCAR (fun);
- if (!SYMBOLP (funcar))
- xsignal1 (Qinvalid_function, original_fun);
- if (EQ (funcar, Qautoload))
- {
- Fautoload_do_load (fun, original_fun, Qnil);
- goto retry;
- }
- if (EQ (funcar, Qmacro))
- {
- ptrdiff_t count = 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
- interpreted using lexical-binding or not. */
- specbind (Qlexical_binding,
- NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
- exp = apply1 (Fcdr (fun), original_args);
- unbind_to (count, Qnil);
- val = eval_sub (exp);