root/src/eval.c

DEFINITIONS

1. backtrace_p
2. specpdl_kind
3. specpdl_old_value
4. set_specpdl_old_value
5. specpdl_where
6. specpdl_arg
7. backtrace_function
8. backtrace_nargs
9. backtrace_args
10. set_backtrace_args
11. set_backtrace_debug_on_exit
12. backtrace_p
13. backtrace_thread_p
14. backtrace_top
15. backtrace_thread_top
16. backtrace_next
17. backtrace_thread_next
18. init_eval_once
19. init_eval_once_for_pdumper
20. init_eval
21. max_ensure_room
22. restore_stack_limits
23. call_debugger
24. do_debug_on_call
25. DEFUN
26. DEFUN
27. DEFUN
28. DEFUN
29. DEFUN
30. prog_ignore
31. DEFUN
32. DEFUN
33. DEFUN
34. DEFUN
35. default_toplevel_binding
36. lexbound_p
37. DEFUN
38. defvar
39. DEFUN
40. DEFUN
41. DEFUN
42. DEFUN
43. DEFUN
44. DEFUN
45. with_delayed_message_display
46. with_delayed_message_cancel
47. DEFUN
48. internal_catch
49. unwind_to_catch
50. DEFUN
51. DEFUN
52. internal_lisp_condition_case
53. internal_condition_case
54. internal_condition_case_1
55. internal_condition_case_2
56. internal_condition_case_n
57. internal_catch_all
58. push_handler
59. push_handler_nosignal
60. process_quit_flag
61. probably_quit
62. quit
63. signal_or_quit
64. xsignal0
65. xsignal1
66. xsignal2
67. xsignal3
68. signal_error
69. define_error
70. overflow_error
71. wants_debugger
72. skip_debugger
73. signal_quit_p
74. maybe_call_debugger
75. find_handler_clause
76. vformat_string
77. verror
78. error
79. un_autoload
80. grow_specpdl_allocation
81. eval_sub
82. funcall_nil
83. funcall_not
84. run_hook_wrapped_funcall
85. run_hook_with_args
86. run_hook
87. run_hook_with_args_2
88. apply1
89. DEFUN
90. FUNCTIONP
91. funcall_general
92. funcall_subr
93. fetch_and_exec_byte_code
94. apply_lambda
95. funcall_lambda
96. DEFUN
97. lambda_arity
98. DEFUN
99. let_shadows_buffer_binding_p
100. do_specbind
101. specbind
102. record_unwind_protect
103. record_unwind_protect_array
104. record_unwind_protect_ptr
105. record_unwind_protect_ptr_mark
106. record_unwind_protect_int
107. record_unwind_protect_intmax
108. record_unwind_protect_excursion
109. record_unwind_protect_void
110. record_unwind_protect_module
111. do_one_unbind
112. do_nothing
113. record_unwind_protect_nothing
114. clear_unwind_protect
115. set_unwind_protect
116. set_unwind_protect_ptr
117. unbind_to
118. DEFUN
119. get_backtrace_starting_at
120. get_backtrace_frame
121. backtrace_frame_apply
122. DEFUN
123. specpdl_unrewind
124. backtrace_eval_unrewind
125. mark_specpdl
126. get_backtrace
127. backtrace_top_function
128. syms_of_eval

     1 /* Evaluator for GNU Emacs Lisp interpreter.
     2 
     3 Copyright (C) 1985-1987, 1993-1995, 1999-2023 Free Software Foundation,
     4 Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     8 GNU Emacs is free software: you can redistribute it and/or modify
     9 it under the terms of the GNU General Public License as published by
    10 the Free Software Foundation, either version 3 of the License, or (at
    11 your option) any later version.
    12 
    13 GNU Emacs is distributed in the hope that it will be useful,
    14 but WITHOUT ANY WARRANTY; without even the implied warranty of
    15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16 GNU General Public License for more details.
    17 
    18 You should have received a copy of the GNU General Public License
    19 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    20 
    21 
    22 #include <config.h>
    23 #include <limits.h>
    24 #include <stdlib.h>
    25 #include "lisp.h"
    26 #include "blockinput.h"
    27 #include "commands.h"
    28 #include "keyboard.h"
    29 #include "dispextern.h"
    30 #include "buffer.h"
    31 #include "pdumper.h"
    32 #include "atimer.h"
    33 
    34 /* CACHEABLE is ordinarily nothing, except it is 'volatile' if
    35    necessary to cajole GCC into not warning incorrectly that a
    36    variable should be volatile.  */
    37 #if defined GCC_LINT || defined lint
    38 # define CACHEABLE volatile
    39 #else
    40 # define CACHEABLE /* empty */
    41 #endif
    42 
    43 /* Non-nil means record all fset's and provide's, to be undone
    44    if the file being autoloaded is not fully loaded.
    45    They are recorded by being consed onto the front of Vautoload_queue:
    46    (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide.  */
    47 
    48 Lisp_Object Vautoload_queue;
    49 
    50 /* This holds either the symbol `run-hooks' or nil.
    51    It is nil at an early stage of startup, and when Emacs
    52    is shutting down.  */
    53 Lisp_Object Vrun_hooks;
    54 
    55 /* The function from which the last `signal' was called.  Set in
    56    Fsignal.  */
    57 /* FIXME: We should probably get rid of this!  */
    58 Lisp_Object Vsignaling_function;
    59 
    60 /* The handler structure which will catch errors in Lisp hooks called
    61    from redisplay.  We do not use it for this; we compare it with the
    62    handler which is about to be used in signal_or_quit, and if it
    63    matches, cause a backtrace to be generated.  */
    64 static struct handler *redisplay_deep_handler;
    65 
    66 /* These would ordinarily be static, but they need to be visible to GDB.  */
    67 bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
    68 Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
    69 Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE;
    70 union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE;
    71 union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
    72 
    73 static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
    74 static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, specpdl_ref);
    75 static Lisp_Object lambda_arity (Lisp_Object);
    76 
    77 static Lisp_Object
    78 specpdl_symbol (union specbinding *pdl)
    79 {
    80   eassert (pdl->kind >= SPECPDL_LET);
    81   return pdl->let.symbol;
    82 }
    83 
    84 static enum specbind_tag
    85 specpdl_kind (union specbinding *pdl)
    86 {
    87   eassert (pdl->kind >= SPECPDL_LET);
    88   return pdl->let.kind;
    89 }
    90 
    91 static Lisp_Object
    92 specpdl_old_value (union specbinding *pdl)
    93 {
    94   eassert (pdl->kind >= SPECPDL_LET);
    95   return pdl->let.old_value;
    96 }
    97 
    98 static void
    99 set_specpdl_old_value (union specbinding *pdl, Lisp_Object val)
   100 {
   101   eassert (pdl->kind >= SPECPDL_LET);
   102   pdl->let.old_value = val;
   103 }
   104 
   105 static Lisp_Object
   106 specpdl_where (union specbinding *pdl)
   107 {
   108   eassert (pdl->kind > SPECPDL_LET);
   109   return pdl->let.where;
   110 }
   111 
   112 static Lisp_Object
   113 specpdl_arg (union specbinding *pdl)
   114 {
   115   eassert (pdl->kind == SPECPDL_UNWIND);
   116   return pdl->unwind.arg;
   117 }
   118 
   119 Lisp_Object
   120 backtrace_function (union specbinding *pdl)
   121 {
   122   eassert (pdl->kind == SPECPDL_BACKTRACE);
   123   return pdl->bt.function;
   124 }
   125 
   126 static ptrdiff_t
   127 backtrace_nargs (union specbinding *pdl)
   128 {
   129   eassert (pdl->kind == SPECPDL_BACKTRACE);
   130   return pdl->bt.nargs;
   131 }
   132 
   133 Lisp_Object *
   134 backtrace_args (union specbinding *pdl)
   135 {
   136   eassert (pdl->kind == SPECPDL_BACKTRACE);
   137   return pdl->bt.args;
   138 }
   139 
   140 /* Functions to modify slots of backtrace records.  */
   141 
   142 static void
   143 set_backtrace_args (union specbinding *pdl, Lisp_Object *args, ptrdiff_t nargs)
   144 {
   145   eassert (pdl->kind == SPECPDL_BACKTRACE);
   146   pdl->bt.args = args;
   147   pdl->bt.nargs = nargs;
   148 }
   149 
   150 static void
   151 set_backtrace_debug_on_exit (union specbinding *pdl, bool doe)
   152 {
   153   eassert (pdl->kind == SPECPDL_BACKTRACE);
   154   pdl->bt.debug_on_exit = doe;
   155 }
   156 
   157 /* Helper functions to scan the backtrace.  */
   158 
   159 bool
   160 backtrace_p (union specbinding *pdl)
   161 { return specpdl ? pdl >= specpdl : false; }
   162 
   163 static bool
   164 backtrace_thread_p (struct thread_state *tstate, union specbinding *pdl)
   165 { return pdl >= tstate->m_specpdl; }
   166 
   167 union specbinding *
   168 backtrace_top (void)
   169 {
   170   /* This is so "xbacktrace" doesn't crash in pdumped Emacs if they
   171      invoke the command before init_eval_once_for_pdumper initializes
   172      specpdl machinery.  See also backtrace_p above.  */
   173   if (!specpdl)
   174     return NULL;
   175 
   176   union specbinding *pdl = specpdl_ptr - 1;
   177   while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
   178     pdl--;
   179   return pdl;
   180 }
   181 
   182 static union specbinding *
   183 backtrace_thread_top (struct thread_state *tstate)
   184 {
   185   union specbinding *pdl = tstate->m_specpdl_ptr - 1;
   186   while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE)
   187     pdl--;
   188   return pdl;
   189 }
   190 
   191 union specbinding *
   192 backtrace_next (union specbinding *pdl)
   193 {
   194   pdl--;
   195   while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
   196     pdl--;
   197   return pdl;
   198 }
   199 
   200 static void init_eval_once_for_pdumper (void);
   201 
   202 static union specbinding *
   203 backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl)
   204 {
   205   pdl--;
   206   while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE)
   207     pdl--;
   208   return pdl;
   209 }
   210 
   211 void
   212 init_eval_once (void)
   213 {
   214   /* Don't forget to update docs (lispref node "Eval").  */
   215   max_lisp_eval_depth = 1600;
   216   Vrun_hooks = Qnil;
   217   pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
   218 }
   219 
   220 static void
   221 init_eval_once_for_pdumper (void)
   222 {
   223   enum { size = 50 };
   224   union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl);
   225   specpdl = specpdl_ptr = pdlvec + 1;
   226   specpdl_end = specpdl + size;
   227 }
   228 
   229 void
   230 init_eval (void)
   231 {
   232   specpdl_ptr = specpdl;
   233   { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
   234        This is important since handlerlist->nextfree holds the freelist
   235        which would otherwise leak every time we unwind back to top-level.   */
   236     handlerlist_sentinel = xzalloc (sizeof (struct handler));
   237     handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel;
   238     struct handler *c = push_handler (Qunbound, CATCHER);
   239     eassert (c == handlerlist_sentinel);
   240     handlerlist_sentinel->nextfree = NULL;
   241     handlerlist_sentinel->next = NULL;
   242   }
   243   Vquit_flag = Qnil;
   244   debug_on_next_call = 0;
   245   lisp_eval_depth = 0;
   246   /* This is less than the initial value of num_nonmacro_input_events.  */
   247   when_entered_debugger = -1;
   248   redisplay_deep_handler = NULL;
   249 }
   250 
   251 /* Ensure that *M is at least A + B if possible, or is its maximum
   252    value otherwise.  */
   253 
   254 static void
   255 max_ensure_room (intmax_t *m, intmax_t a, intmax_t b)
   256 {
   257   intmax_t sum = INT_ADD_WRAPV (a, b, &sum) ? INTMAX_MAX : sum;
   258   *m = max (*m, sum);
   259 }
   260 
   261 /* Unwind-protect function used by call_debugger.  */
   262 
   263 static void
   264 restore_stack_limits (Lisp_Object data)
   265 {
   266   integer_to_intmax (data, &max_lisp_eval_depth);
   267 }
   268 
   269 /* Call the Lisp debugger, giving it argument ARG.  */
   270 
   271 Lisp_Object
   272 call_debugger (Lisp_Object arg)
   273 {
   274   bool debug_while_redisplaying;
   275   specpdl_ref count = SPECPDL_INDEX ();
   276   Lisp_Object val;
   277   intmax_t old_depth = max_lisp_eval_depth;
   278 
   279   /* The previous value of 40 is too small now that the debugger
   280      prints using cl-prin1 instead of prin1.  Printing lists nested 8
   281      deep (which is the value of print-level used in the debugger)
   282      currently requires 77 additional frames.  See bug#31919.  */
   283   max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
   284 
   285   /* Restore limits after leaving the debugger.  */
   286   record_unwind_protect (restore_stack_limits, make_int (old_depth));
   287 
   288 #ifdef HAVE_WINDOW_SYSTEM
   289   if (display_hourglass_p)
   290     cancel_hourglass ();
   291 #endif
   292 
   293   debug_on_next_call = 0;
   294   when_entered_debugger = num_nonmacro_input_events;
   295 
   296   /* Resetting redisplaying_p to 0 makes sure that debug output is
   297      displayed if the debugger is invoked during redisplay.  */
   298   debug_while_redisplaying = redisplaying_p;
   299   redisplaying_p = 0;
   300   specbind (intern ("debugger-may-continue"),
   301             debug_while_redisplaying ? Qnil : Qt);
   302   specbind (Qinhibit_redisplay, Qnil);
   303   specbind (Qinhibit_debugger, Qt);
   304 
   305   /* If we are debugging an error while `inhibit-changing-match-data'
   306      is bound to non-nil (e.g., within a call to `string-match-p'),
   307      then make sure debugger code can still use match data.  */
   308   specbind (Qinhibit_changing_match_data, Qnil);
   309 
   310 #if 0 /* Binding this prevents execution of Lisp code during
   311          redisplay, which necessarily leads to display problems.  */
   312   specbind (Qinhibit_eval_during_redisplay, Qt);
   313 #endif
   314 
   315   val = apply1 (Vdebugger, arg);
   316 
   317   /* Interrupting redisplay and resuming it later is not safe under
   318      all circumstances.  So, when the debugger returns, abort the
   319      interrupted redisplay by going back to the top-level.  */
   320   if (debug_while_redisplaying
   321       && !EQ (Vdebugger, Qdebug_early))
   322     Ftop_level ();
   323 
   324   return unbind_to (count, val);
   325 }
   326 
   327 void
   328 do_debug_on_call (Lisp_Object code, specpdl_ref count)
   329 {
   330   debug_on_next_call = 0;
   331   set_backtrace_debug_on_exit (specpdl_ref_to_ptr (count), true);
   332   call_debugger (list1 (code));
   333 }
   334 
   335 
   336 DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
   337        doc: /* Eval args until one of them yields non-nil, then return that value.
   338 The remaining args are not evalled at all.
   339 If all args return nil, return nil.
   340 usage: (or CONDITIONS...)  */)
   341   (Lisp_Object args)
   342 {
   343   Lisp_Object val = Qnil;
   344 
   345   while (CONSP (args))
   346     {
   347       Lisp_Object arg = XCAR (args);
   348       args = XCDR (args);
   349       val = eval_sub (arg);
   350       if (!NILP (val))
   351         break;
   352     }
   353 
   354   return val;
   355 }
   356 
   357 DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
   358        doc: /* Eval args until one of them yields nil, then return nil.
   359 The remaining args are not evalled at all.
   360 If no arg yields nil, return the last arg's value.
   361 usage: (and CONDITIONS...)  */)
   362   (Lisp_Object args)
   363 {
   364   Lisp_Object val = Qt;
   365 
   366   while (CONSP (args))
   367     {
   368       Lisp_Object arg = XCAR (args);
   369       args = XCDR (args);
   370       val = eval_sub (arg);
   371       if (NILP (val))
   372         break;
   373     }
   374 
   375   return val;
   376 }
   377 
   378 DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
   379        doc: /* If COND yields non-nil, do THEN, else do ELSE...
   380 Returns the value of THEN or the value of the last of the ELSE's.
   381 THEN must be one expression, but ELSE... can be zero or more expressions.
   382 If COND yields nil, and there are no ELSE's, the value is nil.
   383 usage: (if COND THEN ELSE...)  */)
   384   (Lisp_Object args)
   385 {
   386   Lisp_Object cond;
   387 
   388   cond = eval_sub (XCAR (args));
   389 
   390   if (!NILP (cond))
   391     return eval_sub (Fcar (XCDR (args)));
   392   return Fprogn (Fcdr (XCDR (args)));
   393 }
   394 
   395 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
   396        doc: /* Try each clause until one succeeds.
   397 Each clause looks like (CONDITION BODY...).  CONDITION is evaluated
   398 and, if the value is non-nil, this clause succeeds:
   399 then the expressions in BODY are evaluated and the last one's
   400 value is the value of the cond-form.
   401 If a clause has one element, as in (CONDITION), then the cond-form
   402 returns CONDITION's value, if that is non-nil.
   403 If no clause succeeds, cond returns nil.
   404 usage: (cond CLAUSES...)  */)
   405   (Lisp_Object args)
   406 {
   407   Lisp_Object val = args;
   408 
   409   while (CONSP (args))
   410     {
   411       Lisp_Object clause = XCAR (args);
   412       val = eval_sub (Fcar (clause));
   413       if (!NILP (val))
   414         {
   415           if (!NILP (XCDR (clause)))
   416             val = Fprogn (XCDR (clause));
   417           break;
   418         }
   419       args = XCDR (args);
   420     }
   421 
   422   return val;
   423 }
   424 
   425 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
   426        doc: /* Eval BODY forms sequentially and return value of last one.
   427 usage: (progn BODY...)  */)
   428   (Lisp_Object body)
   429 {
   430   Lisp_Object CACHEABLE val = Qnil;
   431 
   432   while (CONSP (body))
   433     {
   434       Lisp_Object form = XCAR (body);
   435       body = XCDR (body);
   436       val = eval_sub (form);
   437     }
   438 
   439   return val;
   440 }
   441 
   442 /* Evaluate BODY sequentially, discarding its value.  */
   443 
   444 void
   445 prog_ignore (Lisp_Object body)
   446 {
   447   Fprogn (body);
   448 }
   449 
   450 DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
   451        doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
   452 The value of FIRST is saved during the evaluation of the remaining args,
   453 whose values are discarded.
   454 usage: (prog1 FIRST BODY...)  */)
   455   (Lisp_Object args)
   456 {
   457   Lisp_Object val = eval_sub (XCAR (args));
   458   prog_ignore (XCDR (args));
   459   return val;
   460 }
   461 
   462 DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
   463        doc: /* Set each SYM to the value of its VAL.
   464 The symbols SYM are variables; they are literal (not evaluated).
   465 The values VAL are expressions; they are evaluated.
   466 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
   467 The second VAL is not computed until after the first SYM is set, and so on;
   468 each VAL can use the new value of variables set earlier in the `setq'.
   469 The return value of the `setq' form is the value of the last VAL.
   470 usage: (setq [SYM VAL]...)  */)
   471   (Lisp_Object args)
   472 {
   473   Lisp_Object val = args, tail = args;
   474 
   475   for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2)
   476     {
   477       Lisp_Object sym = XCAR (tail);
   478       tail = XCDR (tail);
   479       if (!CONSP (tail))
   480         xsignal2 (Qwrong_number_of_arguments, Qsetq, make_fixnum (nargs + 1));
   481       Lisp_Object arg = XCAR (tail);
   482       tail = XCDR (tail);
   483       val = eval_sub (arg);
   484       /* Like for eval_sub, we do not check declared_special here since
   485          it's been done when let-binding.  */
   486       Lisp_Object lex_binding
   487         = (SYMBOLP (sym)
   488            ? Fassq (sym, Vinternal_interpreter_environment)
   489            : Qnil);
   490       if (!NILP (lex_binding))
   491         XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
   492       else
   493         Fset (sym, val);        /* SYM is dynamically bound.  */
   494     }
   495 
   496   return val;
   497 }
   498 
   499 DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
   500        doc: /* Return the argument, without evaluating it.  `(quote x)' yields `x'.
   501 Warning: `quote' does not construct its return value, but just returns
   502 the value that was pre-constructed by the Lisp reader (see info node
   503 `(elisp)Printed Representation').
   504 This means that \\='(a . b) is not identical to (cons \\='a \\='b): the former
   505 does not cons.  Quoting should be reserved for constants that will
   506 never be modified by side-effects, unless you like self-modifying code.
   507 See the common pitfall in info node `(elisp)Rearrangement' for an example
   508 of unexpected results when a quoted object is modified.
   509 usage: (quote ARG)  */)
   510   (Lisp_Object args)
   511 {
   512   if (!NILP (XCDR (args)))
   513     xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
   514   return XCAR (args);
   515 }
   516 
   517 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
   518        doc: /* Like `quote', but preferred for objects which are functions.
   519 In byte compilation, `function' causes its argument to be handled by
   520 the byte compiler.  Similarly, when expanding macros and expressions,
   521 ARG can be examined and possibly expanded.  If `quote' is used
   522 instead, this doesn't happen.
   523 
   524 usage: (function ARG)  */)
   525   (Lisp_Object args)
   526 {
   527   Lisp_Object quoted = XCAR (args);
   528 
   529   if (!NILP (XCDR (args)))
   530     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
   531 
   532   if (!NILP (Vinternal_interpreter_environment)
   533       && CONSP (quoted)
   534       && EQ (XCAR (quoted), Qlambda))
   535     { /* This is a lambda expression within a lexical environment;
   536          return an interpreted closure instead of a simple lambda.  */
   537       Lisp_Object cdr = XCDR (quoted);
   538       Lisp_Object tmp = cdr;
   539       if (CONSP (tmp)
   540           && (tmp = XCDR (tmp), CONSP (tmp))
   541           && (tmp = XCAR (tmp), CONSP (tmp))
   542           && (EQ (QCdocumentation, XCAR (tmp))))
   543         { /* Handle the special (:documentation <form>) to build the docstring
   544              dynamically.  */
   545           Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
   546           if (SYMBOLP (docstring) && !NILP (docstring))
   547             /* Hack for OClosures: Allow the docstring to be a symbol
   548              * (the OClosure's type).  */
   549             docstring = Fsymbol_name (docstring);
   550           CHECK_STRING (docstring);
   551           cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
   552         }
   553       if (NILP (Vinternal_make_interpreted_closure_function))
   554         return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr));
   555       else
   556         return call2 (Vinternal_make_interpreted_closure_function,
   557                       Fcons (Qlambda, cdr),
   558                       Vinternal_interpreter_environment);
   559     }
   560   else
   561     /* Simply quote the argument.  */
   562     return quoted;
   563 }
   564 
   565 
   566 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
   567        doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
   568 Aliased variables always have the same value; setting one sets the other.
   569 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS.  If it is
   570 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
   571 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
   572 itself an alias.  If NEW-ALIAS is bound, and BASE-VARIABLE is not,
   573 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
   574 The return value is BASE-VARIABLE.  */)
   575   (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
   576 {
   577   struct Lisp_Symbol *sym;
   578 
   579   CHECK_SYMBOL (new_alias);
   580   CHECK_SYMBOL (base_variable);
   581 
   582   if (SYMBOL_CONSTANT_P (new_alias))
   583     /* Making it an alias effectively changes its value.  */
   584     error ("Cannot make a constant an alias: %s",
   585            SDATA (SYMBOL_NAME (new_alias)));
   586 
   587   sym = XSYMBOL (new_alias);
   588 
   589   switch (sym->u.s.redirect)
   590     {
   591     case SYMBOL_FORWARDED:
   592       error ("Cannot make a built-in variable an alias: %s",
   593              SDATA (SYMBOL_NAME (new_alias)));
   594     case SYMBOL_LOCALIZED:
   595       error ("Don't know how to make a buffer-local variable an alias: %s",
   596              SDATA (SYMBOL_NAME (new_alias)));
   597     case SYMBOL_PLAINVAL:
   598     case SYMBOL_VARALIAS:
   599       break;
   600     default:
   601       emacs_abort ();
   602     }
   603 
   604   /* https://lists.gnu.org/r/emacs-devel/2008-04/msg00834.html
   605      If n_a is bound, but b_v is not, set the value of b_v to n_a,
   606      so that old-code that affects n_a before the aliasing is setup
   607      still works.  */
   608   if (NILP (Fboundp (base_variable)))
   609     set_internal (base_variable, find_symbol_value (new_alias),
   610                   Qnil, SET_INTERNAL_BIND);
   611   else if (!NILP (Fboundp (new_alias))
   612            && !EQ (find_symbol_value (new_alias),
   613                    find_symbol_value (base_variable)))
   614     call2 (intern ("display-warning"),
   615            list3 (Qdefvaralias, intern ("losing-value"), new_alias),
   616            CALLN (Fformat_message,
   617                   build_string
   618                   ("Overwriting value of `%s' by aliasing to `%s'"),
   619                   new_alias, base_variable));
   620 
   621   {
   622     union specbinding *p;
   623 
   624     for (p = specpdl_ptr; p > specpdl; )
   625       if ((--p)->kind >= SPECPDL_LET
   626           && (EQ (new_alias, specpdl_symbol (p))))
   627         error ("Don't know how to make a let-bound variable an alias: %s",
   628                SDATA (SYMBOL_NAME (new_alias)));
   629   }
   630 
   631   if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
   632     notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
   633 
   634   sym->u.s.declared_special = true;
   635   XSYMBOL (base_variable)->u.s.declared_special = true;
   636   sym->u.s.redirect = SYMBOL_VARALIAS;
   637   SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
   638   sym->u.s.trapped_write = XSYMBOL (base_variable)->u.s.trapped_write;
   639   LOADHIST_ATTACH (new_alias);
   640   /* Even if docstring is nil: remove old docstring.  */
   641   Fput (new_alias, Qvariable_documentation, docstring);
   642 
   643   return base_variable;
   644 }
   645 
   646 static union specbinding *
   647 default_toplevel_binding (Lisp_Object symbol)
   648 {
   649   union specbinding *binding = NULL;
   650   union specbinding *pdl = specpdl_ptr;
   651   while (pdl > specpdl)
   652     {
   653       switch ((--pdl)->kind)
   654         {
   655         case SPECPDL_LET_DEFAULT:
   656         case SPECPDL_LET:
   657           if (EQ (specpdl_symbol (pdl), symbol))
   658             binding = pdl;
   659           break;
   660 
   661         default: break;
   662         }
   663     }
   664   return binding;
   665 }
   666 
   667 /* Look for a lexical-binding of SYMBOL somewhere up the stack.
   668    This will only find bindings created with interpreted code, since once
   669    compiled names of lexical variables are basically gone anyway.  */
   670 static bool
   671 lexbound_p (Lisp_Object symbol)
   672 {
   673   union specbinding *pdl = specpdl_ptr;
   674   while (pdl > specpdl)
   675     {
   676       switch ((--pdl)->kind)
   677         {
   678         case SPECPDL_LET_DEFAULT:
   679         case SPECPDL_LET:
   680           if (EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment))
   681             {
   682               Lisp_Object env = specpdl_old_value (pdl);
   683               if (CONSP (env) && !NILP (Fassq (symbol, env)))
   684                 return true;
   685             }
   686           break;
   687 
   688         default: break;
   689         }
   690     }
   691   return false;
   692 }
   693 
   694 DEFUN ("default-toplevel-value", Fdefault_toplevel_value, Sdefault_toplevel_value, 1, 1, 0,
   695        doc: /* Return SYMBOL's toplevel default value.
   696 "Toplevel" means outside of any let binding.  */)
   697   (Lisp_Object symbol)
   698 {
   699   union specbinding *binding = default_toplevel_binding (symbol);
   700   Lisp_Object value
   701     = binding ? specpdl_old_value (binding) : Fdefault_value (symbol);
   702   if (!BASE_EQ (value, Qunbound))
   703     return value;
   704   xsignal1 (Qvoid_variable, symbol);
   705 }
   706 
   707 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value,
   708        Sset_default_toplevel_value, 2, 2, 0,
   709        doc: /* Set SYMBOL's toplevel default value to VALUE.
   710 "Toplevel" means outside of any let binding.  */)
   711      (Lisp_Object symbol, Lisp_Object value)
   712 {
   713   union specbinding *binding = default_toplevel_binding (symbol);
   714   if (binding)
   715     set_specpdl_old_value (binding, value);
   716   else
   717     Fset_default (symbol, value);
   718   return Qnil;
   719 }
   720 
   721 DEFUN ("internal--define-uninitialized-variable",
   722        Finternal__define_uninitialized_variable,
   723        Sinternal__define_uninitialized_variable, 1, 2, 0,
   724        doc: /* Define SYMBOL as a variable, with DOC as its docstring.
   725 This is like `defvar' and `defconst' but without affecting the variable's
   726 value.  */)
   727   (Lisp_Object symbol, Lisp_Object doc)
   728 {
   729   if (!XSYMBOL (symbol)->u.s.declared_special
   730       && lexbound_p (symbol))
   731     /* This test tries to catch the situation where we do
   732        (let ((<foo-var> ...)) ...(<foo-function> ...)....)
   733        and where the `foo` package only gets loaded when <foo-function>
   734        is called, so the outer `let` incorrectly made the binding lexical
   735        because the <foo-var> wasn't yet declared as dynamic at that point.  */
   736     xsignal2 (Qerror,
   737               build_string ("Defining as dynamic an already lexical var"),
   738               symbol);
   739 
   740   XSYMBOL (symbol)->u.s.declared_special = true;
   741   if (!NILP (doc))
   742     {
   743       if (!NILP (Vpurify_flag))
   744         doc = Fpurecopy (doc);
   745       Fput (symbol, Qvariable_documentation, doc);
   746     }
   747   LOADHIST_ATTACH (symbol);
   748   return Qnil;
   749 }
   750 
   751 static Lisp_Object
   752 defvar (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring, bool eval)
   753 {
   754   Lisp_Object tem;
   755 
   756   CHECK_SYMBOL (sym);
   757 
   758   tem = Fdefault_boundp (sym);
   759 
   760   /* Do it before evaluating the initial value, for self-references.  */
   761   Finternal__define_uninitialized_variable (sym, docstring);
   762 
   763   if (NILP (tem))
   764     Fset_default (sym, eval ? eval_sub (initvalue) : initvalue);
   765   else
   766     { /* Check if there is really a global binding rather than just a let
   767              binding that shadows the global unboundness of the var.  */
   768       union specbinding *binding = default_toplevel_binding (sym);
   769       if (binding && BASE_EQ (specpdl_old_value (binding), Qunbound))
   770         {
   771           set_specpdl_old_value (binding,
   772                                  eval ? eval_sub (initvalue) : initvalue);
   773         }
   774     }
   775   return sym;
   776 }
   777 
   778 DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
   779        doc: /* Define SYMBOL as a variable, and return SYMBOL.
   780 You are not required to define a variable in order to use it, but
   781 defining it lets you supply an initial value and documentation, which
   782 can be referred to by the Emacs help facilities and other programming
   783 tools.  The `defvar' form also declares the variable as \"special\",
   784 so that it is always dynamically bound even if `lexical-binding' is t.
   785 
   786 If SYMBOL's value is void and the optional argument INITVALUE is
   787 provided, INITVALUE is evaluated and the result used to set SYMBOL's
   788 value.  If SYMBOL is buffer-local, its default value is what is set;
   789 buffer-local values are not affected.  If INITVALUE is missing,
   790 SYMBOL's value is not set.
   791 
   792 If SYMBOL is let-bound, then this form does not affect the local let
   793 binding but the toplevel default binding instead, like
   794 `set-toplevel-default-binding`.
   795 (`defcustom' behaves similarly in this respect.)
   796 
   797 The optional argument DOCSTRING is a documentation string for the
   798 variable.
   799 
   800 To define a user option, use `defcustom' instead of `defvar'.
   801 
   802 To define a buffer-local variable, use `defvar-local'.
   803 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
   804   (Lisp_Object args)
   805 {
   806   Lisp_Object sym, tail;
   807 
   808   sym = XCAR (args);
   809   tail = XCDR (args);
   810 
   811   CHECK_SYMBOL (sym);
   812 
   813   if (!NILP (tail))
   814     {
   815       if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
   816         error ("Too many arguments");
   817       Lisp_Object exp = XCAR (tail);
   818       tail = XCDR (tail);
   819       return defvar (sym, exp, CAR (tail), true);
   820     }
   821   else if (!NILP (Vinternal_interpreter_environment)
   822            && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special))
   823     /* A simple (defvar foo) with lexical scoping does "nothing" except
   824        declare that var to be dynamically scoped *locally* (i.e. within
   825        the current file or let-block).  */
   826     Vinternal_interpreter_environment
   827       = Fcons (sym, Vinternal_interpreter_environment);
   828   else
   829     {
   830       /* Simple (defvar <var>) should not count as a definition at all.
   831          It could get in the way of other definitions, and unloading this
   832          package could try to make the variable unbound.  */
   833     }
   834 
   835   return sym;
   836 }
   837 
   838 DEFUN ("defvar-1", Fdefvar_1, Sdefvar_1, 2, 3, 0,
   839        doc: /* Like `defvar' but as a function.
   840 More specifically behaves like (defvar SYM 'INITVALUE DOCSTRING).  */)
   841   (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring)
   842 {
   843   return defvar (sym, initvalue, docstring, false);
   844 }
   845 
   846 DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
   847        doc: /* Define SYMBOL as a constant variable.
   848 This declares that neither programs nor users should ever change the
   849 value.  This constancy is not actually enforced by Emacs Lisp, but
   850 SYMBOL is marked as a special variable so that it is never lexically
   851 bound.
   852 
   853 The `defconst' form always sets the value of SYMBOL to the result of
   854 evalling INITVALUE.  If SYMBOL is buffer-local, its default value is
   855 what is set; buffer-local values are not affected.  If SYMBOL has a
   856 local binding, then this form sets the local binding's value.
   857 However, you should normally not make local bindings for variables
   858 defined with this form.
   859 
   860 The optional DOCSTRING specifies the variable's documentation string.
   861 usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   862   (Lisp_Object args)
   863 {
   864   Lisp_Object sym, tem;
   865 
   866   sym = XCAR (args);
   867   CHECK_SYMBOL (sym);
   868   Lisp_Object docstring = Qnil;
   869   if (!NILP (XCDR (XCDR (args))))
   870     {
   871       if (!NILP (XCDR (XCDR (XCDR (args)))))
   872         error ("Too many arguments");
   873       docstring = XCAR (XCDR (XCDR (args)));
   874     }
   875   tem = eval_sub (XCAR (XCDR (args)));
   876   return Fdefconst_1 (sym, tem, docstring);
   877 }
   878 
   879 DEFUN ("defconst-1", Fdefconst_1, Sdefconst_1, 2, 3, 0,
   880        doc: /* Like `defconst' but as a function.
   881 More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING).  */)
   882   (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring)
   883 {
   884   CHECK_SYMBOL (sym);
   885   Lisp_Object tem = initvalue;
   886   Finternal__define_uninitialized_variable (sym, docstring);
   887   if (!NILP (Vpurify_flag))
   888     tem = Fpurecopy (tem);
   889   Fset_default (sym, tem);      /* FIXME: set-default-toplevel-value? */
   890   Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why?  */
   891   return sym;
   892 }
   893 
   894 /* Make SYMBOL lexically scoped.  */
   895 DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
   896        Smake_var_non_special, 1, 1, 0,
   897        doc: /* Internal function.  */)
   898      (Lisp_Object symbol)
   899 {
   900   CHECK_SYMBOL (symbol);
   901   XSYMBOL (symbol)->u.s.declared_special = false;
   902   return Qnil;
   903 }
   904 
   905 
   906 DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
   907        doc: /* Bind variables according to VARLIST then eval BODY.
   908 The value of the last form in BODY is returned.
   909 Each element of VARLIST is a symbol (which is bound to nil)
   910 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
   911 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
   912 usage: (let* VARLIST BODY...)  */)
   913   (Lisp_Object args)
   914 {
   915   Lisp_Object var, val, elt, lexenv;
   916   specpdl_ref count = SPECPDL_INDEX ();
   917 
   918   lexenv = Vinternal_interpreter_environment;
   919 
   920   Lisp_Object varlist = XCAR (args);
   921   FOR_EACH_TAIL (varlist)
   922     {
   923       elt = XCAR (varlist);
   924       if (SYMBOLP (elt))
   925         {
   926           var = elt;
   927           val = Qnil;
   928         }
   929       else
   930         {
   931           var = Fcar (elt);
   932           if (! NILP (Fcdr (XCDR (elt))))
   933             signal_error ("`let' bindings can have only one value-form", elt);
   934           val = eval_sub (Fcar (XCDR (elt)));
   935         }
   936 
   937       if (!NILP (lexenv) && SYMBOLP (var)
   938           && !XSYMBOL (var)->u.s.declared_special
   939           && NILP (Fmemq (var, Vinternal_interpreter_environment)))
   940         /* Lexically bind VAR by adding it to the interpreter's binding
   941            alist.  */
   942         {
   943           Lisp_Object newenv
   944             = Fcons (Fcons (var, val), Vinternal_interpreter_environment);
   945           if (EQ (Vinternal_interpreter_environment, lexenv))
   946             /* Save the old lexical environment on the specpdl stack,
   947                but only for the first lexical binding, since we'll never
   948                need to revert to one of the intermediate ones.  */
   949             specbind (Qinternal_interpreter_environment, newenv);
   950           else
   951             Vinternal_interpreter_environment = newenv;
   952         }
   953       else
   954         specbind (var, val);
   955     }
   956   CHECK_LIST_END (varlist, XCAR (args));
   957 
   958   val = Fprogn (XCDR (args));
   959   return unbind_to (count, val);
   960 }
   961 
   962 DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
   963        doc: /* Bind variables according to VARLIST then eval BODY.
   964 The value of the last form in BODY is returned.
   965 Each element of VARLIST is a symbol (which is bound to nil)
   966 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
   967 All the VALUEFORMs are evalled before any symbols are bound.
   968 usage: (let VARLIST BODY...)  */)
   969   (Lisp_Object args)
   970 {
   971   Lisp_Object *temps, tem, lexenv;
   972   Lisp_Object elt;
   973   specpdl_ref count = SPECPDL_INDEX ();
   974   ptrdiff_t argnum;
   975   USE_SAFE_ALLOCA;
   976 
   977   Lisp_Object varlist = XCAR (args);
   978 
   979   /* Make space to hold the values to give the bound variables.  */
   980   EMACS_INT varlist_len = list_length (varlist);
   981   SAFE_ALLOCA_LISP (temps, varlist_len);
   982   ptrdiff_t nvars = varlist_len;
   983 
   984   /* Compute the values and store them in `temps'.  */
   985 
   986   for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
   987     {
   988       maybe_quit ();
   989       elt = XCAR (varlist);
   990       varlist = XCDR (varlist);
   991       if (SYMBOLP (elt))
   992         temps[argnum] = Qnil;
   993       else if (! NILP (Fcdr (Fcdr (elt))))
   994         signal_error ("`let' bindings can have only one value-form", elt);
   995       else
   996         temps[argnum] = eval_sub (Fcar (Fcdr (elt)));
   997     }
   998   nvars = argnum;
   999 
  1000   lexenv = Vinternal_interpreter_environment;
  1001 
  1002   varlist = XCAR (args);
  1003   for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
  1004     {
  1005       Lisp_Object var;
  1006 
  1007       elt = XCAR (varlist);
  1008       varlist = XCDR (varlist);
  1009       var = SYMBOLP (elt) ? elt : Fcar (elt);
  1010       tem = temps[argnum];
  1011 
  1012       if (!NILP (lexenv) && SYMBOLP (var)
  1013           && !XSYMBOL (var)->u.s.declared_special
  1014           && NILP (Fmemq (var, Vinternal_interpreter_environment)))
  1015         /* Lexically bind VAR by adding it to the lexenv alist.  */
  1016         lexenv = Fcons (Fcons (var, tem), lexenv);
  1017       else
  1018         /* Dynamically bind VAR.  */
  1019         specbind (var, tem);
  1020     }
  1021 
  1022   if (!EQ (lexenv, Vinternal_interpreter_environment))
  1023     /* Instantiate a new lexical environment.  */
  1024     specbind (Qinternal_interpreter_environment, lexenv);
  1025 
  1026   elt = Fprogn (XCDR (args));
  1027   return SAFE_FREE_UNBIND_TO (count, elt);
  1028 }
  1029 
  1030 DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
  1031        doc: /* If TEST yields non-nil, eval BODY... and repeat.
  1032 The order of execution is thus TEST, BODY, TEST, BODY and so on
  1033 until TEST returns nil.
  1034 
  1035 The value of a `while' form is always nil.
  1036 
  1037 usage: (while TEST BODY...)  */)
  1038   (Lisp_Object args)
  1039 {
  1040   Lisp_Object test, body;
  1041 
  1042   test = XCAR (args);
  1043   body = XCDR (args);
  1044   while (!NILP (eval_sub (test)))
  1045     {
  1046       maybe_quit ();
  1047       prog_ignore (body);
  1048     }
  1049 
  1050   return Qnil;
  1051 }
  1052 
  1053 static void
  1054 with_delayed_message_display (struct atimer *timer)
  1055 {
  1056   message3 (build_string (timer->client_data));
  1057 }
  1058 
  1059 static void
  1060 with_delayed_message_cancel (void *timer)
  1061 {
  1062   xfree (((struct atimer *) timer)->client_data);
  1063   cancel_atimer (timer);
  1064 }
  1065 
  1066 DEFUN ("funcall-with-delayed-message",
  1067        Ffuncall_with_delayed_message, Sfuncall_with_delayed_message,
  1068        3, 3, 0,
  1069        doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT.
  1070 TIMEOUT is a number of seconds, and can be an integer or a floating
  1071 point number.
  1072 
  1073 If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE
  1074 is not displayed.  */)
  1075   (Lisp_Object timeout, Lisp_Object message, Lisp_Object function)
  1076 {
  1077   specpdl_ref count = SPECPDL_INDEX ();
  1078 
  1079   CHECK_NUMBER (timeout);
  1080   CHECK_STRING (message);
  1081 
  1082   /* Set up the atimer.  */
  1083   struct timespec interval = dtotimespec (XFLOATINT (timeout));
  1084   struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval,
  1085                                        with_delayed_message_display,
  1086                                        xstrdup (SSDATA (message)));
  1087   record_unwind_protect_ptr (with_delayed_message_cancel, timer);
  1088 
  1089   Lisp_Object result = CALLN (Ffuncall, function);
  1090 
  1091   return unbind_to (count, result);
  1092 }
  1093 
  1094 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
  1095        doc: /* Return result of expanding macros at top level of FORM.
  1096 If FORM is not a macro call, it is returned unchanged.
  1097 Otherwise, the macro is expanded and the expansion is considered
  1098 in place of FORM.  When a non-macro-call results, it is returned.
  1099 
  1100 The second optional arg ENVIRONMENT specifies an environment of macro
  1101 definitions to shadow the loaded ones for use in file byte-compilation.  */)
  1102   (Lisp_Object form, Lisp_Object environment)
  1103 {
  1104   /* With cleanups from Hallvard Furuseth.  */
  1105   register Lisp_Object expander, sym, def, tem;
  1106 
  1107   while (1)
  1108     {
  1109       /* Come back here each time we expand a macro call,
  1110          in case it expands into another macro call.  */
  1111       if (!CONSP (form))
  1112         break;
  1113       /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
  1114       def = sym = XCAR (form);
  1115       tem = Qnil;
  1116       /* Trace symbols aliases to other symbols
  1117          until we get a symbol that is not an alias.  */
  1118       while (SYMBOLP (def))
  1119         {
  1120           maybe_quit ();
  1121           sym = def;
  1122           tem = Fassq (sym, environment);
  1123           if (NILP (tem))
  1124             {
  1125               def = XSYMBOL (sym)->u.s.function;
  1126               if (!NILP (def))
  1127                 continue;
  1128             }
  1129           break;
  1130         }
  1131       /* Right now TEM is the result from SYM in ENVIRONMENT,
  1132          and if TEM is nil then DEF is SYM's function definition.  */
  1133       if (NILP (tem))
  1134         {
  1135           /* SYM is not mentioned in ENVIRONMENT.
  1136              Look at its function definition.  */
  1137           def = Fautoload_do_load (def, sym, Qmacro);
  1138           if (!CONSP (def))
  1139             /* Not defined or definition not suitable.  */
  1140             break;
  1141           if (!EQ (XCAR (def), Qmacro))
  1142             break;
  1143           else expander = XCDR (def);
  1144         }
  1145       else
  1146         {
  1147           expander = XCDR (tem);
  1148           if (NILP (expander))
  1149             break;
  1150         }
  1151       {
  1152         Lisp_Object newform = apply1 (expander, XCDR (form));
  1153         if (EQ (form, newform))
  1154           break;
  1155         else
  1156           form = newform;
  1157       }
  1158     }
  1159   return form;
  1160 }
  1161 
  1162 DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
  1163        doc: /* Eval BODY allowing nonlocal exits using `throw'.
  1164 TAG is evalled to get the tag to use; it must not be nil.
  1165 
  1166 Then the BODY is executed.
  1167 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
  1168 If no throw happens, `catch' returns the value of the last BODY form.
  1169 If a throw happens, it specifies the value to return from `catch'.
  1170 usage: (catch TAG BODY...)  */)
  1171   (Lisp_Object args)
  1172 {
  1173   Lisp_Object tag = eval_sub (XCAR (args));
  1174   return internal_catch (tag, Fprogn, XCDR (args));
  1175 }
  1176 
  1177 /* Assert that E is true, but do not evaluate E.  Use this instead of
  1178    eassert (E) when E contains variables that might be clobbered by a
  1179    longjmp.  */
  1180 
  1181 #define clobbered_eassert(E) verify (sizeof (E) != 0)
  1182 
  1183 /* Set up a catch, then call C function FUNC on argument ARG.
  1184    FUNC should return a Lisp_Object.
  1185    This is how catches are done from within C code.  */
  1186 
  1187 Lisp_Object
  1188 internal_catch (Lisp_Object tag,
  1189                 Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
  1190 {
  1191   /* This structure is made part of the chain `catchlist'.  */
  1192   struct handler *c = push_handler (tag, CATCHER);
  1193 
  1194   /* Call FUNC.  */
  1195   if (! sys_setjmp (c->jmp))
  1196     {
  1197       Lisp_Object val = func (arg);
  1198       eassert (handlerlist == c);
  1199       handlerlist = c->next;
  1200       return val;
  1201     }
  1202   else
  1203     { /* Throw works by a longjmp that comes right here.  */
  1204       Lisp_Object val = handlerlist->val;
  1205       clobbered_eassert (handlerlist == c);
  1206       handlerlist = handlerlist->next;
  1207       return val;
  1208     }
  1209 }
  1210 
  1211 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
  1212    jump to that CATCH, returning VALUE as the value of that catch.
  1213 
  1214    This is the guts of Fthrow and Fsignal; they differ only in the way
  1215    they choose the catch tag to throw to.  A catch tag for a
  1216    condition-case form has a TAG of Qnil.
  1217 
  1218    Before each catch is discarded, unbind all special bindings and
  1219    execute all unwind-protect clauses made above that catch.  Unwind
  1220    the handler stack as we go, so that the proper handlers are in
  1221    effect for each unwind-protect clause we run.  At the end, restore
  1222    some static info saved in CATCH, and longjmp to the location
  1223    specified there.
  1224 
  1225    This is used for correct unwinding in Fthrow and Fsignal.  */
  1226 
  1227 static AVOID
  1228 unwind_to_catch (struct handler *catch, enum nonlocal_exit type,
  1229                  Lisp_Object value)
  1230 {
  1231   bool last_time;
  1232 
  1233   eassert (catch->next);
  1234 
  1235   /* Save the value in the tag.  */
  1236   catch->nonlocal_exit = type;
  1237   catch->val = value;
  1238 
  1239   /* Restore certain special C variables.  */
  1240   set_poll_suppress_count (catch->poll_suppress_count);
  1241   unblock_input_to (catch->interrupt_input_blocked);
  1242 
  1243 #ifdef HAVE_X_WINDOWS
  1244   /* Restore the X error handler stack.  This is important because
  1245      otherwise a display disconnect won't unwind the stack of error
  1246      traps to the right depth.  */
  1247   x_unwind_errors_to (catch->x_error_handler_depth);
  1248 #endif
  1249 
  1250   do
  1251     {
  1252       /* Unwind the specpdl stack, and then restore the proper set of
  1253          handlers.  */
  1254       unbind_to (handlerlist->pdlcount, Qnil);
  1255       last_time = handlerlist == catch;
  1256       if (! last_time)
  1257         handlerlist = handlerlist->next;
  1258     }
  1259   while (! last_time);
  1260 
  1261   eassert (handlerlist == catch);
  1262 
  1263   lisp_eval_depth = catch->f_lisp_eval_depth;
  1264   set_act_rec (current_thread, catch->act_rec);
  1265 
  1266   sys_longjmp (catch->jmp, 1);
  1267 }
  1268 
  1269 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
  1270        doc: /* Throw to the catch for TAG and return VALUE from it.
  1271 Both TAG and VALUE are evalled.  */
  1272        attributes: noreturn)
  1273   (register Lisp_Object tag, Lisp_Object value)
  1274 {
  1275   struct handler *c;
  1276 
  1277   if (!NILP (tag))
  1278     for (c = handlerlist; c; c = c->next)
  1279       {
  1280         if (c->type == CATCHER_ALL)
  1281           unwind_to_catch (c, NONLOCAL_EXIT_THROW, Fcons (tag, value));
  1282         if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
  1283           unwind_to_catch (c, NONLOCAL_EXIT_THROW, value);
  1284       }
  1285   xsignal2 (Qno_catch, tag, value);
  1286 }
  1287 
  1288 
  1289 DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
  1290        doc: /* Do BODYFORM, protecting with UNWINDFORMS.
  1291 If BODYFORM completes normally, its value is returned
  1292 after executing the UNWINDFORMS.
  1293 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
  1294 usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
  1295   (Lisp_Object args)
  1296 {
  1297   Lisp_Object val;
  1298   specpdl_ref count = SPECPDL_INDEX ();
  1299 
  1300   record_unwind_protect (prog_ignore, XCDR (args));
  1301   val = eval_sub (XCAR (args));
  1302   return unbind_to (count, val);
  1303 }
  1304 
  1305 DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
  1306        doc: /* Regain control when an error is signaled.
  1307 Executes BODYFORM and returns its value if no error happens.
  1308 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
  1309 or (:success BODY...), where the BODY is made of Lisp expressions.
  1310 
  1311 A handler is applicable to an error if CONDITION-NAME is one of the
  1312 error's condition names.  Handlers may also apply when non-error
  1313 symbols are signaled (e.g., `quit').  A CONDITION-NAME of t applies to
  1314 any symbol, including non-error symbols.  If multiple handlers are
  1315 applicable, only the first one runs.
  1316 
  1317 The car of a handler may be a list of condition names instead of a
  1318 single condition name; then it handles all of them.  If the special
  1319 condition name `debug' is present in this list, it allows another
  1320 condition in the list to run the debugger if `debug-on-error' and the
  1321 other usual mechanisms say it should (otherwise, `condition-case'
  1322 suppresses the debugger).
  1323 
  1324 When a handler handles an error, control returns to the `condition-case'
  1325 and it executes the handler's BODY...
  1326 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
  1327 \(If VAR is nil, the handler can't access that information.)
  1328 Then the value of the last BODY form is returned from the `condition-case'
  1329 expression.
  1330 
  1331 The special handler (:success BODY...) is invoked if BODYFORM terminated
  1332 without signaling an error.  BODY is then evaluated with VAR bound to
  1333 the value returned by BODYFORM.
  1334 
  1335 See also the function `signal' for more info.
  1336 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
  1337   (Lisp_Object args)
  1338 {
  1339   Lisp_Object var = XCAR (args);
  1340   Lisp_Object bodyform = XCAR (XCDR (args));
  1341   Lisp_Object handlers = XCDR (XCDR (args));
  1342 
  1343   return internal_lisp_condition_case (var, bodyform, handlers);
  1344 }
  1345 
  1346 /* Like Fcondition_case, but the args are separate
  1347    rather than passed in a list.  Used by Fbyte_code.  */
  1348 
  1349 Lisp_Object
  1350 internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
  1351                               Lisp_Object handlers)
  1352 {
  1353   struct handler *oldhandlerlist = handlerlist;
  1354   ptrdiff_t CACHEABLE clausenb = 0;
  1355 
  1356   CHECK_SYMBOL (var);
  1357 
  1358   Lisp_Object success_handler = Qnil;
  1359 
  1360   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
  1361     {
  1362       Lisp_Object tem = XCAR (tail);
  1363       if (! (NILP (tem)
  1364              || (CONSP (tem)
  1365                  && (SYMBOLP (XCAR (tem))
  1366                      || CONSP (XCAR (tem))))))
  1367         error ("Invalid condition handler: %s",
  1368                SDATA (Fprin1_to_string (tem, Qt, Qnil)));
  1369       if (CONSP (tem) && EQ (XCAR (tem), QCsuccess))
  1370         success_handler = XCDR (tem);
  1371       else
  1372         clausenb++;
  1373     }
  1374 
  1375   /* The first clause is the one that should be checked first, so it
  1376      should be added to handlerlist last.  So build in CLAUSES a table
  1377      that contains HANDLERS but in reverse order.  CLAUSES is pointer
  1378      to volatile to avoid issues with setjmp and local storage.
  1379      SAFE_ALLOCA won't work here due to the setjmp, so impose a
  1380      MAX_ALLOCA limit.  */
  1381   if (MAX_ALLOCA / word_size < clausenb)
  1382     memory_full (SIZE_MAX);
  1383   Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
  1384   clauses += clausenb;
  1385   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
  1386     {
  1387       Lisp_Object tem = XCAR (tail);
  1388       if (!(CONSP (tem) && EQ (XCAR (tem), QCsuccess)))
  1389         *--clauses = tem;
  1390     }
  1391   for (ptrdiff_t i = 0; i < clausenb; i++)
  1392     {
  1393       Lisp_Object clause = clauses[i];
  1394       Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil;
  1395       if (!CONSP (condition))
  1396         condition = list1 (condition);
  1397       struct handler *c = push_handler (condition, CONDITION_CASE);
  1398       if (sys_setjmp (c->jmp))
  1399         {
  1400           Lisp_Object val = handlerlist->val;
  1401           Lisp_Object volatile *chosen_clause = clauses;
  1402           for (struct handler *h = handlerlist->next; h != oldhandlerlist;
  1403                h = h->next)
  1404             chosen_clause++;
  1405           Lisp_Object handler_body = XCDR (*chosen_clause);
  1406           handlerlist = oldhandlerlist;
  1407 
  1408           if (NILP (var))
  1409             return Fprogn (handler_body);
  1410 
  1411           Lisp_Object handler_var = var;
  1412           if (!NILP (Vinternal_interpreter_environment))
  1413             {
  1414               val = Fcons (Fcons (var, val),
  1415                            Vinternal_interpreter_environment);
  1416               handler_var = Qinternal_interpreter_environment;
  1417             }
  1418 
  1419           /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY.
  1420              The unbind_to undoes just this binding; whoever longjumped
  1421              to us unwound the stack to C->pdlcount before throwing.  */
  1422           specpdl_ref count = SPECPDL_INDEX ();
  1423           specbind (handler_var, val);
  1424           return unbind_to (count, Fprogn (handler_body));
  1425         }
  1426     }
  1427 
  1428   Lisp_Object CACHEABLE result = eval_sub (bodyform);
  1429   handlerlist = oldhandlerlist;
  1430   if (!NILP (success_handler))
  1431     {
  1432       if (NILP (var))
  1433         return Fprogn (success_handler);
  1434 
  1435       Lisp_Object handler_var = var;
  1436       if (!NILP (Vinternal_interpreter_environment))
  1437         {
  1438           result = Fcons (Fcons (var, result),
  1439                        Vinternal_interpreter_environment);
  1440           handler_var = Qinternal_interpreter_environment;
  1441         }
  1442 
  1443       specpdl_ref count = SPECPDL_INDEX ();
  1444       specbind (handler_var, result);
  1445       return unbind_to (count, Fprogn (success_handler));
  1446     }
  1447   return result;
  1448 }
  1449 
  1450 /* Call the function BFUN with no arguments, catching errors within it
  1451    according to HANDLERS.  If there is an error, call HFUN with
  1452    one argument which is the data that describes the error:
  1453    (SIGNALNAME . DATA)
  1454 
  1455    HANDLERS can be a list of conditions to catch.
  1456    If HANDLERS is Qt, catch all errors.
  1457    If HANDLERS is Qerror, catch all errors
  1458    but allow the debugger to run if that is enabled.  */
  1459 
  1460 Lisp_Object
  1461 internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
  1462                          Lisp_Object (*hfun) (Lisp_Object))
  1463 {
  1464   struct handler *c = push_handler (handlers, CONDITION_CASE);
  1465   if (sys_setjmp (c->jmp))
  1466     {
  1467       Lisp_Object val = handlerlist->val;
  1468       clobbered_eassert (handlerlist == c);
  1469       handlerlist = handlerlist->next;
  1470       return hfun (val);
  1471     }
  1472   else
  1473     {
  1474       Lisp_Object val = bfun ();
  1475       eassert (handlerlist == c);
  1476       handlerlist = c->next;
  1477       return val;
  1478     }
  1479 }
  1480 
  1481 /* Like internal_condition_case but call BFUN with ARG as its argument.  */
  1482 
  1483 Lisp_Object
  1484 internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
  1485                            Lisp_Object handlers,
  1486                            Lisp_Object (*hfun) (Lisp_Object))
  1487 {
  1488   struct handler *c = push_handler (handlers, CONDITION_CASE);
  1489   if (sys_setjmp (c->jmp))
  1490     {
  1491       Lisp_Object val = handlerlist->val;
  1492       clobbered_eassert (handlerlist == c);
  1493       handlerlist = handlerlist->next;
  1494       return hfun (val);
  1495     }
  1496   else
  1497     {
  1498       Lisp_Object val = bfun (arg);
  1499       eassert (handlerlist == c);
  1500       handlerlist = c->next;
  1501       return val;
  1502     }
  1503 }
  1504 
  1505 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
  1506    its arguments.  */
  1507 
  1508 Lisp_Object
  1509 internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
  1510                            Lisp_Object arg1,
  1511                            Lisp_Object arg2,
  1512                            Lisp_Object handlers,
  1513                            Lisp_Object (*hfun) (Lisp_Object))
  1514 {
  1515   struct handler *c = push_handler (handlers, CONDITION_CASE);
  1516   if (sys_setjmp (c->jmp))
  1517     {
  1518       Lisp_Object val = handlerlist->val;
  1519       clobbered_eassert (handlerlist == c);
  1520       handlerlist = handlerlist->next;
  1521       return hfun (val);
  1522     }
  1523   else
  1524     {
  1525       Lisp_Object val = bfun (arg1, arg2);
  1526       eassert (handlerlist == c);
  1527       handlerlist = c->next;
  1528       return val;
  1529     }
  1530 }
  1531 
  1532 /* Like internal_condition_case but call BFUN with NARGS as first,
  1533    and ARGS as second argument.  */
  1534 
  1535 Lisp_Object
  1536 internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
  1537                            ptrdiff_t nargs,
  1538                            Lisp_Object *args,
  1539                            Lisp_Object handlers,
  1540                            Lisp_Object (*hfun) (Lisp_Object err,
  1541                                                 ptrdiff_t nargs,
  1542                                                 Lisp_Object *args))
  1543 {
  1544   struct handler *old_deep = redisplay_deep_handler;
  1545   struct handler *c = push_handler (handlers, CONDITION_CASE);
  1546   if (redisplaying_p)
  1547     redisplay_deep_handler = c;
  1548   if (sys_setjmp (c->jmp))
  1549     {
  1550       Lisp_Object val = handlerlist->val;
  1551       clobbered_eassert (handlerlist == c);
  1552       handlerlist = handlerlist->next;
  1553       redisplay_deep_handler = old_deep;
  1554       return hfun (val, nargs, args);
  1555     }
  1556   else
  1557     {
  1558       Lisp_Object val = bfun (nargs, args);
  1559       eassert (handlerlist == c);
  1560       handlerlist = c->next;
  1561       redisplay_deep_handler = old_deep;
  1562       return val;
  1563     }
  1564 }
  1565 
  1566 static Lisp_Object Qcatch_all_memory_full;
  1567 
  1568 /* Like a combination of internal_condition_case_1 and internal_catch.
  1569    Catches all signals and throws.  Never exits nonlocally; returns
  1570    Qcatch_all_memory_full if no handler could be allocated.  */
  1571 
  1572 Lisp_Object
  1573 internal_catch_all (Lisp_Object (*function) (void *), void *argument,
  1574                     Lisp_Object (*handler) (enum nonlocal_exit, Lisp_Object))
  1575 {
  1576   struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
  1577   if (c == NULL)
  1578     return Qcatch_all_memory_full;
  1579 
  1580   if (sys_setjmp (c->jmp) == 0)
  1581     {
  1582       Lisp_Object val = function (argument);
  1583       eassert (handlerlist == c);
  1584       handlerlist = c->next;
  1585       return val;
  1586     }
  1587   else
  1588     {
  1589       eassert (handlerlist == c);
  1590       enum nonlocal_exit type = c->nonlocal_exit;
  1591       Lisp_Object val = c->val;
  1592       handlerlist = c->next;
  1593       return handler (type, val);
  1594     }
  1595 }
  1596 
  1597 struct handler *
  1598 push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
  1599 {
  1600   struct handler *c = push_handler_nosignal (tag_ch_val, handlertype);
  1601   if (!c)
  1602     memory_full (sizeof *c);
  1603   return c;
  1604 }
  1605 
  1606 struct handler *
  1607 push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
  1608 {
  1609   struct handler *CACHEABLE c = handlerlist->nextfree;
  1610   if (!c)
  1611     {
  1612       c = malloc (sizeof *c);
  1613       if (!c)
  1614         return c;
  1615       if (profiler_memory_running)
  1616         malloc_probe (sizeof *c);
  1617       c->nextfree = NULL;
  1618       handlerlist->nextfree = c;
  1619     }
  1620   c->type = handlertype;
  1621   c->tag_or_ch = tag_ch_val;
  1622   c->val = Qnil;
  1623   c->next = handlerlist;
  1624   c->f_lisp_eval_depth = lisp_eval_depth;
  1625   c->pdlcount = SPECPDL_INDEX ();
  1626   c->act_rec = get_act_rec (current_thread);
  1627   c->poll_suppress_count = poll_suppress_count;
  1628   c->interrupt_input_blocked = interrupt_input_blocked;
  1629 #ifdef HAVE_X_WINDOWS
  1630   c->x_error_handler_depth = x_error_message_count;
  1631 #endif
  1632   handlerlist = c;
  1633   return c;
  1634 }
  1635 
  1636 
  1637 static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool);
  1638 static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
  1639 static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
  1640                                  Lisp_Object data);
  1641 
  1642 static void
  1643 process_quit_flag (void)
  1644 {
  1645   Lisp_Object flag = Vquit_flag;
  1646   Vquit_flag = Qnil;
  1647   if (EQ (flag, Qkill_emacs))
  1648     Fkill_emacs (Qnil, Qnil);
  1649   if (EQ (Vthrow_on_input, flag))
  1650     Fthrow (Vthrow_on_input, Qt);
  1651   quit ();
  1652 }
  1653 
  1654 void
  1655 probably_quit (void)
  1656 {
  1657   specpdl_ref gc_count = inhibit_garbage_collection ();
  1658   if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
  1659     process_quit_flag ();
  1660   else if (pending_signals)
  1661     process_pending_signals ();
  1662   unbind_to (gc_count, Qnil);
  1663 }
  1664 
  1665 DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
  1666        doc: /* Signal an error.  Args are ERROR-SYMBOL and associated DATA.
  1667 This function does not return.
  1668 
  1669 An error symbol is a symbol with an `error-conditions' property
  1670 that is a list of condition names.  The symbol should be non-nil.
  1671 A handler for any of those names will get to handle this signal.
  1672 The symbol `error' should normally be one of them.
  1673 
  1674 DATA should be a list.  Its elements are printed as part of the error message.
  1675 See Info anchor `(elisp)Definition of signal' for some details on how this
  1676 error message is constructed.
  1677 If the signal is handled, DATA is made available to the handler.
  1678 See also the function `condition-case'.  */
  1679        attributes: noreturn)
  1680   (Lisp_Object error_symbol, Lisp_Object data)
  1681 {
  1682   /* If they call us with nonsensical arguments, produce "peculiar error".  */
  1683   if (NILP (error_symbol) && NILP (data))
  1684     error_symbol = Qerror;
  1685   signal_or_quit (error_symbol, data, false);
  1686   eassume (false);
  1687 }
  1688 
  1689 /* Quit, in response to a keyboard quit request.  */
  1690 Lisp_Object
  1691 quit (void)
  1692 {
  1693   return signal_or_quit (Qquit, Qnil, true);
  1694 }
  1695 
  1696 /* Has an error in redisplay giving rise to a backtrace occurred as
  1697    yet in the current command?  This gets reset in the command
  1698    loop.  */
  1699 bool backtrace_yet = false;
  1700 
  1701 /* Signal an error, or quit.  ERROR_SYMBOL and DATA are as with Fsignal.
  1702    If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
  1703    Qquit and DATA should be Qnil, and this function may return.
  1704    Otherwise this function is like Fsignal and does not return.  */
  1705 
  1706 static Lisp_Object
  1707 signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
  1708 {
  1709   /* When memory is full, ERROR-SYMBOL is nil,
  1710      and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
  1711      That is a special case--don't do this in other situations.  */
  1712   Lisp_Object conditions;
  1713   Lisp_Object string;
  1714   Lisp_Object real_error_symbol
  1715     = (NILP (error_symbol) ? Fcar (data) : error_symbol);
  1716   Lisp_Object clause = Qnil;
  1717   struct handler *h;
  1718 
  1719   if (gc_in_progress || waiting_for_input)
  1720     emacs_abort ();
  1721 
  1722 #if 0 /* rms: I don't know why this was here,
  1723          but it is surely wrong for an error that is handled.  */
  1724 #ifdef HAVE_WINDOW_SYSTEM
  1725   if (display_hourglass_p)
  1726     cancel_hourglass ();
  1727 #endif
  1728 #endif
  1729 
  1730   /* This hook is used by edebug.  */
  1731   if (! NILP (Vsignal_hook_function)
  1732       && ! NILP (error_symbol)
  1733       /* Don't try to call a lisp function if we've already overflowed
  1734          the specpdl stack.  */
  1735       && specpdl_ptr < specpdl_end)
  1736     {
  1737       /* Edebug takes care of restoring these variables when it exits.  */
  1738       max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20);
  1739 
  1740       call2 (Vsignal_hook_function, error_symbol, data);
  1741     }
  1742 
  1743   conditions = Fget (real_error_symbol, Qerror_conditions);
  1744 
  1745   /* Remember from where signal was called.  Skip over the frame for
  1746      `signal' itself.  If a frame for `error' follows, skip that,
  1747      too.  Don't do this when ERROR_SYMBOL is nil, because that
  1748      is a memory-full error.  */
  1749   Vsignaling_function = Qnil;
  1750   if (!NILP (error_symbol))
  1751     {
  1752       union specbinding *pdl = backtrace_next (backtrace_top ());
  1753       if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
  1754         pdl = backtrace_next (pdl);
  1755       if (backtrace_p (pdl))
  1756         Vsignaling_function = backtrace_function (pdl);
  1757     }
  1758 
  1759   for (h = handlerlist; h; h = h->next)
  1760     {
  1761       if (h->type == CATCHER_ALL)
  1762         {
  1763           clause = Qt;
  1764           break;
  1765         }
  1766       if (h->type != CONDITION_CASE)
  1767         continue;
  1768       clause = find_handler_clause (h->tag_or_ch, conditions);
  1769       if (!NILP (clause))
  1770         break;
  1771     }
  1772 
  1773   bool debugger_called = false;
  1774   if (/* Don't run the debugger for a memory-full error.
  1775          (There is no room in memory to do that!)  */
  1776       !NILP (error_symbol)
  1777       && (!NILP (Vdebug_on_signal)
  1778           /* If no handler is present now, try to run the debugger.  */
  1779           || NILP (clause)
  1780           /* A `debug' symbol in the handler list disables the normal
  1781              suppression of the debugger.  */
  1782           || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause)))
  1783           /* Special handler that means "print a message and run debugger
  1784              if requested".  */
  1785           || EQ (h->tag_or_ch, Qerror)))
  1786     {
  1787       debugger_called
  1788         = maybe_call_debugger (conditions, error_symbol, data);
  1789       /* We can't return values to code which signaled an error, but we
  1790          can continue code which has signaled a quit.  */
  1791       if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit))
  1792         return Qnil;
  1793     }
  1794 
  1795   /* If we're in batch mode, print a backtrace unconditionally to help
  1796      with debugging.  Make sure to use `debug-early' unconditionally
  1797      to not interfere with ERT or other packages that install custom
  1798      debuggers.  */
  1799   if (!debugger_called && !NILP (error_symbol)
  1800       && (NILP (clause) || EQ (h->tag_or_ch, Qerror))
  1801       && noninteractive && backtrace_on_error_noninteractive
  1802       && NILP (Vinhibit_debugger)
  1803       && !NILP (Ffboundp (Qdebug_early)))
  1804     {
  1805       max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
  1806       specpdl_ref count = SPECPDL_INDEX ();
  1807       specbind (Qdebugger, Qdebug_early);
  1808       call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
  1809       unbind_to (count, Qnil);
  1810     }
  1811 
  1812   /* If an error is signaled during a Lisp hook in redisplay, write a
  1813      backtrace into the buffer *Redisplay-trace*.  */
  1814   if (!debugger_called && !NILP (error_symbol)
  1815       && backtrace_on_redisplay_error
  1816       && (NILP (clause) || h == redisplay_deep_handler)
  1817       && NILP (Vinhibit_debugger)
  1818       && !NILP (Ffboundp (Qdebug_early)))
  1819     {
  1820       max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
  1821       specpdl_ref count = SPECPDL_INDEX ();
  1822       AUTO_STRING (redisplay_trace, "*Redisplay_trace*");
  1823       Lisp_Object redisplay_trace_buffer;
  1824       AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */
  1825       Lisp_Object delayed_warning;
  1826       redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil);
  1827       current_buffer = XBUFFER (redisplay_trace_buffer);
  1828       if (!backtrace_yet) /* Are we on the first backtrace of the command?  */
  1829         Ferase_buffer ();
  1830       else
  1831         Finsert (1, &gap);
  1832       backtrace_yet = true;
  1833       specbind (Qstandard_output, redisplay_trace_buffer);
  1834       specbind (Qdebugger, Qdebug_early);
  1835       call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
  1836       unbind_to (count, Qnil);
  1837       delayed_warning = make_string
  1838         ("Error in a redisplay Lisp hook.  See buffer *Redisplay_trace*", 61);
  1839 
  1840       Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
  1841                                       Vdelayed_warnings_list);
  1842     }
  1843 
  1844   if (!NILP (clause))
  1845     {
  1846       Lisp_Object unwind_data
  1847         = (NILP (error_symbol) ? data : Fcons (error_symbol, data));
  1848 
  1849       unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data);
  1850     }
  1851   else
  1852     {
  1853       if (handlerlist != handlerlist_sentinel)
  1854         /* FIXME: This will come right back here if there's no `top-level'
  1855            catcher.  A better solution would be to abort here, and instead
  1856            add a catch-all condition handler so we never come here.  */
  1857         Fthrow (Qtop_level, Qt);
  1858     }
  1859 
  1860   if (! NILP (error_symbol))
  1861     data = Fcons (error_symbol, data);
  1862 
  1863   string = Ferror_message_string (data);
  1864   fatal ("%s", SDATA (string));
  1865 }
  1866 
  1867 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */
  1868 
  1869 void
  1870 xsignal0 (Lisp_Object error_symbol)
  1871 {
  1872   xsignal (error_symbol, Qnil);
  1873 }
  1874 
  1875 void
  1876 xsignal1 (Lisp_Object error_symbol, Lisp_Object arg)
  1877 {
  1878   xsignal (error_symbol, list1 (arg));
  1879 }
  1880 
  1881 void
  1882 xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2)
  1883 {
  1884   xsignal (error_symbol, list2 (arg1, arg2));
  1885 }
  1886 
  1887 void
  1888 xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
  1889 {
  1890   xsignal (error_symbol, list3 (arg1, arg2, arg3));
  1891 }
  1892 
  1893 /* Signal `error' with message S, and additional arg ARG.
  1894    If ARG is not a proper list, make it a one-element list.  */
  1895 
  1896 void
  1897 signal_error (const char *s, Lisp_Object arg)
  1898 {
  1899   if (NILP (Fproper_list_p (arg)))
  1900     arg = list1 (arg);
  1901 
  1902   xsignal (Qerror, Fcons (build_string (s), arg));
  1903 }
  1904 
  1905 void
  1906 define_error (Lisp_Object name, const char *message, Lisp_Object parent)
  1907 {
  1908   eassert (SYMBOLP (name));
  1909   eassert (SYMBOLP (parent));
  1910   Lisp_Object parent_conditions = Fget (parent, Qerror_conditions);
  1911   eassert (CONSP (parent_conditions));
  1912   eassert (!NILP (Fmemq (parent, parent_conditions)));
  1913   eassert (NILP (Fmemq (name, parent_conditions)));
  1914   Fput (name, Qerror_conditions, pure_cons (name, parent_conditions));
  1915   Fput (name, Qerror_message, build_pure_c_string (message));
  1916 }
  1917 
  1918 /* Use this for arithmetic overflow, e.g., when an integer result is
  1919    too large even for a bignum.  */
  1920 void
  1921 overflow_error (void)
  1922 {
  1923   xsignal0 (Qoverflow_error);
  1924 }
  1925 
  1926 
  1927 /* Return true if LIST is a non-nil atom or
  1928    a list containing one of CONDITIONS.  */
  1929 
  1930 static bool
  1931 wants_debugger (Lisp_Object list, Lisp_Object conditions)
  1932 {
  1933   if (NILP (list))
  1934     return 0;
  1935   if (! CONSP (list))
  1936     return 1;
  1937 
  1938   while (CONSP (conditions))
  1939     {
  1940       Lisp_Object this, tail;
  1941       this = XCAR (conditions);
  1942       for (tail = list; CONSP (tail); tail = XCDR (tail))
  1943         if (EQ (XCAR (tail), this))
  1944           return 1;
  1945       conditions = XCDR (conditions);
  1946     }
  1947   return 0;
  1948 }
  1949 
  1950 /* Return true if an error with condition-symbols CONDITIONS,
  1951    and described by SIGNAL-DATA, should skip the debugger
  1952    according to debugger-ignored-errors.  */
  1953 
  1954 static bool
  1955 skip_debugger (Lisp_Object conditions, Lisp_Object data)
  1956 {
  1957   Lisp_Object tail;
  1958   bool first_string = 1;
  1959   Lisp_Object error_message;
  1960 
  1961   error_message = Qnil;
  1962   for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
  1963     {
  1964       if (STRINGP (XCAR (tail)))
  1965         {
  1966           if (first_string)
  1967             {
  1968               error_message = Ferror_message_string (data);
  1969               first_string = 0;
  1970             }
  1971 
  1972           if (fast_string_match (XCAR (tail), error_message) >= 0)
  1973             return 1;
  1974         }
  1975       else
  1976         {
  1977           Lisp_Object contail;
  1978 
  1979           for (contail = conditions; CONSP (contail); contail = XCDR (contail))
  1980             if (EQ (XCAR (tail), XCAR (contail)))
  1981               return 1;
  1982         }
  1983     }
  1984 
  1985   return 0;
  1986 }
  1987 
  1988 /* Say whether SIGNAL is a `quit' symbol (or inherits from it).  */
  1989 bool
  1990 signal_quit_p (Lisp_Object signal)
  1991 {
  1992   Lisp_Object list;
  1993 
  1994   return EQ (signal, Qquit)
  1995     || (!NILP (Fsymbolp (signal))
  1996         && CONSP (list = Fget (signal, Qerror_conditions))
  1997         && !NILP (Fmemq (Qquit, list)));
  1998 }
  1999 
  2000 /* Call the debugger if calling it is currently enabled for CONDITIONS.
  2001    SIG and DATA describe the signal.  There are two ways to pass them:
  2002     = SIG is the error symbol, and DATA is the rest of the data.
  2003     = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
  2004       This is for memory-full errors only.  */
  2005 static bool
  2006 maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
  2007 {
  2008   Lisp_Object combined_data;
  2009 
  2010   combined_data = Fcons (sig, data);
  2011 
  2012   if (
  2013       /* Don't try to run the debugger with interrupts blocked.
  2014          The editing loop would return anyway.  */
  2015       ! input_blocked_p ()
  2016       && NILP (Vinhibit_debugger)
  2017       /* Does user want to enter debugger for this kind of error?  */
  2018       && (signal_quit_p (sig)
  2019           ? debug_on_quit
  2020           : wants_debugger (Vdebug_on_error, conditions))
  2021       && ! skip_debugger (conditions, combined_data)
  2022       /* See commentary on definition of
  2023          `internal-when-entered-debugger'.  */
  2024       && when_entered_debugger < num_nonmacro_input_events)
  2025     {
  2026       call_debugger (list2 (Qerror, combined_data));
  2027       return 1;
  2028     }
  2029 
  2030   return 0;
  2031 }
  2032 
  2033 static Lisp_Object
  2034 find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
  2035 {
  2036   register Lisp_Object h;
  2037 
  2038   /* t is used by handlers for all conditions, set up by C code.  */
  2039   if (EQ (handlers, Qt))
  2040     return Qt;
  2041 
  2042   /* error is used similarly, but means print an error message
  2043      and run the debugger if that is enabled.  */
  2044   if (EQ (handlers, Qerror))
  2045     return Qt;
  2046 
  2047   for (h = handlers; CONSP (h); h = XCDR (h))
  2048     {
  2049       Lisp_Object handler = XCAR (h);
  2050       if (!NILP (Fmemq (handler, conditions))
  2051           /* t is also used as a catch-all by Lisp code.  */
  2052           || EQ (handler, Qt))
  2053         return handlers;
  2054     }
  2055 
  2056   return Qnil;
  2057 }
  2058 
  2059 
  2060 /* Format and return a string; called like vprintf.  */
  2061 Lisp_Object
  2062 vformat_string (const char *m, va_list ap)
  2063 {
  2064   char buf[4000];
  2065   ptrdiff_t size = sizeof buf;
  2066   ptrdiff_t size_max = STRING_BYTES_BOUND + 1;
  2067   char *buffer = buf;
  2068   ptrdiff_t used;
  2069   Lisp_Object string;
  2070 
  2071   used = evxprintf (&buffer, &size, buf, size_max, m, ap);
  2072   string = make_string (buffer, used);
  2073   if (buffer != buf)
  2074     xfree (buffer);
  2075 
  2076   return string;
  2077 }
  2078 
  2079 /* Dump an error message; called like vprintf.  */
  2080 void
  2081 verror (const char *m, va_list ap)
  2082 {
  2083   xsignal1 (Qerror, vformat_string (m, ap));
  2084 }
  2085 
  2086 
  2087 /* Dump an error message; called like printf.  */
  2088 
  2089 void
  2090 error (const char *m, ...)
  2091 {
  2092   va_list ap;
  2093   va_start (ap, m);
  2094   verror (m, ap);
  2095 }
  2096 
  2097 DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
  2098        doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
  2099 This means it contains a description for how to read arguments to give it.
  2100 The value is nil for an invalid function or a symbol with no function
  2101 definition.
  2102 
  2103 Interactively callable functions include strings and vectors (treated
  2104 as keyboard macros), lambda-expressions that contain a top-level call
  2105 to `interactive', autoload definitions made by `autoload' with non-nil
  2106 fourth argument, and some of the built-in functions of Lisp.
  2107 
  2108 Also, a symbol satisfies `commandp' if its function definition does so.
  2109 
  2110 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
  2111 then strings and vectors are not accepted.  */)
  2112   (Lisp_Object function, Lisp_Object for_call_interactively)
  2113 {
  2114   register Lisp_Object fun;
  2115   bool genfun = false; /* If true, we should consult `interactive-form'.  */
  2116 
  2117   fun = function;
  2118 
  2119   fun = indirect_function (fun); /* Check cycles.  */
  2120   if (NILP (fun))
  2121     return Qnil;
  2122 
  2123   /* Emacs primitives are interactive if their DEFUN specifies an
  2124      interactive spec.  */
  2125   if (SUBRP (fun))
  2126     {
  2127       if (XSUBR (fun)->intspec.string)
  2128         return Qt;
  2129     }
  2130   /* Bytecode objects are interactive if they are long enough to
  2131      have an element whose index is COMPILED_INTERACTIVE, which is
  2132      where the interactive spec is stored.  */
  2133   else if (COMPILEDP (fun))
  2134     {
  2135       if (PVSIZE (fun) > COMPILED_INTERACTIVE)
  2136         return Qt;
  2137       else if (PVSIZE (fun) > COMPILED_DOC_STRING)
  2138         {
  2139           Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
  2140           /* An invalid "docstring" is a sign that we have an OClosure.  */
  2141           genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
  2142         }
  2143     }
  2144 
  2145 #ifdef HAVE_MODULES
  2146   /* Module functions are interactive if their `interactive_form'
  2147      field is non-nil. */
  2148   else if (MODULE_FUNCTIONP (fun))
  2149     {
  2150       if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))))
  2151         return Qt;
  2152     }
  2153 #endif
  2154 
  2155   /* Strings and vectors are keyboard macros.  */
  2156   else if (STRINGP (fun) || VECTORP (fun))
  2157     return (NILP (for_call_interactively) ? Qt : Qnil);
  2158 
  2159   /* Lists may represent commands.  */
  2160   else if (!CONSP (fun))
  2161     return Qnil;
  2162   else
  2163     {
  2164       Lisp_Object funcar = XCAR (fun);
  2165       if (EQ (funcar, Qautoload))
  2166         {
  2167           if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))))
  2168             return Qt;
  2169         }
  2170       else
  2171         {
  2172           Lisp_Object body = CDR_SAFE (XCDR (fun));
  2173           if (EQ (funcar, Qclosure))
  2174             body = CDR_SAFE (body);
  2175           else if (!EQ (funcar, Qlambda))
  2176             return Qnil;
  2177           if (!NILP (Fassq (Qinteractive, body)))
  2178             return Qt;
  2179           else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
  2180             /* A "docstring" is a sign that we may have an OClosure.  */
  2181             genfun = true;
  2182         }
  2183     }
  2184 
  2185   /* By now, if it's not a function we already returned nil.  */
  2186 
  2187   /* Check an `interactive-form' property if present, analogous to the
  2188      function-documentation property.  */
  2189   fun = function;
  2190   while (SYMBOLP (fun))
  2191     {
  2192       Lisp_Object tmp = Fget (fun, Qinteractive_form);
  2193       if (!NILP (tmp))
  2194         error ("Found an 'interactive-form' property!");
  2195       fun = Fsymbol_function (fun);
  2196     }
  2197 
  2198   /* If there's no immediate interactive form but it's an OClosure,
  2199      then delegate to the generic-function in case it has
  2200      a type-specific interactive-form.  */
  2201   if (genfun)
  2202     {
  2203       Lisp_Object iform = call1 (Qinteractive_form, fun);
  2204       return NILP (iform) ? Qnil : Qt;
  2205     }
  2206   else
  2207     return Qnil;
  2208 }
  2209 
  2210 DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
  2211        doc: /* Define FUNCTION to autoload from FILE.
  2212 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
  2213 
  2214 Third arg DOCSTRING is documentation for the function.
  2215 
  2216 Fourth arg INTERACTIVE if non-nil says function can be called
  2217 interactively.  If INTERACTIVE is a list, it is interpreted as a list
  2218 of modes the function is applicable for.
  2219 
  2220 Fifth arg TYPE indicates the type of the object:
  2221    nil or omitted says FUNCTION is a function,
  2222    `keymap' says FUNCTION is really a keymap, and
  2223    `macro' or t says FUNCTION is really a macro.
  2224 
  2225 Third through fifth args give info about the real definition.
  2226 They default to nil.
  2227 
  2228 If FUNCTION is already defined other than as an autoload,
  2229 this does nothing and returns nil.  */)
  2230   (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type)
  2231 {
  2232   CHECK_SYMBOL (function);
  2233   CHECK_STRING (file);
  2234 
  2235   /* If function is defined and not as an autoload, don't override.  */
  2236   if (!NILP (XSYMBOL (function)->u.s.function)
  2237       && !AUTOLOADP (XSYMBOL (function)->u.s.function))
  2238     return Qnil;
  2239 
  2240   if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0)))
  2241     /* `read1' in lread.c has found the docstring starting with "\
  2242        and assumed the docstring will be provided by Snarf-documentation, so it
  2243        passed us 0 instead.  But that leads to accidental sharing in purecopy's
  2244        hash-consing, so we use a (hopefully) unique integer instead.  */
  2245     docstring = make_ufixnum (XHASH (function));
  2246   return Fdefalias (function,
  2247                     list5 (Qautoload, file, docstring, interactive, type),
  2248                     Qnil);
  2249 }
  2250 
  2251 static void
  2252 un_autoload (Lisp_Object oldqueue)
  2253 {
  2254   /* Queue to unwind is current value of Vautoload_queue.
  2255      oldqueue is the shadowed value to leave in Vautoload_queue.  */
  2256   Lisp_Object queue = Vautoload_queue;
  2257   Vautoload_queue = oldqueue;
  2258   while (CONSP (queue))
  2259     {
  2260       Lisp_Object first = XCAR (queue);
  2261       if (CONSP (first) && BASE_EQ (XCAR (first), make_fixnum (0)))
  2262         Vfeatures = XCDR (first);
  2263       else
  2264         Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history))));
  2265       queue = XCDR (queue);
  2266     }
  2267 }
  2268 
  2269 Lisp_Object
  2270 load_with_autoload_queue
  2271   (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
  2272    Lisp_Object nosuffix, Lisp_Object must_suffix)
  2273 {
  2274   specpdl_ref count = SPECPDL_INDEX ();
  2275 
  2276   /* If autoloading gets an error (which includes the error of failing
  2277      to define the function being called), we use Vautoload_queue
  2278      to undo function definitions and `provide' calls made by
  2279      the function.  We do this in the specific case of autoloading
  2280      because autoloading is not an explicit request "load this file",
  2281      but rather a request to "call this function".
  2282 
  2283      The value saved here is to be restored into Vautoload_queue.  */
  2284   record_unwind_protect (un_autoload, Vautoload_queue);
  2285   Vautoload_queue = Qt;
  2286   Lisp_Object tem
  2287     = save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix);
  2288 
  2289   /* Once loading finishes, don't undo it.  */
  2290   Vautoload_queue = Qt;
  2291   unbind_to (count, Qnil);
  2292   return tem;
  2293 }
  2294 
  2295 /* Load an autoloaded function.
  2296    FUNNAME is the symbol which is the function's name.
  2297    FUNDEF is the autoload definition (a list).  */
  2298 
  2299 DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
  2300        doc: /* Load FUNDEF which should be an autoload.
  2301 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
  2302 in which case the function returns the new autoloaded function value.
  2303 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
  2304 it defines a macro.  */)
  2305   (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
  2306 {
  2307   if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
  2308     return fundef;
  2309 
  2310   Lisp_Object kind = Fnth (make_fixnum (4), fundef);
  2311   if (EQ (macro_only, Qmacro)
  2312       && !(EQ (kind, Qt) || EQ (kind, Qmacro)))
  2313     return fundef;
  2314 
  2315   /* This is to make sure that loadup.el gives a clear picture
  2316      of what files are preloaded and when.  */
  2317   if (will_dump_p () && !will_bootstrap_p ())
  2318     {
  2319       /* Avoid landing here recursively while outputting the
  2320          backtrace from the error.  */
  2321       gflags.will_dump_ = false;
  2322       error ("Attempt to autoload %s while preparing to dump",
  2323              SDATA (SYMBOL_NAME (funname)));
  2324     }
  2325 
  2326   CHECK_SYMBOL (funname);
  2327 
  2328   /* If `macro_only' is set and fundef isn't a macro, assume this autoload to
  2329      be a "best-effort" (e.g. to try and find a compiler macro),
  2330      so don't signal an error if autoloading fails.  */
  2331   Lisp_Object ignore_errors
  2332     = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
  2333   load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
  2334 
  2335   if (NILP (funname) || !NILP (ignore_errors))
  2336     return Qnil;
  2337   else
  2338     {
  2339       Lisp_Object fun = Findirect_function (funname, Qnil);
  2340 
  2341       if (!NILP (Fequal (fun, fundef)))
  2342         error ("Autoloading file %s failed to define function %s",
  2343                SDATA (Fcar (Fcar (Vload_history))),
  2344                SDATA (SYMBOL_NAME (funname)));
  2345       else
  2346         return fun;
  2347     }
  2348 }
  2349 
  2350 
  2351 DEFUN ("eval", Feval, Seval, 1, 2, 0,
  2352        doc: /* Evaluate FORM and return its value.
  2353 If LEXICAL is t, evaluate using lexical scoping.
  2354 LEXICAL can also be an actual lexical environment, in the form of an
  2355 alist mapping symbols to their value.  */)
  2356   (Lisp_Object form, Lisp_Object lexical)
  2357 {
  2358   specpdl_ref count = SPECPDL_INDEX ();
  2359   specbind (Qinternal_interpreter_environment,
  2360             CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
  2361   return unbind_to (count, eval_sub (form));
  2362 }
  2363 
  2364 void
  2365 grow_specpdl_allocation (void)
  2366 {
  2367   eassert (specpdl_ptr == specpdl_end);
  2368 
  2369   specpdl_ref count = SPECPDL_INDEX ();
  2370   ptrdiff_t max_size = PTRDIFF_MAX - 1000;
  2371   union specbinding *pdlvec = specpdl - 1;
  2372   ptrdiff_t size = specpdl_end - specpdl;
  2373   ptrdiff_t pdlvecsize = size + 1;
  2374   if (max_size <= size)
  2375     xsignal0 (Qexcessive_variable_binding);  /* Can't happen, essentially.  */
  2376   pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
  2377   specpdl = pdlvec + 1;
  2378   specpdl_end = specpdl + pdlvecsize - 1;
  2379   specpdl_ptr = specpdl_ref_to_ptr (count);
  2380 }
  2381 
  2382 /* Eval a sub-expression of the current expression (i.e. in the same
  2383    lexical scope).  */
  2384 Lisp_Object
  2385 eval_sub (Lisp_Object form)
  2386 {
  2387   if (SYMBOLP (form))
  2388     {
  2389       /* Look up its binding in the lexical environment.
  2390          We do not pay attention to the declared_special flag here, since we
  2391          already did that when let-binding the variable.  */
  2392       Lisp_Object lex_binding
  2393         = Fassq (form, Vinternal_interpreter_environment);
  2394       return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form);
  2395     }
  2396 
  2397   if (!CONSP (form))
  2398     return form;
  2399 
  2400   maybe_quit ();
  2401 
  2402   maybe_gc ();
  2403 
  2404   if (++lisp_eval_depth > max_lisp_eval_depth)
  2405     {
  2406       if (max_lisp_eval_depth < 100)
  2407         max_lisp_eval_depth = 100;
  2408       if (lisp_eval_depth > max_lisp_eval_depth)
  2409         xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
  2410     }
  2411 
  2412   Lisp_Object original_fun = XCAR (form);
  2413   Lisp_Object original_args = XCDR (form);
  2414   CHECK_LIST (original_args);
  2415 
  2416   /* This also protects them from gc.  */
  2417   specpdl_ref count
  2418     = record_in_backtrace (original_fun, &original_args, UNEVALLED);
  2419 
  2420   if (debug_on_next_call)
  2421     do_debug_on_call (Qt, count);
  2422 
  2423   Lisp_Object fun, val, funcar;
  2424   /* Declare here, as this array may be accessed by call_debugger near
  2425      the end of this function.  See Bug#21245.  */
  2426   Lisp_Object argvals[8];
  2427 
  2428  retry:
  2429 
  2430   /* Optimize for no indirection.  */
  2431   fun = original_fun;
  2432   if (!SYMBOLP (fun))
  2433     fun = Ffunction (list1 (fun));
  2434   else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
  2435     fun = indirect_function (fun);
  2436 
  2437   if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
  2438     {
  2439       Lisp_Object args_left = original_args;
  2440       ptrdiff_t numargs = list_length (args_left);
  2441 
  2442       if (numargs < XSUBR (fun)->min_args
  2443           || (XSUBR (fun)->max_args >= 0
  2444               && XSUBR (fun)->max_args < numargs))
  2445         xsignal2 (Qwrong_number_of_arguments, original_fun,
  2446                   make_fixnum (numargs));
  2447 
  2448       else if (XSUBR (fun)->max_args == UNEVALLED)
  2449         val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
  2450       else if (XSUBR (fun)->max_args == MANY
  2451                || XSUBR (fun)->max_args > 8)
  2452 
  2453         {
  2454           /* Pass a vector of evaluated arguments.  */
  2455           Lisp_Object *vals;
  2456           ptrdiff_t argnum = 0;
  2457           USE_SAFE_ALLOCA;
  2458 
  2459           SAFE_ALLOCA_LISP (vals, numargs);
  2460 
  2461           while (CONSP (args_left) && argnum < numargs)
  2462             {
  2463               Lisp_Object arg = XCAR (args_left);
  2464               args_left = XCDR (args_left);
  2465               vals[argnum++] = eval_sub (arg);
  2466             }
  2467 
  2468           set_backtrace_args (specpdl_ref_to_ptr (count), vals, argnum);
  2469 
  2470           val = XSUBR (fun)->function.aMANY (argnum, vals);
  2471 
  2472           lisp_eval_depth--;
  2473           /* Do the debug-on-exit now, while VALS still exists.  */
  2474           if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count)))
  2475             val = call_debugger (list2 (Qexit, val));
  2476           SAFE_FREE ();
  2477           specpdl_ptr--;
  2478           return val;
  2479         }
  2480       else
  2481         {
  2482           int i, maxargs = XSUBR (fun)->max_args;
  2483 
  2484           for (i = 0; i < maxargs; i++)
  2485             {
  2486               argvals[i] = eval_sub (Fcar (args_left));
  2487               args_left = Fcdr (args_left);
  2488             }
  2489 
  2490           set_backtrace_args (specpdl_ref_to_ptr (count), argvals, numargs);
  2491 
  2492           switch (i)
  2493             {
  2494             case 0:
  2495               val = (XSUBR (fun)->function.a0 ());
  2496               break;
  2497             case 1:
  2498               val = (XSUBR (fun)->function.a1 (argvals[0]));
  2499               break;
  2500             case 2:
  2501               val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1]));
  2502               break;
  2503             case 3:
  2504               val = (XSUBR (fun)->function.a3
  2505                      (argvals[0], argvals[1], argvals[2]));
  2506               break;
  2507             case 4:
  2508               val = (XSUBR (fun)->function.a4
  2509                      (argvals[0], argvals[1], argvals[2], argvals[3]));
  2510               break;
  2511             case 5:
  2512               val = (XSUBR (fun)->function.a5
  2513                      (argvals[0], argvals[1], argvals[2], argvals[3],
  2514                       argvals[4]));
  2515               break;
  2516             case 6:
  2517               val = (XSUBR (fun)->function.a6
  2518                      (argvals[0], argvals[1], argvals[2], argvals[3],
  2519                       argvals[4], argvals[5]));
  2520               break;
  2521             case 7:
  2522               val = (XSUBR (fun)->function.a7
  2523                      (argvals[0], argvals[1], argvals[2], argvals[3],
  2524                       argvals[4], argvals[5], argvals[6]));
  2525               break;
  2526 
  2527             case 8:
  2528               val = (XSUBR (fun)->function.a8
  2529                      (argvals[0], argvals[1], argvals[2], argvals[3],
  2530                       argvals[4], argvals[5], argvals[6], argvals[7]));
  2531               break;
  2532 
  2533             default:
  2534               /* Someone has created a subr that takes more arguments than
  2535                  is supported by this code.  We need to either rewrite the
  2536                  subr to use a different argument protocol, or add more
  2537                  cases to this switch.  */
  2538               emacs_abort ();
  2539             }
  2540         }
  2541     }
  2542   else if (COMPILEDP (fun)
  2543            || SUBR_NATIVE_COMPILED_DYNP (fun)
  2544            || MODULE_FUNCTIONP (fun))
  2545     return apply_lambda (fun, original_args, count);
  2546   else
  2547     {
  2548       if (NILP (fun))
  2549         xsignal1 (Qvoid_function, original_fun);
  2550       if (!CONSP (fun))
  2551         xsignal1 (Qinvalid_function, original_fun);
  2552       funcar = XCAR (fun);
  2553       if (!SYMBOLP (funcar))
  2554         xsignal1 (Qinvalid_function, original_fun);
  2555       if (EQ (funcar, Qautoload))
  2556         {
  2557           Fautoload_do_load (fun, original_fun, Qnil);
  2558           goto retry;
  2559         }
  2560       if (EQ (funcar, Qmacro))
  2561         {
  2562           specpdl_ref count1 = SPECPDL_INDEX ();
  2563           Lisp_Object exp;
  2564           /* Bind lexical-binding during expansion of the macro, so the
  2565              macro can know reliably if the code it outputs will be
  2566              interpreted using lexical-binding or not.  */
  2567           specbind (Qlexical_binding,
  2568                     NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
  2569 
  2570           /* Make the macro aware of any defvar declarations in scope. */
  2571           Lisp_Object dynvars = Vmacroexp__dynvars;
  2572           for (Lisp_Object p = Vinternal_interpreter_environment;
  2573                !NILP (p); p = XCDR(p))
  2574             {
  2575               Lisp_Object e = XCAR (p);
  2576               if (SYMBOLP (e))
  2577                 dynvars = Fcons(e, dynvars);
  2578             }
  2579           if (!EQ (dynvars, Vmacroexp__dynvars))
  2580             specbind (Qmacroexp__dynvars, dynvars);
  2581 
  2582           exp = apply1 (Fcdr (fun), original_args);
  2583           exp = unbind_to (count1, exp);
  2584           val = eval_sub (exp);
  2585         }
  2586       else if (EQ (funcar, Qlambda)
  2587                || EQ (funcar, Qclosure))
  2588         return apply_lambda (fun, original_args, count);
  2589       else
  2590         xsignal1 (Qinvalid_function, original_fun);
  2591     }
  2592 
  2593   lisp_eval_depth--;
  2594   if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count)))
  2595     val = call_debugger (list2 (Qexit, val));
  2596   specpdl_ptr--;
  2597 
  2598   return val;
  2599 }
  2600 
  2601 DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
  2602        doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
  2603 Then return the value FUNCTION returns.
  2604 With a single argument, call the argument's first element using the
  2605 other elements as args.
  2606 Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10.
  2607 usage: (apply FUNCTION &rest ARGUMENTS)  */)
  2608   (ptrdiff_t nargs, Lisp_Object *args)
  2609 {
  2610   ptrdiff_t i, funcall_nargs;
  2611   Lisp_Object *funcall_args = NULL;
  2612   Lisp_Object spread_arg = args[nargs - 1];
  2613   Lisp_Object fun = args[0];
  2614   USE_SAFE_ALLOCA;
  2615 
  2616   ptrdiff_t numargs = list_length (spread_arg);
  2617 
  2618   if (numargs == 0)
  2619     return Ffuncall (max (1, nargs - 1), args);
  2620   else if (numargs == 1)
  2621     {
  2622       args [nargs - 1] = XCAR (spread_arg);
  2623       return Ffuncall (nargs, args);
  2624     }
  2625 
  2626   numargs += nargs - 2;
  2627 
  2628   /* Optimize for no indirection.  */
  2629   if (SYMBOLP (fun) && !NILP (fun)
  2630       && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
  2631     {
  2632       fun = indirect_function (fun);
  2633       if (NILP (fun))
  2634         /* Let funcall get the error.  */
  2635         fun = args[0];
  2636     }
  2637 
  2638   if (SUBRP (fun) && XSUBR (fun)->max_args > numargs
  2639       /* Don't hide an error by adding missing arguments.  */
  2640       && numargs >= XSUBR (fun)->min_args)
  2641     {
  2642       /* Avoid making funcall cons up a yet another new vector of arguments
  2643          by explicitly supplying nil's for optional values.  */
  2644       SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
  2645       memclear (funcall_args + numargs + 1,
  2646                 (XSUBR (fun)->max_args - numargs) * word_size);
  2647       funcall_nargs = 1 + XSUBR (fun)->max_args;
  2648     }
  2649   else
  2650     { /* We add 1 to numargs because funcall_args includes the
  2651          function itself as well as its arguments.  */
  2652       SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
  2653       funcall_nargs = 1 + numargs;
  2654     }
  2655 
  2656   memcpy (funcall_args, args, nargs * word_size);
  2657   /* Spread the last arg we got.  Its first element goes in
  2658      the slot that it used to occupy, hence this value of I.  */
  2659   i = nargs - 1;
  2660   while (!NILP (spread_arg))
  2661     {
  2662       funcall_args [i++] = XCAR (spread_arg);
  2663       spread_arg = XCDR (spread_arg);
  2664     }
  2665 
  2666   Lisp_Object retval = Ffuncall (funcall_nargs, funcall_args);
  2667 
  2668   SAFE_FREE ();
  2669   return retval;
  2670 }
  2671 
  2672 /* Run hook variables in various ways.  */
  2673 
  2674 static Lisp_Object
  2675 funcall_nil (ptrdiff_t nargs, Lisp_Object *args)
  2676 {
  2677   Ffuncall (nargs, args);
  2678   return Qnil;
  2679 }
  2680 
  2681 DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
  2682        doc: /* Run each hook in HOOKS.
  2683 Each argument should be a symbol, a hook variable.
  2684 These symbols are processed in the order specified.
  2685 If a hook symbol has a non-nil value, that value may be a function
  2686 or a list of functions to be called to run the hook.
  2687 If the value is a function, it is called with no arguments.
  2688 If it is a list, the elements are called, in order, with no arguments.
  2689 
  2690 Major modes should not use this function directly to run their mode
  2691 hook; they should use `run-mode-hooks' instead.
  2692 
  2693 Do not use `make-local-variable' to make a hook variable buffer-local.
  2694 Instead, use `add-hook' and specify t for the LOCAL argument.
  2695 usage: (run-hooks &rest HOOKS)  */)
  2696   (ptrdiff_t nargs, Lisp_Object *args)
  2697 {
  2698   ptrdiff_t i;
  2699 
  2700   for (i = 0; i < nargs; i++)
  2701     run_hook (args[i]);
  2702 
  2703   return Qnil;
  2704 }
  2705 
  2706 DEFUN ("run-hook-with-args", Frun_hook_with_args,
  2707        Srun_hook_with_args, 1, MANY, 0,
  2708        doc: /* Run HOOK with the specified arguments ARGS.
  2709 HOOK should be a symbol, a hook variable.  The value of HOOK
  2710 may be nil, a function, or a list of functions.  Call each
  2711 function in order with arguments ARGS.  The final return value
  2712 is unspecified.
  2713 
  2714 Do not use `make-local-variable' to make a hook variable buffer-local.
  2715 Instead, use `add-hook' and specify t for the LOCAL argument.
  2716 usage: (run-hook-with-args HOOK &rest ARGS)  */)
  2717   (ptrdiff_t nargs, Lisp_Object *args)
  2718 {
  2719   return run_hook_with_args (nargs, args, funcall_nil);
  2720 }
  2721 
  2722 /* NB this one still documents a specific non-nil return value.
  2723    (As did run-hook-with-args and run-hook-with-args-until-failure
  2724    until they were changed in 24.1.)  */
  2725 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
  2726        Srun_hook_with_args_until_success, 1, MANY, 0,
  2727        doc: /* Run HOOK with the specified arguments ARGS.
  2728 HOOK should be a symbol, a hook variable.  The value of HOOK
  2729 may be nil, a function, or a list of functions.  Call each
  2730 function in order with arguments ARGS, stopping at the first
  2731 one that returns non-nil, and return that value.  Otherwise (if
  2732 all functions return nil, or if there are no functions to call),
  2733 return nil.
  2734 
  2735 Do not use `make-local-variable' to make a hook variable buffer-local.
  2736 Instead, use `add-hook' and specify t for the LOCAL argument.
  2737 usage: (run-hook-with-args-until-success HOOK &rest ARGS)  */)
  2738   (ptrdiff_t nargs, Lisp_Object *args)
  2739 {
  2740   return run_hook_with_args (nargs, args, Ffuncall);
  2741 }
  2742 
  2743 static Lisp_Object
  2744 funcall_not (ptrdiff_t nargs, Lisp_Object *args)
  2745 {
  2746   return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
  2747 }
  2748 
  2749 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
  2750        Srun_hook_with_args_until_failure, 1, MANY, 0,
  2751        doc: /* Run HOOK with the specified arguments ARGS.
  2752 HOOK should be a symbol, a hook variable.  The value of HOOK
  2753 may be nil, a function, or a list of functions.  Call each
  2754 function in order with arguments ARGS, stopping at the first
  2755 one that returns nil, and return nil.  Otherwise (if all functions
  2756 return non-nil, or if there are no functions to call), return non-nil
  2757 \(do not rely on the precise return value in this case).
  2758 
  2759 Do not use `make-local-variable' to make a hook variable buffer-local.
  2760 Instead, use `add-hook' and specify t for the LOCAL argument.
  2761 usage: (run-hook-with-args-until-failure HOOK &rest ARGS)  */)
  2762   (ptrdiff_t nargs, Lisp_Object *args)
  2763 {
  2764   return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil;
  2765 }
  2766 
  2767 static Lisp_Object
  2768 run_hook_wrapped_funcall (ptrdiff_t nargs, Lisp_Object *args)
  2769 {
  2770   Lisp_Object tmp = args[0], ret;
  2771   args[0] = args[1];
  2772   args[1] = tmp;
  2773   ret = Ffuncall (nargs, args);
  2774   args[1] = args[0];
  2775   args[0] = tmp;
  2776   return ret;
  2777 }
  2778 
  2779 DEFUN ("run-hook-wrapped", Frun_hook_wrapped, Srun_hook_wrapped, 2, MANY, 0,
  2780        doc: /* Run HOOK, passing each function through WRAP-FUNCTION.
  2781 I.e. instead of calling each function FUN directly with arguments ARGS,
  2782 it calls WRAP-FUNCTION with arguments FUN and ARGS.
  2783 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
  2784 aborts and returns that value.
  2785 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS)  */)
  2786      (ptrdiff_t nargs, Lisp_Object *args)
  2787 {
  2788   return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
  2789 }
  2790 
  2791 /* ARGS[0] should be a hook symbol.
  2792    Call each of the functions in the hook value, passing each of them
  2793    as arguments all the rest of ARGS (all NARGS - 1 elements).
  2794    FUNCALL specifies how to call each function on the hook.  */
  2795 
  2796 Lisp_Object
  2797 run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
  2798                     Lisp_Object (*funcall) (ptrdiff_t nargs, Lisp_Object *args))
  2799 {
  2800   Lisp_Object sym, val, ret = Qnil;
  2801 
  2802   /* If we are dying or still initializing,
  2803      don't do anything--it would probably crash if we tried.  */
  2804   if (NILP (Vrun_hooks))
  2805     return Qnil;
  2806 
  2807   sym = args[0];
  2808   val = find_symbol_value (sym);
  2809 
  2810   if (BASE_EQ (val, Qunbound) || NILP (val))
  2811     return ret;
  2812   else if (!CONSP (val) || FUNCTIONP (val))
  2813     {
  2814       args[0] = val;
  2815       return funcall (nargs, args);
  2816     }
  2817   else
  2818     {
  2819       Lisp_Object global_vals = Qnil;
  2820 
  2821       for (;
  2822            CONSP (val) && NILP (ret);
  2823            val = XCDR (val))
  2824         {
  2825           if (EQ (XCAR (val), Qt))
  2826             {
  2827               /* t indicates this hook has a local binding;
  2828                  it means to run the global binding too.  */
  2829               global_vals = Fdefault_value (sym);
  2830               if (NILP (global_vals)) continue;
  2831 
  2832               if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda))
  2833                 {
  2834                   args[0] = global_vals;
  2835                   ret = funcall (nargs, args);
  2836                 }
  2837               else
  2838                 {
  2839                   for (;
  2840                        CONSP (global_vals) && NILP (ret);
  2841                        global_vals = XCDR (global_vals))
  2842                     {
  2843                       args[0] = XCAR (global_vals);
  2844                       /* In a global value, t should not occur.  If it does, we
  2845                          must ignore it to avoid an endless loop.  */
  2846                       if (!EQ (args[0], Qt))
  2847                         ret = funcall (nargs, args);
  2848                     }
  2849                 }
  2850             }
  2851           else
  2852             {
  2853               args[0] = XCAR (val);
  2854               ret = funcall (nargs, args);
  2855             }
  2856         }
  2857 
  2858       return ret;
  2859     }
  2860 }
  2861 
  2862 /* Run the hook HOOK, giving each function no args.  */
  2863 
  2864 void
  2865 run_hook (Lisp_Object hook)
  2866 {
  2867   Frun_hook_with_args (1, &hook);
  2868 }
  2869 
  2870 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2.  */
  2871 
  2872 void
  2873 run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
  2874 {
  2875   CALLN (Frun_hook_with_args, hook, arg1, arg2);
  2876 }
  2877 
  2878 /* Apply fn to arg.  */
  2879 Lisp_Object
  2880 apply1 (Lisp_Object fn, Lisp_Object arg)
  2881 {
  2882   return NILP (arg) ? Ffuncall (1, &fn) : CALLN (Fapply, fn, arg);
  2883 }
  2884 
  2885 DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
  2886        doc: /* Return t if OBJECT is a function.
  2887 
  2888 An object is a function if it is callable via `funcall'; this includes
  2889 symbols with function bindings, but excludes macros and special forms.
  2890 
  2891 Ordinarily return nil if OBJECT is not a function, although t might be
  2892 returned in rare cases.  */)
  2893      (Lisp_Object object)
  2894 {
  2895   if (FUNCTIONP (object))
  2896     return Qt;
  2897   return Qnil;
  2898 }
  2899 
  2900 bool
  2901 FUNCTIONP (Lisp_Object object)
  2902 {
  2903   if (SYMBOLP (object) && !NILP (Ffboundp (object)))
  2904     {
  2905       object = Findirect_function (object, Qt);
  2906 
  2907       if (CONSP (object) && EQ (XCAR (object), Qautoload))
  2908         {
  2909           /* Autoloaded symbols are functions, except if they load
  2910              macros or keymaps.  */
  2911           for (int i = 0; i < 4 && CONSP (object); i++)
  2912             object = XCDR (object);
  2913 
  2914           return ! (CONSP (object) && !NILP (XCAR (object)));
  2915         }
  2916     }
  2917 
  2918   if (SUBRP (object))
  2919     return XSUBR (object)->max_args != UNEVALLED;
  2920   else if (COMPILEDP (object) || MODULE_FUNCTIONP (object))
  2921     return true;
  2922   else if (CONSP (object))
  2923     {
  2924       Lisp_Object car = XCAR (object);
  2925       return EQ (car, Qlambda) || EQ (car, Qclosure);
  2926     }
  2927   else
  2928     return false;
  2929 }
  2930 
  2931 Lisp_Object
  2932 funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args)
  2933 {
  2934   Lisp_Object original_fun = fun;
  2935  retry:
  2936   if (SYMBOLP (fun) && !NILP (fun)
  2937       && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
  2938     fun = indirect_function (fun);
  2939 
  2940   if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
  2941     return funcall_subr (XSUBR (fun), numargs, args);
  2942   else if (COMPILEDP (fun)
  2943            || SUBR_NATIVE_COMPILED_DYNP (fun)
  2944            || MODULE_FUNCTIONP (fun))
  2945     return funcall_lambda (fun, numargs, args);
  2946   else
  2947     {
  2948       if (NILP (fun))
  2949         xsignal1 (Qvoid_function, original_fun);
  2950       if (!CONSP (fun))
  2951         xsignal1 (Qinvalid_function, original_fun);
  2952       Lisp_Object funcar = XCAR (fun);
  2953       if (!SYMBOLP (funcar))
  2954         xsignal1 (Qinvalid_function, original_fun);
  2955       if (EQ (funcar, Qlambda)
  2956           || EQ (funcar, Qclosure))
  2957         return funcall_lambda (fun, numargs, args);
  2958       else if (EQ (funcar, Qautoload))
  2959         {
  2960           Fautoload_do_load (fun, original_fun, Qnil);
  2961           fun = original_fun;
  2962           goto retry;
  2963         }
  2964       else
  2965         xsignal1 (Qinvalid_function, original_fun);
  2966     }
  2967 }
  2968 
  2969 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
  2970        doc: /* Call first argument as a function, passing remaining arguments to it.
  2971 Return the value that function returns.
  2972 Thus, (funcall \\='cons \\='x \\='y) returns (x . y).
  2973 usage: (funcall FUNCTION &rest ARGUMENTS)  */)
  2974   (ptrdiff_t nargs, Lisp_Object *args)
  2975 {
  2976   specpdl_ref count;
  2977 
  2978   maybe_quit ();
  2979 
  2980   if (++lisp_eval_depth > max_lisp_eval_depth)
  2981     {
  2982       if (max_lisp_eval_depth < 100)
  2983         max_lisp_eval_depth = 100;
  2984       if (lisp_eval_depth > max_lisp_eval_depth)
  2985         xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
  2986     }
  2987 
  2988   count = record_in_backtrace (args[0], &args[1], nargs - 1);
  2989 
  2990   maybe_gc ();
  2991 
  2992   if (debug_on_next_call)
  2993     do_debug_on_call (Qlambda, count);
  2994 
  2995   Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1);
  2996 
  2997   lisp_eval_depth--;
  2998   if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count)))
  2999     val = call_debugger (list2 (Qexit, val));
  3000   specpdl_ptr--;
  3001   return val;
  3002 }
  3003 
  3004 
  3005 /* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR
  3006    and return the result of evaluation.  */
  3007 
  3008 Lisp_Object
  3009 funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
  3010 {
  3011   eassume (numargs >= 0);
  3012   if (numargs >= subr->min_args)
  3013     {
  3014       /* Conforming call to finite-arity subr.  */
  3015       if (numargs <= subr->max_args
  3016           && subr->max_args <= 8)
  3017         {
  3018           Lisp_Object argbuf[8];
  3019           Lisp_Object *a;
  3020           if (numargs < subr->max_args)
  3021             {
  3022               eassume (subr->max_args <= ARRAYELTS (argbuf));
  3023               a = argbuf;
  3024               memcpy (a, args, numargs * word_size);
  3025               memclear (a + numargs, (subr->max_args - numargs) * word_size);
  3026             }
  3027           else
  3028             a = args;
  3029           switch (subr->max_args)
  3030             {
  3031             case 0:
  3032               return subr->function.a0 ();
  3033             case 1:
  3034               return subr->function.a1 (a[0]);
  3035             case 2:
  3036               return subr->function.a2 (a[0], a[1]);
  3037             case 3:
  3038               return subr->function.a3 (a[0], a[1], a[2]);
  3039             case 4:
  3040               return subr->function.a4 (a[0], a[1], a[2], a[3]);
  3041             case 5:
  3042               return subr->function.a5 (a[0], a[1], a[2], a[3], a[4]);
  3043             case 6:
  3044               return subr->function.a6 (a[0], a[1], a[2], a[3], a[4], a[5]);
  3045             case 7:
  3046               return subr->function.a7 (a[0], a[1], a[2], a[3], a[4], a[5],
  3047                                         a[6]);
  3048             case 8:
  3049               return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5],
  3050                                         a[6], a[7]);
  3051             default:
  3052               emacs_abort ();   /* Can't happen. */
  3053             }
  3054         }
  3055 
  3056       /* Call to n-adic subr.  */
  3057       if (subr->max_args == MANY
  3058           || subr->max_args > 8)
  3059         return subr->function.aMANY (numargs, args);
  3060     }
  3061 
  3062   /* Anything else is an error.  */
  3063   Lisp_Object fun;
  3064   XSETSUBR (fun, subr);
  3065   if (subr->max_args == UNEVALLED)
  3066     xsignal1 (Qinvalid_function, fun);
  3067   else
  3068     xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs));
  3069 }
  3070 
  3071 /* Call the compiled Lisp function FUN.  If we have not yet read FUN's
  3072    bytecode string and constants vector, fetch them from the file first.  */
  3073 
  3074 static Lisp_Object
  3075 fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
  3076                           ptrdiff_t nargs, Lisp_Object *args)
  3077 {
  3078   if (CONSP (AREF (fun, COMPILED_BYTECODE)))
  3079     Ffetch_bytecode (fun);
  3080 
  3081   return exec_byte_code (fun, args_template, nargs, args);
  3082 }
  3083 
  3084 static Lisp_Object
  3085 apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count)
  3086 {
  3087   Lisp_Object *arg_vector;
  3088   Lisp_Object tem;
  3089   USE_SAFE_ALLOCA;
  3090 
  3091   ptrdiff_t numargs = list_length (args);
  3092   SAFE_ALLOCA_LISP (arg_vector, numargs);
  3093   Lisp_Object args_left = args;
  3094 
  3095   for (ptrdiff_t i = 0; i < numargs; i++)
  3096     {
  3097       tem = Fcar (args_left), args_left = Fcdr (args_left);
  3098       tem = eval_sub (tem);
  3099       arg_vector[i] = tem;
  3100     }
  3101 
  3102   set_backtrace_args (specpdl_ref_to_ptr (count), arg_vector, numargs);
  3103   tem = funcall_lambda (fun, numargs, arg_vector);
  3104 
  3105   lisp_eval_depth--;
  3106   /* Do the debug-on-exit now, while arg_vector still exists.  */
  3107   if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count)))
  3108     tem = call_debugger (list2 (Qexit, tem));
  3109   SAFE_FREE ();
  3110   specpdl_ptr--;
  3111   return tem;
  3112 }
  3113 
  3114 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
  3115    and return the result of evaluation.
  3116    FUN must be either a lambda-expression, a compiled-code object,
  3117    or a module function.  */
  3118 
  3119 static Lisp_Object
  3120 funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
  3121                 register Lisp_Object *arg_vector)
  3122 {
  3123   Lisp_Object val, syms_left, next, lexenv;
  3124   specpdl_ref count = SPECPDL_INDEX ();
  3125   ptrdiff_t i;
  3126   bool optional, rest;
  3127 
  3128   if (CONSP (fun))
  3129     {
  3130       if (EQ (XCAR (fun), Qclosure))
  3131         {
  3132           Lisp_Object cdr = XCDR (fun); /* Drop `closure'.  */
  3133           if (! CONSP (cdr))
  3134             xsignal1 (Qinvalid_function, fun);
  3135           fun = cdr;
  3136           lexenv = XCAR (fun);
  3137         }
  3138       else
  3139         lexenv = Qnil;
  3140       syms_left = XCDR (fun);
  3141       if (CONSP (syms_left))
  3142         syms_left = XCAR (syms_left);
  3143       else
  3144         xsignal1 (Qinvalid_function, fun);
  3145     }
  3146   else if (COMPILEDP (fun))
  3147     {
  3148       syms_left = AREF (fun, COMPILED_ARGLIST);
  3149       /* Bytecode objects using lexical binding have an integral
  3150          ARGLIST slot value: pass the arguments to the byte-code
  3151          engine directly.  */
  3152       if (FIXNUMP (syms_left))
  3153         return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left),
  3154                                          nargs, arg_vector);
  3155       /* Otherwise the bytecode object uses dynamic binding and the
  3156          ARGLIST slot contains a standard formal argument list whose
  3157          variables are bound dynamically below.  */
  3158       lexenv = Qnil;
  3159     }
  3160 #ifdef HAVE_MODULES
  3161   else if (MODULE_FUNCTIONP (fun))
  3162     return funcall_module (fun, nargs, arg_vector);
  3163 #endif
  3164 #ifdef HAVE_NATIVE_COMP
  3165   else if (SUBR_NATIVE_COMPILED_DYNP (fun))
  3166     {
  3167       syms_left = XSUBR (fun)->lambda_list;
  3168       lexenv = Qnil;
  3169     }
  3170 #endif
  3171   else
  3172     emacs_abort ();
  3173 
  3174   i = optional = rest = 0;
  3175   bool previous_rest = false;
  3176   for (; CONSP (syms_left); syms_left = XCDR (syms_left))
  3177     {
  3178       maybe_quit ();
  3179 
  3180       next = XCAR (syms_left);
  3181       if (!SYMBOLP (next))
  3182         xsignal1 (Qinvalid_function, fun);
  3183 
  3184       if (EQ (next, Qand_rest))
  3185         {
  3186           if (rest || previous_rest)
  3187             xsignal1 (Qinvalid_function, fun);
  3188           rest = 1;
  3189           previous_rest = true;
  3190         }
  3191       else if (EQ (next, Qand_optional))
  3192         {
  3193           if (optional || rest || previous_rest)
  3194             xsignal1 (Qinvalid_function, fun);
  3195           optional = 1;
  3196         }
  3197       else
  3198         {
  3199           Lisp_Object arg;
  3200           if (rest)
  3201             {
  3202               arg = Flist (nargs - i, &arg_vector[i]);
  3203               i = nargs;
  3204             }
  3205           else if (i < nargs)
  3206             arg = arg_vector[i++];
  3207           else if (!optional)
  3208             xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
  3209           else
  3210             arg = Qnil;
  3211 
  3212           /* Bind the argument.  */
  3213           if (!NILP (lexenv) && SYMBOLP (next))
  3214             /* Lexically bind NEXT by adding it to the lexenv alist.  */
  3215             lexenv = Fcons (Fcons (next, arg), lexenv);
  3216           else
  3217             /* Dynamically bind NEXT.  */
  3218             specbind (next, arg);
  3219           previous_rest = false;
  3220         }
  3221     }
  3222 
  3223   if (!NILP (syms_left) || previous_rest)
  3224     xsignal1 (Qinvalid_function, fun);
  3225   else if (i < nargs)
  3226     xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
  3227 
  3228   if (!EQ (lexenv, Vinternal_interpreter_environment))
  3229     /* Instantiate a new lexical environment.  */
  3230     specbind (Qinternal_interpreter_environment, lexenv);
  3231 
  3232   if (CONSP (fun))
  3233     val = Fprogn (XCDR (XCDR (fun)));
  3234   else if (SUBR_NATIVE_COMPILEDP (fun))
  3235     {
  3236       eassert (SUBR_NATIVE_COMPILED_DYNP (fun));
  3237       /* No need to use funcall_subr as we have zero arguments by
  3238          construction.  */
  3239       val = XSUBR (fun)->function.a0 ();
  3240     }
  3241   else
  3242     val = fetch_and_exec_byte_code (fun, 0, 0, NULL);
  3243 
  3244   return unbind_to (count, val);
  3245 }
  3246 
  3247 DEFUN ("func-arity", Ffunc_arity, Sfunc_arity, 1, 1, 0,
  3248        doc: /* Return minimum and maximum number of args allowed for FUNCTION.
  3249 FUNCTION must be a function of some kind.
  3250 The returned value is a cons cell (MIN . MAX).  MIN is the minimum number
  3251 of args.  MAX is the maximum number, or the symbol `many', for a
  3252 function with `&rest' args, or `unevalled' for a special form.  */)
  3253   (Lisp_Object function)
  3254 {
  3255   Lisp_Object original;
  3256   Lisp_Object funcar;
  3257   Lisp_Object result;
  3258 
  3259   original = function;
  3260 
  3261  retry:
  3262 
  3263   /* Optimize for no indirection.  */
  3264   function = original;
  3265   if (SYMBOLP (function) && !NILP (function))
  3266     {
  3267       function = XSYMBOL (function)->u.s.function;
  3268       if (SYMBOLP (function))
  3269         function = indirect_function (function);
  3270     }
  3271 
  3272   if (CONSP (function) && EQ (XCAR (function), Qmacro))
  3273     function = XCDR (function);
  3274 
  3275   if (SUBRP (function))
  3276     result = Fsubr_arity (function);
  3277   else if (COMPILEDP (function))
  3278     result = lambda_arity (function);
  3279 #ifdef HAVE_MODULES
  3280   else if (MODULE_FUNCTIONP (function))
  3281     result = module_function_arity (XMODULE_FUNCTION (function));
  3282 #endif
  3283   else
  3284     {
  3285       if (NILP (function))
  3286         xsignal1 (Qvoid_function, original);
  3287       if (!CONSP (function))
  3288         xsignal1 (Qinvalid_function, original);
  3289       funcar = XCAR (function);
  3290       if (!SYMBOLP (funcar))
  3291         xsignal1 (Qinvalid_function, original);
  3292       if (EQ (funcar, Qlambda)
  3293           || EQ (funcar, Qclosure))
  3294         result = lambda_arity (function);
  3295       else if (EQ (funcar, Qautoload))
  3296         {
  3297           Fautoload_do_load (function, original, Qnil);
  3298           goto retry;
  3299         }
  3300       else
  3301         xsignal1 (Qinvalid_function, original);
  3302     }
  3303   return result;
  3304 }
  3305 
  3306 /* FUN must be either a lambda-expression or a compiled-code object.  */
  3307 static Lisp_Object
  3308 lambda_arity (Lisp_Object fun)
  3309 {
  3310   Lisp_Object syms_left;
  3311 
  3312   if (CONSP (fun))
  3313     {
  3314       if (EQ (XCAR (fun), Qclosure))
  3315         {
  3316           fun = XCDR (fun);     /* Drop `closure'.  */
  3317           CHECK_CONS (fun);
  3318         }
  3319       syms_left = XCDR (fun);
  3320       if (CONSP (syms_left))
  3321         syms_left = XCAR (syms_left);
  3322       else
  3323         xsignal1 (Qinvalid_function, fun);
  3324     }
  3325   else if (COMPILEDP (fun))
  3326     {
  3327       syms_left = AREF (fun, COMPILED_ARGLIST);
  3328       if (FIXNUMP (syms_left))
  3329         return get_byte_code_arity (syms_left);
  3330     }
  3331   else
  3332     emacs_abort ();
  3333 
  3334   EMACS_INT minargs = 0, maxargs = 0;
  3335   bool optional = false;
  3336   for (; CONSP (syms_left); syms_left = XCDR (syms_left))
  3337     {
  3338       Lisp_Object next = XCAR (syms_left);
  3339       if (!SYMBOLP (next))
  3340         xsignal1 (Qinvalid_function, fun);
  3341 
  3342       if (EQ (next, Qand_rest))
  3343         return Fcons (make_fixnum (minargs), Qmany);
  3344       else if (EQ (next, Qand_optional))
  3345         optional = true;
  3346       else
  3347         {
  3348           if (!optional)
  3349             minargs++;
  3350           maxargs++;
  3351         }
  3352     }
  3353 
  3354   if (!NILP (syms_left))
  3355     xsignal1 (Qinvalid_function, fun);
  3356 
  3357   return Fcons (make_fixnum (minargs), make_fixnum (maxargs));
  3358 }
  3359 
  3360 DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
  3361        1, 1, 0,
  3362        doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now.  */)
  3363   (Lisp_Object object)
  3364 {
  3365   Lisp_Object tem;
  3366 
  3367   if (COMPILEDP (object))
  3368     {
  3369       if (CONSP (AREF (object, COMPILED_BYTECODE)))
  3370         {
  3371           tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
  3372           if (! (CONSP (tem) && STRINGP (XCAR (tem))
  3373                  && VECTORP (XCDR (tem))))
  3374             {
  3375               tem = AREF (object, COMPILED_BYTECODE);
  3376               if (CONSP (tem) && STRINGP (XCAR (tem)))
  3377                 error ("Invalid byte code in %s", SDATA (XCAR (tem)));
  3378               else
  3379                 error ("Invalid byte code");
  3380             }
  3381 
  3382           Lisp_Object bytecode = XCAR (tem);
  3383           if (STRING_MULTIBYTE (bytecode))
  3384             {
  3385               /* BYTECODE must have been produced by Emacs 20.2 or earlier
  3386                  because it produced a raw 8-bit string for byte-code and now
  3387                  such a byte-code string is loaded as multibyte with raw 8-bit
  3388                  characters converted to multibyte form.  Convert them back to
  3389                  the original unibyte form.  */
  3390               bytecode = Fstring_as_unibyte (bytecode);
  3391             }
  3392 
  3393           pin_string (bytecode);
  3394           ASET (object, COMPILED_BYTECODE, bytecode);
  3395           ASET (object, COMPILED_CONSTANTS, XCDR (tem));
  3396         }
  3397     }
  3398   return object;
  3399 }
  3400 
  3401 /* Return true if SYMBOL currently has a let-binding
  3402    which was made in the buffer that is now current.  */
  3403 
  3404 bool
  3405 let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
  3406 {
  3407   union specbinding *p;
  3408   Lisp_Object buf = Fcurrent_buffer ();
  3409 
  3410   for (p = specpdl_ptr; p > specpdl; )
  3411     if ((--p)->kind > SPECPDL_LET)
  3412       {
  3413         struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
  3414         eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS);
  3415         if (symbol == let_bound_symbol
  3416             && EQ (specpdl_where (p), buf))
  3417           return 1;
  3418       }
  3419 
  3420   return 0;
  3421 }
  3422 
  3423 static void
  3424 do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
  3425              Lisp_Object value, enum Set_Internal_Bind bindflag)
  3426 {
  3427   switch (sym->u.s.redirect)
  3428     {
  3429     case SYMBOL_PLAINVAL:
  3430       if (!sym->u.s.trapped_write)
  3431         SET_SYMBOL_VAL (sym, value);
  3432       else
  3433         set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
  3434       break;
  3435 
  3436     case SYMBOL_FORWARDED:
  3437       if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))
  3438           && specpdl_kind (bind) == SPECPDL_LET_DEFAULT)
  3439         {
  3440           set_default_internal (specpdl_symbol (bind), value, bindflag);
  3441           return;
  3442         }
  3443       FALLTHROUGH;
  3444     case SYMBOL_LOCALIZED:
  3445       set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
  3446       break;
  3447 
  3448     default:
  3449       emacs_abort ();
  3450     }
  3451 }
  3452 
  3453 /* `specpdl_ptr' describes which variable is
  3454    let-bound, so it can be properly undone when we unbind_to.
  3455    It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
  3456    - SYMBOL is the variable being bound.  Note that it should not be
  3457      aliased (i.e. when let-binding V1 that's aliased to V2, we want
  3458      to record V2 here).
  3459    - WHERE tells us in which buffer the binding took place.
  3460      This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
  3461      buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
  3462      i.e. bindings to the default value of a variable which can be
  3463      buffer-local.  */
  3464 
  3465 void
  3466 specbind (Lisp_Object symbol, Lisp_Object value)
  3467 {
  3468   struct Lisp_Symbol *sym;
  3469 
  3470   CHECK_SYMBOL (symbol);
  3471   sym = XSYMBOL (symbol);
  3472 
  3473  start:
  3474   switch (sym->u.s.redirect)
  3475     {
  3476     case SYMBOL_VARALIAS:
  3477       sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
  3478     case SYMBOL_PLAINVAL:
  3479       /* The most common case is that of a non-constant symbol with a
  3480          trivial value.  Make that as fast as we can.  */
  3481       specpdl_ptr->let.kind = SPECPDL_LET;
  3482       specpdl_ptr->let.symbol = symbol;
  3483       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
  3484       break;
  3485     case SYMBOL_LOCALIZED:
  3486     case SYMBOL_FORWARDED:
  3487       {
  3488         Lisp_Object ovalue = find_symbol_value (symbol);
  3489         specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
  3490         specpdl_ptr->let.symbol = symbol;
  3491         specpdl_ptr->let.old_value = ovalue;
  3492         specpdl_ptr->let.where = Fcurrent_buffer ();
  3493 
  3494         eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
  3495                  || (BASE_EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
  3496 
  3497         if (sym->u.s.redirect == SYMBOL_LOCALIZED)
  3498           {
  3499             if (!blv_found (SYMBOL_BLV (sym)))
  3500               specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
  3501           }
  3502         else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
  3503           {
  3504             /* If SYMBOL is a per-buffer variable which doesn't have a
  3505                buffer-local value here, make the `let' change the global
  3506                value by changing the value of SYMBOL in all buffers not
  3507                having their own value.  This is consistent with what
  3508                happens with other buffer-local variables.  */
  3509             if (NILP (Flocal_variable_p (symbol, Qnil)))
  3510               specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
  3511           }
  3512         else
  3513           specpdl_ptr->let.kind = SPECPDL_LET;
  3514 
  3515         break;
  3516       }
  3517     default: emacs_abort ();
  3518     }
  3519   grow_specpdl ();
  3520   do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
  3521 }
  3522 
  3523 /* Push unwind-protect entries of various types.  */
  3524 
  3525 void
  3526 record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
  3527 {
  3528   specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
  3529   specpdl_ptr->unwind.func = function;
  3530   specpdl_ptr->unwind.arg = arg;
  3531   specpdl_ptr->unwind.eval_depth = lisp_eval_depth;
  3532   grow_specpdl ();
  3533 }
  3534 
  3535 void
  3536 record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts)
  3537 {
  3538   specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY;
  3539   specpdl_ptr->unwind_array.array = array;
  3540   specpdl_ptr->unwind_array.nelts = nelts;
  3541   grow_specpdl ();
  3542 }
  3543 
  3544 void
  3545 record_unwind_protect_ptr (void (*function) (void *), void *arg)
  3546 {
  3547   specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
  3548   specpdl_ptr->unwind_ptr.func = function;
  3549   specpdl_ptr->unwind_ptr.arg = arg;
  3550   specpdl_ptr->unwind_ptr.mark = NULL;
  3551   grow_specpdl ();
  3552 }
  3553 
  3554 /* Like `record_unwind_protect_ptr', but also specifies a function
  3555    for GC-marking Lisp objects only reachable through ARG.  */
  3556 void
  3557 record_unwind_protect_ptr_mark (void (*function) (void *), void *arg,
  3558                                 void (*mark) (void *))
  3559 {
  3560   specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
  3561   specpdl_ptr->unwind_ptr.func = function;
  3562   specpdl_ptr->unwind_ptr.arg = arg;
  3563   specpdl_ptr->unwind_ptr.mark = mark;
  3564   grow_specpdl ();
  3565 }
  3566 
  3567 void
  3568 record_unwind_protect_int (void (*function) (int), int arg)
  3569 {
  3570   specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
  3571   specpdl_ptr->unwind_int.func = function;
  3572   specpdl_ptr->unwind_int.arg = arg;
  3573   grow_specpdl ();
  3574 }
  3575 
  3576 void
  3577 record_unwind_protect_intmax (void (*function) (intmax_t), intmax_t arg)
  3578 {
  3579   specpdl_ptr->unwind_intmax.kind = SPECPDL_UNWIND_INTMAX;
  3580   specpdl_ptr->unwind_intmax.func = function;
  3581   specpdl_ptr->unwind_intmax.arg = arg;
  3582   grow_specpdl ();
  3583 }
  3584 
  3585 void
  3586 record_unwind_protect_excursion (void)
  3587 {
  3588   specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION;
  3589   save_excursion_save (specpdl_ptr);
  3590   grow_specpdl ();
  3591 }
  3592 
  3593 void
  3594 record_unwind_protect_void (void (*function) (void))
  3595 {
  3596   specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
  3597   specpdl_ptr->unwind_void.func = function;
  3598   grow_specpdl ();
  3599 }
  3600 
  3601 void
  3602 record_unwind_protect_module (enum specbind_tag kind, void *ptr)
  3603 {
  3604   specpdl_ptr->kind = kind;
  3605   specpdl_ptr->unwind_ptr.func = NULL;
  3606   specpdl_ptr->unwind_ptr.arg = ptr;
  3607   specpdl_ptr->unwind_ptr.mark = NULL;
  3608   grow_specpdl ();
  3609 }
  3610 
  3611 static void
  3612 do_one_unbind (union specbinding *this_binding, bool unwinding,
  3613                enum Set_Internal_Bind bindflag)
  3614 {
  3615   eassert (unwinding || this_binding->kind >= SPECPDL_LET);
  3616   switch (this_binding->kind)
  3617     {
  3618     case SPECPDL_UNWIND:
  3619       lisp_eval_depth = this_binding->unwind.eval_depth;
  3620       this_binding->unwind.func (this_binding->unwind.arg);
  3621       break;
  3622     case SPECPDL_UNWIND_ARRAY:
  3623       xfree (this_binding->unwind_array.array);
  3624       break;
  3625     case SPECPDL_UNWIND_PTR:
  3626       this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg);
  3627       break;
  3628     case SPECPDL_UNWIND_INT:
  3629       this_binding->unwind_int.func (this_binding->unwind_int.arg);
  3630       break;
  3631     case SPECPDL_UNWIND_INTMAX:
  3632       this_binding->unwind_intmax.func (this_binding->unwind_intmax.arg);
  3633       break;
  3634     case SPECPDL_UNWIND_VOID:
  3635       this_binding->unwind_void.func ();
  3636       break;
  3637     case SPECPDL_UNWIND_EXCURSION:
  3638       save_excursion_restore (this_binding->unwind_excursion.marker,
  3639                               this_binding->unwind_excursion.window);
  3640       break;
  3641     case SPECPDL_BACKTRACE:
  3642     case SPECPDL_NOP:
  3643       break;
  3644 #ifdef HAVE_MODULES
  3645     case SPECPDL_MODULE_RUNTIME:
  3646       finalize_runtime_unwind (this_binding->unwind_ptr.arg);
  3647       break;
  3648     case SPECPDL_MODULE_ENVIRONMENT:
  3649       finalize_environment_unwind (this_binding->unwind_ptr.arg);
  3650       break;
  3651 #endif
  3652     case SPECPDL_LET:
  3653       { /* If variable has a trivial value (no forwarding), and isn't
  3654            trapped, we can just set it.  */
  3655         Lisp_Object sym = specpdl_symbol (this_binding);
  3656         if (SYMBOLP (sym) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
  3657           {
  3658             if (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_UNTRAPPED_WRITE)
  3659               SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding));
  3660             else
  3661               set_internal (sym, specpdl_old_value (this_binding),
  3662                             Qnil, bindflag);
  3663             break;
  3664           }
  3665       }
  3666       /* Come here only if make_local_foo was used for the first time
  3667          on this var within this let.  */
  3668       FALLTHROUGH;
  3669     case SPECPDL_LET_DEFAULT:
  3670       set_default_internal (specpdl_symbol (this_binding),
  3671                             specpdl_old_value (this_binding),
  3672                             bindflag);
  3673       break;
  3674     case SPECPDL_LET_LOCAL:
  3675       {
  3676         Lisp_Object symbol = specpdl_symbol (this_binding);
  3677         Lisp_Object where = specpdl_where (this_binding);
  3678         Lisp_Object old_value = specpdl_old_value (this_binding);
  3679         eassert (BUFFERP (where));
  3680 
  3681         /* If this was a local binding, reset the value in the appropriate
  3682            buffer, but only if that buffer's binding still exists.  */
  3683         if (!NILP (Flocal_variable_p (symbol, where)))
  3684           set_internal (symbol, old_value, where, bindflag);
  3685       }
  3686       break;
  3687     }
  3688 }
  3689 
  3690 static void
  3691 do_nothing (void)
  3692 {}
  3693 
  3694 /* Push an unwind-protect entry that does nothing, so that
  3695    set_unwind_protect_ptr can overwrite it later.  */
  3696 
  3697 void
  3698 record_unwind_protect_nothing (void)
  3699 {
  3700   record_unwind_protect_void (do_nothing);
  3701 }
  3702 
  3703 /* Clear the unwind-protect entry COUNT, so that it does nothing.
  3704    It need not be at the top of the stack.  */
  3705 
  3706 void
  3707 clear_unwind_protect (specpdl_ref count)
  3708 {
  3709   union specbinding *p = specpdl_ref_to_ptr (count);
  3710   p->unwind_void.kind = SPECPDL_UNWIND_VOID;
  3711   p->unwind_void.func = do_nothing;
  3712 }
  3713 
  3714 /* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
  3715    It need not be at the top of the stack.  Discard the entry's
  3716    previous value without invoking it.  */
  3717 
  3718 void
  3719 set_unwind_protect (specpdl_ref count, void (*func) (Lisp_Object),
  3720                     Lisp_Object arg)
  3721 {
  3722   union specbinding *p = specpdl_ref_to_ptr (count);
  3723   p->unwind.kind = SPECPDL_UNWIND;
  3724   p->unwind.func = func;
  3725   p->unwind.arg = arg;
  3726   p->unwind.eval_depth = lisp_eval_depth;
  3727 }
  3728 
  3729 void
  3730 set_unwind_protect_ptr (specpdl_ref count, void (*func) (void *), void *arg)
  3731 {
  3732   union specbinding *p = specpdl_ref_to_ptr (count);
  3733   p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
  3734   p->unwind_ptr.func = func;
  3735   p->unwind_ptr.arg = arg;
  3736   p->unwind_ptr.mark = NULL;
  3737 }
  3738 
  3739 /* Pop and execute entries from the unwind-protect stack until the
  3740    depth COUNT is reached.  Return VALUE.  */
  3741 
  3742 Lisp_Object
  3743 unbind_to (specpdl_ref count, Lisp_Object value)
  3744 {
  3745   Lisp_Object quitf = Vquit_flag;
  3746 
  3747   Vquit_flag = Qnil;
  3748 
  3749   while (specpdl_ptr != specpdl_ref_to_ptr (count))
  3750     {
  3751       /* Copy the binding, and decrement specpdl_ptr, before we do
  3752          the work to unbind it.  We decrement first
  3753          so that an error in unbinding won't try to unbind
  3754          the same entry again, and we copy the binding first
  3755          in case more bindings are made during some of the code we run.  */
  3756 
  3757       union specbinding this_binding;
  3758       this_binding = *--specpdl_ptr;
  3759 
  3760       do_one_unbind (&this_binding, true, SET_INTERNAL_UNBIND);
  3761     }
  3762 
  3763   if (NILP (Vquit_flag) && !NILP (quitf))
  3764     Vquit_flag = quitf;
  3765 
  3766   return value;
  3767 }
  3768 
  3769 DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0,
  3770        doc: /* Return non-nil if SYMBOL's global binding has been declared special.
  3771 A special variable is one that will be bound dynamically, even in a
  3772 context where binding is lexical by default.  */)
  3773   (Lisp_Object symbol)
  3774 {
  3775    CHECK_SYMBOL (symbol);
  3776    return XSYMBOL (symbol)->u.s.declared_special ? Qt : Qnil;
  3777 }
  3778 
  3779 
  3780 static union specbinding *
  3781 get_backtrace_starting_at (Lisp_Object base)
  3782 {
  3783   union specbinding *pdl = backtrace_top ();
  3784 
  3785   if (!NILP (base))
  3786     { /* Skip up to `base'.  */
  3787       base = Findirect_function (base, Qt);
  3788       while (backtrace_p (pdl)
  3789              && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
  3790         pdl = backtrace_next (pdl);
  3791     }
  3792 
  3793   return pdl;
  3794 }
  3795 
  3796 static union specbinding *
  3797 get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
  3798 {
  3799   register EMACS_INT i;
  3800 
  3801   CHECK_FIXNAT (nframes);
  3802   union specbinding *pdl = get_backtrace_starting_at (base);
  3803 
  3804   /* Find the frame requested.  */
  3805   for (i = XFIXNAT (nframes); i > 0 && backtrace_p (pdl); i--)
  3806     pdl = backtrace_next (pdl);
  3807 
  3808   return pdl;
  3809 }
  3810 
  3811 static Lisp_Object
  3812 backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
  3813 {
  3814   if (!backtrace_p (pdl))
  3815     return Qnil;
  3816 
  3817   Lisp_Object flags = Qnil;
  3818   if (backtrace_debug_on_exit (pdl))
  3819     flags = list2 (QCdebug_on_exit, Qt);
  3820 
  3821   if (backtrace_nargs (pdl) == UNEVALLED)
  3822     return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
  3823   else
  3824     {
  3825       Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
  3826       return call4 (function, Qt, backtrace_function (pdl), tem, flags);
  3827     }
  3828 }
  3829 
  3830 DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
  3831        doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
  3832 The debugger is entered when that frame exits, if the flag is non-nil.  */)
  3833   (Lisp_Object level, Lisp_Object flag)
  3834 {
  3835   CHECK_FIXNUM (level);
  3836   union specbinding *pdl = get_backtrace_frame(level, Qnil);
  3837 
  3838   if (backtrace_p (pdl))
  3839     set_backtrace_debug_on_exit (pdl, !NILP (flag));
  3840 
  3841   return flag;
  3842 }
  3843 
  3844 DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
  3845        doc: /* Call FUNCTION for each frame in backtrace.
  3846 If BASE is non-nil, it should be a function and iteration will start
  3847 from its nearest activation frame.
  3848 FUNCTION is called with 4 arguments: EVALD, FUNC, ARGS, and FLAGS.  If
  3849 a frame has not evaluated its arguments yet or is a special form,
  3850 EVALD is nil and ARGS is a list of forms.  If a frame has evaluated
  3851 its arguments and called its function already, EVALD is t and ARGS is
  3852 a list of values.
  3853 FLAGS is a plist of properties of the current frame: currently, the
  3854 only supported property is :debug-on-exit.  `mapbacktrace' always
  3855 returns nil.  */)
  3856      (Lisp_Object function, Lisp_Object base)
  3857 {
  3858   union specbinding *pdl = get_backtrace_starting_at (base);
  3859 
  3860   while (backtrace_p (pdl))
  3861     {
  3862       ptrdiff_t i = pdl - specpdl;
  3863       backtrace_frame_apply (function, pdl);
  3864       /* Beware! PDL is no longer valid here because FUNCTION might
  3865          have caused grow_specpdl to reallocate pdlvec.  We must use
  3866          the saved index, cf. Bug#27258.  */
  3867       pdl = backtrace_next (&specpdl[i]);
  3868     }
  3869 
  3870   return Qnil;
  3871 }
  3872 
  3873 DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal,
  3874        Sbacktrace_frame_internal, 3, 3, NULL,
  3875        doc: /* Call FUNCTION on stack frame NFRAMES away from BASE.
  3876 Return the result of FUNCTION, or nil if no matching frame could be found. */)
  3877      (Lisp_Object function, Lisp_Object nframes, Lisp_Object base)
  3878 {
  3879   return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
  3880 }
  3881 
  3882 DEFUN ("backtrace--frames-from-thread", Fbacktrace_frames_from_thread,
  3883        Sbacktrace_frames_from_thread, 1, 1, NULL,
  3884        doc: /* Return the list of backtrace frames from current execution point in THREAD.
  3885 If a frame has not evaluated the arguments yet (or is a special form),
  3886 the value of the list element is (nil FUNCTION ARG-FORMS...).
  3887 If a frame has evaluated its arguments and called its function already,
  3888 the value of the list element is (t FUNCTION ARG-VALUES...).
  3889 A &rest arg is represented as the tail of the list ARG-VALUES.
  3890 FUNCTION is whatever was supplied as car of evaluated list,
  3891 or a lambda expression for macro calls.  */)
  3892      (Lisp_Object thread)
  3893 {
  3894   struct thread_state *tstate;
  3895   CHECK_THREAD (thread);
  3896   tstate = XTHREAD (thread);
  3897 
  3898   union specbinding *pdl = backtrace_thread_top (tstate);
  3899   Lisp_Object list = Qnil;
  3900 
  3901   while (backtrace_thread_p (tstate, pdl))
  3902     {
  3903       Lisp_Object frame;
  3904       if (backtrace_nargs (pdl) == UNEVALLED)
  3905         frame = Fcons (Qnil,
  3906                       Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
  3907       else
  3908         {
  3909           Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
  3910           frame = Fcons (Qt, Fcons (backtrace_function (pdl), tem));
  3911         }
  3912       list = Fcons (frame, list);
  3913       pdl = backtrace_thread_next (tstate, pdl);
  3914     }
  3915   return Fnreverse (list);
  3916 }
  3917 
  3918 /* For backtrace-eval, we want to temporarily unwind the last few elements of
  3919    the specpdl stack, and then rewind them.  We store the pre-unwind values
  3920    directly in the pre-existing specpdl elements (i.e. we swap the current
  3921    value and the old value stored in the specpdl), kind of like the inplace
  3922    pointer-reversal trick.  As it turns out, the rewind does the same as the
  3923    unwind, except it starts from the other end of the specpdl stack, so we use
  3924    the same function for both unwind and rewind.
  3925    This same code is used when switching threads, except in that case
  3926    we unwind/rewind the whole specpdl of the threads.  */
  3927 void
  3928 specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only)
  3929 {
  3930   union specbinding *tmp = pdl;
  3931   int step = -1;
  3932   if (distance < 0)
  3933     { /* It's a rewind rather than unwind.  */
  3934       tmp += distance - 1;
  3935       step = 1;
  3936       distance = -distance;
  3937     }
  3938 
  3939   for (; distance > 0; distance--)
  3940     {
  3941       tmp += step;
  3942       switch (tmp->kind)
  3943         {
  3944           /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
  3945              unwind_protect, but the problem is that we don't know how to
  3946              rewind them afterwards.  */
  3947         case SPECPDL_UNWIND:
  3948           if (vars_only)
  3949             break;
  3950           if (tmp->unwind.func == set_buffer_if_live)
  3951             {
  3952               Lisp_Object oldarg = tmp->unwind.arg;
  3953               tmp->unwind.arg = Fcurrent_buffer ();
  3954               set_buffer_if_live (oldarg);
  3955             }
  3956           break;
  3957         case SPECPDL_UNWIND_EXCURSION:
  3958           if (vars_only)
  3959             break;
  3960           {
  3961             Lisp_Object marker = tmp->unwind_excursion.marker;
  3962             Lisp_Object window = tmp->unwind_excursion.window;
  3963             save_excursion_save (tmp);
  3964             save_excursion_restore (marker, window);
  3965           }
  3966           break;
  3967         case SPECPDL_LET:
  3968           { /* If variable has a trivial value (no forwarding), we can
  3969                just set it.  No need to check for constant symbols here,
  3970                since that was already done by specbind.  */
  3971             Lisp_Object sym = specpdl_symbol (tmp);
  3972             if (SYMBOLP (sym)
  3973                 && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
  3974               {
  3975                 Lisp_Object old_value = specpdl_old_value (tmp);
  3976                 set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym)));
  3977                 SET_SYMBOL_VAL (XSYMBOL (sym), old_value);
  3978                 break;
  3979               }
  3980           }
  3981           /* Come here only if make_local_foo was used for the first
  3982              time on this var within this let.  */
  3983           FALLTHROUGH;
  3984         case SPECPDL_LET_DEFAULT:
  3985           {
  3986             Lisp_Object sym = specpdl_symbol (tmp);
  3987             Lisp_Object old_value = specpdl_old_value (tmp);
  3988             set_specpdl_old_value (tmp, default_value (sym));
  3989             set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH);
  3990           }
  3991           break;
  3992         case SPECPDL_LET_LOCAL:
  3993           {
  3994             Lisp_Object symbol = specpdl_symbol (tmp);
  3995             Lisp_Object where = specpdl_where (tmp);
  3996             Lisp_Object old_value = specpdl_old_value (tmp);
  3997             eassert (BUFFERP (where));
  3998 
  3999             /* If this was a local binding, reset the value in the appropriate
  4000                buffer, but only if that buffer's binding still exists.  */
  4001             if (!NILP (Flocal_variable_p (symbol, where)))
  4002               {
  4003                 set_specpdl_old_value
  4004                   (tmp, buffer_local_value (symbol, where));
  4005                 set_internal (symbol, old_value, where,
  4006                               SET_INTERNAL_THREAD_SWITCH);
  4007               }
  4008             else
  4009               /* If the var is not local any more, it can't be undone nor
  4010                  redone, so just zap it.
  4011                  This is important in case the buffer re-gains a local value
  4012                  before we unrewind again, in which case we'd risk applying
  4013                  this entry in the wrong direction.  */
  4014               tmp->kind = SPECPDL_NOP;
  4015           }
  4016           break;
  4017 
  4018         default: break;
  4019         }
  4020     }
  4021 }
  4022 
  4023 static void
  4024 backtrace_eval_unrewind (int distance)
  4025 {
  4026   specpdl_unrewind (specpdl_ptr, distance, false);
  4027 }
  4028 
  4029 DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
  4030        doc: /* Evaluate EXP in the context of some activation frame.
  4031 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.  */)
  4032      (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
  4033 {
  4034   union specbinding *pdl = get_backtrace_frame (nframes, base);
  4035   specpdl_ref count = SPECPDL_INDEX ();
  4036   ptrdiff_t distance = specpdl_ptr - pdl;
  4037   eassert (distance >= 0);
  4038 
  4039   if (!backtrace_p (pdl))
  4040     error ("Activation frame not found!");
  4041 
  4042   backtrace_eval_unrewind (distance);
  4043   record_unwind_protect_int (backtrace_eval_unrewind, -distance);
  4044 
  4045   /* Use eval_sub rather than Feval since the main motivation behind
  4046      backtrace-eval is to be able to get/set the value of lexical variables
  4047      from the debugger.  */
  4048   return unbind_to (count, eval_sub (exp));
  4049 }
  4050 
  4051 DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL,
  4052        doc: /* Return names and values of local variables of a stack frame.
  4053 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.  */)
  4054   (Lisp_Object nframes, Lisp_Object base)
  4055 {
  4056   union specbinding *frame = get_backtrace_frame (nframes, base);
  4057   union specbinding *prevframe
  4058     = get_backtrace_frame (make_fixnum (XFIXNAT (nframes) - 1), base);
  4059   ptrdiff_t distance = specpdl_ptr - frame;
  4060   Lisp_Object result = Qnil;
  4061   eassert (distance >= 0);
  4062 
  4063   if (!backtrace_p (prevframe))
  4064     error ("Activation frame not found!");
  4065   if (!backtrace_p (frame))
  4066     error ("Activation frame not found!");
  4067 
  4068   /* The specpdl entries normally contain the symbol being bound along with its
  4069      `old_value', so it can be restored.  The new value to which it is bound is
  4070      available in one of two places: either in the current value of the
  4071      variable (if it hasn't been rebound yet) or in the `old_value' slot of the
  4072      next specpdl entry for it.
  4073      `backtrace_eval_unrewind' happens to swap the role of `old_value'
  4074      and "new value", so we abuse it here, to fetch the new value.
  4075      It's ugly (we'd rather not modify global data) and a bit inefficient,
  4076      but it does the job for now.  */
  4077   backtrace_eval_unrewind (distance);
  4078 
  4079   /* Grab values.  */
  4080   {
  4081     union specbinding *tmp = prevframe;
  4082     for (; tmp > frame; tmp--)
  4083       {
  4084         switch (tmp->kind)
  4085           {
  4086           case SPECPDL_LET:
  4087           case SPECPDL_LET_DEFAULT:
  4088           case SPECPDL_LET_LOCAL:
  4089             {
  4090               Lisp_Object sym = specpdl_symbol (tmp);
  4091               Lisp_Object val = specpdl_old_value (tmp);
  4092               if (EQ (sym, Qinternal_interpreter_environment))
  4093                 {
  4094                   Lisp_Object env = val;
  4095                   for (; CONSP (env); env = XCDR (env))
  4096                     {
  4097                       Lisp_Object binding = XCAR (env);
  4098                       if (CONSP (binding))
  4099                         result = Fcons (Fcons (XCAR (binding),
  4100                                                XCDR (binding)),
  4101                                         result);
  4102                     }
  4103                 }
  4104               else
  4105                 result = Fcons (Fcons (sym, val), result);
  4106             }
  4107             break;
  4108 
  4109           default: break;
  4110           }
  4111       }
  4112   }
  4113 
  4114   /* Restore values from specpdl to original place.  */
  4115   backtrace_eval_unrewind (-distance);
  4116 
  4117   return result;
  4118 }
  4119 
  4120 
  4121 void
  4122 mark_specpdl (union specbinding *first, union specbinding *ptr)
  4123 {
  4124   union specbinding *pdl;
  4125   for (pdl = first; pdl != ptr; pdl++)
  4126     {
  4127       switch (pdl->kind)
  4128         {
  4129         case SPECPDL_UNWIND:
  4130           mark_object (specpdl_arg (pdl));
  4131           break;
  4132 
  4133         case SPECPDL_UNWIND_ARRAY:
  4134           mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
  4135           break;
  4136 
  4137         case SPECPDL_UNWIND_EXCURSION:
  4138           mark_object (pdl->unwind_excursion.marker);
  4139           mark_object (pdl->unwind_excursion.window);
  4140           break;
  4141 
  4142         case SPECPDL_BACKTRACE:
  4143           {
  4144             ptrdiff_t nargs = backtrace_nargs (pdl);
  4145             mark_object (backtrace_function (pdl));
  4146             if (nargs == UNEVALLED)
  4147               nargs = 1;
  4148             mark_objects (backtrace_args (pdl), nargs);
  4149           }
  4150           break;
  4151 
  4152 #ifdef HAVE_MODULES
  4153         case SPECPDL_MODULE_RUNTIME:
  4154           break;
  4155         case SPECPDL_MODULE_ENVIRONMENT:
  4156           mark_module_environment (pdl->unwind_ptr.arg);
  4157           break;
  4158 #endif
  4159 
  4160         case SPECPDL_LET_DEFAULT:
  4161         case SPECPDL_LET_LOCAL:
  4162           mark_object (specpdl_where (pdl));
  4163           FALLTHROUGH;
  4164         case SPECPDL_LET:
  4165           mark_object (specpdl_symbol (pdl));
  4166           mark_object (specpdl_old_value (pdl));
  4167           break;
  4168 
  4169         case SPECPDL_UNWIND_PTR:
  4170           if (pdl->unwind_ptr.mark)
  4171             pdl->unwind_ptr.mark (pdl->unwind_ptr.arg);
  4172           break;
  4173 
  4174         case SPECPDL_UNWIND_INT:
  4175         case SPECPDL_UNWIND_INTMAX:
  4176         case SPECPDL_UNWIND_VOID:
  4177         case SPECPDL_NOP:
  4178           break;
  4179 
  4180         /* While other loops that scan the specpdl use "default: break;"
  4181            for simplicity, here we explicitly list all cases and abort
  4182            if we find an unexpected value, as a sanity check.  */
  4183         default:
  4184           emacs_abort ();
  4185         }
  4186     }
  4187 }
  4188 
  4189 void
  4190 get_backtrace (Lisp_Object array)
  4191 {
  4192   union specbinding *pdl = backtrace_next (backtrace_top ());
  4193   ptrdiff_t i = 0, asize = ASIZE (array);
  4194 
  4195   /* Copy the backtrace contents into working memory.  */
  4196   for (; i < asize; i++)
  4197     {
  4198       if (backtrace_p (pdl))
  4199         {
  4200           ASET (array, i, backtrace_function (pdl));
  4201           pdl = backtrace_next (pdl);
  4202         }
  4203       else
  4204         ASET (array, i, Qnil);
  4205     }
  4206 }
  4207 
  4208 Lisp_Object backtrace_top_function (void)
  4209 {
  4210   union specbinding *pdl = backtrace_top ();
  4211   return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil);
  4212 }
  4213 
  4214 void
  4215 syms_of_eval (void)
  4216 {
  4217   DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
  4218               doc: /* Limit on depth in `eval', `apply' and `funcall' before error.
  4219 
  4220 This limit serves to catch infinite recursions for you before they cause
  4221 actual stack overflow in C, which would be fatal for Emacs.
  4222 You can safely make it considerably larger than its default value,
  4223 if that proves inconveniently small.  However, if you increase it too far,
  4224 Emacs could overflow the real C stack, and crash.  */);
  4225 
  4226   DEFVAR_LISP ("quit-flag", Vquit_flag,
  4227                doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
  4228 If the value is t, that means do an ordinary quit.
  4229 If the value equals `throw-on-input', that means quit by throwing
  4230 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
  4231 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
  4232 but `inhibit-quit' non-nil prevents anything from taking notice of that.  */);
  4233   Vquit_flag = Qnil;
  4234 
  4235   DEFVAR_LISP ("inhibit-quit", Vinhibit_quit,
  4236                doc: /* Non-nil inhibits C-g quitting from happening immediately.
  4237 Note that `quit-flag' will still be set by typing C-g,
  4238 so a quit will be signaled as soon as `inhibit-quit' is nil.
  4239 To prevent this happening, set `quit-flag' to nil
  4240 before making `inhibit-quit' nil.  */);
  4241   Vinhibit_quit = Qnil;
  4242 
  4243   DEFSYM (Qsetq, "setq");
  4244   DEFSYM (Qinhibit_quit, "inhibit-quit");
  4245   DEFSYM (Qautoload, "autoload");
  4246   DEFSYM (Qinhibit_debugger, "inhibit-debugger");
  4247   DEFSYM (Qmacro, "macro");
  4248 
  4249   /* Note that the process handling also uses Qexit, but we don't want
  4250      to staticpro it twice, so we just do it here.  */
  4251   DEFSYM (Qexit, "exit");
  4252 
  4253   DEFSYM (Qinteractive, "interactive");
  4254   DEFSYM (Qcommandp, "commandp");
  4255   DEFSYM (Qand_rest, "&rest");
  4256   DEFSYM (Qand_optional, "&optional");
  4257   DEFSYM (Qclosure, "closure");
  4258   DEFSYM (QCdocumentation, ":documentation");
  4259   DEFSYM (Qdebug, "debug");
  4260   DEFSYM (Qdebug_early, "debug-early");
  4261 
  4262   DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
  4263                doc: /* Non-nil means never enter the debugger.
  4264 Normally set while the debugger is already active, to avoid recursive
  4265 invocations.  */);
  4266   Vinhibit_debugger = Qnil;
  4267 
  4268   DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
  4269                doc: /* Non-nil means enter debugger if an error is signaled.
  4270 Does not apply to errors handled by `condition-case' or those
  4271 matched by `debug-ignored-errors'.
  4272 If the value is a list, an error only means to enter the debugger
  4273 if one of its condition symbols appears in the list.
  4274 When you evaluate an expression interactively, this variable
  4275 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
  4276 The command `toggle-debug-on-error' toggles this.
  4277 See also the variable `debug-on-quit' and `inhibit-debugger'.  */);
  4278   Vdebug_on_error = Qnil;
  4279 
  4280   DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
  4281     doc: /* List of errors for which the debugger should not be called.
  4282 Each element may be a condition-name or a regexp that matches error messages.
  4283 If any element applies to a given error, that error skips the debugger
  4284 and just returns to top level.
  4285 This overrides the variable `debug-on-error'.
  4286 It does not apply to errors handled by `condition-case'.  */);
  4287   Vdebug_ignored_errors = Qnil;
  4288 
  4289   DEFVAR_BOOL ("debug-on-quit", debug_on_quit,
  4290     doc: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
  4291 Does not apply if quit is handled by a `condition-case'.  */);
  4292   debug_on_quit = 0;
  4293 
  4294   DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call,
  4295                doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'.  */);
  4296 
  4297   DEFVAR_BOOL ("backtrace-on-redisplay-error", backtrace_on_redisplay_error,
  4298                doc: /* Non-nil means create a backtrace if a lisp error occurs in redisplay.
  4299 The backtrace is written to buffer *Redisplay-trace*.  */);
  4300   backtrace_on_redisplay_error = false;
  4301 
  4302   DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue,
  4303                doc: /* Non-nil means debugger may continue execution.
  4304 This is nil when the debugger is called under circumstances where it
  4305 might not be safe to continue.  */);
  4306   debugger_may_continue = 1;
  4307 
  4308   DEFVAR_BOOL ("debugger-stack-frame-as-list", debugger_stack_frame_as_list,
  4309                doc: /* Non-nil means display call stack frames as lists. */);
  4310   debugger_stack_frame_as_list = 0;
  4311 
  4312   DEFSYM (Qdebugger, "debugger");
  4313   DEFVAR_LISP ("debugger", Vdebugger,
  4314                doc: /* Function to call to invoke debugger.
  4315 If due to frame exit, args are `exit' and the value being returned;
  4316  this function's value will be returned instead of that.
  4317 If due to error, args are `error' and a list of the args to `signal'.
  4318 If due to `apply' or `funcall' entry, one arg, `lambda'.
  4319 If due to `eval' entry, one arg, t.  */);
  4320   Vdebugger = Qdebug_early;
  4321 
  4322   DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function,
  4323                doc: /* If non-nil, this is a function for `signal' to call.
  4324 It receives the same arguments that `signal' was given.
  4325 The Edebug package uses this to regain control.  */);
  4326   Vsignal_hook_function = Qnil;
  4327 
  4328   DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
  4329                doc: /* Non-nil means call the debugger regardless of condition handlers.
  4330 Note that `debug-on-error', `debug-on-quit' and friends
  4331 still determine whether to handle the particular condition.  */);
  4332   Vdebug_on_signal = Qnil;
  4333 
  4334   DEFVAR_BOOL ("backtrace-on-error-noninteractive",
  4335                backtrace_on_error_noninteractive,
  4336                doc: /* Non-nil means print backtrace on error in batch mode.
  4337 If this is nil, errors in batch mode will just print the error
  4338 message upon encountering an unhandled error, without showing
  4339 the Lisp backtrace.  */);
  4340   backtrace_on_error_noninteractive = true;
  4341 
  4342   /* The value of num_nonmacro_input_events as of the last time we
  4343    started to enter the debugger.  If we decide to enter the debugger
  4344    again when this is still equal to num_nonmacro_input_events, then we
  4345    know that the debugger itself has an error, and we should just
  4346    signal the error instead of entering an infinite loop of debugger
  4347    invocations.  */
  4348   DEFSYM (Qinternal_when_entered_debugger, "internal-when-entered-debugger");
  4349   DEFVAR_INT ("internal-when-entered-debugger", when_entered_debugger,
  4350               doc: /* The number of keyboard events as of last time `debugger' was called.
  4351 Used to avoid infinite loops if the debugger itself has an error.
  4352 Don't set this unless you're sure that can't happen.  */);
  4353 
  4354   /* When lexical binding is being used,
  4355    Vinternal_interpreter_environment is non-nil, and contains an alist
  4356    of lexically-bound variable, or (t), indicating an empty
  4357    environment.  The lisp name of this variable would be
  4358    `internal-interpreter-environment' if it weren't hidden.
  4359    Every element of this list can be either a cons (VAR . VAL)
  4360    specifying a lexical binding, or a single symbol VAR indicating
  4361    that this variable should use dynamic scoping.  */
  4362   DEFSYM (Qinternal_interpreter_environment,
  4363           "internal-interpreter-environment");
  4364   DEFVAR_LISP ("internal-interpreter-environment",
  4365                 Vinternal_interpreter_environment,
  4366                doc: /* If non-nil, the current lexical environment of the lisp interpreter.
  4367 When lexical binding is not being used, this variable is nil.
  4368 A value of `(t)' indicates an empty environment, otherwise it is an
  4369 alist of active lexical bindings.  */);
  4370   Vinternal_interpreter_environment = Qnil;
  4371   /* Don't export this variable to Elisp, so no one can mess with it
  4372      (Just imagine if someone makes it buffer-local).  */
  4373   Funintern (Qinternal_interpreter_environment, Qnil);
  4374 
  4375   DEFVAR_LISP ("internal-make-interpreted-closure-function",
  4376                Vinternal_make_interpreted_closure_function,
  4377                doc: /* Function to filter the env when constructing a closure.  */);
  4378   Vinternal_make_interpreted_closure_function = Qnil;
  4379 
  4380   Vrun_hooks = intern_c_string ("run-hooks");
  4381   staticpro (&Vrun_hooks);
  4382 
  4383   staticpro (&Vautoload_queue);
  4384   Vautoload_queue = Qnil;
  4385   staticpro (&Vsignaling_function);
  4386   Vsignaling_function = Qnil;
  4387 
  4388   staticpro (&Qcatch_all_memory_full);
  4389   /* Make sure Qcatch_all_memory_full is a unique object.  We could
  4390      also use something like Fcons (Qnil, Qnil), but json.c treats any
  4391      cons cell as error data, so use an uninterned symbol instead.  */
  4392   Qcatch_all_memory_full
  4393     = Fmake_symbol (build_pure_c_string ("catch-all-memory-full"));
  4394 
  4395   defsubr (&Sor);
  4396   defsubr (&Sand);
  4397   defsubr (&Sif);
  4398   defsubr (&Scond);
  4399   defsubr (&Sprogn);
  4400   defsubr (&Sprog1);
  4401   defsubr (&Ssetq);
  4402   defsubr (&Squote);
  4403   defsubr (&Sfunction);
  4404   defsubr (&Sdefault_toplevel_value);
  4405   defsubr (&Sset_default_toplevel_value);
  4406   defsubr (&Sdefvar);
  4407   defsubr (&Sdefvar_1);
  4408   defsubr (&Sdefvaralias);
  4409   DEFSYM (Qdefvaralias, "defvaralias");
  4410   defsubr (&Sdefconst);
  4411   defsubr (&Sdefconst_1);
  4412   defsubr (&Sinternal__define_uninitialized_variable);
  4413   defsubr (&Smake_var_non_special);
  4414   defsubr (&Slet);
  4415   defsubr (&SletX);
  4416   defsubr (&Swhile);
  4417   defsubr (&Sfuncall_with_delayed_message);
  4418   defsubr (&Smacroexpand);
  4419   defsubr (&Scatch);
  4420   defsubr (&Sthrow);
  4421   defsubr (&Sunwind_protect);
  4422   defsubr (&Scondition_case);
  4423   DEFSYM (QCsuccess, ":success");
  4424   defsubr (&Ssignal);
  4425   defsubr (&Scommandp);
  4426   defsubr (&Sautoload);
  4427   defsubr (&Sautoload_do_load);
  4428   defsubr (&Seval);
  4429   defsubr (&Sapply);
  4430   defsubr (&Sfuncall);
  4431   defsubr (&Sfunc_arity);
  4432   defsubr (&Srun_hooks);
  4433   defsubr (&Srun_hook_with_args);
  4434   defsubr (&Srun_hook_with_args_until_success);
  4435   defsubr (&Srun_hook_with_args_until_failure);
  4436   defsubr (&Srun_hook_wrapped);
  4437   defsubr (&Sfetch_bytecode);
  4438   defsubr (&Sbacktrace_debug);
  4439   DEFSYM (QCdebug_on_exit, ":debug-on-exit");
  4440   defsubr (&Smapbacktrace);
  4441   defsubr (&Sbacktrace_frame_internal);
  4442   defsubr (&Sbacktrace_frames_from_thread);
  4443   defsubr (&Sbacktrace_eval);
  4444   defsubr (&Sbacktrace__locals);
  4445   defsubr (&Sspecial_variable_p);
  4446   DEFSYM (Qfunctionp, "functionp");
  4447   defsubr (&Sfunctionp);
  4448 }