1 /* Evaluator for GNU Emacs Lisp interpreter.
3 Copyright (C) 1985-1987, 1993-1995, 1999-2014 Free Software Foundation,
6 This file is part of GNU Emacs.
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
11 (at your option) any later version.
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.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include "blockinput.h"
29 #include "dispextern.h"
31 /* Chain of condition and catch handlers currently in effect. */
33 struct handler
*handlerlist
;
36 /* Count levels of GCPRO to detect failure to UNGCPRO. */
40 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
;
41 Lisp_Object Qinhibit_quit
;
42 Lisp_Object Qand_rest
;
43 static Lisp_Object Qand_optional
;
44 static Lisp_Object Qinhibit_debugger
;
45 static Lisp_Object Qdeclare
;
46 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
48 static Lisp_Object Qdebug
;
50 /* This holds either the symbol `run-hooks' or nil.
51 It is nil at an early stage of startup, and when Emacs
54 Lisp_Object Vrun_hooks
;
56 /* Non-nil means record all fset's and provide's, to be undone
57 if the file being autoloaded is not fully loaded.
58 They are recorded by being consed onto the front of Vautoload_queue:
59 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
61 Lisp_Object Vautoload_queue
;
63 /* Current number of specbindings allocated in specpdl, not counting
64 the dummy entry specpdl[-1]. */
66 ptrdiff_t specpdl_size
;
68 /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists
69 only so that its address can be taken. */
71 union specbinding
*specpdl
;
73 /* Pointer to first unused element in specpdl. */
75 union specbinding
*specpdl_ptr
;
77 /* Depth in Lisp evaluations and function calls. */
79 EMACS_INT lisp_eval_depth
;
81 /* The value of num_nonmacro_input_events as of the last time we
82 started to enter the debugger. If we decide to enter the debugger
83 again when this is still equal to num_nonmacro_input_events, then we
84 know that the debugger itself has an error, and we should just
85 signal the error instead of entering an infinite loop of debugger
88 static EMACS_INT when_entered_debugger
;
90 /* The function from which the last `signal' was called. Set in
92 /* FIXME: We should probably get rid of this! */
93 Lisp_Object Vsignaling_function
;
95 /* If non-nil, Lisp code must not be run since some part of Emacs is
96 in an inconsistent state. Currently, x-create-frame uses this to
97 avoid triggering window-configuration-change-hook while the new
98 frame is half-initialized. */
99 Lisp_Object inhibit_lisp_code
;
101 /* These would ordinarily be static, but they need to be visible to GDB. */
102 bool backtrace_p (union specbinding
*) EXTERNALLY_VISIBLE
;
103 Lisp_Object
*backtrace_args (union specbinding
*) EXTERNALLY_VISIBLE
;
104 Lisp_Object
backtrace_function (union specbinding
*) EXTERNALLY_VISIBLE
;
105 union specbinding
*backtrace_next (union specbinding
*) EXTERNALLY_VISIBLE
;
106 union specbinding
*backtrace_top (void) EXTERNALLY_VISIBLE
;
108 static Lisp_Object
funcall_lambda (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
109 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
112 specpdl_symbol (union specbinding
*pdl
)
114 eassert (pdl
->kind
>= SPECPDL_LET
);
115 return pdl
->let
.symbol
;
119 specpdl_old_value (union specbinding
*pdl
)
121 eassert (pdl
->kind
>= SPECPDL_LET
);
122 return pdl
->let
.old_value
;
126 set_specpdl_old_value (union specbinding
*pdl
, Lisp_Object val
)
128 eassert (pdl
->kind
>= SPECPDL_LET
);
129 pdl
->let
.old_value
= val
;
133 specpdl_where (union specbinding
*pdl
)
135 eassert (pdl
->kind
> SPECPDL_LET
);
136 return pdl
->let
.where
;
140 specpdl_arg (union specbinding
*pdl
)
142 eassert (pdl
->kind
== SPECPDL_UNWIND
);
143 return pdl
->unwind
.arg
;
147 backtrace_function (union specbinding
*pdl
)
149 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
150 return pdl
->bt
.function
;
154 backtrace_nargs (union specbinding
*pdl
)
156 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
157 return pdl
->bt
.nargs
;
161 backtrace_args (union specbinding
*pdl
)
163 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
168 backtrace_debug_on_exit (union specbinding
*pdl
)
170 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
171 return pdl
->bt
.debug_on_exit
;
174 /* Functions to modify slots of backtrace records. */
177 set_backtrace_args (union specbinding
*pdl
, Lisp_Object
*args
)
179 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
184 set_backtrace_nargs (union specbinding
*pdl
, ptrdiff_t n
)
186 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
191 set_backtrace_debug_on_exit (union specbinding
*pdl
, bool doe
)
193 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
194 pdl
->bt
.debug_on_exit
= doe
;
197 /* Helper functions to scan the backtrace. */
200 backtrace_p (union specbinding
*pdl
)
201 { return pdl
>= specpdl
; }
206 union specbinding
*pdl
= specpdl_ptr
- 1;
207 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
213 backtrace_next (union specbinding
*pdl
)
216 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
223 init_eval_once (void)
226 union specbinding
*pdlvec
= xmalloc ((size
+ 1) * sizeof *specpdl
);
228 specpdl
= specpdl_ptr
= pdlvec
+ 1;
229 /* Don't forget to update docs (lispref node "Local Variables"). */
230 max_specpdl_size
= 1300; /* 1000 is not enough for CEDET's c-by.el. */
231 max_lisp_eval_depth
= 600;
236 static struct handler handlerlist_sentinel
;
241 specpdl_ptr
= specpdl
;
242 { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
243 This is important since handlerlist->nextfree holds the freelist
244 which would otherwise leak every time we unwind back to top-level. */
246 handlerlist
= handlerlist_sentinel
.nextfree
= &handlerlist_sentinel
;
247 PUSH_HANDLER (c
, Qunbound
, CATCHER
);
248 eassert (c
== &handlerlist_sentinel
);
249 handlerlist_sentinel
.nextfree
= NULL
;
250 handlerlist_sentinel
.next
= NULL
;
253 debug_on_next_call
= 0;
258 /* This is less than the initial value of num_nonmacro_input_events. */
259 when_entered_debugger
= -1;
262 /* Unwind-protect function used by call_debugger. */
265 restore_stack_limits (Lisp_Object data
)
267 max_specpdl_size
= XINT (XCAR (data
));
268 max_lisp_eval_depth
= XINT (XCDR (data
));
271 static void grow_specpdl (void);
273 /* Call the Lisp debugger, giving it argument ARG. */
276 call_debugger (Lisp_Object arg
)
278 bool debug_while_redisplaying
;
281 EMACS_INT old_depth
= max_lisp_eval_depth
;
282 /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
283 EMACS_INT old_max
= max (max_specpdl_size
, count
);
285 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
286 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
288 /* While debugging Bug#16603, previous value of 100 was found
289 too small to avoid specpdl overflow in the debugger itself. */
290 if (max_specpdl_size
- 200 < count
)
291 max_specpdl_size
= count
+ 200;
293 if (old_max
== count
)
295 /* We can enter the debugger due to specpdl overflow (Bug#16603). */
300 /* Restore limits after leaving the debugger. */
301 record_unwind_protect (restore_stack_limits
,
302 Fcons (make_number (old_max
),
303 make_number (old_depth
)));
305 #ifdef HAVE_WINDOW_SYSTEM
306 if (display_hourglass_p
)
310 debug_on_next_call
= 0;
311 when_entered_debugger
= num_nonmacro_input_events
;
313 /* Resetting redisplaying_p to 0 makes sure that debug output is
314 displayed if the debugger is invoked during redisplay. */
315 debug_while_redisplaying
= redisplaying_p
;
317 specbind (intern ("debugger-may-continue"),
318 debug_while_redisplaying
? Qnil
: Qt
);
319 specbind (Qinhibit_redisplay
, Qnil
);
320 specbind (Qinhibit_debugger
, Qt
);
322 #if 0 /* Binding this prevents execution of Lisp code during
323 redisplay, which necessarily leads to display problems. */
324 specbind (Qinhibit_eval_during_redisplay
, Qt
);
327 val
= apply1 (Vdebugger
, arg
);
329 /* Interrupting redisplay and resuming it later is not safe under
330 all circumstances. So, when the debugger returns, abort the
331 interrupted redisplay by going back to the top-level. */
332 if (debug_while_redisplaying
)
340 do_debug_on_call (Lisp_Object code
)
342 debug_on_next_call
= 0;
343 set_backtrace_debug_on_exit (specpdl_ptr
- 1, true);
344 call_debugger (list1 (code
));
347 /* NOTE!!! Every function that can call EVAL must protect its args
348 and temporaries from garbage collection while it needs them.
349 The definition of `For' shows what you have to do. */
351 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
352 doc
: /* Eval args until one of them yields non-nil, then return that value.
353 The remaining args are not evalled at all.
354 If all args return nil, return nil.
355 usage: (or CONDITIONS...) */)
358 register Lisp_Object val
= Qnil
;
365 val
= eval_sub (XCAR (args
));
375 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
376 doc
: /* Eval args until one of them yields nil, then return nil.
377 The remaining args are not evalled at all.
378 If no arg yields nil, return the last arg's value.
379 usage: (and CONDITIONS...) */)
382 register Lisp_Object val
= Qt
;
389 val
= eval_sub (XCAR (args
));
399 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
400 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
401 Returns the value of THEN or the value of the last of the ELSE's.
402 THEN must be one expression, but ELSE... can be zero or more expressions.
403 If COND yields nil, and there are no ELSE's, the value is nil.
404 usage: (if COND THEN ELSE...) */)
411 cond
= eval_sub (XCAR (args
));
415 return eval_sub (Fcar (XCDR (args
)));
416 return Fprogn (XCDR (XCDR (args
)));
419 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
420 doc
: /* Try each clause until one succeeds.
421 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
422 and, if the value is non-nil, this clause succeeds:
423 then the expressions in BODY are evaluated and the last one's
424 value is the value of the cond-form.
425 If a clause has one element, as in (CONDITION), then the cond-form
426 returns CONDITION's value, if that is non-nil.
427 If no clause succeeds, cond returns nil.
428 usage: (cond CLAUSES...) */)
431 Lisp_Object val
= args
;
437 Lisp_Object clause
= XCAR (args
);
438 val
= eval_sub (Fcar (clause
));
441 if (!NILP (XCDR (clause
)))
442 val
= Fprogn (XCDR (clause
));
452 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
453 doc
: /* Eval BODY forms sequentially and return value of last one.
454 usage: (progn BODY...) */)
457 Lisp_Object val
= Qnil
;
464 val
= eval_sub (XCAR (body
));
472 /* Evaluate BODY sequentially, discarding its value. Suitable for
473 record_unwind_protect. */
476 unwind_body (Lisp_Object body
)
481 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
482 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
483 The value of FIRST is saved during the evaluation of the remaining args,
484 whose values are discarded.
485 usage: (prog1 FIRST BODY...) */)
489 Lisp_Object args_left
;
490 struct gcpro gcpro1
, gcpro2
;
496 val
= eval_sub (XCAR (args_left
));
497 while (CONSP (args_left
= XCDR (args_left
)))
498 eval_sub (XCAR (args_left
));
504 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
505 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
506 The value of FORM2 is saved during the evaluation of the
507 remaining args, whose values are discarded.
508 usage: (prog2 FORM1 FORM2 BODY...) */)
514 eval_sub (XCAR (args
));
516 return Fprog1 (XCDR (args
));
519 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
520 doc
: /* Set each SYM to the value of its VAL.
521 The symbols SYM are variables; they are literal (not evaluated).
522 The values VAL are expressions; they are evaluated.
523 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
524 The second VAL is not computed until after the first SYM is set, and so on;
525 each VAL can use the new value of variables set earlier in the `setq'.
526 The return value of the `setq' form is the value of the last VAL.
527 usage: (setq [SYM VAL]...) */)
530 Lisp_Object val
, sym
, lex_binding
;
535 Lisp_Object args_left
= args
;
541 val
= eval_sub (Fcar (XCDR (args_left
)));
542 sym
= XCAR (args_left
);
544 /* Like for eval_sub, we do not check declared_special here since
545 it's been done when let-binding. */
546 if (!NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
548 && !NILP (lex_binding
549 = Fassq (sym
, Vinternal_interpreter_environment
)))
550 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
552 Fset (sym
, val
); /* SYM is dynamically bound. */
554 args_left
= Fcdr (XCDR (args_left
));
556 while (CONSP (args_left
));
564 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
565 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
566 Warning: `quote' does not construct its return value, but just returns
567 the value that was pre-constructed by the Lisp reader (see info node
568 `(elisp)Printed Representation').
569 This means that '(a . b) is not identical to (cons 'a 'b): the former
570 does not cons. Quoting should be reserved for constants that will
571 never be modified by side-effects, unless you like self-modifying code.
572 See the common pitfall in info node `(elisp)Rearrangement' for an example
573 of unexpected results when a quoted object is modified.
574 usage: (quote ARG) */)
577 if (CONSP (XCDR (args
)))
578 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
582 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
583 doc
: /* Like `quote', but preferred for objects which are functions.
584 In byte compilation, `function' causes its argument to be compiled.
585 `quote' cannot do that.
586 usage: (function ARG) */)
589 Lisp_Object quoted
= XCAR (args
);
591 if (CONSP (XCDR (args
)))
592 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
594 if (!NILP (Vinternal_interpreter_environment
)
596 && EQ (XCAR (quoted
), Qlambda
))
597 /* This is a lambda expression within a lexical environment;
598 return an interpreted closure instead of a simple lambda. */
599 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
602 /* Simply quote the argument. */
607 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
608 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
609 Aliased variables always have the same value; setting one sets the other.
610 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
611 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
612 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
613 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
614 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
615 The return value is BASE-VARIABLE. */)
616 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
618 struct Lisp_Symbol
*sym
;
620 CHECK_SYMBOL (new_alias
);
621 CHECK_SYMBOL (base_variable
);
623 sym
= XSYMBOL (new_alias
);
626 /* Not sure why, but why not? */
627 error ("Cannot make a constant an alias");
629 switch (sym
->redirect
)
631 case SYMBOL_FORWARDED
:
632 error ("Cannot make an internal variable an alias");
633 case SYMBOL_LOCALIZED
:
634 error ("Don't know how to make a localized variable an alias");
637 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
638 If n_a is bound, but b_v is not, set the value of b_v to n_a,
639 so that old-code that affects n_a before the aliasing is setup
641 if (NILP (Fboundp (base_variable
)))
642 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
645 union specbinding
*p
;
647 for (p
= specpdl_ptr
; p
> specpdl
; )
648 if ((--p
)->kind
>= SPECPDL_LET
649 && (EQ (new_alias
, specpdl_symbol (p
))))
650 error ("Don't know how to make a let-bound variable an alias");
653 sym
->declared_special
= 1;
654 XSYMBOL (base_variable
)->declared_special
= 1;
655 sym
->redirect
= SYMBOL_VARALIAS
;
656 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
657 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
658 LOADHIST_ATTACH (new_alias
);
659 /* Even if docstring is nil: remove old docstring. */
660 Fput (new_alias
, Qvariable_documentation
, docstring
);
662 return base_variable
;
665 static union specbinding
*
666 default_toplevel_binding (Lisp_Object symbol
)
668 union specbinding
*binding
= NULL
;
669 union specbinding
*pdl
= specpdl_ptr
;
670 while (pdl
> specpdl
)
672 switch ((--pdl
)->kind
)
674 case SPECPDL_LET_DEFAULT
:
676 if (EQ (specpdl_symbol (pdl
), symbol
))
684 DEFUN ("default-toplevel-value", Fdefault_toplevel_value
, Sdefault_toplevel_value
, 1, 1, 0,
685 doc
: /* Return SYMBOL's toplevel default value.
686 "Toplevel" means outside of any let binding. */)
689 union specbinding
*binding
= default_toplevel_binding (symbol
);
691 = binding
? specpdl_old_value (binding
) : Fdefault_value (symbol
);
692 if (!EQ (value
, Qunbound
))
694 xsignal1 (Qvoid_variable
, symbol
);
697 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value
,
698 Sset_default_toplevel_value
, 2, 2, 0,
699 doc
: /* Set SYMBOL's toplevel default value to VALUE.
700 "Toplevel" means outside of any let binding. */)
701 (Lisp_Object symbol
, Lisp_Object value
)
703 union specbinding
*binding
= default_toplevel_binding (symbol
);
705 set_specpdl_old_value (binding
, value
);
707 Fset_default (symbol
, value
);
711 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
712 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
713 You are not required to define a variable in order to use it, but
714 defining it lets you supply an initial value and documentation, which
715 can be referred to by the Emacs help facilities and other programming
716 tools. The `defvar' form also declares the variable as \"special\",
717 so that it is always dynamically bound even if `lexical-binding' is t.
719 The optional argument INITVALUE is evaluated, and used to set SYMBOL,
720 only if SYMBOL's value is void. If SYMBOL is buffer-local, its
721 default value is what is set; buffer-local values are not affected.
722 If INITVALUE is missing, SYMBOL's value is not set.
724 If SYMBOL has a local binding, then this form affects the local
725 binding. This is usually not what you want. Thus, if you need to
726 load a file defining variables, with this form or with `defconst' or
727 `defcustom', you should always load that file _outside_ any bindings
728 for these variables. \(`defconst' and `defcustom' behave similarly in
731 The optional argument DOCSTRING is a documentation string for the
734 To define a user option, use `defcustom' instead of `defvar'.
735 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
738 Lisp_Object sym
, tem
, tail
;
745 if (CONSP (XCDR (tail
)) && CONSP (XCDR (XCDR (tail
))))
746 error ("Too many arguments");
748 tem
= Fdefault_boundp (sym
);
750 /* Do it before evaluating the initial value, for self-references. */
751 XSYMBOL (sym
)->declared_special
= 1;
754 Fset_default (sym
, eval_sub (XCAR (tail
)));
756 { /* Check if there is really a global binding rather than just a let
757 binding that shadows the global unboundness of the var. */
758 union specbinding
*binding
= default_toplevel_binding (sym
);
759 if (binding
&& EQ (specpdl_old_value (binding
), Qunbound
))
761 set_specpdl_old_value (binding
, eval_sub (XCAR (tail
)));
768 if (!NILP (Vpurify_flag
))
769 tem
= Fpurecopy (tem
);
770 Fput (sym
, Qvariable_documentation
, tem
);
772 LOADHIST_ATTACH (sym
);
774 else if (!NILP (Vinternal_interpreter_environment
)
775 && !XSYMBOL (sym
)->declared_special
)
776 /* A simple (defvar foo) with lexical scoping does "nothing" except
777 declare that var to be dynamically scoped *locally* (i.e. within
778 the current file or let-block). */
779 Vinternal_interpreter_environment
780 = Fcons (sym
, Vinternal_interpreter_environment
);
783 /* Simple (defvar <var>) should not count as a definition at all.
784 It could get in the way of other definitions, and unloading this
785 package could try to make the variable unbound. */
791 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
792 doc
: /* Define SYMBOL as a constant variable.
793 This declares that neither programs nor users should ever change the
794 value. This constancy is not actually enforced by Emacs Lisp, but
795 SYMBOL is marked as a special variable so that it is never lexically
798 The `defconst' form always sets the value of SYMBOL to the result of
799 evalling INITVALUE. If SYMBOL is buffer-local, its default value is
800 what is set; buffer-local values are not affected. If SYMBOL has a
801 local binding, then this form sets the local binding's value.
802 However, you should normally not make local bindings for variables
803 defined with this form.
805 The optional DOCSTRING specifies the variable's documentation string.
806 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
809 Lisp_Object sym
, tem
;
812 if (CONSP (Fcdr (XCDR (XCDR (args
)))))
813 error ("Too many arguments");
815 tem
= eval_sub (Fcar (XCDR (args
)));
816 if (!NILP (Vpurify_flag
))
817 tem
= Fpurecopy (tem
);
818 Fset_default (sym
, tem
);
819 XSYMBOL (sym
)->declared_special
= 1;
820 tem
= Fcar (XCDR (XCDR (args
)));
823 if (!NILP (Vpurify_flag
))
824 tem
= Fpurecopy (tem
);
825 Fput (sym
, Qvariable_documentation
, tem
);
827 Fput (sym
, Qrisky_local_variable
, Qt
);
828 LOADHIST_ATTACH (sym
);
832 /* Make SYMBOL lexically scoped. */
833 DEFUN ("internal-make-var-non-special", Fmake_var_non_special
,
834 Smake_var_non_special
, 1, 1, 0,
835 doc
: /* Internal function. */)
838 CHECK_SYMBOL (symbol
);
839 XSYMBOL (symbol
)->declared_special
= 0;
844 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
845 doc
: /* Bind variables according to VARLIST then eval BODY.
846 The value of the last form in BODY is returned.
847 Each element of VARLIST is a symbol (which is bound to nil)
848 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
849 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
850 usage: (let* VARLIST BODY...) */)
853 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
855 struct gcpro gcpro1
, gcpro2
, gcpro3
;
857 GCPRO3 (args
, elt
, varlist
);
859 lexenv
= Vinternal_interpreter_environment
;
861 varlist
= XCAR (args
);
862 while (CONSP (varlist
))
866 elt
= XCAR (varlist
);
872 else if (! NILP (Fcdr (Fcdr (elt
))))
873 signal_error ("`let' bindings can have only one value-form", elt
);
877 val
= eval_sub (Fcar (Fcdr (elt
)));
880 if (!NILP (lexenv
) && SYMBOLP (var
)
881 && !XSYMBOL (var
)->declared_special
882 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
883 /* Lexically bind VAR by adding it to the interpreter's binding
887 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
888 if (EQ (Vinternal_interpreter_environment
, lexenv
))
889 /* Save the old lexical environment on the specpdl stack,
890 but only for the first lexical binding, since we'll never
891 need to revert to one of the intermediate ones. */
892 specbind (Qinternal_interpreter_environment
, newenv
);
894 Vinternal_interpreter_environment
= newenv
;
899 varlist
= XCDR (varlist
);
902 val
= Fprogn (XCDR (args
));
907 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
908 doc
: /* Bind variables according to VARLIST then eval BODY.
909 The value of the last form in BODY is returned.
910 Each element of VARLIST is a symbol (which is bound to nil)
911 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
912 All the VALUEFORMs are evalled before any symbols are bound.
913 usage: (let VARLIST BODY...) */)
916 Lisp_Object
*temps
, tem
, lexenv
;
917 register Lisp_Object elt
, varlist
;
920 struct gcpro gcpro1
, gcpro2
;
923 varlist
= XCAR (args
);
925 /* Make space to hold the values to give the bound variables. */
926 elt
= Flength (varlist
);
927 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
929 /* Compute the values and store them in `temps'. */
931 GCPRO2 (args
, *temps
);
934 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
937 elt
= XCAR (varlist
);
939 temps
[argnum
++] = Qnil
;
940 else if (! NILP (Fcdr (Fcdr (elt
))))
941 signal_error ("`let' bindings can have only one value-form", elt
);
943 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
944 gcpro2
.nvars
= argnum
;
948 lexenv
= Vinternal_interpreter_environment
;
950 varlist
= XCAR (args
);
951 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
955 elt
= XCAR (varlist
);
956 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
957 tem
= temps
[argnum
++];
959 if (!NILP (lexenv
) && SYMBOLP (var
)
960 && !XSYMBOL (var
)->declared_special
961 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
962 /* Lexically bind VAR by adding it to the lexenv alist. */
963 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
965 /* Dynamically bind VAR. */
969 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
970 /* Instantiate a new lexical environment. */
971 specbind (Qinternal_interpreter_environment
, lexenv
);
973 elt
= Fprogn (XCDR (args
));
979 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
980 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
981 The order of execution is thus TEST, BODY, TEST, BODY and so on
982 until TEST returns nil.
983 usage: (while TEST BODY...) */)
986 Lisp_Object test
, body
;
987 struct gcpro gcpro1
, gcpro2
;
993 while (!NILP (eval_sub (test
)))
1003 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1004 doc
: /* Return result of expanding macros at top level of FORM.
1005 If FORM is not a macro call, it is returned unchanged.
1006 Otherwise, the macro is expanded and the expansion is considered
1007 in place of FORM. When a non-macro-call results, it is returned.
1009 The second optional arg ENVIRONMENT specifies an environment of macro
1010 definitions to shadow the loaded ones for use in file byte-compilation. */)
1011 (Lisp_Object form
, Lisp_Object environment
)
1013 /* With cleanups from Hallvard Furuseth. */
1014 register Lisp_Object expander
, sym
, def
, tem
;
1018 /* Come back here each time we expand a macro call,
1019 in case it expands into another macro call. */
1022 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1023 def
= sym
= XCAR (form
);
1025 /* Trace symbols aliases to other symbols
1026 until we get a symbol that is not an alias. */
1027 while (SYMBOLP (def
))
1031 tem
= Fassq (sym
, environment
);
1034 def
= XSYMBOL (sym
)->function
;
1040 /* Right now TEM is the result from SYM in ENVIRONMENT,
1041 and if TEM is nil then DEF is SYM's function definition. */
1044 /* SYM is not mentioned in ENVIRONMENT.
1045 Look at its function definition. */
1046 struct gcpro gcpro1
;
1048 def
= Fautoload_do_load (def
, sym
, Qmacro
);
1051 /* Not defined or definition not suitable. */
1053 if (!EQ (XCAR (def
), Qmacro
))
1055 else expander
= XCDR (def
);
1059 expander
= XCDR (tem
);
1060 if (NILP (expander
))
1064 Lisp_Object newform
= apply1 (expander
, XCDR (form
));
1065 if (EQ (form
, newform
))
1074 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1075 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1076 TAG is evalled to get the tag to use; it must not be nil.
1078 Then the BODY is executed.
1079 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1080 If no throw happens, `catch' returns the value of the last BODY form.
1081 If a throw happens, it specifies the value to return from `catch'.
1082 usage: (catch TAG BODY...) */)
1085 register Lisp_Object tag
;
1086 struct gcpro gcpro1
;
1089 tag
= eval_sub (XCAR (args
));
1091 return internal_catch (tag
, Fprogn
, XCDR (args
));
1094 /* Assert that E is true, as a comment only. Use this instead of
1095 eassert (E) when E contains variables that might be clobbered by a
1098 #define clobbered_eassert(E) ((void) 0)
1100 /* Set up a catch, then call C function FUNC on argument ARG.
1101 FUNC should return a Lisp_Object.
1102 This is how catches are done from within C code. */
1105 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1107 /* This structure is made part of the chain `catchlist'. */
1110 /* Fill in the components of c, and put it on the list. */
1111 PUSH_HANDLER (c
, tag
, CATCHER
);
1114 if (! sys_setjmp (c
->jmp
))
1116 Lisp_Object val
= (*func
) (arg
);
1117 clobbered_eassert (handlerlist
== c
);
1118 handlerlist
= handlerlist
->next
;
1122 { /* Throw works by a longjmp that comes right here. */
1123 Lisp_Object val
= handlerlist
->val
;
1124 clobbered_eassert (handlerlist
== c
);
1125 handlerlist
= handlerlist
->next
;
1130 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1131 jump to that CATCH, returning VALUE as the value of that catch.
1133 This is the guts of Fthrow and Fsignal; they differ only in the way
1134 they choose the catch tag to throw to. A catch tag for a
1135 condition-case form has a TAG of Qnil.
1137 Before each catch is discarded, unbind all special bindings and
1138 execute all unwind-protect clauses made above that catch. Unwind
1139 the handler stack as we go, so that the proper handlers are in
1140 effect for each unwind-protect clause we run. At the end, restore
1141 some static info saved in CATCH, and longjmp to the location
1144 This is used for correct unwinding in Fthrow and Fsignal. */
1146 static Lisp_Object
unbind_to_1 (ptrdiff_t, Lisp_Object
, bool);
1148 static _Noreturn
void
1149 unwind_to_catch (struct handler
*catch, Lisp_Object value
)
1153 eassert (catch->next
);
1155 /* Save the value in the tag. */
1158 /* Restore certain special C variables. */
1159 set_poll_suppress_count (catch->poll_suppress_count
);
1160 unblock_input_to (catch->interrupt_input_blocked
);
1165 /* Unwind the specpdl stack, and then restore the proper set of
1167 unbind_to_1 (handlerlist
->pdlcount
, Qnil
, false);
1168 last_time
= handlerlist
== catch;
1170 handlerlist
= handlerlist
->next
;
1172 while (! last_time
);
1174 eassert (handlerlist
== catch);
1176 gcprolist
= catch->gcpro
;
1178 gcpro_level
= gcprolist
? gcprolist
->level
+ 1 : 0;
1180 lisp_eval_depth
= catch->lisp_eval_depth
;
1182 sys_longjmp (catch->jmp
, 1);
1185 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1186 doc
: /* Throw to the catch for TAG and return VALUE from it.
1187 Both TAG and VALUE are evalled. */)
1188 (register Lisp_Object tag
, Lisp_Object value
)
1193 for (c
= handlerlist
; c
; c
= c
->next
)
1195 if (c
->type
== CATCHER
&& EQ (c
->tag_or_ch
, tag
))
1196 unwind_to_catch (c
, value
);
1198 xsignal2 (Qno_catch
, tag
, value
);
1202 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1203 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1204 If BODYFORM completes normally, its value is returned
1205 after executing the UNWINDFORMS.
1206 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1207 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1213 record_unwind_protect (unwind_body
, XCDR (args
));
1214 val
= eval_sub (XCAR (args
));
1219 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1220 doc
: /* Regain control when an error is signaled.
1221 Executes BODYFORM and returns its value if no error happens.
1222 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1223 where the BODY is made of Lisp expressions.
1225 A handler is applicable to an error
1226 if CONDITION-NAME is one of the error's condition names.
1227 If an error happens, the first applicable handler is run.
1229 The car of a handler may be a list of condition names instead of a
1230 single condition name; then it handles all of them. If the special
1231 condition name `debug' is present in this list, it allows another
1232 condition in the list to run the debugger if `debug-on-error' and the
1233 other usual mechanisms says it should (otherwise, `condition-case'
1234 suppresses the debugger).
1236 When a handler handles an error, control returns to the `condition-case'
1237 and it executes the handler's BODY...
1238 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1239 \(If VAR is nil, the handler can't access that information.)
1240 Then the value of the last BODY form is returned from the `condition-case'
1243 See also the function `signal' for more info.
1244 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1247 Lisp_Object var
= XCAR (args
);
1248 Lisp_Object bodyform
= XCAR (XCDR (args
));
1249 Lisp_Object handlers
= XCDR (XCDR (args
));
1251 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1254 /* Like Fcondition_case, but the args are separate
1255 rather than passed in a list. Used by Fbyte_code. */
1258 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1259 Lisp_Object handlers
)
1263 struct handler
*oldhandlerlist
= handlerlist
;
1268 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1270 Lisp_Object tem
= XCAR (val
);
1274 && (SYMBOLP (XCAR (tem
))
1275 || CONSP (XCAR (tem
))))))
1276 error ("Invalid condition handler: %s",
1277 SDATA (Fprin1_to_string (tem
, Qt
)));
1280 { /* The first clause is the one that should be checked first, so it should
1281 be added to handlerlist last. So we build in `clauses' a table that
1282 contains `handlers' but in reverse order. */
1283 Lisp_Object
*clauses
= alloca (clausenb
* sizeof (Lisp_Object
*));
1284 Lisp_Object
*volatile clauses_volatile
= clauses
;
1286 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1287 clauses
[--i
] = XCAR (val
);
1288 for (i
= 0; i
< clausenb
; i
++)
1290 Lisp_Object clause
= clauses
[i
];
1291 Lisp_Object condition
= XCAR (clause
);
1292 if (!CONSP (condition
))
1293 condition
= Fcons (condition
, Qnil
);
1294 PUSH_HANDLER (c
, condition
, CONDITION_CASE
);
1295 if (sys_setjmp (c
->jmp
))
1297 ptrdiff_t count
= SPECPDL_INDEX ();
1298 Lisp_Object val
= handlerlist
->val
;
1299 Lisp_Object
*chosen_clause
= clauses_volatile
;
1300 for (c
= handlerlist
->next
; c
!= oldhandlerlist
; c
= c
->next
)
1302 handlerlist
= oldhandlerlist
;
1305 if (!NILP (Vinternal_interpreter_environment
))
1306 specbind (Qinternal_interpreter_environment
,
1307 Fcons (Fcons (var
, val
),
1308 Vinternal_interpreter_environment
));
1310 specbind (var
, val
);
1312 val
= Fprogn (XCDR (*chosen_clause
));
1313 /* Note that this just undoes the binding of var; whoever
1314 longjumped to us unwound the stack to c.pdlcount before
1317 unbind_to (count
, Qnil
);
1323 val
= eval_sub (bodyform
);
1324 handlerlist
= oldhandlerlist
;
1328 /* Call the function BFUN with no arguments, catching errors within it
1329 according to HANDLERS. If there is an error, call HFUN with
1330 one argument which is the data that describes the error:
1333 HANDLERS can be a list of conditions to catch.
1334 If HANDLERS is Qt, catch all errors.
1335 If HANDLERS is Qerror, catch all errors
1336 but allow the debugger to run if that is enabled. */
1339 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1340 Lisp_Object (*hfun
) (Lisp_Object
))
1345 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1346 if (sys_setjmp (c
->jmp
))
1348 Lisp_Object val
= handlerlist
->val
;
1349 clobbered_eassert (handlerlist
== c
);
1350 handlerlist
= handlerlist
->next
;
1351 return (*hfun
) (val
);
1355 clobbered_eassert (handlerlist
== c
);
1356 handlerlist
= handlerlist
->next
;
1360 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1363 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1364 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1369 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1370 if (sys_setjmp (c
->jmp
))
1372 Lisp_Object val
= handlerlist
->val
;
1373 clobbered_eassert (handlerlist
== c
);
1374 handlerlist
= handlerlist
->next
;
1375 return (*hfun
) (val
);
1378 val
= (*bfun
) (arg
);
1379 clobbered_eassert (handlerlist
== c
);
1380 handlerlist
= handlerlist
->next
;
1384 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1388 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1391 Lisp_Object handlers
,
1392 Lisp_Object (*hfun
) (Lisp_Object
))
1397 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1398 if (sys_setjmp (c
->jmp
))
1400 Lisp_Object val
= handlerlist
->val
;
1401 clobbered_eassert (handlerlist
== c
);
1402 handlerlist
= handlerlist
->next
;
1403 return (*hfun
) (val
);
1406 val
= (*bfun
) (arg1
, arg2
);
1407 clobbered_eassert (handlerlist
== c
);
1408 handlerlist
= handlerlist
->next
;
1412 /* Like internal_condition_case but call BFUN with NARGS as first,
1413 and ARGS as second argument. */
1416 internal_condition_case_n (Lisp_Object (*bfun
) (ptrdiff_t, Lisp_Object
*),
1419 Lisp_Object handlers
,
1420 Lisp_Object (*hfun
) (Lisp_Object err
,
1427 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1428 if (sys_setjmp (c
->jmp
))
1430 Lisp_Object val
= handlerlist
->val
;
1431 clobbered_eassert (handlerlist
== c
);
1432 handlerlist
= handlerlist
->next
;
1433 return (*hfun
) (val
, nargs
, args
);
1436 val
= (*bfun
) (nargs
, args
);
1437 clobbered_eassert (handlerlist
== c
);
1438 handlerlist
= handlerlist
->next
;
1443 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
);
1444 static bool maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1448 process_quit_flag (void)
1450 Lisp_Object flag
= Vquit_flag
;
1452 if (EQ (flag
, Qkill_emacs
))
1454 if (EQ (Vthrow_on_input
, flag
))
1455 Fthrow (Vthrow_on_input
, Qt
);
1456 Fsignal (Qquit
, Qnil
);
1459 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1460 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1461 This function does not return.
1463 An error symbol is a symbol with an `error-conditions' property
1464 that is a list of condition names.
1465 A handler for any of those names will get to handle this signal.
1466 The symbol `error' should normally be one of them.
1468 DATA should be a list. Its elements are printed as part of the error message.
1469 See Info anchor `(elisp)Definition of signal' for some details on how this
1470 error message is constructed.
1471 If the signal is handled, DATA is made available to the handler.
1472 See also the function `condition-case'. */)
1473 (Lisp_Object error_symbol
, Lisp_Object data
)
1475 /* When memory is full, ERROR-SYMBOL is nil,
1476 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1477 That is a special case--don't do this in other situations. */
1478 Lisp_Object conditions
;
1480 Lisp_Object real_error_symbol
1481 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1482 register Lisp_Object clause
= Qnil
;
1486 if (waiting_for_input
)
1489 #if 0 /* rms: I don't know why this was here,
1490 but it is surely wrong for an error that is handled. */
1491 #ifdef HAVE_WINDOW_SYSTEM
1492 if (display_hourglass_p
)
1493 cancel_hourglass ();
1497 /* This hook is used by edebug. */
1498 if (! NILP (Vsignal_hook_function
)
1499 && ! NILP (error_symbol
))
1501 /* Edebug takes care of restoring these variables when it exits. */
1502 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1503 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1505 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1506 max_specpdl_size
= SPECPDL_INDEX () + 40;
1508 call2 (Vsignal_hook_function
, error_symbol
, data
);
1511 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1513 /* Remember from where signal was called. Skip over the frame for
1514 `signal' itself. If a frame for `error' follows, skip that,
1515 too. Don't do this when ERROR_SYMBOL is nil, because that
1516 is a memory-full error. */
1517 Vsignaling_function
= Qnil
;
1518 if (!NILP (error_symbol
))
1520 union specbinding
*pdl
= backtrace_next (backtrace_top ());
1521 if (backtrace_p (pdl
) && EQ (backtrace_function (pdl
), Qerror
))
1522 pdl
= backtrace_next (pdl
);
1523 if (backtrace_p (pdl
))
1524 Vsignaling_function
= backtrace_function (pdl
);
1527 for (h
= handlerlist
; h
; h
= h
->next
)
1529 if (h
->type
!= CONDITION_CASE
)
1531 clause
= find_handler_clause (h
->tag_or_ch
, conditions
);
1536 if (/* Don't run the debugger for a memory-full error.
1537 (There is no room in memory to do that!) */
1538 !NILP (error_symbol
)
1539 && (!NILP (Vdebug_on_signal
)
1540 /* If no handler is present now, try to run the debugger. */
1542 /* A `debug' symbol in the handler list disables the normal
1543 suppression of the debugger. */
1544 || (CONSP (clause
) && CONSP (clause
)
1545 && !NILP (Fmemq (Qdebug
, clause
)))
1546 /* Special handler that means "print a message and run debugger
1548 || EQ (h
->tag_or_ch
, Qerror
)))
1550 bool debugger_called
1551 = maybe_call_debugger (conditions
, error_symbol
, data
);
1552 /* We can't return values to code which signaled an error, but we
1553 can continue code which has signaled a quit. */
1554 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1560 Lisp_Object unwind_data
1561 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1563 unwind_to_catch (h
, unwind_data
);
1567 if (handlerlist
!= &handlerlist_sentinel
)
1568 /* FIXME: This will come right back here if there's no `top-level'
1569 catcher. A better solution would be to abort here, and instead
1570 add a catch-all condition handler so we never come here. */
1571 Fthrow (Qtop_level
, Qt
);
1574 if (! NILP (error_symbol
))
1575 data
= Fcons (error_symbol
, data
);
1577 string
= Ferror_message_string (data
);
1578 fatal ("%s", SDATA (string
));
1581 /* Internal version of Fsignal that never returns.
1582 Used for anything but Qquit (which can return from Fsignal). */
1585 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1587 Fsignal (error_symbol
, data
);
1591 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1594 xsignal0 (Lisp_Object error_symbol
)
1596 xsignal (error_symbol
, Qnil
);
1600 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1602 xsignal (error_symbol
, list1 (arg
));
1606 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1608 xsignal (error_symbol
, list2 (arg1
, arg2
));
1612 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1614 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1617 /* Signal `error' with message S, and additional arg ARG.
1618 If ARG is not a genuine list, make it a one-element list. */
1621 signal_error (const char *s
, Lisp_Object arg
)
1623 Lisp_Object tortoise
, hare
;
1625 hare
= tortoise
= arg
;
1626 while (CONSP (hare
))
1633 tortoise
= XCDR (tortoise
);
1635 if (EQ (hare
, tortoise
))
1642 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1646 /* Return true if LIST is a non-nil atom or
1647 a list containing one of CONDITIONS. */
1650 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1657 while (CONSP (conditions
))
1659 Lisp_Object
this, tail
;
1660 this = XCAR (conditions
);
1661 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1662 if (EQ (XCAR (tail
), this))
1664 conditions
= XCDR (conditions
);
1669 /* Return true if an error with condition-symbols CONDITIONS,
1670 and described by SIGNAL-DATA, should skip the debugger
1671 according to debugger-ignored-errors. */
1674 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1677 bool first_string
= 1;
1678 Lisp_Object error_message
;
1680 error_message
= Qnil
;
1681 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1683 if (STRINGP (XCAR (tail
)))
1687 error_message
= Ferror_message_string (data
);
1691 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1696 Lisp_Object contail
;
1698 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1699 if (EQ (XCAR (tail
), XCAR (contail
)))
1707 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1708 SIG and DATA describe the signal. There are two ways to pass them:
1709 = SIG is the error symbol, and DATA is the rest of the data.
1710 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1711 This is for memory-full errors only. */
1713 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1715 Lisp_Object combined_data
;
1717 combined_data
= Fcons (sig
, data
);
1720 /* Don't try to run the debugger with interrupts blocked.
1721 The editing loop would return anyway. */
1722 ! input_blocked_p ()
1723 && NILP (Vinhibit_debugger
)
1724 /* Does user want to enter debugger for this kind of error? */
1727 : wants_debugger (Vdebug_on_error
, conditions
))
1728 && ! skip_debugger (conditions
, combined_data
)
1729 /* RMS: What's this for? */
1730 && when_entered_debugger
< num_nonmacro_input_events
)
1732 call_debugger (list2 (Qerror
, combined_data
));
1740 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
)
1742 register Lisp_Object h
;
1744 /* t is used by handlers for all conditions, set up by C code. */
1745 if (EQ (handlers
, Qt
))
1748 /* error is used similarly, but means print an error message
1749 and run the debugger if that is enabled. */
1750 if (EQ (handlers
, Qerror
))
1753 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1755 Lisp_Object handler
= XCAR (h
);
1756 if (!NILP (Fmemq (handler
, conditions
)))
1764 /* Dump an error message; called like vprintf. */
1766 verror (const char *m
, va_list ap
)
1769 ptrdiff_t size
= sizeof buf
;
1770 ptrdiff_t size_max
= STRING_BYTES_BOUND
+ 1;
1775 used
= evxprintf (&buffer
, &size
, buf
, size_max
, m
, ap
);
1776 string
= make_string (buffer
, used
);
1780 xsignal1 (Qerror
, string
);
1784 /* Dump an error message; called like printf. */
1788 error (const char *m
, ...)
1795 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1796 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1797 This means it contains a description for how to read arguments to give it.
1798 The value is nil for an invalid function or a symbol with no function
1801 Interactively callable functions include strings and vectors (treated
1802 as keyboard macros), lambda-expressions that contain a top-level call
1803 to `interactive', autoload definitions made by `autoload' with non-nil
1804 fourth argument, and some of the built-in functions of Lisp.
1806 Also, a symbol satisfies `commandp' if its function definition does so.
1808 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1809 then strings and vectors are not accepted. */)
1810 (Lisp_Object function
, Lisp_Object for_call_interactively
)
1812 register Lisp_Object fun
;
1813 register Lisp_Object funcar
;
1814 Lisp_Object if_prop
= Qnil
;
1818 fun
= indirect_function (fun
); /* Check cycles. */
1822 /* Check an `interactive-form' property if present, analogous to the
1823 function-documentation property. */
1825 while (SYMBOLP (fun
))
1827 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
1830 fun
= Fsymbol_function (fun
);
1833 /* Emacs primitives are interactive if their DEFUN specifies an
1834 interactive spec. */
1836 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
1838 /* Bytecode objects are interactive if they are long enough to
1839 have an element whose index is COMPILED_INTERACTIVE, which is
1840 where the interactive spec is stored. */
1841 else if (COMPILEDP (fun
))
1842 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1845 /* Strings and vectors are keyboard macros. */
1846 if (STRINGP (fun
) || VECTORP (fun
))
1847 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
1849 /* Lists may represent commands. */
1852 funcar
= XCAR (fun
);
1853 if (EQ (funcar
, Qclosure
))
1854 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
1856 else if (EQ (funcar
, Qlambda
))
1857 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
1858 else if (EQ (funcar
, Qautoload
))
1859 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
1864 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1865 doc
: /* Define FUNCTION to autoload from FILE.
1866 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1867 Third arg DOCSTRING is documentation for the function.
1868 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1869 Fifth arg TYPE indicates the type of the object:
1870 nil or omitted says FUNCTION is a function,
1871 `keymap' says FUNCTION is really a keymap, and
1872 `macro' or t says FUNCTION is really a macro.
1873 Third through fifth args give info about the real definition.
1874 They default to nil.
1875 If FUNCTION is already defined other than as an autoload,
1876 this does nothing and returns nil. */)
1877 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
1879 CHECK_SYMBOL (function
);
1880 CHECK_STRING (file
);
1882 /* If function is defined and not as an autoload, don't override. */
1883 if (!NILP (XSYMBOL (function
)->function
)
1884 && !AUTOLOADP (XSYMBOL (function
)->function
))
1887 return Fdefalias (function
,
1888 list5 (Qautoload
, file
, docstring
, interactive
, type
),
1893 un_autoload (Lisp_Object oldqueue
)
1895 Lisp_Object queue
, first
, second
;
1897 /* Queue to unwind is current value of Vautoload_queue.
1898 oldqueue is the shadowed value to leave in Vautoload_queue. */
1899 queue
= Vautoload_queue
;
1900 Vautoload_queue
= oldqueue
;
1901 while (CONSP (queue
))
1903 first
= XCAR (queue
);
1904 second
= Fcdr (first
);
1905 first
= Fcar (first
);
1906 if (EQ (first
, make_number (0)))
1909 Ffset (first
, second
);
1910 queue
= XCDR (queue
);
1914 /* Load an autoloaded function.
1915 FUNNAME is the symbol which is the function's name.
1916 FUNDEF is the autoload definition (a list). */
1918 DEFUN ("autoload-do-load", Fautoload_do_load
, Sautoload_do_load
, 1, 3, 0,
1919 doc
: /* Load FUNDEF which should be an autoload.
1920 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1921 in which case the function returns the new autoloaded function value.
1922 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1923 it is defines a macro. */)
1924 (Lisp_Object fundef
, Lisp_Object funname
, Lisp_Object macro_only
)
1927 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1929 if (!CONSP (fundef
) || !EQ (Qautoload
, XCAR (fundef
))) {
1934 if (EQ (macro_only
, Qmacro
))
1936 Lisp_Object kind
= Fnth (make_number (4), fundef
);
1937 if (! (EQ (kind
, Qt
) || EQ (kind
, Qmacro
))) {
1943 /* This is to make sure that loadup.el gives a clear picture
1944 of what files are preloaded and when. */
1945 if (! NILP (Vpurify_flag
))
1946 error ("Attempt to autoload %s while preparing to dump",
1947 SDATA (SYMBOL_NAME (funname
)));
1949 CHECK_SYMBOL (funname
);
1950 GCPRO3 (funname
, fundef
, macro_only
);
1952 /* Preserve the match data. */
1953 record_unwind_save_match_data ();
1955 /* If autoloading gets an error (which includes the error of failing
1956 to define the function being called), we use Vautoload_queue
1957 to undo function definitions and `provide' calls made by
1958 the function. We do this in the specific case of autoloading
1959 because autoloading is not an explicit request "load this file",
1960 but rather a request to "call this function".
1962 The value saved here is to be restored into Vautoload_queue. */
1963 record_unwind_protect (un_autoload
, Vautoload_queue
);
1964 Vautoload_queue
= Qt
;
1965 /* If `macro_only', assume this autoload to be a "best-effort",
1966 so don't signal an error if autoloading fails. */
1967 Fload (Fcar (Fcdr (fundef
)), macro_only
, Qt
, Qnil
, Qt
);
1969 /* Once loading finishes, don't undo it. */
1970 Vautoload_queue
= Qt
;
1979 Lisp_Object fun
= Findirect_function (funname
, Qnil
);
1981 if (!NILP (Fequal (fun
, fundef
)))
1982 error ("Autoloading failed to define function %s",
1983 SDATA (SYMBOL_NAME (funname
)));
1990 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
1991 doc
: /* Evaluate FORM and return its value.
1992 If LEXICAL is t, evaluate using lexical scoping.
1993 LEXICAL can also be an actual lexical environment, in the form of an
1994 alist mapping symbols to their value. */)
1995 (Lisp_Object form
, Lisp_Object lexical
)
1998 specbind (Qinternal_interpreter_environment
,
1999 CONSP (lexical
) || NILP (lexical
) ? lexical
: list1 (Qt
));
2000 Lisp_Object tem0
= eval_sub (form
);
2005 /* Grow the specpdl stack by one entry.
2006 The caller should have already initialized the entry.
2007 Signal an error on stack overflow.
2009 Make sure that there is always one unused entry past the top of the
2010 stack, so that the just-initialized entry is safely unwound if
2011 memory exhausted and an error is signaled here. Also, allocate a
2012 never-used entry just before the bottom of the stack; sometimes its
2013 address is taken. */
2020 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2022 ptrdiff_t count
= SPECPDL_INDEX ();
2023 ptrdiff_t max_size
= min (max_specpdl_size
, PTRDIFF_MAX
- 1000);
2024 union specbinding
*pdlvec
= specpdl
- 1;
2025 ptrdiff_t pdlvecsize
= specpdl_size
+ 1;
2026 if (max_size
<= specpdl_size
)
2028 if (max_specpdl_size
< 400)
2029 max_size
= max_specpdl_size
= 400;
2030 if (max_size
<= specpdl_size
)
2031 signal_error ("Variable binding depth exceeds max-specpdl-size",
2034 pdlvec
= xpalloc (pdlvec
, &pdlvecsize
, 1, max_size
+ 1, sizeof *specpdl
);
2035 specpdl
= pdlvec
+ 1;
2036 specpdl_size
= pdlvecsize
- 1;
2037 specpdl_ptr
= specpdl
+ count
;
2042 record_in_backtrace (Lisp_Object function
, Lisp_Object
*args
, ptrdiff_t nargs
)
2044 eassert (nargs
>= UNEVALLED
);
2045 specpdl_ptr
->bt
.kind
= SPECPDL_BACKTRACE
;
2046 specpdl_ptr
->bt
.debug_on_exit
= false;
2047 specpdl_ptr
->bt
.function
= function
;
2048 specpdl_ptr
->bt
.args
= args
;
2049 specpdl_ptr
->bt
.nargs
= nargs
;
2053 /* Eval a sub-expression of the current expression (i.e. in the same
2056 eval_sub (Lisp_Object form
)
2058 Lisp_Object fun
, val
, original_fun
, original_args
;
2060 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2064 /* Look up its binding in the lexical environment.
2065 We do not pay attention to the declared_special flag here, since we
2066 already did that when let-binding the variable. */
2067 Lisp_Object lex_binding
2068 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2069 ? Fassq (form
, Vinternal_interpreter_environment
)
2071 if (CONSP (lex_binding
))
2072 return XCDR (lex_binding
);
2074 return Fsymbol_value (form
);
2086 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2088 if (max_lisp_eval_depth
< 100)
2089 max_lisp_eval_depth
= 100;
2090 if (lisp_eval_depth
> max_lisp_eval_depth
)
2091 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2094 original_fun
= XCAR (form
);
2095 original_args
= XCDR (form
);
2097 /* This also protects them from gc. */
2098 record_in_backtrace (original_fun
, &original_args
, UNEVALLED
);
2100 if (debug_on_next_call
)
2101 do_debug_on_call (Qt
);
2103 /* At this point, only original_fun and original_args
2104 have values that will be used below. */
2107 /* Optimize for no indirection. */
2110 fun
= Ffunction (Fcons (fun
, Qnil
));
2111 else if (!NILP (fun
) && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2112 fun
= indirect_function (fun
);
2116 Lisp_Object numargs
;
2117 Lisp_Object argvals
[8];
2118 Lisp_Object args_left
;
2119 register int i
, maxargs
;
2121 args_left
= original_args
;
2122 numargs
= Flength (args_left
);
2124 if (XINT (numargs
) < XSUBR (fun
)->min_args
2125 || (XSUBR (fun
)->max_args
>= 0
2126 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2127 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2129 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2130 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2131 else if (XSUBR (fun
)->max_args
== MANY
)
2133 /* Pass a vector of evaluated arguments. */
2135 ptrdiff_t argnum
= 0;
2138 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2140 GCPRO3 (args_left
, fun
, fun
);
2144 while (!NILP (args_left
))
2146 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2147 args_left
= Fcdr (args_left
);
2148 gcpro3
.nvars
= argnum
;
2151 set_backtrace_args (specpdl_ptr
- 1, vals
);
2152 set_backtrace_nargs (specpdl_ptr
- 1, XINT (numargs
));
2154 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2160 GCPRO3 (args_left
, fun
, fun
);
2161 gcpro3
.var
= argvals
;
2164 maxargs
= XSUBR (fun
)->max_args
;
2165 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2167 argvals
[i
] = eval_sub (Fcar (args_left
));
2173 set_backtrace_args (specpdl_ptr
- 1, argvals
);
2174 set_backtrace_nargs (specpdl_ptr
- 1, XINT (numargs
));
2179 val
= (XSUBR (fun
)->function
.a0 ());
2182 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2185 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2188 val
= (XSUBR (fun
)->function
.a3
2189 (argvals
[0], argvals
[1], argvals
[2]));
2192 val
= (XSUBR (fun
)->function
.a4
2193 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2196 val
= (XSUBR (fun
)->function
.a5
2197 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2201 val
= (XSUBR (fun
)->function
.a6
2202 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2203 argvals
[4], argvals
[5]));
2206 val
= (XSUBR (fun
)->function
.a7
2207 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2208 argvals
[4], argvals
[5], argvals
[6]));
2212 val
= (XSUBR (fun
)->function
.a8
2213 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2214 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2218 /* Someone has created a subr that takes more arguments than
2219 is supported by this code. We need to either rewrite the
2220 subr to use a different argument protocol, or add more
2221 cases to this switch. */
2226 else if (COMPILEDP (fun
))
2227 val
= apply_lambda (fun
, original_args
);
2231 xsignal1 (Qvoid_function
, original_fun
);
2233 xsignal1 (Qinvalid_function
, original_fun
);
2234 funcar
= XCAR (fun
);
2235 if (!SYMBOLP (funcar
))
2236 xsignal1 (Qinvalid_function
, original_fun
);
2237 if (EQ (funcar
, Qautoload
))
2239 Fautoload_do_load (fun
, original_fun
, Qnil
);
2242 if (EQ (funcar
, Qmacro
))
2246 /* Bind lexical-binding during expansion of the macro, so the
2247 macro can know reliably if the code it outputs will be
2248 interpreted using lexical-binding or not. */
2249 specbind (Qlexical_binding
,
2250 NILP (Vinternal_interpreter_environment
) ? Qnil
: Qt
);
2251 exp
= apply1 (Fcdr (fun
), original_args
);
2253 val
= eval_sub (exp
);
2255 else if (EQ (funcar
, Qlambda
)
2256 || EQ (funcar
, Qclosure
))
2257 val
= apply_lambda (fun
, original_args
);
2259 xsignal1 (Qinvalid_function
, original_fun
);
2263 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2264 val
= call_debugger (list2 (Qexit
, val
));
2270 DEFUN ("apply", Fapply
, Sapply
, 1, MANY
, 0,
2271 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2272 Then return the value FUNCTION returns.
2273 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2274 usage: (apply FUNCTION &rest ARGUMENTS) */)
2275 (ptrdiff_t nargs
, Lisp_Object
*args
)
2279 register Lisp_Object spread_arg
;
2280 register Lisp_Object
*funcall_args
;
2281 Lisp_Object fun
, retval
;
2282 struct gcpro gcpro1
;
2287 spread_arg
= args
[nargs
- 1];
2288 CHECK_LIST (spread_arg
);
2290 numargs
= XINT (Flength (spread_arg
));
2293 return Ffuncall (nargs
- 1, args
);
2294 else if (numargs
== 1)
2296 args
[nargs
- 1] = XCAR (spread_arg
);
2297 return Ffuncall (nargs
, args
);
2300 numargs
+= nargs
- 2;
2302 /* Optimize for no indirection. */
2303 if (SYMBOLP (fun
) && !NILP (fun
)
2304 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2305 fun
= indirect_function (fun
);
2308 /* Let funcall get the error. */
2315 if (numargs
< XSUBR (fun
)->min_args
2316 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2317 goto funcall
; /* Let funcall get the error. */
2318 else if (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
> numargs
)
2320 /* Avoid making funcall cons up a yet another new vector of arguments
2321 by explicitly supplying nil's for optional values. */
2322 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2323 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2324 funcall_args
[++i
] = Qnil
;
2325 GCPRO1 (*funcall_args
);
2326 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2330 /* We add 1 to numargs because funcall_args includes the
2331 function itself as well as its arguments. */
2334 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2335 GCPRO1 (*funcall_args
);
2336 gcpro1
.nvars
= 1 + numargs
;
2339 memcpy (funcall_args
, args
, nargs
* word_size
);
2340 /* Spread the last arg we got. Its first element goes in
2341 the slot that it used to occupy, hence this value of I. */
2343 while (!NILP (spread_arg
))
2345 funcall_args
[i
++] = XCAR (spread_arg
);
2346 spread_arg
= XCDR (spread_arg
);
2349 /* By convention, the caller needs to gcpro Ffuncall's args. */
2350 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
2357 /* Run hook variables in various ways. */
2360 funcall_nil (ptrdiff_t nargs
, Lisp_Object
*args
)
2362 Ffuncall (nargs
, args
);
2366 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2367 doc
: /* Run each hook in HOOKS.
2368 Each argument should be a symbol, a hook variable.
2369 These symbols are processed in the order specified.
2370 If a hook symbol has a non-nil value, that value may be a function
2371 or a list of functions to be called to run the hook.
2372 If the value is a function, it is called with no arguments.
2373 If it is a list, the elements are called, in order, with no arguments.
2375 Major modes should not use this function directly to run their mode
2376 hook; they should use `run-mode-hooks' instead.
2378 Do not use `make-local-variable' to make a hook variable buffer-local.
2379 Instead, use `add-hook' and specify t for the LOCAL argument.
2380 usage: (run-hooks &rest HOOKS) */)
2381 (ptrdiff_t nargs
, Lisp_Object
*args
)
2383 Lisp_Object hook
[1];
2386 for (i
= 0; i
< nargs
; i
++)
2389 run_hook_with_args (1, hook
, funcall_nil
);
2395 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2396 Srun_hook_with_args
, 1, MANY
, 0,
2397 doc
: /* Run HOOK with the specified arguments ARGS.
2398 HOOK should be a symbol, a hook variable. The value of HOOK
2399 may be nil, a function, or a list of functions. Call each
2400 function in order with arguments ARGS. The final return value
2403 Do not use `make-local-variable' to make a hook variable buffer-local.
2404 Instead, use `add-hook' and specify t for the LOCAL argument.
2405 usage: (run-hook-with-args HOOK &rest ARGS) */)
2406 (ptrdiff_t nargs
, Lisp_Object
*args
)
2408 return run_hook_with_args (nargs
, args
, funcall_nil
);
2411 /* NB this one still documents a specific non-nil return value.
2412 (As did run-hook-with-args and run-hook-with-args-until-failure
2413 until they were changed in 24.1.) */
2414 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2415 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2416 doc
: /* Run HOOK with the specified arguments ARGS.
2417 HOOK should be a symbol, a hook variable. The value of HOOK
2418 may be nil, a function, or a list of functions. Call each
2419 function in order with arguments ARGS, stopping at the first
2420 one that returns non-nil, and return that value. Otherwise (if
2421 all functions return nil, or if there are no functions to call),
2424 Do not use `make-local-variable' to make a hook variable buffer-local.
2425 Instead, use `add-hook' and specify t for the LOCAL argument.
2426 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2427 (ptrdiff_t nargs
, Lisp_Object
*args
)
2429 return run_hook_with_args (nargs
, args
, Ffuncall
);
2433 funcall_not (ptrdiff_t nargs
, Lisp_Object
*args
)
2435 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2438 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2439 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2440 doc
: /* Run HOOK with the specified arguments ARGS.
2441 HOOK should be a symbol, a hook variable. The value of HOOK
2442 may be nil, a function, or a list of functions. Call each
2443 function in order with arguments ARGS, stopping at the first
2444 one that returns nil, and return nil. Otherwise (if all functions
2445 return non-nil, or if there are no functions to call), return non-nil
2446 \(do not rely on the precise return value in this case).
2448 Do not use `make-local-variable' to make a hook variable buffer-local.
2449 Instead, use `add-hook' and specify t for the LOCAL argument.
2450 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2451 (ptrdiff_t nargs
, Lisp_Object
*args
)
2453 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2457 run_hook_wrapped_funcall (ptrdiff_t nargs
, Lisp_Object
*args
)
2459 Lisp_Object tmp
= args
[0], ret
;
2462 ret
= Ffuncall (nargs
, args
);
2468 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2469 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2470 I.e. instead of calling each function FUN directly with arguments ARGS,
2471 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2472 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2473 aborts and returns that value.
2474 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2475 (ptrdiff_t nargs
, Lisp_Object
*args
)
2477 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2480 /* ARGS[0] should be a hook symbol.
2481 Call each of the functions in the hook value, passing each of them
2482 as arguments all the rest of ARGS (all NARGS - 1 elements).
2483 FUNCALL specifies how to call each function on the hook.
2484 The caller (or its caller, etc) must gcpro all of ARGS,
2485 except that it isn't necessary to gcpro ARGS[0]. */
2488 run_hook_with_args (ptrdiff_t nargs
, Lisp_Object
*args
,
2489 Lisp_Object (*funcall
) (ptrdiff_t nargs
, Lisp_Object
*args
))
2491 Lisp_Object sym
, val
, ret
= Qnil
;
2492 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2494 /* If we are dying or still initializing,
2495 don't do anything--it would probably crash if we tried. */
2496 if (NILP (Vrun_hooks
))
2500 val
= find_symbol_value (sym
);
2502 if (EQ (val
, Qunbound
) || NILP (val
))
2504 else if (!CONSP (val
) || FUNCTIONP (val
))
2507 return funcall (nargs
, args
);
2511 Lisp_Object global_vals
= Qnil
;
2512 GCPRO3 (sym
, val
, global_vals
);
2515 CONSP (val
) && NILP (ret
);
2518 if (EQ (XCAR (val
), Qt
))
2520 /* t indicates this hook has a local binding;
2521 it means to run the global binding too. */
2522 global_vals
= Fdefault_value (sym
);
2523 if (NILP (global_vals
)) continue;
2525 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2527 args
[0] = global_vals
;
2528 ret
= funcall (nargs
, args
);
2533 CONSP (global_vals
) && NILP (ret
);
2534 global_vals
= XCDR (global_vals
))
2536 args
[0] = XCAR (global_vals
);
2537 /* In a global value, t should not occur. If it does, we
2538 must ignore it to avoid an endless loop. */
2539 if (!EQ (args
[0], Qt
))
2540 ret
= funcall (nargs
, args
);
2546 args
[0] = XCAR (val
);
2547 ret
= funcall (nargs
, args
);
2556 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2559 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2561 Lisp_Object temp
[3];
2566 Frun_hook_with_args (3, temp
);
2569 /* Apply fn to arg. */
2571 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2573 struct gcpro gcpro1
;
2577 return Ffuncall (1, &fn
);
2580 Lisp_Object args
[2];
2584 return Fapply (2, args
);
2588 /* Call function fn on no arguments. */
2590 call0 (Lisp_Object fn
)
2592 struct gcpro gcpro1
;
2595 return Ffuncall (1, &fn
);
2598 /* Call function fn with 1 argument arg1. */
2601 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2603 struct gcpro gcpro1
;
2604 Lisp_Object args
[2];
2610 return Ffuncall (2, args
);
2613 /* Call function fn with 2 arguments arg1, arg2. */
2616 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2618 struct gcpro gcpro1
;
2619 Lisp_Object args
[3];
2625 return Ffuncall (3, args
);
2628 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2631 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2633 struct gcpro gcpro1
;
2634 Lisp_Object args
[4];
2641 return Ffuncall (4, args
);
2644 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2647 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2650 struct gcpro gcpro1
;
2651 Lisp_Object args
[5];
2659 return Ffuncall (5, args
);
2662 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2665 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2666 Lisp_Object arg4
, Lisp_Object arg5
)
2668 struct gcpro gcpro1
;
2669 Lisp_Object args
[6];
2678 return Ffuncall (6, args
);
2681 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2684 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2685 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2687 struct gcpro gcpro1
;
2688 Lisp_Object args
[7];
2698 return Ffuncall (7, args
);
2701 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2704 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2705 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2707 struct gcpro gcpro1
;
2708 Lisp_Object args
[8];
2719 return Ffuncall (8, args
);
2722 /* The caller should GCPRO all the elements of ARGS. */
2724 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2725 doc
: /* Non-nil if OBJECT is a function. */)
2726 (Lisp_Object object
)
2728 if (FUNCTIONP (object
))
2733 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2734 doc
: /* Call first argument as a function, passing remaining arguments to it.
2735 Return the value that function returns.
2736 Thus, (funcall 'cons 'x 'y) returns (x . y).
2737 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2738 (ptrdiff_t nargs
, Lisp_Object
*args
)
2740 Lisp_Object fun
, original_fun
;
2742 ptrdiff_t numargs
= nargs
- 1;
2743 Lisp_Object lisp_numargs
;
2745 register Lisp_Object
*internal_args
;
2750 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2752 if (max_lisp_eval_depth
< 100)
2753 max_lisp_eval_depth
= 100;
2754 if (lisp_eval_depth
> max_lisp_eval_depth
)
2755 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2758 /* This also GCPROs them. */
2759 record_in_backtrace (args
[0], &args
[1], nargs
- 1);
2761 /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
2764 if (debug_on_next_call
)
2765 do_debug_on_call (Qlambda
);
2767 original_fun
= args
[0];
2771 /* Optimize for no indirection. */
2773 if (SYMBOLP (fun
) && !NILP (fun
)
2774 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2775 fun
= indirect_function (fun
);
2779 if (numargs
< XSUBR (fun
)->min_args
2780 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2782 XSETFASTINT (lisp_numargs
, numargs
);
2783 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
2786 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2787 xsignal1 (Qinvalid_function
, original_fun
);
2789 else if (XSUBR (fun
)->max_args
== MANY
)
2790 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
2793 if (XSUBR (fun
)->max_args
> numargs
)
2795 internal_args
= alloca (XSUBR (fun
)->max_args
2796 * sizeof *internal_args
);
2797 memcpy (internal_args
, args
+ 1, numargs
* word_size
);
2798 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2799 internal_args
[i
] = Qnil
;
2802 internal_args
= args
+ 1;
2803 switch (XSUBR (fun
)->max_args
)
2806 val
= (XSUBR (fun
)->function
.a0 ());
2809 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
2812 val
= (XSUBR (fun
)->function
.a2
2813 (internal_args
[0], internal_args
[1]));
2816 val
= (XSUBR (fun
)->function
.a3
2817 (internal_args
[0], internal_args
[1], internal_args
[2]));
2820 val
= (XSUBR (fun
)->function
.a4
2821 (internal_args
[0], internal_args
[1], internal_args
[2],
2825 val
= (XSUBR (fun
)->function
.a5
2826 (internal_args
[0], internal_args
[1], internal_args
[2],
2827 internal_args
[3], internal_args
[4]));
2830 val
= (XSUBR (fun
)->function
.a6
2831 (internal_args
[0], internal_args
[1], internal_args
[2],
2832 internal_args
[3], internal_args
[4], internal_args
[5]));
2835 val
= (XSUBR (fun
)->function
.a7
2836 (internal_args
[0], internal_args
[1], internal_args
[2],
2837 internal_args
[3], internal_args
[4], internal_args
[5],
2842 val
= (XSUBR (fun
)->function
.a8
2843 (internal_args
[0], internal_args
[1], internal_args
[2],
2844 internal_args
[3], internal_args
[4], internal_args
[5],
2845 internal_args
[6], internal_args
[7]));
2850 /* If a subr takes more than 8 arguments without using MANY
2851 or UNEVALLED, we need to extend this function to support it.
2852 Until this is done, there is no way to call the function. */
2857 else if (COMPILEDP (fun
))
2858 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2862 xsignal1 (Qvoid_function
, original_fun
);
2864 xsignal1 (Qinvalid_function
, original_fun
);
2865 funcar
= XCAR (fun
);
2866 if (!SYMBOLP (funcar
))
2867 xsignal1 (Qinvalid_function
, original_fun
);
2868 if (EQ (funcar
, Qlambda
)
2869 || EQ (funcar
, Qclosure
))
2870 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2871 else if (EQ (funcar
, Qautoload
))
2873 Fautoload_do_load (fun
, original_fun
, Qnil
);
2877 xsignal1 (Qinvalid_function
, original_fun
);
2880 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2881 val
= call_debugger (list2 (Qexit
, val
));
2887 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
2889 Lisp_Object args_left
;
2892 register Lisp_Object
*arg_vector
;
2893 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2894 register Lisp_Object tem
;
2897 numargs
= XFASTINT (Flength (args
));
2898 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
2901 GCPRO3 (*arg_vector
, args_left
, fun
);
2904 for (i
= 0; i
< numargs
; )
2906 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2907 tem
= eval_sub (tem
);
2908 arg_vector
[i
++] = tem
;
2914 set_backtrace_args (specpdl_ptr
- 1, arg_vector
);
2915 set_backtrace_nargs (specpdl_ptr
- 1, i
);
2916 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
2918 /* Do the debug-on-exit now, while arg_vector still exists. */
2919 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2921 /* Don't do it again when we return to eval. */
2922 set_backtrace_debug_on_exit (specpdl_ptr
- 1, false);
2923 tem
= call_debugger (list2 (Qexit
, tem
));
2929 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2930 and return the result of evaluation.
2931 FUN must be either a lambda-expression or a compiled-code object. */
2934 funcall_lambda (Lisp_Object fun
, ptrdiff_t nargs
,
2935 register Lisp_Object
*arg_vector
)
2937 Lisp_Object val
, syms_left
, next
, lexenv
;
2940 bool optional
, rest
;
2944 if (EQ (XCAR (fun
), Qclosure
))
2946 fun
= XCDR (fun
); /* Drop `closure'. */
2947 lexenv
= XCAR (fun
);
2948 CHECK_LIST_CONS (fun
, fun
);
2952 syms_left
= XCDR (fun
);
2953 if (CONSP (syms_left
))
2954 syms_left
= XCAR (syms_left
);
2956 xsignal1 (Qinvalid_function
, fun
);
2958 else if (COMPILEDP (fun
))
2960 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2961 if (INTEGERP (syms_left
))
2962 /* A byte-code object with a non-nil `push args' slot means we
2963 shouldn't bind any arguments, instead just call the byte-code
2964 interpreter directly; it will push arguments as necessary.
2966 Byte-code objects with either a non-existent, or a nil value for
2967 the `push args' slot (the default), have dynamically-bound
2968 arguments, and use the argument-binding code below instead (as do
2969 all interpreted functions, even lexically bound ones). */
2971 /* If we have not actually read the bytecode string
2972 and constants vector yet, fetch them from the file. */
2973 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2974 Ffetch_bytecode (fun
);
2976 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
2977 AREF (fun
, COMPILED_CONSTANTS
),
2978 AREF (fun
, COMPILED_STACK_DEPTH
),
2987 i
= optional
= rest
= 0;
2988 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2992 next
= XCAR (syms_left
);
2993 if (!SYMBOLP (next
))
2994 xsignal1 (Qinvalid_function
, fun
);
2996 if (EQ (next
, Qand_rest
))
2998 else if (EQ (next
, Qand_optional
))
3005 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
3009 arg
= arg_vector
[i
++];
3011 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3015 /* Bind the argument. */
3016 if (!NILP (lexenv
) && SYMBOLP (next
))
3017 /* Lexically bind NEXT by adding it to the lexenv alist. */
3018 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
3020 /* Dynamically bind NEXT. */
3021 specbind (next
, arg
);
3025 if (!NILP (syms_left
))
3026 xsignal1 (Qinvalid_function
, fun
);
3028 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3030 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3031 /* Instantiate a new lexical environment. */
3032 specbind (Qinternal_interpreter_environment
, lexenv
);
3035 val
= Fprogn (XCDR (XCDR (fun
)));
3038 /* If we have not actually read the bytecode string
3039 and constants vector yet, fetch them from the file. */
3040 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3041 Ffetch_bytecode (fun
);
3042 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3043 AREF (fun
, COMPILED_CONSTANTS
),
3044 AREF (fun
, COMPILED_STACK_DEPTH
),
3052 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3054 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3055 (Lisp_Object object
)
3059 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3061 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3064 tem
= AREF (object
, COMPILED_BYTECODE
);
3065 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3066 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3068 error ("Invalid byte code");
3070 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3071 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3076 /* Return true if SYMBOL currently has a let-binding
3077 which was made in the buffer that is now current. */
3080 let_shadows_buffer_binding_p (struct Lisp_Symbol
*symbol
)
3082 union specbinding
*p
;
3083 Lisp_Object buf
= Fcurrent_buffer ();
3085 for (p
= specpdl_ptr
; p
> specpdl
; )
3086 if ((--p
)->kind
> SPECPDL_LET
)
3088 struct Lisp_Symbol
*let_bound_symbol
= XSYMBOL (specpdl_symbol (p
));
3089 eassert (let_bound_symbol
->redirect
!= SYMBOL_VARALIAS
);
3090 if (symbol
== let_bound_symbol
3091 && EQ (specpdl_where (p
), buf
))
3099 let_shadows_global_binding_p (Lisp_Object symbol
)
3101 union specbinding
*p
;
3103 for (p
= specpdl_ptr
; p
> specpdl
; )
3104 if ((--p
)->kind
>= SPECPDL_LET
&& EQ (specpdl_symbol (p
), symbol
))
3110 /* `specpdl_ptr' describes which variable is
3111 let-bound, so it can be properly undone when we unbind_to.
3112 It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
3113 - SYMBOL is the variable being bound. Note that it should not be
3114 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3116 - WHERE tells us in which buffer the binding took place.
3117 This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
3118 buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
3119 i.e. bindings to the default value of a variable which can be
3123 specbind (Lisp_Object symbol
, Lisp_Object value
)
3125 struct Lisp_Symbol
*sym
;
3127 CHECK_SYMBOL (symbol
);
3128 sym
= XSYMBOL (symbol
);
3131 switch (sym
->redirect
)
3133 case SYMBOL_VARALIAS
:
3134 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3135 case SYMBOL_PLAINVAL
:
3136 /* The most common case is that of a non-constant symbol with a
3137 trivial value. Make that as fast as we can. */
3138 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3139 specpdl_ptr
->let
.symbol
= symbol
;
3140 specpdl_ptr
->let
.old_value
= SYMBOL_VAL (sym
);
3143 SET_SYMBOL_VAL (sym
, value
);
3145 set_internal (symbol
, value
, Qnil
, 1);
3147 case SYMBOL_LOCALIZED
:
3148 if (SYMBOL_BLV (sym
)->frame_local
)
3149 error ("Frame-local vars cannot be let-bound");
3150 case SYMBOL_FORWARDED
:
3152 Lisp_Object ovalue
= find_symbol_value (symbol
);
3153 specpdl_ptr
->let
.kind
= SPECPDL_LET_LOCAL
;
3154 specpdl_ptr
->let
.symbol
= symbol
;
3155 specpdl_ptr
->let
.old_value
= ovalue
;
3156 specpdl_ptr
->let
.where
= Fcurrent_buffer ();
3158 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3159 || (EQ (SYMBOL_BLV (sym
)->where
, Fcurrent_buffer ())));
3161 if (sym
->redirect
== SYMBOL_LOCALIZED
)
3163 if (!blv_found (SYMBOL_BLV (sym
)))
3164 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3166 else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3168 /* If SYMBOL is a per-buffer variable which doesn't have a
3169 buffer-local value here, make the `let' change the global
3170 value by changing the value of SYMBOL in all buffers not
3171 having their own value. This is consistent with what
3172 happens with other buffer-local variables. */
3173 if (NILP (Flocal_variable_p (symbol
, Qnil
)))
3175 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3177 Fset_default (symbol
, value
);
3182 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3185 set_internal (symbol
, value
, Qnil
, 1);
3188 default: emacs_abort ();
3192 /* Push unwind-protect entries of various types. */
3195 record_unwind_protect_1 (void (*function
) (Lisp_Object
), Lisp_Object arg
,
3196 bool wind_explicitly
)
3198 specpdl_ptr
->unwind
.kind
= SPECPDL_UNWIND
;
3199 specpdl_ptr
->unwind
.func
= function
;
3200 specpdl_ptr
->unwind
.arg
= arg
;
3201 specpdl_ptr
->unwind
.wind_explicitly
= wind_explicitly
;
3206 record_unwind_protect (void (*function
) (Lisp_Object
), Lisp_Object arg
)
3208 record_unwind_protect_1 (function
, arg
, true);
3212 record_unwind_protect_ptr_1 (void (*function
) (void *), void *arg
,
3213 bool wind_explicitly
)
3215 specpdl_ptr
->unwind_ptr
.kind
= SPECPDL_UNWIND_PTR
;
3216 specpdl_ptr
->unwind_ptr
.func
= function
;
3217 specpdl_ptr
->unwind_ptr
.arg
= arg
;
3218 specpdl_ptr
->unwind_ptr
.wind_explicitly
= wind_explicitly
;
3223 record_unwind_protect_ptr (void (*function
) (void *), void *arg
)
3225 record_unwind_protect_ptr_1 (function
, arg
, true);
3229 record_unwind_protect_int_1 (void (*function
) (int), int arg
,
3230 bool wind_explicitly
)
3232 specpdl_ptr
->unwind_int
.kind
= SPECPDL_UNWIND_INT
;
3233 specpdl_ptr
->unwind_int
.func
= function
;
3234 specpdl_ptr
->unwind_int
.arg
= arg
;
3235 specpdl_ptr
->unwind_int
.wind_explicitly
= wind_explicitly
;
3240 record_unwind_protect_int (void (*function
) (int), int arg
)
3242 record_unwind_protect_int_1 (function
, arg
, true);
3246 record_unwind_protect_void_1 (void (*function
) (void),
3247 bool wind_explicitly
)
3249 specpdl_ptr
->unwind_void
.kind
= SPECPDL_UNWIND_VOID
;
3250 specpdl_ptr
->unwind_void
.func
= function
;
3251 specpdl_ptr
->unwind_void
.wind_explicitly
= wind_explicitly
;
3256 record_unwind_protect_void (void (*function
) (void))
3258 record_unwind_protect_void_1 (function
, true);
3262 unbind_once (bool explicit)
3264 /* Decrement specpdl_ptr before we do the work to unbind it, so
3265 that an error in unbinding won't try to unbind the same entry
3266 again. Take care to copy any parts of the binding needed
3267 before invoking any code that can make more bindings. */
3271 switch (specpdl_ptr
->kind
)
3273 case SPECPDL_UNWIND
:
3274 if (specpdl_ptr
->unwind
.wind_explicitly
|| ! explicit)
3275 specpdl_ptr
->unwind
.func (specpdl_ptr
->unwind
.arg
);
3277 case SPECPDL_UNWIND_PTR
:
3278 if (specpdl_ptr
->unwind_ptr
.wind_explicitly
|| ! explicit)
3279 specpdl_ptr
->unwind_ptr
.func (specpdl_ptr
->unwind_ptr
.arg
);
3281 case SPECPDL_UNWIND_INT
:
3282 if (specpdl_ptr
->unwind_int
.wind_explicitly
|| ! explicit)
3283 specpdl_ptr
->unwind_int
.func (specpdl_ptr
->unwind_int
.arg
);
3285 case SPECPDL_UNWIND_VOID
:
3286 if (specpdl_ptr
->unwind_void
.wind_explicitly
|| ! explicit)
3287 specpdl_ptr
->unwind_void
.func ();
3289 case SPECPDL_BACKTRACE
:
3292 { /* If variable has a trivial value (no forwarding), we can
3293 just set it. No need to check for constant symbols here,
3294 since that was already done by specbind. */
3295 struct Lisp_Symbol
*sym
= XSYMBOL (specpdl_symbol (specpdl_ptr
));
3296 if (sym
->redirect
== SYMBOL_PLAINVAL
)
3298 SET_SYMBOL_VAL (sym
, specpdl_old_value (specpdl_ptr
));
3303 NOTE: we only ever come here if make_local_foo was used for
3304 the first time on this var within this let. */
3307 case SPECPDL_LET_DEFAULT
:
3308 Fset_default (specpdl_symbol (specpdl_ptr
),
3309 specpdl_old_value (specpdl_ptr
));
3311 case SPECPDL_LET_LOCAL
:
3313 Lisp_Object symbol
= specpdl_symbol (specpdl_ptr
);
3314 Lisp_Object where
= specpdl_where (specpdl_ptr
);
3315 Lisp_Object old_value
= specpdl_old_value (specpdl_ptr
);
3316 eassert (BUFFERP (where
));
3318 /* If this was a local binding, reset the value in the appropriate
3319 buffer, but only if that buffer's binding still exists. */
3320 if (!NILP (Flocal_variable_p (symbol
, where
)))
3321 set_internal (symbol
, old_value
, where
, 1);
3328 dynwind_begin (void)
3330 specpdl_ptr
->kind
= SPECPDL_FRAME
;
3337 enum specbind_tag last
;
3338 Lisp_Object quitf
= Vquit_flag
;
3339 union specbinding
*pdl
= specpdl_ptr
;
3345 while (pdl
->kind
!= SPECPDL_FRAME
);
3347 while (specpdl_ptr
!= pdl
)
3354 unbind_to_1 (ptrdiff_t count
, Lisp_Object value
, bool explicit)
3356 Lisp_Object quitf
= Vquit_flag
;
3357 struct gcpro gcpro1
, gcpro2
;
3359 GCPRO2 (value
, quitf
);
3362 while (specpdl_ptr
!= specpdl
+ count
)
3363 unbind_once (explicit);
3365 if (NILP (Vquit_flag
) && !NILP (quitf
))
3373 unbind_to (ptrdiff_t count
, Lisp_Object value
)
3375 return unbind_to_1 (count
, value
, true);
3378 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3379 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3380 A special variable is one that will be bound dynamically, even in a
3381 context where binding is lexical by default. */)
3382 (Lisp_Object symbol
)
3384 CHECK_SYMBOL (symbol
);
3385 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3389 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3390 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3391 The debugger is entered when that frame exits, if the flag is non-nil. */)
3392 (Lisp_Object level
, Lisp_Object flag
)
3394 union specbinding
*pdl
= backtrace_top ();
3395 register EMACS_INT i
;
3397 CHECK_NUMBER (level
);
3399 for (i
= 0; backtrace_p (pdl
) && i
< XINT (level
); i
++)
3400 pdl
= backtrace_next (pdl
);
3402 if (backtrace_p (pdl
))
3403 set_backtrace_debug_on_exit (pdl
, !NILP (flag
));
3408 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3409 doc
: /* Print a trace of Lisp function calls currently active.
3410 Output stream used is value of `standard-output'. */)
3413 union specbinding
*pdl
= backtrace_top ();
3415 Lisp_Object old_print_level
= Vprint_level
;
3417 if (NILP (Vprint_level
))
3418 XSETFASTINT (Vprint_level
, 8);
3420 while (backtrace_p (pdl
))
3422 write_string (backtrace_debug_on_exit (pdl
) ? "* " : " ", 2);
3423 if (backtrace_nargs (pdl
) == UNEVALLED
)
3425 Fprin1 (Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)),
3427 write_string ("\n", -1);
3431 tem
= backtrace_function (pdl
);
3432 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3433 write_string ("(", -1);
3436 for (i
= 0; i
< backtrace_nargs (pdl
); i
++)
3438 if (i
) write_string (" ", -1);
3439 Fprin1 (backtrace_args (pdl
)[i
], Qnil
);
3442 write_string (")\n", -1);
3444 pdl
= backtrace_next (pdl
);
3447 Vprint_level
= old_print_level
;
3451 static union specbinding
*
3452 get_backtrace_frame (Lisp_Object nframes
, Lisp_Object base
)
3454 union specbinding
*pdl
= backtrace_top ();
3455 register EMACS_INT i
;
3457 CHECK_NATNUM (nframes
);
3460 { /* Skip up to `base'. */
3461 base
= Findirect_function (base
, Qt
);
3462 while (backtrace_p (pdl
)
3463 && !EQ (base
, Findirect_function (backtrace_function (pdl
), Qt
)))
3464 pdl
= backtrace_next (pdl
);
3467 /* Find the frame requested. */
3468 for (i
= XFASTINT (nframes
); i
> 0 && backtrace_p (pdl
); i
--)
3469 pdl
= backtrace_next (pdl
);
3474 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 2, NULL
,
3475 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3476 If that frame has not evaluated the arguments yet (or is a special form),
3477 the value is (nil FUNCTION ARG-FORMS...).
3478 If that frame has evaluated its arguments and called its function already,
3479 the value is (t FUNCTION ARG-VALUES...).
3480 A &rest arg is represented as the tail of the list ARG-VALUES.
3481 FUNCTION is whatever was supplied as car of evaluated list,
3482 or a lambda expression for macro calls.
3483 If NFRAMES is more than the number of frames, the value is nil.
3484 If BASE is non-nil, it should be a function and NFRAMES counts from its
3485 nearest activation frame. */)
3486 (Lisp_Object nframes
, Lisp_Object base
)
3488 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3490 if (!backtrace_p (pdl
))
3492 if (backtrace_nargs (pdl
) == UNEVALLED
)
3494 Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)));
3497 Lisp_Object tem
= Flist (backtrace_nargs (pdl
), backtrace_args (pdl
));
3499 return Fcons (Qt
, Fcons (backtrace_function (pdl
), tem
));
3503 /* For backtrace-eval, we want to temporarily unwind the last few elements of
3504 the specpdl stack, and then rewind them. We store the pre-unwind values
3505 directly in the pre-existing specpdl elements (i.e. we swap the current
3506 value and the old value stored in the specpdl), kind of like the inplace
3507 pointer-reversal trick. As it turns out, the rewind does the same as the
3508 unwind, except it starts from the other end of the specpdl stack, so we use
3509 the same function for both unwind and rewind. */
3511 backtrace_eval_unrewind (int distance
)
3513 union specbinding
*tmp
= specpdl_ptr
;
3516 { /* It's a rewind rather than unwind. */
3517 tmp
+= distance
- 1;
3519 distance
= -distance
;
3522 for (; distance
> 0; distance
--)
3528 /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
3529 unwind_protect, but the problem is that we don't know how to
3530 rewind them afterwards. */
3531 case SPECPDL_UNWIND
:
3532 case SPECPDL_UNWIND_PTR
:
3533 case SPECPDL_UNWIND_INT
:
3534 case SPECPDL_UNWIND_VOID
:
3535 case SPECPDL_BACKTRACE
:
3538 { /* If variable has a trivial value (no forwarding), we can
3539 just set it. No need to check for constant symbols here,
3540 since that was already done by specbind. */
3541 struct Lisp_Symbol
*sym
= XSYMBOL (specpdl_symbol (tmp
));
3542 if (sym
->redirect
== SYMBOL_PLAINVAL
)
3544 Lisp_Object old_value
= specpdl_old_value (tmp
);
3545 set_specpdl_old_value (tmp
, SYMBOL_VAL (sym
));
3546 SET_SYMBOL_VAL (sym
, old_value
);
3551 NOTE: we only ever come here if make_local_foo was used for
3552 the first time on this var within this let. */
3555 case SPECPDL_LET_DEFAULT
:
3557 Lisp_Object sym
= specpdl_symbol (tmp
);
3558 Lisp_Object old_value
= specpdl_old_value (tmp
);
3559 set_specpdl_old_value (tmp
, Fdefault_value (sym
));
3560 Fset_default (sym
, old_value
);
3563 case SPECPDL_LET_LOCAL
:
3565 Lisp_Object symbol
= specpdl_symbol (tmp
);
3566 Lisp_Object where
= specpdl_where (tmp
);
3567 Lisp_Object old_value
= specpdl_old_value (tmp
);
3568 eassert (BUFFERP (where
));
3570 /* If this was a local binding, reset the value in the appropriate
3571 buffer, but only if that buffer's binding still exists. */
3572 if (!NILP (Flocal_variable_p (symbol
, where
)))
3574 set_specpdl_old_value
3575 (tmp
, Fbuffer_local_value (symbol
, where
));
3576 set_internal (symbol
, old_value
, where
, 1);
3584 DEFUN ("backtrace-eval", Fbacktrace_eval
, Sbacktrace_eval
, 2, 3, NULL
,
3585 doc
: /* Evaluate EXP in the context of some activation frame.
3586 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3587 (Lisp_Object exp
, Lisp_Object nframes
, Lisp_Object base
)
3589 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3591 ptrdiff_t distance
= specpdl_ptr
- pdl
;
3592 eassert (distance
>= 0);
3594 if (!backtrace_p (pdl
))
3595 error ("Activation frame not found!");
3597 backtrace_eval_unrewind (distance
);
3598 record_unwind_protect_int (backtrace_eval_unrewind
, -distance
);
3600 /* Use eval_sub rather than Feval since the main motivation behind
3601 backtrace-eval is to be able to get/set the value of lexical variables
3602 from the debugger. */
3603 Lisp_Object tem1
= eval_sub (exp
);
3608 DEFUN ("backtrace--locals", Fbacktrace__locals
, Sbacktrace__locals
, 1, 2, NULL
,
3609 doc
: /* Return names and values of local variables of a stack frame.
3610 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3611 (Lisp_Object nframes
, Lisp_Object base
)
3613 union specbinding
*frame
= get_backtrace_frame (nframes
, base
);
3614 union specbinding
*prevframe
3615 = get_backtrace_frame (make_number (XFASTINT (nframes
) - 1), base
);
3616 ptrdiff_t distance
= specpdl_ptr
- frame
;
3617 Lisp_Object result
= Qnil
;
3618 eassert (distance
>= 0);
3620 if (!backtrace_p (prevframe
))
3621 error ("Activation frame not found!");
3622 if (!backtrace_p (frame
))
3623 error ("Activation frame not found!");
3625 /* The specpdl entries normally contain the symbol being bound along with its
3626 `old_value', so it can be restored. The new value to which it is bound is
3627 available in one of two places: either in the current value of the
3628 variable (if it hasn't been rebound yet) or in the `old_value' slot of the
3629 next specpdl entry for it.
3630 `backtrace_eval_unrewind' happens to swap the role of `old_value'
3631 and "new value", so we abuse it here, to fetch the new value.
3632 It's ugly (we'd rather not modify global data) and a bit inefficient,
3633 but it does the job for now. */
3634 backtrace_eval_unrewind (distance
);
3638 union specbinding
*tmp
= prevframe
;
3639 for (; tmp
> frame
; tmp
--)
3644 case SPECPDL_LET_DEFAULT
:
3645 case SPECPDL_LET_LOCAL
:
3647 Lisp_Object sym
= specpdl_symbol (tmp
);
3648 Lisp_Object val
= specpdl_old_value (tmp
);
3649 if (EQ (sym
, Qinternal_interpreter_environment
))
3651 Lisp_Object env
= val
;
3652 for (; CONSP (env
); env
= XCDR (env
))
3654 Lisp_Object binding
= XCAR (env
);
3655 if (CONSP (binding
))
3656 result
= Fcons (Fcons (XCAR (binding
),
3662 result
= Fcons (Fcons (sym
, val
), result
);
3668 /* Restore values from specpdl to original place. */
3669 backtrace_eval_unrewind (-distance
);
3676 get_backtrace (Lisp_Object array
)
3678 union specbinding
*pdl
= backtrace_next (backtrace_top ());
3679 ptrdiff_t i
= 0, asize
= ASIZE (array
);
3681 /* Copy the backtrace contents into working memory. */
3682 for (; i
< asize
; i
++)
3684 if (backtrace_p (pdl
))
3686 ASET (array
, i
, backtrace_function (pdl
));
3687 pdl
= backtrace_next (pdl
);
3690 ASET (array
, i
, Qnil
);
3694 Lisp_Object
backtrace_top_function (void)
3696 union specbinding
*pdl
= backtrace_top ();
3697 return (backtrace_p (pdl
) ? backtrace_function (pdl
) : Qnil
);
3705 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3706 doc
: /* Limit on number of Lisp variable bindings and `unwind-protect's.
3707 If Lisp code tries to increase the total number past this amount,
3708 an error is signaled.
3709 You can safely use a value considerably larger than the default value,
3710 if that proves inconveniently small. However, if you increase it too far,
3711 Emacs could run out of memory trying to make the stack bigger.
3712 Note that this limit may be silently increased by the debugger
3713 if `debug-on-error' or `debug-on-quit' is set. */);
3715 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3716 doc
: /* Limit on depth in `eval', `apply' and `funcall' before error.
3718 This limit serves to catch infinite recursions for you before they cause
3719 actual stack overflow in C, which would be fatal for Emacs.
3720 You can safely make it considerably larger than its default value,
3721 if that proves inconveniently small. However, if you increase it too far,
3722 Emacs could overflow the real C stack, and crash. */);
3724 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3725 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3726 If the value is t, that means do an ordinary quit.
3727 If the value equals `throw-on-input', that means quit by throwing
3728 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3729 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3730 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3733 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3734 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3735 Note that `quit-flag' will still be set by typing C-g,
3736 so a quit will be signaled as soon as `inhibit-quit' is nil.
3737 To prevent this happening, set `quit-flag' to nil
3738 before making `inhibit-quit' nil. */);
3739 Vinhibit_quit
= Qnil
;
3741 DEFSYM (Qinhibit_quit
, "inhibit-quit");
3742 DEFSYM (Qautoload
, "autoload");
3743 DEFSYM (Qinhibit_debugger
, "inhibit-debugger");
3744 DEFSYM (Qmacro
, "macro");
3745 DEFSYM (Qdeclare
, "declare");
3747 /* Note that the process handling also uses Qexit, but we don't want
3748 to staticpro it twice, so we just do it here. */
3749 DEFSYM (Qexit
, "exit");
3751 DEFSYM (Qinteractive
, "interactive");
3752 DEFSYM (Qcommandp
, "commandp");
3753 DEFSYM (Qand_rest
, "&rest");
3754 DEFSYM (Qand_optional
, "&optional");
3755 DEFSYM (Qclosure
, "closure");
3756 DEFSYM (Qdebug
, "debug");
3758 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger
,
3759 doc
: /* Non-nil means never enter the debugger.
3760 Normally set while the debugger is already active, to avoid recursive
3762 Vinhibit_debugger
= Qnil
;
3764 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3765 doc
: /* Non-nil means enter debugger if an error is signaled.
3766 Does not apply to errors handled by `condition-case' or those
3767 matched by `debug-ignored-errors'.
3768 If the value is a list, an error only means to enter the debugger
3769 if one of its condition symbols appears in the list.
3770 When you evaluate an expression interactively, this variable
3771 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3772 The command `toggle-debug-on-error' toggles this.
3773 See also the variable `debug-on-quit' and `inhibit-debugger'. */);
3774 Vdebug_on_error
= Qnil
;
3776 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3777 doc
: /* List of errors for which the debugger should not be called.
3778 Each element may be a condition-name or a regexp that matches error messages.
3779 If any element applies to a given error, that error skips the debugger
3780 and just returns to top level.
3781 This overrides the variable `debug-on-error'.
3782 It does not apply to errors handled by `condition-case'. */);
3783 Vdebug_ignored_errors
= Qnil
;
3785 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3786 doc
: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
3787 Does not apply if quit is handled by a `condition-case'. */);
3790 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3791 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3793 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3794 doc
: /* Non-nil means debugger may continue execution.
3795 This is nil when the debugger is called under circumstances where it
3796 might not be safe to continue. */);
3797 debugger_may_continue
= 1;
3799 DEFVAR_LISP ("debugger", Vdebugger
,
3800 doc
: /* Function to call to invoke debugger.
3801 If due to frame exit, args are `exit' and the value being returned;
3802 this function's value will be returned instead of that.
3803 If due to error, args are `error' and a list of the args to `signal'.
3804 If due to `apply' or `funcall' entry, one arg, `lambda'.
3805 If due to `eval' entry, one arg, t. */);
3808 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3809 doc
: /* If non-nil, this is a function for `signal' to call.
3810 It receives the same arguments that `signal' was given.
3811 The Edebug package uses this to regain control. */);
3812 Vsignal_hook_function
= Qnil
;
3814 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3815 doc
: /* Non-nil means call the debugger regardless of condition handlers.
3816 Note that `debug-on-error', `debug-on-quit' and friends
3817 still determine whether to handle the particular condition. */);
3818 Vdebug_on_signal
= Qnil
;
3820 /* When lexical binding is being used,
3821 Vinternal_interpreter_environment is non-nil, and contains an alist
3822 of lexically-bound variable, or (t), indicating an empty
3823 environment. The lisp name of this variable would be
3824 `internal-interpreter-environment' if it weren't hidden.
3825 Every element of this list can be either a cons (VAR . VAL)
3826 specifying a lexical binding, or a single symbol VAR indicating
3827 that this variable should use dynamic scoping. */
3828 DEFSYM (Qinternal_interpreter_environment
,
3829 "internal-interpreter-environment");
3830 DEFVAR_LISP ("internal-interpreter-environment",
3831 Vinternal_interpreter_environment
,
3832 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3833 When lexical binding is not being used, this variable is nil.
3834 A value of `(t)' indicates an empty environment, otherwise it is an
3835 alist of active lexical bindings. */);
3836 Vinternal_interpreter_environment
= Qnil
;
3837 /* Don't export this variable to Elisp, so no one can mess with it
3838 (Just imagine if someone makes it buffer-local). */
3839 Funintern (Qinternal_interpreter_environment
, Qnil
);
3841 DEFSYM (Vrun_hooks
, "run-hooks");
3843 staticpro (&Vautoload_queue
);
3844 Vautoload_queue
= Qnil
;
3845 staticpro (&Vsignaling_function
);
3846 Vsignaling_function
= Qnil
;
3848 inhibit_lisp_code
= Qnil
;