X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/67343d1d9fef95c242a6d050187bb036e4bb82eb..e3060a0c4d2f418ac786775109d71e5843ccf42e:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 7d54ddb18f..77b1db9539 100644 --- a/src/eval.c +++ b/src/eval.c @@ -92,10 +92,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. */ @@ -106,7 +104,7 @@ union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; 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) @@ -174,17 +172,11 @@ backtrace_debug_on_exit (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 @@ -336,10 +328,10 @@ call_debugger (Lisp_Object arg) } 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)); } @@ -1274,8 +1266,11 @@ 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. */ - 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)) @@ -1313,7 +1308,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, return val; } } - } + } val = eval_sub (bodyform); handlerlist = oldhandlerlist; @@ -2034,9 +2029,11 @@ grow_specpdl (void) } } -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; @@ -2044,6 +2041,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) 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 @@ -2054,6 +2053,7 @@ eval_sub (Lisp_Object form) Lisp_Object fun, val, original_fun, original_args; Lisp_Object funcar; struct gcpro gcpro1, gcpro2, gcpro3; + ptrdiff_t count; if (SYMBOLP (form)) { @@ -2091,10 +2091,10 @@ eval_sub (Lisp_Object 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. */ @@ -2146,8 +2146,7 @@ eval_sub (Lisp_Object form) 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; @@ -2168,8 +2167,7 @@ eval_sub (Lisp_Object form) 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) { @@ -2222,7 +2220,7 @@ eval_sub (Lisp_Object form) } } else if (COMPILEDP (fun)) - val = apply_lambda (fun, original_args); + val = apply_lambda (fun, original_args, count); else { if (NILP (fun)) @@ -2239,7 +2237,7 @@ eval_sub (Lisp_Object form) } 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 @@ -2247,19 +2245,19 @@ eval_sub (Lisp_Object form) 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--; @@ -2273,12 +2271,10 @@ 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; + 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]; @@ -2319,10 +2315,9 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* 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: @@ -2331,8 +2326,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) 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); @@ -2345,11 +2339,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; } @@ -2557,41 +2550,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. */ @@ -2599,14 +2573,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. */ @@ -2614,14 +2581,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. */ @@ -2629,15 +2589,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. */ @@ -2646,16 +2598,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. */ @@ -2664,17 +2607,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. */ @@ -2683,18 +2616,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. */ @@ -2703,19 +2626,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. */ @@ -2742,7 +2654,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object lisp_numargs; Lisp_Object val; register Lisp_Object *internal_args; - ptrdiff_t i; + ptrdiff_t i, count; QUIT; @@ -2755,13 +2667,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } /* 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 (); @@ -2791,10 +2703,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; @@ -2880,14 +2793,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } 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; } 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; @@ -2914,15 +2827,14 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) 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 ();