X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ccb767d639543d70ac689c93eb64849eea376583..35e1f9d9fcbaab51808e05f514e63927f959ae51:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 929b98e9f7..8194468a65 100644 --- a/src/eval.c +++ b/src/eval.c @@ -27,11 +27,7 @@ along with GNU Emacs. If not, see . */ #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. */ @@ -97,10 +93,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. */ @@ -1273,7 +1267,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 +1309,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, return val; } } - } + } val = eval_sub (bodyform); handlerlist = oldhandlerlist; @@ -1536,8 +1533,7 @@ See also the function `condition-case'. */) || 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))) @@ -1921,7 +1917,7 @@ DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0, 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 (); @@ -2275,17 +2271,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)); @@ -2303,38 +2295,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); + 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); - GCPRO1 (*funcall_args); - gcpro1.nvars = 1 + numargs; + funcall_nargs = 1 + numargs; } memcpy (funcall_args, args, nargs * word_size); @@ -2347,11 +2330,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; } @@ -2559,41 +2541,22 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, 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 })); } - + /* 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. */ @@ -2601,14 +2564,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 Ffuncall (2, ((Lisp_Object []) { fn, arg1 })); } /* Call function fn with 2 arguments arg1, arg2. */ @@ -2616,14 +2572,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 Ffuncall (3, ((Lisp_Object []) { fn, arg1, arg2 })); } /* Call function fn with 3 arguments arg1, arg2, arg3. */ @@ -2631,15 +2580,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 Ffuncall (4, ((Lisp_Object []) { fn, arg1, arg2, arg3 })); } /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ @@ -2648,16 +2589,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 Ffuncall (5, ((Lisp_Object []) { fn, arg1, arg2, arg3, arg4 })); } /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ @@ -2666,17 +2598,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 Ffuncall (6, ((Lisp_Object []) { fn, arg1, arg2, arg3, arg4, arg5 })); } /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ @@ -2685,18 +2607,8 @@ 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 Ffuncall (7, ((Lisp_Object []) + { fn, arg1, arg2, arg3, arg4, arg5, arg6 })); } /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ @@ -2705,19 +2617,8 @@ 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 Ffuncall (8, ((Lisp_Object []) + { fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7 })); } /* The caller should GCPRO all the elements of ARGS. */ @@ -2793,10 +2694,11 @@ 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; @@ -3502,13 +3404,24 @@ backtrace_eval_unrewind (int distance) 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: