summaryrefslogtreecommitdiff
path: root/src/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c255
1 files changed, 81 insertions, 174 deletions
diff --git a/src/eval.c b/src/eval.c
index cf062194cb1..b98b224e622 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -27,11 +27,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "commands.h"
#include "keyboard.h"
#include "dispextern.h"
-#include "frame.h" /* For XFRAME. */
-
-#if HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
+#include "buffer.h"
/* Chain of condition and catch handlers currently in effect. */
@@ -42,22 +38,6 @@ struct handler *handlerlist;
int gcpro_level;
#endif
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
-Lisp_Object Qinhibit_quit;
-Lisp_Object Qand_rest;
-static Lisp_Object Qand_optional;
-static Lisp_Object Qinhibit_debugger;
-static Lisp_Object Qdeclare;
-Lisp_Object Qinternal_interpreter_environment, Qclosure;
-
-static Lisp_Object Qdebug;
-
-/* This holds either the symbol `run-hooks' or nil.
- It is nil at an early stage of startup, and when Emacs
- is shutting down. */
-
-Lisp_Object Vrun_hooks;
-
/* Non-nil means record all fset's and provide's, to be undone
if the file being autoloaded is not fully loaded.
They are recorded by being consed onto the front of Vautoload_queue:
@@ -65,6 +45,11 @@ Lisp_Object Vrun_hooks;
Lisp_Object Vautoload_queue;
+/* This holds either the symbol `run-hooks' or nil.
+ It is nil at an early stage of startup, and when Emacs
+ is shutting down. */
+Lisp_Object Vrun_hooks;
+
/* Current number of specbindings allocated in specpdl, not counting
the dummy entry specpdl[-1]. */
@@ -97,10 +82,8 @@ static EMACS_INT when_entered_debugger;
/* 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. */
@@ -1179,7 +1162,8 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
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. */)
+Both TAG and VALUE are evalled. */
+ attributes: noreturn)
(register Lisp_Object tag, Lisp_Object value)
{
struct handler *c;
@@ -1273,7 +1257,10 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
{ /* 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. */
+ 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;
@@ -1312,7 +1299,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
return val;
}
}
- }
+ }
val = eval_sub (bodyform);
handlerlist = oldhandlerlist;
@@ -2274,17 +2261,13 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- EMACS_INT numargs;
- register Lisp_Object spread_arg;
- register Lisp_Object *funcall_args;
- Lisp_Object fun, retval;
- struct gcpro gcpro1;
+ ptrdiff_t i, numargs, funcall_nargs;
+ 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));
@@ -2302,38 +2285,29 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* 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;)
- funcall_args[++i] = Qnil;
- GCPRO1 (*funcall_args);
- gcpro1.nvars = 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);
+ memclear (funcall_args + numargs + 1,
+ (XSUBR (fun)->max_args - numargs) * word_size);
+ 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);
- GCPRO1 (*funcall_args);
- gcpro1.nvars = 1 + numargs;
+ funcall_nargs = 1 + numargs;
}
memcpy (funcall_args, args, nargs * word_size);
@@ -2346,11 +2320,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
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;
}
@@ -2380,14 +2353,10 @@ Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object hook[1];
ptrdiff_t i;
for (i = 0; i < nargs; i++)
- {
- hook[0] = args[i];
- run_hook_with_args (1, hook, funcall_nil);
- }
+ run_hook (args[i]);
return Qnil;
}
@@ -2553,46 +2522,34 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
}
}
+/* Run the hook HOOK, giving each function no args. */
+
+void
+run_hook (Lisp_Object hook)
+{
+ Frun_hook_with_args (1, &hook);
+}
+
/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
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);
+ CALLN (Frun_hook_with_args, hook, arg1, arg2);
}
-
+
/* 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) : CALLN (Fapply, 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. */
@@ -2600,14 +2557,7 @@ call0 (Lisp_Object fn)
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 CALLN (Ffuncall, fn, arg1);
}
/* Call function fn with 2 arguments arg1, arg2. */
@@ -2615,14 +2565,7 @@ call1 (Lisp_Object fn, Lisp_Object arg1)
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 CALLN (Ffuncall, fn, arg1, arg2);
}
/* Call function fn with 3 arguments arg1, arg2, arg3. */
@@ -2630,15 +2573,7 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
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 CALLN (Ffuncall, fn, arg1, arg2, arg3);
}
/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
@@ -2647,16 +2582,7 @@ Lisp_Object
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 CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4);
}
/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
@@ -2665,17 +2591,7 @@ Lisp_Object
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 CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5);
}
/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
@@ -2684,18 +2600,7 @@ Lisp_Object
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 CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6);
}
/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
@@ -2704,19 +2609,7 @@ Lisp_Object
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 CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7);
}
/* The caller should GCPRO all the elements of ARGS. */
@@ -2742,8 +2635,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
ptrdiff_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
- register Lisp_Object *internal_args;
- ptrdiff_t i, count;
+ Lisp_Object *internal_args;
+ ptrdiff_t count;
QUIT;
@@ -2792,13 +2685,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
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;
+ memclear (internal_args + numargs,
+ (XSUBR (fun)->max_args - numargs) * word_size);
}
else
internal_args = args + 1;
@@ -3507,6 +3401,18 @@ backtrace_eval_unrewind (int distance)
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:
@@ -3847,7 +3753,8 @@ alist of active lexical bindings. */);
(Just imagine if someone makes it buffer-local). */
Funintern (Qinternal_interpreter_environment, Qnil);
- DEFSYM (Vrun_hooks, "run-hooks");
+ Vrun_hooks = intern_c_string ("run-hooks");
+ staticpro (&Vrun_hooks);
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 18:39:40 +0000