diff options
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 1921 |
1 files changed, 1116 insertions, 805 deletions
diff --git a/src/eval.c b/src/eval.c index acda64e7f04..7da1d8fb989 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1,6 +1,6 @@ /* Evaluator for GNU Emacs Lisp interpreter. -Copyright (C) 1985-1987, 1993-1995, 1999-2017 Free Software Foundation, +Copyright (C) 1985-1987, 1993-1995, 1999-2022 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include <limits.h> -#include <stdio.h> #include <stdlib.h> #include "lisp.h" #include "blockinput.h" @@ -29,6 +28,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "keyboard.h" #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 @@ -39,10 +40,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # define CACHEABLE /* empty */ #endif -/* Chain of condition and catch handlers currently in effect. */ - -/* struct handler *handlerlist; */ - /* 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: @@ -55,43 +52,16 @@ Lisp_Object Vautoload_queue; is shutting down. */ Lisp_Object Vrun_hooks; -/* The commented-out variables below are macros defined in thread.h. */ - -/* Current number of specbindings allocated in specpdl, not counting - the dummy entry specpdl[-1]. */ - -/* ptrdiff_t specpdl_size; */ - -/* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists - only so that its address can be taken. */ - -/* union specbinding *specpdl; */ - -/* Pointer to first unused element in specpdl. */ - -/* union specbinding *specpdl_ptr; */ - -/* Depth in Lisp evaluations and function calls. */ - -/* static EMACS_INT lisp_eval_depth; */ - -/* The value of num_nonmacro_input_events as of the last time we - started to enter the debugger. If we decide to enter the debugger - again when this is still equal to num_nonmacro_input_events, then we - know that the debugger itself has an error, and we should just - signal the error instead of entering an infinite loop of debugger - invocations. */ - -static EMACS_INT when_entered_debugger; - /* The function from which the last `signal' was called. Set in Fsignal. */ /* 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 unused. */ -Lisp_Object inhibit_lisp_code; +/* The handler structure which will catch errors in Lisp hooks called + from redisplay. We do not use it for this; we compare it with the + handler which is about to be used in signal_or_quit, and if it + matches, cause a backtrace to be generated. */ +static struct handler *redisplay_deep_handler; /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; @@ -101,7 +71,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 @@ -140,13 +110,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); @@ -174,13 +137,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 @@ -202,17 +158,36 @@ set_backtrace_debug_on_exit (union specbinding *pdl, bool doe) bool backtrace_p (union specbinding *pdl) -{ return pdl >= specpdl; } +{ return specpdl ? pdl >= specpdl : false; } + +static bool +backtrace_thread_p (struct thread_state *tstate, union specbinding *pdl) +{ return pdl >= tstate->m_specpdl; } union specbinding * backtrace_top (void) { + /* This is so "xbacktrace" doesn't crash in pdumped Emacs if they + invoke the command before init_eval_once_for_pdumper initializes + specpdl machinery. See also backtrace_p above. */ + if (!specpdl) + return NULL; + union specbinding *pdl = specpdl_ptr - 1; while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) pdl--; return pdl; } +static union specbinding * +backtrace_thread_top (struct thread_state *tstate) +{ + union specbinding *pdl = tstate->m_specpdl_ptr - 1; + while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE) + pdl--; + return pdl; +} + union specbinding * backtrace_next (union specbinding *pdl) { @@ -222,21 +197,34 @@ backtrace_next (union specbinding *pdl) return pdl; } +static void init_eval_once_for_pdumper (void); + +static union specbinding * +backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl) +{ + pdl--; + while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE) + pdl--; + return pdl; +} + void init_eval_once (void) { - enum { size = 50 }; - union specbinding *pdlvec = xmalloc ((size + 1) * sizeof *specpdl); - specpdl_size = size; - specpdl = specpdl_ptr = pdlvec + 1; - /* Don't forget to update docs (lispref node "Local Variables"). */ - max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el. */ - max_lisp_eval_depth = 800; - + /* Don't forget to update docs (lispref node "Eval"). */ + max_lisp_eval_depth = 1600; Vrun_hooks = Qnil; + pdumper_do_now_and_after_load (init_eval_once_for_pdumper); } -/* static struct handler handlerlist_sentinel; */ +static void +init_eval_once_for_pdumper (void) +{ + enum { size = 50 }; + union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl); + specpdl = specpdl_ptr = pdlvec + 1; + specpdl_end = specpdl + size; +} void init_eval (void) @@ -257,6 +245,17 @@ init_eval (void) lisp_eval_depth = 0; /* This is less than the initial value of num_nonmacro_input_events. */ when_entered_debugger = -1; + redisplay_deep_handler = NULL; +} + +/* Ensure that *M is at least A + B if possible, or is its maximum + value otherwise. */ + +static void +max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) +{ + intmax_t sum = INT_ADD_WRAPV (a, b, &sum) ? INTMAX_MAX : sum; + *m = max (*m, sum); } /* Unwind-protect function used by call_debugger. */ @@ -264,43 +263,27 @@ init_eval (void) static void restore_stack_limits (Lisp_Object data) { - max_specpdl_size = XINT (XCAR (data)); - max_lisp_eval_depth = XINT (XCDR (data)); + integer_to_intmax (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; - EMACS_INT old_depth = max_lisp_eval_depth; - /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - EMACS_INT old_max = max (max_specpdl_size, count); - - if (lisp_eval_depth + 40 > max_lisp_eval_depth) - max_lisp_eval_depth = lisp_eval_depth + 40; + intmax_t old_depth = max_lisp_eval_depth; - /* While debugging Bug#16603, previous value of 100 was found - too small to avoid specpdl overflow in the debugger itself. */ - if (max_specpdl_size - 200 < count) - max_specpdl_size = count + 200; - - if (old_max == count) - { - /* We can enter the debugger due to specpdl overflow (Bug#16603). */ - specpdl_ptr--; - grow_specpdl (); - } + /* The previous value of 40 is too small now that the debugger + prints using cl-prin1 instead of prin1. Printing lists nested 8 + deep (which is the value of print-level used in the debugger) + currently requires 77 additional frames. See bug#31919. */ + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); /* Restore limits after leaving the debugger. */ - record_unwind_protect (restore_stack_limits, - Fcons (make_number (old_max), - make_number (old_depth))); + record_unwind_protect (restore_stack_limits, make_int (old_depth)); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -334,23 +317,21 @@ call_debugger (Lisp_Object arg) /* Interrupting redisplay and resuming it later is not safe under all circumstances. So, when the debugger returns, abort the interrupted redisplay by going back to the top-level. */ - if (debug_while_redisplaying) + if (debug_while_redisplaying + && !EQ (Vdebugger, Qdebug_early)) Ftop_level (); 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)); } -/* NOTE!!! Every function that can call EVAL must protect its args - and temporaries from garbage collection while it needs them. - The definition of `For' shows what you have to do. */ DEFUN ("or", For, Sor, 0, UNEVALLED, 0, doc: /* Eval args until one of them yields non-nil, then return that value. @@ -446,7 +427,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, usage: (progn BODY...) */) (Lisp_Object body) { - Lisp_Object val = Qnil; + Lisp_Object CACHEABLE val = Qnil; while (CONSP (body)) { @@ -478,17 +459,6 @@ usage: (prog1 FIRST BODY...) */) return val; } -DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0, - doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2. -The value of FORM2 is saved during the evaluation of the -remaining args, whose values are discarded. -usage: (prog2 FORM1 FORM2 BODY...) */) - (Lisp_Object args) -{ - eval_sub (XCAR (args)); - return Fprog1 (XCDR (args)); -} - DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, doc: /* Set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). @@ -504,19 +474,21 @@ usage: (setq [SYM VAL]...) */) for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2) { - Lisp_Object sym = XCAR (tail), lex_binding; + Lisp_Object sym = XCAR (tail); tail = XCDR (tail); if (!CONSP (tail)) - xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1)); + xsignal2 (Qwrong_number_of_arguments, Qsetq, make_fixnum (nargs + 1)); Lisp_Object arg = XCAR (tail); tail = XCDR (tail); val = eval_sub (arg); /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ - if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym) - && !NILP (lex_binding - = Fassq (sym, Vinternal_interpreter_environment))) + Lisp_Object lex_binding + = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + && SYMBOLP (sym)) + ? Fassq (sym, Vinternal_interpreter_environment) + : Qnil); + if (!NILP (lex_binding)) XSETCDR (lex_binding, val); /* SYM is lexically bound. */ else Fset (sym, val); /* SYM is dynamically bound. */ @@ -545,8 +517,11 @@ usage: (quote ARG) */) DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, doc: /* Like `quote', but preferred for objects which are functions. -In byte compilation, `function' causes its argument to be compiled. -`quote' cannot do that. +In byte compilation, `function' causes its argument to be handled by +the byte compiler. Similarly, when expanding macros and expressions, +ARG can be examined and possibly expanded. If `quote' is used +instead, this doesn't happen. + usage: (function ARG) */) (Lisp_Object args) { @@ -569,6 +544,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)))); } @@ -599,16 +578,19 @@ The return value is BASE-VARIABLE. */) if (SYMBOL_CONSTANT_P (new_alias)) /* Making it an alias effectively changes its value. */ - error ("Cannot make a constant an alias"); + error ("Cannot make a constant an alias: %s", + SDATA (SYMBOL_NAME (new_alias))); sym = XSYMBOL (new_alias); - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_FORWARDED: - error ("Cannot make an internal variable an alias"); + error ("Cannot make a built-in variable an alias: %s", + SDATA (SYMBOL_NAME (new_alias))); case SYMBOL_LOCALIZED: - error ("Don't know how to make a localized variable an alias"); + error ("Don't know how to make a buffer-local variable an alias: %s", + SDATA (SYMBOL_NAME (new_alias))); case SYMBOL_PLAINVAL: case SYMBOL_VARALIAS: break; @@ -616,30 +598,41 @@ The return value is BASE-VARIABLE. */) emacs_abort (); } - /* https://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html + /* https://lists.gnu.org/r/emacs-devel/2008-04/msg00834.html If n_a is bound, but b_v is not, set the value of b_v to n_a, so that old-code that affects n_a before the aliasing is setup still works. */ if (NILP (Fboundp (base_variable))) set_internal (base_variable, find_symbol_value (new_alias), Qnil, SET_INTERNAL_BIND); + else if (!NILP (Fboundp (new_alias)) + && !EQ (find_symbol_value (new_alias), + find_symbol_value (base_variable))) + call2 (intern ("display-warning"), + list3 (Qdefvaralias, intern ("losing-value"), new_alias), + CALLN (Fformat_message, + build_string + ("Overwriting value of `%s' by aliasing to `%s'"), + new_alias, base_variable)); + { union specbinding *p; for (p = specpdl_ptr; p > specpdl; ) if ((--p)->kind >= SPECPDL_LET && (EQ (new_alias, specpdl_symbol (p)))) - error ("Don't know how to make a let-bound variable an alias"); + error ("Don't know how to make a let-bound variable an alias: %s", + SDATA (SYMBOL_NAME (new_alias))); } - if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) + if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE) notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil); - sym->declared_special = 1; - XSYMBOL (base_variable)->declared_special = 1; - sym->redirect = SYMBOL_VARALIAS; + sym->u.s.declared_special = true; + XSYMBOL (base_variable)->u.s.declared_special = true; + sym->u.s.redirect = SYMBOL_VARALIAS; SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); - sym->trapped_write = XSYMBOL (base_variable)->trapped_write; + sym->u.s.trapped_write = XSYMBOL (base_variable)->u.s.trapped_write; LOADHIST_ATTACH (new_alias); /* Even if docstring is nil: remove old docstring. */ Fput (new_alias, Qvariable_documentation, docstring); @@ -662,19 +655,37 @@ default_toplevel_binding (Lisp_Object symbol) binding = pdl; break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: - case SPECPDL_LET_LOCAL: + default: break; + } + } + return binding; +} + +/* Look for a lexical-binding of SYMBOL somewhere up the stack. + This will only find bindings created with interpreted code, since once + compiled names of lexical variables are basically gone anyway. */ +static bool +lexbound_p (Lisp_Object symbol) +{ + union specbinding *pdl = specpdl_ptr; + while (pdl > specpdl) + { + switch ((--pdl)->kind) + { + case SPECPDL_LET_DEFAULT: + case SPECPDL_LET: + if (EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment)) + { + Lisp_Object env = specpdl_old_value (pdl); + if (CONSP (env) && !NILP (Fassq (symbol, env))) + return true; + } break; - default: - emacs_abort (); + default: break; } } - return binding; + return false; } DEFUN ("default-toplevel-value", Fdefault_toplevel_value, Sdefault_toplevel_value, 1, 1, 0, @@ -685,7 +696,7 @@ DEFUN ("default-toplevel-value", Fdefault_toplevel_value, Sdefault_toplevel_valu union specbinding *binding = default_toplevel_binding (symbol); Lisp_Object value = binding ? specpdl_old_value (binding) : Fdefault_value (symbol); - if (!EQ (value, Qunbound)) + if (!BASE_EQ (value, Qunbound)) return value; xsignal1 (Qvoid_variable, symbol); } @@ -704,6 +715,63 @@ DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value, return Qnil; } +DEFUN ("internal--define-uninitialized-variable", + Finternal__define_uninitialized_variable, + Sinternal__define_uninitialized_variable, 1, 2, 0, + doc: /* Define SYMBOL as a variable, with DOC as its docstring. +This is like `defvar' and `defconst' but without affecting the variable's +value. */) + (Lisp_Object symbol, Lisp_Object doc) +{ + if (!XSYMBOL (symbol)->u.s.declared_special + && lexbound_p (symbol)) + /* This test tries to catch the situation where we do + (let ((<foo-var> ...)) ...(<foo-function> ...)....) + and where the `foo` package only gets loaded when <foo-function> + is called, so the outer `let` incorrectly made the binding lexical + because the <foo-var> wasn't yet declared as dynamic at that point. */ + xsignal2 (Qerror, + build_string ("Defining as dynamic an already lexical var"), + symbol); + + XSYMBOL (symbol)->u.s.declared_special = true; + if (!NILP (doc)) + { + if (!NILP (Vpurify_flag)) + doc = Fpurecopy (doc); + Fput (symbol, Qvariable_documentation, doc); + } + LOADHIST_ATTACH (symbol); + return Qnil; +} + +static Lisp_Object +defvar (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring, bool eval) +{ + Lisp_Object tem; + + CHECK_SYMBOL (sym); + + tem = Fdefault_boundp (sym); + + /* Do it before evaluating the initial value, for self-references. */ + Finternal__define_uninitialized_variable (sym, docstring); + + if (NILP (tem)) + Fset_default (sym, eval ? eval_sub (initvalue) : initvalue); + else + { /* Check if there is really a global binding rather than just a let + binding that shadows the global unboundness of the var. */ + union specbinding *binding = default_toplevel_binding (sym); + if (binding && BASE_EQ (specpdl_old_value (binding), Qunbound)) + { + set_specpdl_old_value (binding, + eval ? eval_sub (initvalue) : initvalue); + } + } + return sym; +} + DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, doc: /* Define SYMBOL as a variable, and return SYMBOL. You are not required to define a variable in order to use it, but @@ -718,58 +786,37 @@ value. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If INITVALUE is missing, SYMBOL's value is not set. -If SYMBOL has a local binding, then this form affects the local -binding. This is usually not what you want. Thus, if you need to -load a file defining variables, with this form or with `defconst' or -`defcustom', you should always load that file _outside_ any bindings -for these variables. (`defconst' and `defcustom' behave similarly in -this respect.) +If SYMBOL is let-bound, then this form does not affect the local let +binding but the toplevel default binding instead, like +`set-toplevel-default-binding`. +(`defcustom' behaves similarly in this respect.) The optional argument DOCSTRING is a documentation string for the variable. To define a user option, use `defcustom' instead of `defvar'. + +To define a buffer-local variable, use `defvar-local'. usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - Lisp_Object sym, tem, tail; + Lisp_Object sym, tail; sym = XCAR (args); tail = XCDR (args); + CHECK_SYMBOL (sym); + if (!NILP (tail)) { if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); - - tem = Fdefault_boundp (sym); - - /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; - - if (NILP (tem)) - Fset_default (sym, eval_sub (XCAR (tail))); - else - { /* Check if there is really a global binding rather than just a let - binding that shadows the global unboundness of the var. */ - union specbinding *binding = default_toplevel_binding (sym); - if (binding && EQ (specpdl_old_value (binding), Qunbound)) - { - set_specpdl_old_value (binding, eval_sub (XCAR (tail))); - } - } + Lisp_Object exp = XCAR (tail); tail = XCDR (tail); - tem = Fcar (tail); - if (!NILP (tem)) - { - if (!NILP (Vpurify_flag)) - tem = Fpurecopy (tem); - Fput (sym, Qvariable_documentation, tem); - } - LOADHIST_ATTACH (sym); + return defvar (sym, exp, CAR (tail), true); } else if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (sym)->declared_special) + && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ @@ -785,6 +832,14 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) return sym; } +DEFUN ("defvar-1", Fdefvar_1, Sdefvar_1, 2, 3, 0, + doc: /* Like `defvar' but as a function. +More specifically behaves like (defvar SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + return defvar (sym, initvalue, docstring, false); +} + DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, doc: /* Define SYMBOL as a constant variable. This declares that neither programs nor users should ever change the @@ -806,6 +861,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) Lisp_Object sym, tem; sym = XCAR (args); + CHECK_SYMBOL (sym); Lisp_Object docstring = Qnil; if (!NILP (XCDR (XCDR (args)))) { @@ -813,20 +869,22 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) error ("Too many arguments"); docstring = XCAR (XCDR (XCDR (args))); } - tem = eval_sub (XCAR (XCDR (args))); + return Fdefconst_1 (sym, tem, docstring); +} + +DEFUN ("defconst-1", Fdefconst_1, Sdefconst_1, 2, 3, 0, + doc: /* Like `defconst' but as a function. +More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + CHECK_SYMBOL (sym); + Lisp_Object tem = initvalue; + Finternal__define_uninitialized_variable (sym, docstring); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); - Fset_default (sym, tem); - XSYMBOL (sym)->declared_special = 1; - if (!NILP (docstring)) - { - if (!NILP (Vpurify_flag)) - docstring = Fpurecopy (docstring); - Fput (sym, Qvariable_documentation, docstring); - } - Fput (sym, Qrisky_local_variable, Qt); - LOADHIST_ATTACH (sym); + Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ + Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why? */ return sym; } @@ -837,7 +895,7 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special, (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - XSYMBOL (symbol)->declared_special = 0; + XSYMBOL (symbol)->u.s.declared_special = false; return Qnil; } @@ -852,17 +910,14 @@ 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; Lisp_Object varlist = XCAR (args); - while (CONSP (varlist)) + FOR_EACH_TAIL (varlist) { - maybe_quit (); - elt = XCAR (varlist); - varlist = XCDR (varlist); if (SYMBOLP (elt)) { var = elt; @@ -877,7 +932,7 @@ usage: (let* VARLIST BODY...) */) } if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && !XSYMBOL (var)->u.s.declared_special && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ @@ -911,16 +966,15 @@ usage: (let VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object *temps, tem, lexenv; - Lisp_Object elt, varlist; - ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object elt; + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t argnum; USE_SAFE_ALLOCA; - varlist = XCAR (args); - CHECK_LIST (varlist); + Lisp_Object varlist = XCAR (args); /* Make space to hold the values to give the bound variables. */ - EMACS_INT varlist_len = XFASTINT (Flength (varlist)); + EMACS_INT varlist_len = list_length (varlist); SAFE_ALLOCA_LISP (temps, varlist_len); ptrdiff_t nvars = varlist_len; @@ -953,7 +1007,7 @@ usage: (let VARLIST BODY...) */) tem = temps[argnum]; if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && !XSYMBOL (var)->u.s.declared_special && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (var, tem), lexenv); @@ -967,14 +1021,16 @@ usage: (let VARLIST BODY...) */) specbind (Qinternal_interpreter_environment, lexenv); elt = Fprogn (XCDR (args)); - SAFE_FREE (); - return unbind_to (count, elt); + return SAFE_FREE_UNBIND_TO (count, elt); } DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0, doc: /* If TEST yields non-nil, eval BODY... and repeat. The order of execution is thus TEST, BODY, TEST, BODY and so on until TEST returns nil. + +The value of a `while' form is always nil. + usage: (while TEST BODY...) */) (Lisp_Object args) { @@ -991,6 +1047,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. @@ -1022,7 +1119,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) tem = Fassq (sym, environment); if (NILP (tem)) { - def = XSYMBOL (sym)->function; + def = XSYMBOL (sym)->u.s.function; if (!NILP (def)) continue; } @@ -1124,20 +1221,29 @@ internal_catch (Lisp_Object tag, This is used for correct unwinding in Fthrow and Fsignal. */ -static _Noreturn void -unwind_to_catch (struct handler *catch, Lisp_Object value) +static AVOID +unwind_to_catch (struct handler *catch, enum nonlocal_exit type, + Lisp_Object value) { bool last_time; eassert (catch->next); /* Save the value in the tag. */ + catch->nonlocal_exit = type; catch->val = value; /* Restore certain special C variables. */ set_poll_suppress_count (catch->poll_suppress_count); unblock_input_to (catch->interrupt_input_blocked); +#ifdef HAVE_X_WINDOWS + /* Restore the X error handler stack. This is important because + otherwise a display disconnect won't unwind the stack of error + traps to the right depth. */ + x_unwind_errors_to (catch->x_error_handler_depth); +#endif + do { /* Unwind the specpdl stack, and then restore the proper set of @@ -1152,6 +1258,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) eassert (handlerlist == catch); lisp_eval_depth = catch->f_lisp_eval_depth; + set_act_rec (current_thread, catch->act_rec); sys_longjmp (catch->jmp, 1); } @@ -1168,9 +1275,9 @@ Both TAG and VALUE are evalled. */ for (c = handlerlist; c; c = c->next) { if (c->type == CATCHER_ALL) - unwind_to_catch (c, Fcons (tag, value)); - if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) - unwind_to_catch (c, value); + unwind_to_catch (c, NONLOCAL_EXIT_THROW, Fcons (tag, value)); + if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) + unwind_to_catch (c, NONLOCAL_EXIT_THROW, value); } xsignal2 (Qno_catch, tag, value); } @@ -1185,7 +1292,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)); @@ -1196,17 +1303,19 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0, doc: /* Regain control when an error is signaled. Executes BODYFORM and returns its value if no error happens. Each element of HANDLERS looks like (CONDITION-NAME BODY...) -where the BODY is made of Lisp expressions. +or (:success BODY...), where the BODY is made of Lisp expressions. -A handler is applicable to an error -if CONDITION-NAME is one of the error's condition names. -If an error happens, the first applicable handler is run. +A handler is applicable to an error if CONDITION-NAME is one of the +error's condition names. Handlers may also apply when non-error +symbols are signaled (e.g., `quit'). A CONDITION-NAME of t applies to +any symbol, including non-error symbols. If multiple handlers are +applicable, only the first one runs. The car of a handler may be a list of condition names instead of a single condition name; then it handles all of them. If the special condition name `debug' is present in this list, it allows another condition in the list to run the debugger if `debug-on-error' and the -other usual mechanisms says it should (otherwise, `condition-case' +other usual mechanisms say it should (otherwise, `condition-case' suppresses the debugger). When a handler handles an error, control returns to the `condition-case' @@ -1216,6 +1325,10 @@ with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error. Then the value of the last BODY form is returned from the `condition-case' expression. +The special handler (:success BODY...) is invoked if BODYFORM terminated +without signalling an error. BODY is then evaluated with VAR bound to +the value returned by BODYFORM. + See also the function `signal' for more info. usage: (condition-case VAR BODYFORM &rest HANDLERS) */) (Lisp_Object args) @@ -1239,16 +1352,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, CHECK_SYMBOL (var); + Lisp_Object success_handler = Qnil; + for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); - clausenb++; if (! (NILP (tem) || (CONSP (tem) && (SYMBOLP (XCAR (tem)) || CONSP (XCAR (tem)))))) error ("Invalid condition handler: %s", - SDATA (Fprin1_to_string (tem, Qt))); + SDATA (Fprin1_to_string (tem, Qt, Qnil))); + if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) + success_handler = XCDR (tem); + else + clausenb++; } /* The first clause is the one that should be checked first, so it @@ -1262,7 +1380,11 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses); clauses += clausenb; for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail)) - *--clauses = XCAR (tail); + { + Lisp_Object tem = XCAR (tail); + if (!(CONSP (tem) && EQ (XCAR (tem), QCsuccess))) + *--clauses = tem; + } for (ptrdiff_t i = 0; i < clausenb; i++) { Lisp_Object clause = clauses[i]; @@ -1294,14 +1416,31 @@ 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)); } } - Lisp_Object result = eval_sub (bodyform); + Lisp_Object CACHEABLE result = eval_sub (bodyform); handlerlist = oldhandlerlist; + if (!NILP (success_handler)) + { + if (NILP (var)) + return Fprogn (success_handler); + + Lisp_Object handler_var = var; + if (!NILP (Vinternal_interpreter_environment)) + { + result = Fcons (Fcons (var, result), + Vinternal_interpreter_environment); + handler_var = Qinternal_interpreter_environment; + } + + specpdl_ref count = SPECPDL_INDEX (); + specbind (handler_var, result); + return unbind_to (count, Fprogn (success_handler)); + } return result; } @@ -1399,12 +1538,16 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args)) { + struct handler *old_deep = redisplay_deep_handler; struct handler *c = push_handler (handlers, CONDITION_CASE); + if (redisplaying_p) + redisplay_deep_handler = c; if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; + redisplay_deep_handler = old_deep; return hfun (val, nargs, args); } else @@ -1412,8 +1555,40 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), Lisp_Object val = bfun (nargs, args); eassert (handlerlist == c); handlerlist = c->next; + redisplay_deep_handler = old_deep; + return val; + } +} + +static Lisp_Object Qcatch_all_memory_full; + +/* Like a combination of internal_condition_case_1 and internal_catch. + Catches all signals and throws. Never exits nonlocally; returns + Qcatch_all_memory_full if no handler could be allocated. */ + +Lisp_Object +internal_catch_all (Lisp_Object (*function) (void *), void *argument, + Lisp_Object (*handler) (enum nonlocal_exit, Lisp_Object)) +{ + struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL); + if (c == NULL) + return Qcatch_all_memory_full; + + if (sys_setjmp (c->jmp) == 0) + { + Lisp_Object val = function (argument); + eassert (handlerlist == c); + handlerlist = c->next; return val; } + else + { + eassert (handlerlist == c); + enum nonlocal_exit type = c->nonlocal_exit; + Lisp_Object val = c->val; + handlerlist = c->next; + return handler (type, val); + } } struct handler * @@ -1445,8 +1620,12 @@ 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; +#ifdef HAVE_X_WINDOWS + c->x_error_handler_depth = x_error_message_count; +#endif handlerlist = c; return c; } @@ -1463,30 +1642,14 @@ process_quit_flag (void) Lisp_Object flag = Vquit_flag; Vquit_flag = Qnil; if (EQ (flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (EQ (Vthrow_on_input, flag)) Fthrow (Vthrow_on_input, Qt); 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. - - If you change this function, also adapt module_should_quit in - emacs-module.c. */ - void -maybe_quit (void) +probably_quit (void) { if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) process_quit_flag (); @@ -1499,7 +1662,7 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, This function does not return. An error symbol is a symbol with an `error-conditions' property -that is a list of condition names. +that is a list of condition names. The symbol should be non-nil. A handler for any of those names will get to handle this signal. The symbol `error' should normally be one of them. @@ -1511,6 +1674,9 @@ See also the function `condition-case'. */ attributes: noreturn) (Lisp_Object error_symbol, Lisp_Object data) { + /* If they call us with nonsensical arguments, produce "peculiar error". */ + if (NILP (error_symbol) && NILP (data)) + error_symbol = Qerror; signal_or_quit (error_symbol, data, false); eassume (false); } @@ -1522,6 +1688,11 @@ quit (void) return signal_or_quit (Qquit, Qnil, true); } +/* Has an error in redisplay giving rise to a backtrace occurred as + yet in the current command? This gets reset in the command + loop. */ +bool backtrace_yet = false; + /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be Qquit and DATA should be Qnil, and this function may return. @@ -1553,14 +1724,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) - && ! NILP (error_symbol)) + && ! NILP (error_symbol) + /* Don't try to call a lisp function if we've already overflowed + the specpdl stack. */ + && specpdl_ptr < specpdl_end) { /* Edebug takes care of restoring these variables when it exits. */ - if (lisp_eval_depth + 20 > max_lisp_eval_depth) - max_lisp_eval_depth = lisp_eval_depth + 20; - - if (SPECPDL_INDEX () + 40 > max_specpdl_size) - max_specpdl_size = SPECPDL_INDEX () + 40; + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1583,6 +1753,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) for (h = handlerlist; h; h = h->next) { + if (h->type == CATCHER_ALL) + { + clause = Qt; + break; + } if (h->type != CONDITION_CASE) continue; clause = find_handler_clause (h->tag_or_ch, conditions); @@ -1590,6 +1765,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) break; } + bool debugger_called = false; if (/* Don't run the debugger for a memory-full error. (There is no room in memory to do that!) */ !NILP (error_symbol) @@ -1603,7 +1779,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) if requested". */ || EQ (h->tag_or_ch, Qerror))) { - bool debugger_called + debugger_called = maybe_call_debugger (conditions, error_symbol, data); /* We can't return values to code which signaled an error, but we can continue code which has signaled a quit. */ @@ -1611,12 +1787,61 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) return Qnil; } + /* If we're in batch mode, print a backtrace unconditionally to help + 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 + && NILP (Vinhibit_debugger) + && !NILP (Ffboundp (Qdebug_early))) + { + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qdebugger, Qdebug_early); + call_debugger (list2 (Qerror, Fcons (error_symbol, data))); + unbind_to (count, Qnil); + } + + /* If an error is signalled during a Lisp hook in redisplay, write a + backtrace into the buffer *Redisplay-trace*. */ + if (!debugger_called && !NILP (error_symbol) + && backtrace_on_redisplay_error + && (NILP (clause) || h == redisplay_deep_handler) + && NILP (Vinhibit_debugger) + && !NILP (Ffboundp (Qdebug_early))) + { + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); + specpdl_ref count = SPECPDL_INDEX (); + AUTO_STRING (redisplay_trace, "*Redisplay_trace*"); + Lisp_Object redisplay_trace_buffer; + AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ + Lisp_Object delayed_warning; + redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); + current_buffer = XBUFFER (redisplay_trace_buffer); + if (!backtrace_yet) /* Are we on the first backtrace of the command? */ + Ferase_buffer (); + else + Finsert (1, &gap); + backtrace_yet = true; + specbind (Qstandard_output, redisplay_trace_buffer); + specbind (Qdebugger, Qdebug_early); + call_debugger (list2 (Qerror, Fcons (error_symbol, data))); + unbind_to (count, Qnil); + delayed_warning = make_string + ("Error in a redisplay Lisp hook. See buffer *Redisplay_trace*", 61); + + Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning), + Vdelayed_warnings_list); + } + if (!NILP (clause)) { Lisp_Object unwind_data = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); - unwind_to_catch (h, unwind_data); + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data); } else { @@ -1661,33 +1886,25 @@ xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Obj } /* Signal `error' with message S, and additional arg ARG. - If ARG is not a genuine list, make it a one-element list. */ + If ARG is not a proper list, make it a one-element list. */ void signal_error (const char *s, Lisp_Object arg) { - Lisp_Object tortoise, hare; - - hare = tortoise = arg; - while (CONSP (hare)) - { - hare = XCDR (hare); - if (!CONSP (hare)) - break; - - hare = XCDR (hare); - tortoise = XCDR (tortoise); - - if (EQ (hare, tortoise)) - break; - } - - if (!NILP (hare)) + if (NILP (Fproper_list_p (arg))) arg = list1 (arg); xsignal (Qerror, Fcons (build_string (s), arg)); } +/* Use this for arithmetic overflow, e.g., when an integer result is + too large even for a bignum. */ +void +overflow_error (void) +{ + xsignal0 (Qoverflow_error); +} + /* Return true if LIST is a non-nil atom or a list containing one of CONDITIONS. */ @@ -1750,6 +1967,18 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data) return 0; } +/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */ +bool +signal_quit_p (Lisp_Object signal) +{ + Lisp_Object list; + + return EQ (signal, Qquit) + || (!NILP (Fsymbolp (signal)) + && CONSP (list = Fget (signal, Qerror_conditions)) + && !NILP (Fmemq (Qquit, list))); +} + /* Call the debugger if calling it is currently enabled for CONDITIONS. SIG and DATA describe the signal. There are two ways to pass them: = SIG is the error symbol, and DATA is the rest of the data. @@ -1768,11 +1997,12 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) ! input_blocked_p () && NILP (Vinhibit_debugger) /* Does user want to enter debugger for this kind of error? */ - && (EQ (sig, Qquit) + && (signal_quit_p (sig) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) && ! skip_debugger (conditions, combined_data) - /* RMS: What's this for? */ + /* See commentary on definition of + `internal-when-entered-debugger'. */ && when_entered_debugger < num_nonmacro_input_events) { call_debugger (list2 (Qerror, combined_data)); @@ -1799,7 +2029,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) for (h = handlers; CONSP (h); h = XCDR (h)) { Lisp_Object handler = XCAR (h); - if (!NILP (Fmemq (handler, conditions))) + if (!NILP (Fmemq (handler, conditions)) + /* t is also used as a catch-all by Lisp code. */ + || EQ (handler, Qt)) return handlers; } @@ -1836,7 +2068,6 @@ verror (const char *m, va_list ap) /* Dump an error message; called like printf. */ -/* VARARGS 1 */ void error (const char *m, ...) { @@ -1863,8 +2094,7 @@ then strings and vectors are not accepted. */) (Lisp_Object function, Lisp_Object for_call_interactively) { register Lisp_Object fun; - register Lisp_Object funcar; - Lisp_Object if_prop = Qnil; + bool genfun = false; /* If true, we should consult `interactive-form'. */ fun = function; @@ -1872,43 +2102,89 @@ then strings and vectors are not accepted. */) if (NILP (fun)) return Qnil; - /* Check an `interactive-form' property if present, analogous to the - function-documentation property. */ - fun = function; - while (SYMBOLP (fun)) - { - Lisp_Object tmp = Fget (fun, Qinteractive_form); - if (!NILP (tmp)) - if_prop = Qt; - fun = Fsymbol_function (fun); - } - /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ if (SUBRP (fun)) - return XSUBR (fun)->intspec ? Qt : if_prop; - + { + if (XSUBR (fun)->intspec.string) + return Qt; + } /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ else if (COMPILEDP (fun)) - return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop); + { + if (PVSIZE (fun) > COMPILED_INTERACTIVE) + return Qt; + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } + } + +#ifdef HAVE_MODULES + /* Module functions are interactive if their `interactive_form' + field is non-nil. */ + else if (MODULE_FUNCTIONP (fun)) + { + if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))) + return Qt; + } +#endif /* Strings and vectors are keyboard macros. */ - if (STRINGP (fun) || VECTORP (fun)) + else if (STRINGP (fun) || VECTORP (fun)) return (NILP (for_call_interactively) ? Qt : Qnil); /* Lists may represent commands. */ - if (!CONSP (fun)) + else if (!CONSP (fun)) return Qnil; - funcar = XCAR (fun); - if (EQ (funcar, Qclosure)) - return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) - ? Qt : if_prop); - else if (EQ (funcar, Qlambda)) - return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; - else if (EQ (funcar, Qautoload)) - return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qautoload)) + { + if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun)))))) + return Qt; + } + else + { + Lisp_Object body = CDR_SAFE (XCDR (fun)); + if (EQ (funcar, Qclosure)) + body = CDR_SAFE (body); + else if (!EQ (funcar, Qlambda)) + return Qnil; + if (!NILP (Fassq (Qinteractive, body))) + return Qt; + else if (VALID_DOCSTRING_P (CAR_SAFE (body))) + /* A "docstring" is a sign that we may have an OClosure. */ + genfun = true; + } + } + + /* By now, if it's not a function we already returned nil. */ + + /* Check an `interactive-form' property if present, analogous to the + function-documentation property. */ + fun = function; + while (SYMBOLP (fun)) + { + Lisp_Object tmp = Fget (fun, Qinteractive_form); + if (!NILP (tmp)) + error ("Found an 'interactive-form' property!"); + fun = Fsymbol_function (fun); + } + + /* If there's no immediate interactive form but it's an OClosure, + then delegate to the generic-function in case it has + a type-specific interactive-form. */ + if (genfun) + { + Lisp_Object iform = call1 (Qinteractive_form, fun); + return NILP (iform) ? Qnil : Qt; + } else return Qnil; } @@ -1916,14 +2192,21 @@ then strings and vectors are not accepted. */) DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0, doc: /* Define FUNCTION to autoload from FILE. FUNCTION is a symbol; FILE is a file name string to pass to `load'. + Third arg DOCSTRING is documentation for the function. -Fourth arg INTERACTIVE if non-nil says function can be called interactively. + +Fourth arg INTERACTIVE if non-nil says function can be called +interactively. If INTERACTIVE is a list, it is interpreted as a list +of modes the function is applicable for. + Fifth arg TYPE indicates the type of the object: nil or omitted says FUNCTION is a function, `keymap' says FUNCTION is really a keymap, and `macro' or t says FUNCTION is really a macro. + Third through fifth args give info about the real definition. They default to nil. + If FUNCTION is already defined other than as an autoload, this does nothing and returns nil. */) (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type) @@ -1932,43 +2215,65 @@ this does nothing and returns nil. */) CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if (!NILP (XSYMBOL (function)->function) - && !AUTOLOADP (XSYMBOL (function)->function)) + if (!NILP (XSYMBOL (function)->u.s.function) + && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) + if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0))) /* `read1' in lread.c has found the docstring starting with "\ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_number (XHASH (function)); + docstring = make_ufixnum (XHASH (function)); return Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), 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_number (0))) - Vfeatures = second; + Lisp_Object first = XCAR (queue); + if (CONSP (first) && BASE_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). */ @@ -1981,48 +2286,35 @@ 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; - if (EQ (macro_only, Qmacro)) - { - Lisp_Object kind = Fnth (make_number (4), fundef); - if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) - return fundef; - } + Lisp_Object kind = Fnth (make_fixnum (4), fundef); + if (EQ (macro_only, Qmacro) + && !(EQ (kind, Qt) || EQ (kind, Qmacro))) + return fundef; /* This is to make sure that loadup.el gives a clear picture of what files are preloaded and when. */ - if (! NILP (Vpurify_flag)) - error ("Attempt to autoload %s while preparing to dump", - SDATA (SYMBOL_NAME (funname))); + if (will_dump_p () && !will_bootstrap_p ()) + { + /* Avoid landing here recursively while outputting the + backtrace from the error. */ + gflags.will_dump_ = false; + error ("Attempt to autoload %s while preparing to dump", + SDATA (SYMBOL_NAME (funname))); + } CHECK_SYMBOL (funname); - /* Preserve the match data. */ - record_unwind_save_match_data (); - - /* 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', assume this autoload to be a "best-effort", + /* 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. */ - Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt); - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - unbind_to (count, Qnil); + Lisp_Object ignore_errors + = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; + load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); - if (NILP (funname)) + if (NILP (funname) || !NILP (ignore_errors)) return Qnil; else { @@ -2045,62 +2337,28 @@ 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) -{ - specpdl_ptr++; - - if (specpdl_ptr == specpdl + specpdl_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; - } -} - -ptrdiff_t -record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) +void +grow_specpdl_allocation (void) { - 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 (); + eassert (specpdl_ptr == specpdl_end); - return count; + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t max_size = PTRDIFF_MAX - 1000; + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t size = specpdl_end - specpdl; + ptrdiff_t pdlvecsize = size + 1; + if (max_size <= size) + xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */ + 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 @@ -2108,27 +2366,16 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) Lisp_Object eval_sub (Lisp_Object form) { - Lisp_Object fun, val, original_fun, original_args; - Lisp_Object funcar; - ptrdiff_t count; - - /* Declare here, as this array may be accessed by call_debugger near - the end of this function. See Bug#21245. */ - Lisp_Object argvals[8]; - 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); + = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + ? Fassq (form, Vinternal_interpreter_environment) + : Qnil); + return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form); } if (!CONSP (form)) @@ -2143,41 +2390,44 @@ 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); } - original_fun = XCAR (form); - original_args = XCDR (form); + Lisp_Object original_fun = XCAR (form); + Lisp_Object original_args = XCDR (form); CHECK_LIST (original_args); /* This also protects them from gc. */ - count = record_in_backtrace (original_fun, &original_args, UNEVALLED); + specpdl_ref count + = record_in_backtrace (original_fun, &original_args, UNEVALLED); if (debug_on_next_call) do_debug_on_call (Qt, count); - /* At this point, only original_fun and original_args - have values that will be used below. */ + Lisp_Object fun, val, funcar; + /* Declare here, as this array may be accessed by call_debugger near + the end of this function. See Bug#21245. */ + Lisp_Object argvals[8]; + 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 = Ffunction (list1 (fun)); + else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); - if (SUBRP (fun)) + if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) { Lisp_Object args_left = original_args; - Lisp_Object numargs = Flength (args_left); - - check_cons_list (); + ptrdiff_t numargs = list_length (args_left); - if (XINT (numargs) < XSUBR (fun)->min_args + if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 - && XSUBR (fun)->max_args < XINT (numargs))) - xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); + && XSUBR (fun)->max_args < numargs)) + xsignal2 (Qwrong_number_of_arguments, original_fun, + make_fixnum (numargs)); else if (XSUBR (fun)->max_args == UNEVALLED) val = (XSUBR (fun)->function.aUNEVALLED) (args_left); @@ -2188,23 +2438,22 @@ eval_sub (Lisp_Object form) ptrdiff_t argnum = 0; USE_SAFE_ALLOCA; - SAFE_ALLOCA_LISP (vals, XINT (numargs)); + SAFE_ALLOCA_LISP (vals, numargs); - while (CONSP (args_left) && argnum < XINT (numargs)) + while (CONSP (args_left) && argnum < numargs) { Lisp_Object arg = XCAR (args_left); args_left = XCDR (args_left); 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); - check_cons_list (); 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--; @@ -2220,7 +2469,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, XINT (numargs)); + set_backtrace_args (specpdl_ref_to_ptr (count), argvals, numargs); switch (i) { @@ -2272,7 +2521,9 @@ eval_sub (Lisp_Object form) } } } - else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun)) + else if (COMPILEDP (fun) + || SUBR_NATIVE_COMPILED_DYNP (fun) + || MODULE_FUNCTIONP (fun)) return apply_lambda (fun, original_args, count); else { @@ -2290,15 +2541,28 @@ 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); - unbind_to (count1, Qnil); + exp = unbind_to (count1, exp); val = eval_sub (exp); } else if (EQ (funcar, Qlambda) @@ -2307,10 +2571,9 @@ eval_sub (Lisp_Object form) else xsignal1 (Qinvalid_function, original_fun); } - check_cons_list (); 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--; @@ -2320,23 +2583,22 @@ eval_sub (Lisp_Object form) DEFUN ("apply", Fapply, Sapply, 1, MANY, 0, doc: /* Call FUNCTION with our remaining args, using our last arg as list of args. Then return the value FUNCTION returns. +With a single argument, call the argument's first element using the +other elements as args. Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10. usage: (apply FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t i, numargs, funcall_nargs; - register Lisp_Object *funcall_args = NULL; - register Lisp_Object spread_arg = args[nargs - 1]; + ptrdiff_t i, funcall_nargs; + Lisp_Object *funcall_args = NULL; + Lisp_Object spread_arg = args[nargs - 1]; Lisp_Object fun = args[0]; - Lisp_Object retval; USE_SAFE_ALLOCA; - CHECK_LIST (spread_arg); - - numargs = XINT (Flength (spread_arg)); + ptrdiff_t numargs = list_length (spread_arg); if (numargs == 0) - return Ffuncall (nargs - 1, args); + return Ffuncall (max (1, nargs - 1), args); else if (numargs == 1) { args [nargs - 1] = XCAR (spread_arg); @@ -2347,7 +2609,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) { fun = indirect_function (fun); if (NILP (fun)) @@ -2383,7 +2645,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) spread_arg = XCDR (spread_arg); } - retval = Ffuncall (funcall_nargs, funcall_args); + Lisp_Object retval = Ffuncall (funcall_nargs, funcall_args); SAFE_FREE (); return retval; @@ -2527,7 +2789,7 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, sym = args[0]; val = find_symbol_value (sym); - if (EQ (val, Qunbound) || NILP (val)) + if (BASE_EQ (val, Qunbound) || NILP (val)) return ret; else if (!CONSP (val) || FUNCTIONP (val)) { @@ -2602,86 +2864,14 @@ 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. */ -/* ARGSUSED */ -Lisp_Object -call1 (Lisp_Object fn, Lisp_Object arg1) -{ - return CALLN (Ffuncall, fn, arg1); -} - -/* Call function fn with 2 arguments arg1, arg2. */ -/* ARGSUSED */ -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. */ -/* ARGSUSED */ -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. */ -/* ARGSUSED */ -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. */ -/* ARGSUSED */ -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. */ -/* ARGSUSED */ -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. */ -/* ARGSUSED */ -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); -} +DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, + doc: /* Return t if OBJECT is a function. -/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, - arg6, arg7, arg8. */ -/* ARGSUSED */ -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); -} +An object is a function if it is callable via `funcall'; this includes +symbols with function bindings, but excludes macros and special forms. -DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, - doc: /* Non-nil if OBJECT is a function. */) +Ordinarily return nil if OBJECT is not a function, although t might be +returned in rare cases. */) (Lisp_Object object) { if (FUNCTIONP (object)) @@ -2720,6 +2910,44 @@ FUNCTIONP (Lisp_Object object) return false; } +Lisp_Object +funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) +{ + Lisp_Object original_fun = fun; + retry: + 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)) + return funcall_subr (XSUBR (fun), numargs, args); + else if (COMPILEDP (fun) + || SUBR_NATIVE_COMPILED_DYNP (fun) + || MODULE_FUNCTIONP (fun)) + return funcall_lambda (fun, numargs, args); + else + { + if (NILP (fun)) + xsignal1 (Qvoid_function, original_fun); + if (!CONSP (fun)) + xsignal1 (Qinvalid_function, original_fun); + Lisp_Object funcar = XCAR (fun); + if (!SYMBOLP (funcar)) + xsignal1 (Qinvalid_function, original_fun); + if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + 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. @@ -2727,11 +2955,7 @@ Thus, (funcall \\='cons \\='x \\='y) returns (x . y). usage: (funcall FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object fun, original_fun; - Lisp_Object funcar; - ptrdiff_t numargs = nargs - 1; - Lisp_Object val; - ptrdiff_t count; + specpdl_ref count; maybe_quit (); @@ -2740,7 +2964,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) 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); } count = record_in_backtrace (args[0], &args[1], nargs - 1); @@ -2750,46 +2974,10 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (debug_on_next_call) do_debug_on_call (Qlambda, count); - check_cons_list (); - - original_fun = args[0]; + Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1); - retry: - - /* Optimize for no indirection. */ - fun = original_fun; - if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) - fun = indirect_function (fun); - - if (SUBRP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args + 1); - else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun)) - val = funcall_lambda (fun, numargs, args + 1); - 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, Qlambda) - || EQ (funcar, Qclosure)) - val = funcall_lambda (fun, numargs, args + 1); - else if (EQ (funcar, Qautoload)) - { - Fautoload_do_load (fun, original_fun, Qnil); - check_cons_list (); - goto retry; - } - else - xsignal1 (Qinvalid_function, original_fun); - } - check_cons_list (); 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; @@ -2802,110 +2990,104 @@ 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_number (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 -apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) +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 (fun, args_template, nargs, args); +} + +static Lisp_Object +apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { - Lisp_Object args_left; - ptrdiff_t i; - EMACS_INT numargs; Lisp_Object *arg_vector; Lisp_Object tem; USE_SAFE_ALLOCA; - numargs = XFASTINT (Flength (args)); + ptrdiff_t numargs = list_length (args); SAFE_ALLOCA_LISP (arg_vector, numargs); - args_left = args; + Lisp_Object args_left = args; - for (i = 0; i < numargs; ) + for (ptrdiff_t i = 0; i < numargs; i++) { tem = Fcar (args_left), args_left = Fcdr (args_left); tem = eval_sub (tem); - arg_vector[i++] = tem; + arg_vector[i] = tem; } - set_backtrace_args (specpdl + count, arg_vector, i); + set_backtrace_args (specpdl_ref_to_ptr (count), arg_vector, numargs); tem = funcall_lambda (fun, numargs, arg_vector); - check_cons_list (); 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--; @@ -2922,7 +3104,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; @@ -2946,41 +3128,34 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, } else if (COMPILEDP (fun)) { - ptrdiff_t size = PVSIZE (fun); - if (size <= COMPILED_STACK_DEPTH) - xsignal1 (Qinvalid_function, fun); syms_left = AREF (fun, COMPILED_ARGLIST); - if (INTEGERP (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). */ - { - /* If we have not actually read the bytecode string - and constants vector yet, fetch them from the file. */ - 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, arg_vector); - } + /* Bytecode objects using lexical binding have an integral + ARGLIST slot value: pass the arguments to the byte-code + engine directly. */ + if (FIXNUMP (syms_left)) + 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 else if (MODULE_FUNCTIONP (fun)) return funcall_module (fun, nargs, arg_vector); #endif +#ifdef HAVE_NATIVE_COMP + else if (SUBR_NATIVE_COMPILED_DYNP (fun)) + { + syms_left = XSUBR (fun)->lambda_list; + lexenv = Qnil; + } +#endif else emacs_abort (); i = optional = rest = 0; - bool previous_optional_or_rest = false; + bool previous_rest = false; for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { maybe_quit (); @@ -2991,17 +3166,16 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (EQ (next, Qand_rest)) { - if (rest || previous_optional_or_rest) + if (rest || previous_rest) xsignal1 (Qinvalid_function, fun); rest = 1; - previous_optional_or_rest = true; + previous_rest = true; } else if (EQ (next, Qand_optional)) { - if (optional || rest || previous_optional_or_rest) + if (optional || rest || previous_rest) xsignal1 (Qinvalid_function, fun); optional = 1; - previous_optional_or_rest = true; } else { @@ -3014,7 +3188,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else if (i < nargs) arg = arg_vector[i++]; else if (!optional) - xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); else arg = Qnil; @@ -3025,14 +3199,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else /* Dynamically bind NEXT. */ specbind (next, arg); - previous_optional_or_rest = false; + previous_rest = false; } } - if (!NILP (syms_left) || previous_optional_or_rest) + if (!NILP (syms_left) || previous_rest) xsignal1 (Qinvalid_function, fun); else if (i < nargs) - xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); if (!EQ (lexenv, Vinternal_interpreter_environment)) /* Instantiate a new lexical environment. */ @@ -3040,17 +3214,15 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); - else + else if (SUBR_NATIVE_COMPILEDP (fun)) { - /* If we have not actually read the bytecode string - and constants vector yet, fetch them from the file. */ - if (CONSP (AREF (fun, COMPILED_BYTECODE))) - Ffetch_bytecode (fun); - val = exec_byte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - Qnil, 0, 0); + eassert (SUBR_NATIVE_COMPILED_DYNP (fun)); + /* No need to use funcall_subr as we have zero arguments by + construction. */ + val = XSUBR (fun)->function.a0 (); } + else + val = fetch_and_exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3075,7 +3247,7 @@ function with `&rest' args, or `unevalled' for a special form. */) function = original; if (SYMBOLP (function) && !NILP (function)) { - function = XSYMBOL (function)->function; + function = XSYMBOL (function)->u.s.function; if (SYMBOLP (function)) function = indirect_function (function); } @@ -3135,11 +3307,8 @@ lambda_arity (Lisp_Object fun) } else if (COMPILEDP (fun)) { - ptrdiff_t size = PVSIZE (fun); - if (size <= COMPILED_STACK_DEPTH) - xsignal1 (Qinvalid_function, fun); syms_left = AREF (fun, COMPILED_ARGLIST); - if (INTEGERP (syms_left)) + if (FIXNUMP (syms_left)) return get_byte_code_arity (syms_left); } else @@ -3154,7 +3323,7 @@ lambda_arity (Lisp_Object fun) xsignal1 (Qinvalid_function, fun); if (EQ (next, Qand_rest)) - return Fcons (make_number (minargs), Qmany); + return Fcons (make_fixnum (minargs), Qmany); else if (EQ (next, Qand_optional)) optional = true; else @@ -3168,7 +3337,7 @@ lambda_arity (Lisp_Object fun) if (!NILP (syms_left)) xsignal1 (Qinvalid_function, fun); - return Fcons (make_number (minargs), make_number (maxargs)); + return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); } DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, @@ -3180,13 +3349,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, if (COMPILEDP (object)) { - ptrdiff_t size = PVSIZE (object); - if (size <= COMPILED_STACK_DEPTH) - xsignal1 (Qinvalid_function, object); if (CONSP (AREF (object, COMPILED_BYTECODE))) { tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); - if (!CONSP (tem)) + if (! (CONSP (tem) && STRINGP (XCAR (tem)) + && VECTORP (XCDR (tem)))) { tem = AREF (object, COMPILED_BYTECODE); if (CONSP (tem) && STRINGP (XCAR (tem))) @@ -3194,7 +3361,20 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, else error ("Invalid byte code"); } - ASET (object, COMPILED_BYTECODE, XCAR (tem)); + + Lisp_Object bytecode = XCAR (tem); + if (STRING_MULTIBYTE (bytecode)) + { + /* BYTECODE must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and now + such a byte-code string is loaded as multibyte with raw 8-bit + characters converted to multibyte form. Convert them back to + the original unibyte form. */ + bytecode = Fstring_as_unibyte (bytecode); + } + + pin_string (bytecode); + ASET (object, COMPILED_BYTECODE, bytecode); ASET (object, COMPILED_CONSTANTS, XCDR (tem)); } } @@ -3214,7 +3394,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) if ((--p)->kind > SPECPDL_LET) { struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); - eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); + eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS); if (symbol == let_bound_symbol && EQ (specpdl_where (p), buf)) return 1; @@ -3227,10 +3407,10 @@ static void do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, Lisp_Object value, enum Set_Internal_Bind bindflag) { - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_PLAINVAL: - if (!sym->trapped_write) + if (!sym->u.s.trapped_write) SET_SYMBOL_VAL (sym, value); else set_internal (specpdl_symbol (bind), value, Qnil, bindflag); @@ -3274,7 +3454,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; @@ -3284,9 +3464,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: @@ -3296,12 +3473,11 @@ 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->redirect != SYMBOL_LOCALIZED - || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); + eassert (sym->u.s.redirect != SYMBOL_LOCALIZED + || (BASE_EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); - if (sym->redirect == SYMBOL_LOCALIZED) + if (sym->u.s.redirect == SYMBOL_LOCALIZED) { if (!blv_found (SYMBOL_BLV (sym))) specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; @@ -3314,22 +3490,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. */ @@ -3340,6 +3511,16 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; specpdl_ptr->unwind.arg = arg; + specpdl_ptr->unwind.eval_depth = lisp_eval_depth; + grow_specpdl (); +} + +void +record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts) +{ + specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY; + specpdl_ptr->unwind_array.array = array; + specpdl_ptr->unwind_array.nelts = nelts; grow_specpdl (); } @@ -3349,6 +3530,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 (); } @@ -3362,6 +3557,23 @@ record_unwind_protect_int (void (*function) (int), int arg) } void +record_unwind_protect_intmax (void (*function) (intmax_t), intmax_t arg) +{ + specpdl_ptr->unwind_intmax.kind = SPECPDL_UNWIND_INTMAX; + specpdl_ptr->unwind_intmax.func = function; + specpdl_ptr->unwind_intmax.arg = arg; + grow_specpdl (); +} + +void +record_unwind_protect_excursion (void) +{ + specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION; + save_excursion_save (specpdl_ptr); + grow_specpdl (); +} + +void record_unwind_protect_void (void (*function) (void)) { specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID; @@ -3370,21 +3582,13 @@ record_unwind_protect_void (void (*function) (void)) } void -rebind_for_thread_switch (void) +record_unwind_protect_module (enum specbind_tag kind, void *ptr) { - 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); - } - } + specpdl_ptr->kind = kind; + specpdl_ptr->unwind_ptr.func = NULL; + specpdl_ptr->unwind_ptr.arg = ptr; + specpdl_ptr->unwind_ptr.mark = NULL; + grow_specpdl (); } static void @@ -3395,26 +3599,46 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, switch (this_binding->kind) { case SPECPDL_UNWIND: + lisp_eval_depth = this_binding->unwind.eval_depth; this_binding->unwind.func (this_binding->unwind.arg); break; + case SPECPDL_UNWIND_ARRAY: + xfree (this_binding->unwind_array.array); + break; case SPECPDL_UNWIND_PTR: this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg); break; case SPECPDL_UNWIND_INT: this_binding->unwind_int.func (this_binding->unwind_int.arg); break; + case SPECPDL_UNWIND_INTMAX: + this_binding->unwind_intmax.func (this_binding->unwind_intmax.arg); + break; case SPECPDL_UNWIND_VOID: this_binding->unwind_void.func (); break; + case SPECPDL_UNWIND_EXCURSION: + save_excursion_restore (this_binding->unwind_excursion.marker, + this_binding->unwind_excursion.window); + break; case SPECPDL_BACKTRACE: + case SPECPDL_NOP: + break; +#ifdef HAVE_MODULES + case SPECPDL_MODULE_RUNTIME: + finalize_runtime_unwind (this_binding->unwind_ptr.arg); + break; + case SPECPDL_MODULE_ENVIRONMENT: + finalize_environment_unwind (this_binding->unwind_ptr.arg); break; +#endif case SPECPDL_LET: { /* If variable has a trivial value (no forwarding), and isn't trapped, we can just set it. */ Lisp_Object sym = specpdl_symbol (this_binding); - if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) + if (SYMBOLP (sym) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL) { - if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE) + if (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_UNTRAPPED_WRITE) SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding)); else set_internal (sym, specpdl_old_value (this_binding), @@ -3463,9 +3687,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; } @@ -3475,35 +3699,37 @@ 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; + p->unwind.eval_depth = lisp_eval_depth; } 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 @@ -3523,22 +3749,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 @@ -3546,7 +3756,7 @@ context where binding is lexical by default. */) (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return XSYMBOL (symbol)->declared_special ? Qt : Qnil; + return XSYMBOL (symbol)->u.s.declared_special ? Qt : Qnil; } @@ -3571,11 +3781,11 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) { register EMACS_INT i; - CHECK_NATNUM (nframes); + CHECK_FIXNAT (nframes); union specbinding *pdl = get_backtrace_starting_at (base); /* Find the frame requested. */ - for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--) + for (i = XFIXNAT (nframes); i > 0 && backtrace_p (pdl); i--) pdl = backtrace_next (pdl); return pdl; @@ -3589,7 +3799,7 @@ backtrace_frame_apply (Lisp_Object function, union specbinding *pdl) Lisp_Object flags = Qnil; if (backtrace_debug_on_exit (pdl)) - flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil)); + flags = list2 (QCdebug_on_exit, Qt); if (backtrace_nargs (pdl) == UNEVALLED) return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags); @@ -3605,7 +3815,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, The debugger is entered when that frame exits, if the flag is non-nil. */) (Lisp_Object level, Lisp_Object flag) { - CHECK_NUMBER (level); + CHECK_FIXNUM (level); union specbinding *pdl = get_backtrace_frame(level, Qnil); if (backtrace_p (pdl)) @@ -3652,17 +3862,55 @@ Return the result of FUNCTION, or nil if no matching frame could be found. */) return backtrace_frame_apply (function, get_backtrace_frame (nframes, base)); } +DEFUN ("backtrace--frames-from-thread", Fbacktrace_frames_from_thread, + Sbacktrace_frames_from_thread, 1, 1, NULL, + doc: /* Return the list of backtrace frames from current execution point in THREAD. +If a frame has not evaluated the arguments yet (or is a special form), +the value of the list element is (nil FUNCTION ARG-FORMS...). +If a frame has evaluated its arguments and called its function already, +the value of the list element is (t FUNCTION ARG-VALUES...). +A &rest arg is represented as the tail of the list ARG-VALUES. +FUNCTION is whatever was supplied as car of evaluated list, +or a lambda expression for macro calls. */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + union specbinding *pdl = backtrace_thread_top (tstate); + Lisp_Object list = Qnil; + + while (backtrace_thread_p (tstate, pdl)) + { + Lisp_Object frame; + if (backtrace_nargs (pdl) == UNEVALLED) + frame = Fcons (Qnil, + Fcons (backtrace_function (pdl), *backtrace_args (pdl))); + else + { + Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); + frame = Fcons (Qt, Fcons (backtrace_function (pdl), tem)); + } + list = Fcons (frame, list); + pdl = backtrace_thread_next (tstate, pdl); + } + return Fnreverse (list); +} + /* For backtrace-eval, we want to temporarily unwind the last few elements of the specpdl stack, and then rewind them. We store the pre-unwind values directly in the pre-existing specpdl elements (i.e. we swap the current 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. */ @@ -3680,29 +3928,32 @@ 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) + if (vars_only) + break; + if (tmp->unwind.func == set_buffer_if_live) + { + Lisp_Object oldarg = tmp->unwind.arg; 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); + set_buffer_if_live (oldarg); + } + break; + case SPECPDL_UNWIND_EXCURSION: + if (vars_only) break; + { + Lisp_Object marker = tmp->unwind_excursion.marker; + Lisp_Object window = tmp->unwind_excursion.window; + save_excursion_save (tmp); + save_excursion_restore (marker, window); } - - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: 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, since that was already done by specbind. */ Lisp_Object sym = specpdl_symbol (tmp); - if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) + if (SYMBOLP (sym) + && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL) { Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym))); @@ -3717,8 +3968,8 @@ backtrace_eval_unrewind (int distance) { Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); - set_specpdl_old_value (tmp, Fdefault_value (sym)); - Fset_default (sym, old_value); + set_specpdl_old_value (tmp, default_value (sym)); + set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH); } break; case SPECPDL_LET_LOCAL: @@ -3733,22 +3984,38 @@ backtrace_eval_unrewind (int distance) if (!NILP (Flocal_variable_p (symbol, where))) { set_specpdl_old_value - (tmp, Fbuffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + (tmp, buffer_local_value (symbol, where)); + 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); @@ -3771,7 +4038,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. { union specbinding *frame = get_backtrace_frame (nframes, base); union specbinding *prevframe - = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base); + = get_backtrace_frame (make_fixnum (XFIXNAT (nframes) - 1), base); ptrdiff_t distance = specpdl_ptr - frame; Lisp_Object result = Qnil; eassert (distance >= 0); @@ -3822,15 +4089,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: - break; - - default: - emacs_abort (); + default: break; } } } @@ -3849,22 +4108,38 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) for (pdl = first; pdl != ptr; pdl++) { switch (pdl->kind) - { + { case SPECPDL_UNWIND: mark_object (specpdl_arg (pdl)); break; + case SPECPDL_UNWIND_ARRAY: + mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); + break; + + case SPECPDL_UNWIND_EXCURSION: + mark_object (pdl->unwind_excursion.marker); + mark_object (pdl->unwind_excursion.window); + break; + case SPECPDL_BACKTRACE: { ptrdiff_t nargs = backtrace_nargs (pdl); mark_object (backtrace_function (pdl)); if (nargs == UNEVALLED) nargs = 1; - while (nargs--) - mark_object (backtrace_args (pdl)[nargs]); + mark_objects (backtrace_args (pdl), nargs); } break; +#ifdef HAVE_MODULES + case SPECPDL_MODULE_RUNTIME: + break; + case SPECPDL_MODULE_ENVIRONMENT: + mark_module_environment (pdl->unwind_ptr.arg); + break; +#endif + case SPECPDL_LET_DEFAULT: case SPECPDL_LET_LOCAL: mark_object (specpdl_where (pdl)); @@ -3872,14 +4147,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_VOID: + 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 (); } @@ -3914,16 +4197,6 @@ Lisp_Object backtrace_top_function (void) void syms_of_eval (void) { - DEFVAR_INT ("max-specpdl-size", max_specpdl_size, - doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. -If Lisp code tries to increase the total number past this amount, -an error is signaled. -You can safely use a value considerably larger than the default value, -if that proves inconveniently small. However, if you increase it too far, -Emacs could run out of memory trying to make the stack bigger. -Note that this limit may be silently increased by the debugger -if `debug-on-error' or `debug-on-quit' is set. */); - DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. @@ -3967,6 +4240,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. @@ -4003,6 +4277,11 @@ Does not apply if quit is handled by a `condition-case'. */); DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call, doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */); + DEFVAR_BOOL ("backtrace-on-redisplay-error", backtrace_on_redisplay_error, + doc: /* Non-nil means create a backtrace if a lisp error occurs in redisplay. +The backtrace is written to buffer *Redisplay-trace*. */); + backtrace_on_redisplay_error = false; + DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue, doc: /* Non-nil means debugger may continue execution. This is nil when the debugger is called under circumstances where it @@ -4013,6 +4292,7 @@ might not be safe to continue. */); doc: /* Non-nil means display call stack frames as lists. */); debugger_stack_frame_as_list = 0; + DEFSYM (Qdebugger, "debugger"); DEFVAR_LISP ("debugger", Vdebugger, doc: /* Function to call to invoke debugger. If due to frame exit, args are `exit' and the value being returned; @@ -4020,7 +4300,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. @@ -4034,6 +4314,26 @@ Note that `debug-on-error', `debug-on-quit' and friends still determine whether to handle the particular condition. */); Vdebug_on_signal = Qnil; + DEFVAR_BOOL ("backtrace-on-error-noninteractive", + backtrace_on_error_noninteractive, + doc: /* Non-nil means print backtrace on error in batch mode. +If this is nil, errors in batch mode will just print the error +message upon encountering an unhandled error, without showing +the Lisp backtrace. */); + backtrace_on_error_noninteractive = true; + + /* The value of num_nonmacro_input_events as of the last time we + started to enter the debugger. If we decide to enter the debugger + again when this is still equal to num_nonmacro_input_events, then we + know that the debugger itself has an error, and we should just + signal the error instead of entering an infinite loop of debugger + invocations. */ + DEFSYM (Qinternal_when_entered_debugger, "internal-when-entered-debugger"); + DEFVAR_INT ("internal-when-entered-debugger", when_entered_debugger, + doc: /* The number of keyboard events as of last time `debugger' was called. +Used to avoid infinite loops if the debugger itself has an error. +Don't set this unless you're sure that can't happen. */); + /* When lexical binding is being used, Vinternal_interpreter_environment is non-nil, and contains an alist of lexically-bound variable, or (t), indicating an empty @@ -4063,7 +4363,12 @@ alist of active lexical bindings. */); staticpro (&Vsignaling_function); Vsignaling_function = Qnil; - inhibit_lisp_code = Qnil; + staticpro (&Qcatch_all_memory_full); + /* Make sure Qcatch_all_memory_full is a unique object. We could + also use something like Fcons (Qnil, Qnil), but json.c treats any + cons cell as error data, so use an uninterned symbol instead. */ + Qcatch_all_memory_full + = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); defsubr (&Sor); defsubr (&Sand); @@ -4071,25 +4376,29 @@ alist of active lexical bindings. */); defsubr (&Scond); defsubr (&Sprogn); defsubr (&Sprog1); - defsubr (&Sprog2); defsubr (&Ssetq); defsubr (&Squote); defsubr (&Sfunction); defsubr (&Sdefault_toplevel_value); defsubr (&Sset_default_toplevel_value); defsubr (&Sdefvar); + defsubr (&Sdefvar_1); defsubr (&Sdefvaralias); DEFSYM (Qdefvaralias, "defvaralias"); defsubr (&Sdefconst); + defsubr (&Sdefconst_1); + defsubr (&Sinternal__define_uninitialized_variable); defsubr (&Smake_var_non_special); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); defsubr (&Sautoload); @@ -4108,8 +4417,10 @@ alist of active lexical bindings. */); DEFSYM (QCdebug_on_exit, ":debug-on-exit"); defsubr (&Smapbacktrace); defsubr (&Sbacktrace_frame_internal); + defsubr (&Sbacktrace_frames_from_thread); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); + DEFSYM (Qfunctionp, "functionp"); defsubr (&Sfunctionp); } |