diff options
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 872 |
1 files changed, 330 insertions, 542 deletions
diff --git a/src/eval.c b/src/eval.c index d002e81da1d..a1cebcd0257 100644 --- a/src/eval.c +++ b/src/eval.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "buffer.h" #include "pdumper.h" +#include "atimer.h" /* CACHEABLE is ordinarily nothing, except it is 'volatile' if necessary to cajole GCC into not warning incorrectly that a @@ -64,7 +65,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, Lisp_Object, ptrdiff_t); +static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, specpdl_ref); static Lisp_Object lambda_arity (Lisp_Object); static Lisp_Object @@ -103,13 +104,6 @@ specpdl_where (union specbinding *pdl) } static Lisp_Object -specpdl_saved_value (union specbinding *pdl) -{ - eassert (pdl->kind >= SPECPDL_LET); - return pdl->let.saved_value; -} - -static Lisp_Object specpdl_arg (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_UNWIND); @@ -137,13 +131,6 @@ backtrace_args (union specbinding *pdl) return pdl->bt.args; } -static bool -backtrace_debug_on_exit (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_BACKTRACE); - return pdl->bt.debug_on_exit; -} - /* Functions to modify slots of backtrace records. */ static void @@ -236,8 +223,8 @@ init_eval_once_for_pdumper (void) { enum { size = 50 }; union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl); - specpdl_size = size; specpdl = specpdl_ptr = pdlvec + 1; + specpdl_end = specpdl + size; } void @@ -280,19 +267,18 @@ restore_stack_limits (Lisp_Object data) integer_to_intmax (XCDR (data), &max_lisp_eval_depth); } -static void grow_specpdl (void); - /* Call the Lisp debugger, giving it argument ARG. */ Lisp_Object call_debugger (Lisp_Object arg) { bool debug_while_redisplaying; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; intmax_t old_depth = max_lisp_eval_depth; /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - intmax_t old_max = max (max_specpdl_size, count); + ptrdiff_t counti = specpdl_ref_to_count (count); + intmax_t old_max = max (max_specpdl_size, counti); /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 @@ -302,9 +288,9 @@ call_debugger (Lisp_Object arg) /* While debugging Bug#16603, previous value of 100 was found too small to avoid specpdl overflow in the debugger itself. */ - max_ensure_room (&max_specpdl_size, count, 200); + max_ensure_room (&max_specpdl_size, counti, 200); - if (old_max == count) + if (old_max == counti) { /* We can enter the debugger due to specpdl overflow (Bug#16603). */ specpdl_ptr--; @@ -353,11 +339,11 @@ call_debugger (Lisp_Object arg) return unbind_to (count, val); } -static void -do_debug_on_call (Lisp_Object code, ptrdiff_t count) +void +do_debug_on_call (Lisp_Object code, specpdl_ref count) { debug_on_next_call = 0; - set_backtrace_debug_on_exit (specpdl + count, true); + set_backtrace_debug_on_exit (specpdl_ref_to_ptr (count), true); call_debugger (list1 (code)); } @@ -573,6 +559,10 @@ usage: (function ARG) */) { /* Handle the special (:documentation <form>) to build the docstring dynamically. */ Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp))); + if (SYMBOLP (docstring) && !NILP (docstring)) + /* Hack for OClosures: Allow the docstring to be a symbol + * (the OClosure's type). */ + docstring = Fsymbol_name (docstring); CHECK_STRING (docstring); cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); } @@ -676,23 +666,7 @@ default_toplevel_binding (Lisp_Object symbol) binding = pdl; break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return binding; @@ -719,23 +693,7 @@ lexbound_p (Lisp_Object symbol) } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return false; @@ -935,7 +893,7 @@ usage: (let* VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object var, val, elt, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); lexenv = Vinternal_interpreter_environment; @@ -995,7 +953,7 @@ usage: (let VARLIST BODY...) */) { Lisp_Object *temps, tem, lexenv; Lisp_Object elt; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t argnum; USE_SAFE_ALLOCA; @@ -1075,6 +1033,47 @@ usage: (while TEST BODY...) */) return Qnil; } +static void +with_delayed_message_display (struct atimer *timer) +{ + message3 (build_string (timer->client_data)); +} + +static void +with_delayed_message_cancel (void *timer) +{ + xfree (((struct atimer *) timer)->client_data); + cancel_atimer (timer); +} + +DEFUN ("funcall-with-delayed-message", + Ffuncall_with_delayed_message, Sfuncall_with_delayed_message, + 3, 3, 0, + doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a floating +point number. + +If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE +is not displayed. */) + (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) +{ + specpdl_ref count = SPECPDL_INDEX (); + + CHECK_NUMBER (timeout); + CHECK_STRING (message); + + /* Set up the atimer. */ + struct timespec interval = dtotimespec (XFLOATINT (timeout)); + struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, + with_delayed_message_display, + xstrdup (SSDATA (message))); + record_unwind_protect_ptr (with_delayed_message_cancel, timer); + + Lisp_Object result = CALLN (Ffuncall, function); + + return unbind_to (count, result); +} + DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, doc: /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. @@ -1238,6 +1237,7 @@ unwind_to_catch (struct handler *catch, enum nonlocal_exit type, eassert (handlerlist == catch); lisp_eval_depth = catch->f_lisp_eval_depth; + set_act_rec (current_thread, catch->act_rec); sys_longjmp (catch->jmp, 1); } @@ -1271,7 +1271,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) (Lisp_Object args) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (prog_ignore, XCDR (args)); val = eval_sub (XCAR (args)); @@ -1395,7 +1395,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY. The unbind_to undoes just this binding; whoever longjumped to us unwound the stack to C->pdlcount before throwing. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, val); return unbind_to (count, Fprogn (handler_body)); } @@ -1416,7 +1416,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, handler_var = Qinternal_interpreter_environment; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); return unbind_to (count, Fprogn (success_handler)); } @@ -1505,90 +1505,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), } } -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as - its arguments. */ - -Lisp_Object -internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as - its arguments. */ - -Lisp_Object -internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, - Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3, arg4); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, - ARG4, ARG5 as its arguments. */ - -Lisp_Object -internal_condition_case_5 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, - Lisp_Object arg5, Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3, arg4, arg5); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - /* Like internal_condition_case but call BFUN with NARGS as first, and ARGS as second argument. */ @@ -1678,6 +1594,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) c->next = handlerlist; c->f_lisp_eval_depth = lisp_eval_depth; c->pdlcount = SPECPDL_INDEX (); + c->act_rec = get_act_rec (current_thread); c->poll_suppress_count = poll_suppress_count; c->interrupt_input_blocked = interrupt_input_blocked; handlerlist = c; @@ -1702,21 +1619,8 @@ process_quit_flag (void) quit (); } -/* Check quit-flag and quit if it is non-nil. Typing C-g does not - directly cause a quit; it only sets Vquit_flag. So the program - needs to call maybe_quit at times when it is safe to quit. Every - loop that might run for a long time or might not exit ought to call - maybe_quit at least once, at a safe place. Unless that is - impossible, of course. But it is very desirable to avoid creating - loops where maybe_quit is impossible. - - If quit-flag is set to `kill-emacs' the SIGINT handler has received - a request to exit Emacs when it is safe to do. - - When not quitting, process any pending signals. */ - void -maybe_quit (void) +probably_quit (void) { if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) process_quit_flag (); @@ -1789,11 +1693,12 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) && ! NILP (error_symbol) /* Don't try to call a lisp function if we've already overflowed the specpdl stack. */ - && specpdl_ptr < specpdl + specpdl_size) + && specpdl_ptr < specpdl_end) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - max_ensure_room (&max_specpdl_size, SPECPDL_INDEX (), 40); + ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ()); + max_ensure_room (&max_specpdl_size, counti, 40); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1851,18 +1756,20 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) } /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug' unconditionally to not - interfere with ERT or other packages that install custom - debuggers. Don't try to call the debugger while dumping or - bootstrapping, it wouldn't work anyway. */ + with debugging. Make sure to use `debug-early' unconditionally + to not interfere with ERT or other packages that install custom + debuggers. */ if (!debugger_called && !NILP (error_symbol) && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) && noninteractive && backtrace_on_error_noninteractive - && !will_dump_p () && !will_bootstrap_p () - && NILP (Vinhibit_debugger)) + && NILP (Vinhibit_debugger) + && !NILP (Ffboundp (Qdebug_early))) { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug); + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t counti = specpdl_ref_to_count (count); + max_ensure_room (&max_specpdl_size, counti, 200); + specbind (Qdebugger, Qdebug_early); call_debugger (list2 (Qerror, Fcons (error_symbol, data))); unbind_to (count, Qnil); } @@ -2225,28 +2132,50 @@ this does nothing and returns nil. */) Qnil); } -void +static void un_autoload (Lisp_Object oldqueue) { - Lisp_Object queue, first, second; - /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ - queue = Vautoload_queue; + Lisp_Object queue = Vautoload_queue; Vautoload_queue = oldqueue; while (CONSP (queue)) { - first = XCAR (queue); - second = Fcdr (first); - first = Fcar (first); - if (EQ (first, make_fixnum (0))) - Vfeatures = second; + Lisp_Object first = XCAR (queue); + if (CONSP (first) && EQ (XCAR (first), make_fixnum (0))) + Vfeatures = XCDR (first); else - Ffset (first, second); + Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history)))); queue = XCDR (queue); } } +Lisp_Object +load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix) +{ + specpdl_ref count = SPECPDL_INDEX (); + + /* If autoloading gets an error (which includes the error of failing + to define the function being called), we use Vautoload_queue + to undo function definitions and `provide' calls made by + the function. We do this in the specific case of autoloading + because autoloading is not an explicit request "load this file", + but rather a request to "call this function". + + The value saved here is to be restored into Vautoload_queue. */ + record_unwind_protect (un_autoload, Vautoload_queue); + Vautoload_queue = Qt; + Lisp_Object tem + = save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix); + + /* Once loading finishes, don't undo it. */ + Vautoload_queue = Qt; + unbind_to (count, Qnil); + return tem; +} + /* Load an autoloaded function. FUNNAME is the symbol which is the function's name. FUNDEF is the autoload definition (a list). */ @@ -2259,8 +2188,6 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if it defines a macro. */) (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) { - ptrdiff_t count = SPECPDL_INDEX (); - if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) return fundef; @@ -2277,26 +2204,12 @@ it defines a macro. */) CHECK_SYMBOL (funname); - /* If autoloading gets an error (which includes the error of failing - to define the function being called), we use Vautoload_queue - to undo function definitions and `provide' calls made by - the function. We do this in the specific case of autoloading - because autoloading is not an explicit request "load this file", - but rather a request to "call this function". - - The value saved here is to be restored into Vautoload_queue. */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; /* If `macro_only' is set and fundef isn't a macro, assume this autoload to be a "best-effort" (e.g. to try and find a compiler macro), so don't signal an error if autoloading fails. */ Lisp_Object ignore_errors = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; - save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - unbind_to (count, Qnil); + load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); if (NILP (funname) || !NILP (ignore_errors)) return Qnil; @@ -2321,62 +2234,33 @@ LEXICAL can also be an actual lexical environment, in the form of an alist mapping symbols to their value. */) (Lisp_Object form, Lisp_Object lexical) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); return unbind_to (count, eval_sub (form)); } -/* Grow the specpdl stack by one entry. - The caller should have already initialized the entry. - Signal an error on stack overflow. - - Make sure that there is always one unused entry past the top of the - stack, so that the just-initialized entry is safely unwound if - memory exhausted and an error is signaled here. Also, allocate a - never-used entry just before the bottom of the stack; sometimes its - address is taken. */ - -static void -grow_specpdl (void) +void +grow_specpdl_allocation (void) { - specpdl_ptr++; + eassert (specpdl_ptr == specpdl_end); - if (specpdl_ptr == specpdl + specpdl_size) + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t size = specpdl_end - specpdl; + ptrdiff_t pdlvecsize = size + 1; + if (max_size <= size) { - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); - union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= specpdl_size) - signal_error ("Variable binding depth exceeds max-specpdl-size", - Qnil); - } - pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); - specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; + if (max_specpdl_size < 400) + max_size = max_specpdl_size = 400; + if (max_size <= size) + xsignal0 (Qexcessive_variable_binding); } -} - -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.function = function; - current_thread->stack_top = specpdl_ptr->bt.args = args; - specpdl_ptr->bt.nargs = nargs; - grow_specpdl (); - - return count; + pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); + specpdl = pdlvec + 1; + specpdl_end = specpdl + pdlvecsize - 1; + specpdl_ptr = specpdl_ref_to_ptr (count); } /* Eval a sub-expression of the current expression (i.e. in the same @@ -2408,7 +2292,7 @@ eval_sub (Lisp_Object form) 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'"); + xsignal0 (Qexcessive_lisp_nesting); } Lisp_Object original_fun = XCAR (form); @@ -2416,7 +2300,7 @@ eval_sub (Lisp_Object form) CHECK_LIST (original_args); /* This also protects them from gc. */ - ptrdiff_t count + specpdl_ref count = record_in_backtrace (original_fun, &original_args, UNEVALLED); if (debug_on_next_call) @@ -2465,13 +2349,13 @@ eval_sub (Lisp_Object form) vals[argnum++] = eval_sub (arg); } - set_backtrace_args (specpdl + count, vals, argnum); + set_backtrace_args (specpdl_ref_to_ptr (count), vals, argnum); val = XSUBR (fun)->function.aMANY (argnum, vals); lisp_eval_depth--; /* Do the debug-on-exit now, while VALS still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); SAFE_FREE (); specpdl_ptr--; @@ -2487,7 +2371,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), argvals, numargs); switch (i) { @@ -2559,13 +2443,26 @@ eval_sub (Lisp_Object form) } if (EQ (funcar, Qmacro)) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref 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 interpreted using lexical-binding or not. */ specbind (Qlexical_binding, NILP (Vinternal_interpreter_environment) ? Qnil : Qt); + + /* Make the macro aware of any defvar declarations in scope. */ + Lisp_Object dynvars = Vmacroexp__dynvars; + for (Lisp_Object p = Vinternal_interpreter_environment; + !NILP (p); p = XCDR(p)) + { + Lisp_Object e = XCAR (p); + if (SYMBOLP (e)) + dynvars = Fcons(e, dynvars); + } + if (!EQ (dynvars, Vmacroexp__dynvars)) + specbind (Qmacroexp__dynvars, dynvars); + exp = apply1 (Fcdr (fun), original_args); exp = unbind_to (count1, exp); val = eval_sub (exp); @@ -2578,7 +2475,7 @@ eval_sub (Lisp_Object form) } lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -2869,76 +2766,6 @@ apply1 (Lisp_Object fn, Lisp_Object arg) return NILP (arg) ? Ffuncall (1, &fn) : CALLN (Fapply, fn, arg); } -/* Call function fn on no arguments. */ -Lisp_Object -call0 (Lisp_Object fn) -{ - return Ffuncall (1, &fn); -} - -/* Call function fn with 1 argument arg1. */ -Lisp_Object -call1 (Lisp_Object fn, Lisp_Object arg1) -{ - return CALLN (Ffuncall, fn, arg1); -} - -/* Call function fn with 2 arguments arg1, arg2. */ -Lisp_Object -call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) -{ - return CALLN (Ffuncall, fn, arg1, arg2); -} - -/* Call function fn with 3 arguments arg1, arg2, arg3. */ -Lisp_Object -call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3); -} - -/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ -Lisp_Object -call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4); -} - -/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ -Lisp_Object -call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5); -} - -/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ -Lisp_Object -call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6); -} - -/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ -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) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7); -} - -/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, - arg6, arg7, arg8. */ -Lisp_Object -call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, - Lisp_Object arg8) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -} - DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, doc: /* Return t if OBJECT is a function. */) (Lisp_Object object) @@ -2979,74 +2806,74 @@ FUNCTIONP (Lisp_Object object) return false; } -DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, - doc: /* Call first argument as a function, passing remaining arguments to it. -Return the value that function returns. -Thus, (funcall \\='cons \\='x \\='y) returns (x . y). -usage: (funcall FUNCTION &rest ARGUMENTS) */) - (ptrdiff_t nargs, Lisp_Object *args) +Lisp_Object +funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) { - Lisp_Object fun, original_fun; - Lisp_Object funcar; - ptrdiff_t numargs = nargs - 1; - Lisp_Object val; - ptrdiff_t count; - - maybe_quit (); - - 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'"); - } - - count = record_in_backtrace (args[0], &args[1], nargs - 1); - - maybe_gc (); - - if (debug_on_next_call) - do_debug_on_call (Qlambda, count); - - original_fun = args[0]; - + Lisp_Object original_fun = fun; retry: - - /* Optimize for no indirection. */ - fun = original_fun; if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args + 1); + return funcall_subr (XSUBR (fun), numargs, args); else if (COMPILEDP (fun) || SUBR_NATIVE_COMPILED_DYNP (fun) || MODULE_FUNCTIONP (fun)) - val = funcall_lambda (fun, numargs, args + 1); + return funcall_lambda (fun, numargs, args); else { if (NILP (fun)) xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) xsignal1 (Qinvalid_function, original_fun); - funcar = XCAR (fun); + Lisp_Object funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qlambda) || EQ (funcar, Qclosure)) - val = funcall_lambda (fun, numargs, args + 1); + return funcall_lambda (fun, numargs, args); else if (EQ (funcar, Qautoload)) { Fautoload_do_load (fun, original_fun, Qnil); + fun = original_fun; goto retry; } else xsignal1 (Qinvalid_function, original_fun); } +} + +DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, + doc: /* Call first argument as a function, passing remaining arguments to it. +Return the value that function returns. +Thus, (funcall \\='cons \\='x \\='y) returns (x . y). +usage: (funcall FUNCTION &rest ARGUMENTS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + specpdl_ref count; + + maybe_quit (); + + 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) + xsignal0 (Qexcessive_lisp_nesting); + } + + count = record_in_backtrace (args[0], &args[1], nargs - 1); + + maybe_gc (); + + if (debug_on_next_call) + do_debug_on_call (Qlambda, count); + + Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1); + lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; return val; @@ -3059,99 +2886,82 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) { - if (numargs < subr->min_args - || (subr->max_args >= 0 && subr->max_args < numargs)) + eassume (numargs >= 0); + if (numargs >= subr->min_args) { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); - } + /* Conforming call to finite-arity subr. */ + if (numargs <= subr->max_args) + { + Lisp_Object argbuf[8]; + Lisp_Object *a; + if (numargs < subr->max_args) + { + eassume (subr->max_args <= ARRAYELTS (argbuf)); + a = argbuf; + memcpy (a, args, numargs * word_size); + memclear (a + numargs, (subr->max_args - numargs) * word_size); + } + else + a = args; + switch (subr->max_args) + { + case 0: + return subr->function.a0 (); + case 1: + return subr->function.a1 (a[0]); + case 2: + return subr->function.a2 (a[0], a[1]); + case 3: + return subr->function.a3 (a[0], a[1], a[2]); + case 4: + return subr->function.a4 (a[0], a[1], a[2], a[3]); + case 5: + return subr->function.a5 (a[0], a[1], a[2], a[3], a[4]); + case 6: + return subr->function.a6 (a[0], a[1], a[2], a[3], a[4], a[5]); + case 7: + return subr->function.a7 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6]); + case 8: + return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6], a[7]); + default: + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + emacs_abort (); + } + } - else if (subr->max_args == UNEVALLED) - { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal1 (Qinvalid_function, fun); + /* Call to n-adic subr. */ + if (subr->max_args == MANY) + return subr->function.aMANY (numargs, args); } - else if (subr->max_args == MANY) - return (subr->function.aMANY) (numargs, args); + /* Anything else is an error. */ + Lisp_Object fun; + XSETSUBR (fun, subr); + if (subr->max_args == UNEVALLED) + xsignal1 (Qinvalid_function, fun); else - { - Lisp_Object internal_argbuf[8]; - Lisp_Object *internal_args; - if (subr->max_args > numargs) - { - eassert (subr->max_args <= ARRAYELTS (internal_argbuf)); - internal_args = internal_argbuf; - memcpy (internal_args, args, numargs * word_size); - memclear (internal_args + numargs, - (subr->max_args - numargs) * word_size); - } - else - internal_args = args; - switch (subr->max_args) - { - case 0: - return (subr->function.a0 ()); - case 1: - return (subr->function.a1 (internal_args[0])); - case 2: - return (subr->function.a2 - (internal_args[0], internal_args[1])); - case 3: - return (subr->function.a3 - (internal_args[0], internal_args[1], internal_args[2])); - case 4: - return (subr->function.a4 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3])); - case 5: - return (subr->function.a5 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4])); - case 6: - return (subr->function.a6 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5])); - case 7: - return (subr->function.a7 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6])); - case 8: - return (subr->function.a8 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6], internal_args[7])); - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - emacs_abort (); - } - } + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } /* Call the compiled Lisp function FUN. If we have not yet read FUN's bytecode string and constants vector, fetch them from the file first. */ static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left, +fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) { if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); - return exec_byte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - syms_left, nargs, args); + + return exec_byte_code (fun, args_template, nargs, args); } static Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) +apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { Lisp_Object *arg_vector; Lisp_Object tem; @@ -3168,12 +2978,12 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) arg_vector[i] = tem; } - set_backtrace_args (specpdl + count, arg_vector, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), arg_vector, numargs); tem = funcall_lambda (fun, numargs, arg_vector); lisp_eval_depth--; /* Do the debug-on-exit now, while arg_vector still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) tem = call_debugger (list2 (Qexit, tem)); SAFE_FREE (); specpdl_ptr--; @@ -3190,7 +3000,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, register Lisp_Object *arg_vector) { Lisp_Object val, syms_left, next, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t i; bool optional, rest; @@ -3215,18 +3025,15 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else if (COMPILEDP (fun)) { syms_left = AREF (fun, COMPILED_ARGLIST); + /* Bytecode objects using lexical binding have an integral + ARGLIST slot value: pass the arguments to the byte-code + engine directly. */ if (FIXNUMP (syms_left)) - /* A byte-code object with an integer args template means we - shouldn't bind any arguments, instead just call the byte-code - interpreter directly; it will push arguments as necessary. - - Byte-code objects with a nil args template (the default) - have dynamically-bound arguments, and use the - argument-binding code below instead (as do all interpreted - functions, even lexically bound ones). */ - { - return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector); - } + return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), + nargs, arg_vector); + /* Otherwise the bytecode object uses dynamic binding and the + ARGLIST slot contains a standard formal argument list whose + variables are bound dynamically below. */ lexenv = Qnil; } #ifdef HAVE_MODULES @@ -3311,7 +3118,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL); + val = fetch_and_exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3462,6 +3269,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, bytecode = Fstring_as_unibyte (bytecode); } + pin_string (bytecode); ASET (object, COMPILED_BYTECODE, bytecode); ASET (object, COMPILED_CONSTANTS, XCDR (tem)); } @@ -3552,9 +3360,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); - specpdl_ptr->let.saved_value = Qnil; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: @@ -3564,7 +3369,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = ovalue; specpdl_ptr->let.where = Fcurrent_buffer (); - specpdl_ptr->let.saved_value = Qnil; eassert (sym->u.s.redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); @@ -3582,22 +3386,17 @@ specbind (Lisp_Object symbol, Lisp_Object value) having their own value. This is consistent with what happens with other buffer-local variables. */ if (NILP (Flocal_variable_p (symbol, Qnil))) - { - specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); - return; - } + specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; } else specpdl_ptr->let.kind = SPECPDL_LET; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; } default: emacs_abort (); } + grow_specpdl (); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); } /* Push unwind-protect entries of various types. */ @@ -3627,6 +3426,20 @@ record_unwind_protect_ptr (void (*function) (void *), void *arg) specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; specpdl_ptr->unwind_ptr.func = function; specpdl_ptr->unwind_ptr.arg = arg; + specpdl_ptr->unwind_ptr.mark = NULL; + grow_specpdl (); +} + +/* Like `record_unwind_protect_ptr', but also specifies a function + for GC-marking Lisp objects only reachable through ARG. */ +void +record_unwind_protect_ptr_mark (void (*function) (void *), void *arg, + void (*mark) (void *)) +{ + specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; + specpdl_ptr->unwind_ptr.func = function; + specpdl_ptr->unwind_ptr.arg = arg; + specpdl_ptr->unwind_ptr.mark = mark; grow_specpdl (); } @@ -3670,27 +3483,10 @@ record_unwind_protect_module (enum specbind_tag kind, void *ptr) specpdl_ptr->kind = kind; specpdl_ptr->unwind_ptr.func = NULL; specpdl_ptr->unwind_ptr.arg = ptr; + specpdl_ptr->unwind_ptr.mark = NULL; grow_specpdl (); } -void -rebind_for_thread_switch (void) -{ - union specbinding *bind; - - for (bind = specpdl; bind != specpdl_ptr; ++bind) - { - if (bind->kind >= SPECPDL_LET) - { - Lisp_Object value = specpdl_saved_value (bind); - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = Qnil; - do_specbind (XSYMBOL (sym), bind, value, - SET_INTERNAL_THREAD_SWITCH); - } - } -} - static void do_one_unbind (union specbinding *this_binding, bool unwinding, enum Set_Internal_Bind bindflag) @@ -3722,6 +3518,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, this_binding->unwind_excursion.window); break; case SPECPDL_BACKTRACE: + case SPECPDL_NOP: break; #ifdef HAVE_MODULES case SPECPDL_MODULE_RUNTIME: @@ -3786,9 +3583,9 @@ record_unwind_protect_nothing (void) It need not be at the top of the stack. */ void -clear_unwind_protect (ptrdiff_t count) +clear_unwind_protect (specpdl_ref count) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_void.kind = SPECPDL_UNWIND_VOID; p->unwind_void.func = do_nothing; } @@ -3798,10 +3595,10 @@ clear_unwind_protect (ptrdiff_t count) previous value without invoking it. */ void -set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), +set_unwind_protect (specpdl_ref count, void (*func) (Lisp_Object), Lisp_Object arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind.kind = SPECPDL_UNWIND; p->unwind.func = func; p->unwind.arg = arg; @@ -3809,25 +3606,26 @@ set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), } void -set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +set_unwind_protect_ptr (specpdl_ref count, void (*func) (void *), void *arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; p->unwind_ptr.func = func; p->unwind_ptr.arg = arg; + p->unwind_ptr.mark = NULL; } /* Pop and execute entries from the unwind-protect stack until the depth COUNT is reached. Return VALUE. */ Lisp_Object -unbind_to (ptrdiff_t count, Lisp_Object value) +unbind_to (specpdl_ref count, Lisp_Object value) { Lisp_Object quitf = Vquit_flag; Vquit_flag = Qnil; - while (specpdl_ptr != specpdl + count) + while (specpdl_ptr != specpdl_ref_to_ptr (count)) { /* Copy the binding, and decrement specpdl_ptr, before we do the work to unbind it. We decrement first @@ -3847,22 +3645,6 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } -void -unbind_for_thread_switch (struct thread_state *thr) -{ - union specbinding *bind; - - for (bind = thr->m_specpdl_ptr; bind > thr->m_specpdl;) - { - if ((--bind)->kind >= SPECPDL_LET) - { - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = find_symbol_value (sym); - do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH); - } - } -} - DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a @@ -4018,11 +3800,13 @@ or a lambda expression for macro calls. */) value and the old value stored in the specpdl), kind of like the inplace pointer-reversal trick. As it turns out, the rewind does the same as the unwind, except it starts from the other end of the specpdl stack, so we use - the same function for both unwind and rewind. */ -static void -backtrace_eval_unrewind (int distance) + the same function for both unwind and rewind. + This same code is used when switching threads, except in that case + we unwind/rewind the whole specpdl of the threads. */ +void +specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only) { - union specbinding *tmp = specpdl_ptr; + union specbinding *tmp = pdl; int step = -1; if (distance < 0) { /* It's a rewind rather than unwind. */ @@ -4040,6 +3824,8 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: + if (vars_only) + break; if (tmp->unwind.func == set_buffer_if_live) { Lisp_Object oldarg = tmp->unwind.arg; @@ -4048,6 +3834,8 @@ backtrace_eval_unrewind (int distance) } break; case SPECPDL_UNWIND_EXCURSION: + if (vars_only) + break; { Lisp_Object marker = tmp->unwind_excursion.marker; Lisp_Object window = tmp->unwind_excursion.window; @@ -4055,17 +3843,6 @@ backtrace_eval_unrewind (int distance) save_excursion_restore (marker, window); } break; - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; case SPECPDL_LET: { /* If variable has a trivial value (no forwarding), we can just set it. No need to check for constant symbols here, @@ -4088,7 +3865,7 @@ backtrace_eval_unrewind (int distance) Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, default_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH); } break; case SPECPDL_LET_LOCAL: @@ -4104,21 +3881,37 @@ backtrace_eval_unrewind (int distance) { set_specpdl_old_value (tmp, buffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + set_internal (symbol, old_value, where, + SET_INTERNAL_THREAD_SWITCH); } + else + /* If the var is not local any more, it can't be undone nor + redone, so just zap it. + This is important in case the buffer re-gains a local value + before we unrewind again, in which case we'd risk applying + this entry in the wrong direction. */ + tmp->kind = SPECPDL_NOP; } break; + + default: break; } } } +static void +backtrace_eval_unrewind (int distance) +{ + specpdl_unrewind (specpdl_ptr, distance, false); +} + DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL, doc: /* Evaluate EXP in the context of some activation frame. NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base) { union specbinding *pdl = get_backtrace_frame (nframes, base); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t distance = specpdl_ptr - pdl; eassert (distance >= 0); @@ -4192,22 +3985,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; - - default: - emacs_abort (); + default: break; } } } @@ -4265,15 +4043,22 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) case SPECPDL_LET: mark_object (specpdl_symbol (pdl)); mark_object (specpdl_old_value (pdl)); - mark_object (specpdl_saved_value (pdl)); break; case SPECPDL_UNWIND_PTR: + if (pdl->unwind_ptr.mark) + pdl->unwind_ptr.mark (pdl->unwind_ptr.arg); + break; + case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_INTMAX: case SPECPDL_UNWIND_VOID: + case SPECPDL_NOP: break; + /* While other loops that scan the specpdl use "default: break;" + for simplicity, here we explicitly list all cases and abort + if we find an unexpected value, as a sanity check. */ default: emacs_abort (); } @@ -4367,6 +4152,7 @@ before making `inhibit-quit' nil. */); DEFSYM (Qclosure, "closure"); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); + DEFSYM (Qdebug_early, "debug-early"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. @@ -4421,7 +4207,7 @@ If due to frame exit, args are `exit' and the value being returned; If due to error, args are `error' and a list of the args to `signal'. If due to `apply' or `funcall' entry, one arg, `lambda'. If due to `eval' entry, one arg, t. */); - Vdebugger = Qnil; + Vdebugger = Qdebug_early; DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, doc: /* If non-nil, this is a function for `signal' to call. @@ -4511,6 +4297,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); @@ -4539,5 +4326,6 @@ alist of active lexical bindings. */); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); + DEFSYM (Qfunctionp, "functionp"); defsubr (&Sfunctionp); } |