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"
30 #include "frame.h" /* For XFRAME. */
36 /* Chain of condition and catch handlers currently in effect. */
38 struct handler
*handlerlist
;
41 /* Count levels of GCPRO to detect failure to UNGCPRO. */
45 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
;
46 Lisp_Object Qinhibit_quit
;
47 Lisp_Object Qand_rest
;
48 static Lisp_Object Qand_optional
;
49 static Lisp_Object Qinhibit_debugger
;
50 static Lisp_Object Qdeclare
;
51 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
53 static Lisp_Object Qdebug
;
55 /* This holds either the symbol `run-hooks' or nil.
56 It is nil at an early stage of startup, and when Emacs
59 Lisp_Object Vrun_hooks
;
61 /* Non-nil means record all fset's and provide's, to be undone
62 if the file being autoloaded is not fully loaded.
63 They are recorded by being consed onto the front of Vautoload_queue:
64 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
66 Lisp_Object Vautoload_queue
;
68 /* Current number of specbindings allocated in specpdl, not counting
69 the dummy entry specpdl[-1]. */
71 ptrdiff_t specpdl_size
;
73 /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists
74 only so that its address can be taken. */
76 union specbinding
*specpdl
;
78 /* Pointer to first unused element in specpdl. */
80 union specbinding
*specpdl_ptr
;
82 /* Depth in Lisp evaluations and function calls. */
84 EMACS_INT lisp_eval_depth
;
86 /* The value of num_nonmacro_input_events as of the last time we
87 started to enter the debugger. If we decide to enter the debugger
88 again when this is still equal to num_nonmacro_input_events, then we
89 know that the debugger itself has an error, and we should just
90 signal the error instead of entering an infinite loop of debugger
93 static EMACS_INT when_entered_debugger
;
95 /* The function from which the last `signal' was called. Set in
97 /* FIXME: We should probably get rid of this! */
98 Lisp_Object Vsignaling_function
;
100 /* If non-nil, Lisp code must not be run since some part of Emacs is
101 in an inconsistent state. Currently, x-create-frame uses this to
102 avoid triggering window-configuration-change-hook while the new
103 frame is half-initialized. */
104 Lisp_Object inhibit_lisp_code
;
106 /* These would ordinarily be static, but they need to be visible to GDB. */
107 bool backtrace_p (union specbinding
*) EXTERNALLY_VISIBLE
;
108 Lisp_Object
*backtrace_args (union specbinding
*) EXTERNALLY_VISIBLE
;
109 Lisp_Object
backtrace_function (union specbinding
*) EXTERNALLY_VISIBLE
;
110 union specbinding
*backtrace_next (union specbinding
*) EXTERNALLY_VISIBLE
;
111 union specbinding
*backtrace_top (void) EXTERNALLY_VISIBLE
;
113 static Lisp_Object
funcall_lambda (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
114 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
117 specpdl_symbol (union specbinding
*pdl
)
119 eassert (pdl
->kind
>= SPECPDL_LET
);
120 return pdl
->let
.symbol
;
124 specpdl_old_value (union specbinding
*pdl
)
126 eassert (pdl
->kind
>= SPECPDL_LET
);
127 return pdl
->let
.old_value
;
131 set_specpdl_old_value (union specbinding
*pdl
, Lisp_Object val
)
133 eassert (pdl
->kind
>= SPECPDL_LET
);
134 pdl
->let
.old_value
= val
;
138 specpdl_where (union specbinding
*pdl
)
140 eassert (pdl
->kind
> SPECPDL_LET
);
141 return pdl
->let
.where
;
145 specpdl_arg (union specbinding
*pdl
)
147 eassert (pdl
->kind
== SPECPDL_UNWIND
);
148 return pdl
->unwind
.arg
;
152 backtrace_function (union specbinding
*pdl
)
154 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
155 return pdl
->bt
.function
;
159 backtrace_nargs (union specbinding
*pdl
)
161 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
162 return pdl
->bt
.nargs
;
166 backtrace_args (union specbinding
*pdl
)
168 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
173 backtrace_debug_on_exit (union specbinding
*pdl
)
175 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
176 return pdl
->bt
.debug_on_exit
;
179 /* Functions to modify slots of backtrace records. */
182 set_backtrace_args (union specbinding
*pdl
, Lisp_Object
*args
)
184 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
189 set_backtrace_nargs (union specbinding
*pdl
, ptrdiff_t n
)
191 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
196 set_backtrace_debug_on_exit (union specbinding
*pdl
, bool doe
)
198 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
199 pdl
->bt
.debug_on_exit
= doe
;
202 /* Helper functions to scan the backtrace. */
205 backtrace_p (union specbinding
*pdl
)
206 { return pdl
>= specpdl
; }
211 union specbinding
*pdl
= specpdl_ptr
- 1;
212 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
218 backtrace_next (union specbinding
*pdl
)
221 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
228 init_eval_once (void)
231 union specbinding
*pdlvec
= xmalloc ((size
+ 1) * sizeof *specpdl
);
233 specpdl
= specpdl_ptr
= pdlvec
+ 1;
234 /* Don't forget to update docs (lispref node "Local Variables"). */
235 max_specpdl_size
= 1300; /* 1000 is not enough for CEDET's c-by.el. */
236 max_lisp_eval_depth
= 600;
241 static struct handler handlerlist_sentinel
;
246 specpdl_ptr
= specpdl
;
247 { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
248 This is important since handlerlist->nextfree holds the freelist
249 which would otherwise leak every time we unwind back to top-level. */
251 handlerlist
= handlerlist_sentinel
.nextfree
= &handlerlist_sentinel
;
252 PUSH_HANDLER (c
, Qunbound
, CATCHER
);
253 eassert (c
== &handlerlist_sentinel
);
254 handlerlist_sentinel
.nextfree
= NULL
;
255 handlerlist_sentinel
.next
= NULL
;
258 debug_on_next_call
= 0;
263 /* This is less than the initial value of num_nonmacro_input_events. */
264 when_entered_debugger
= -1;
267 /* Unwind-protect function used by call_debugger. */
270 restore_stack_limits (Lisp_Object data
)
272 max_specpdl_size
= XINT (XCAR (data
));
273 max_lisp_eval_depth
= XINT (XCDR (data
));
276 static void grow_specpdl (void);
278 /* Call the Lisp debugger, giving it argument ARG. */
281 call_debugger (Lisp_Object arg
)
283 bool debug_while_redisplaying
;
284 ptrdiff_t count
= SPECPDL_INDEX ();
286 EMACS_INT old_max
= max_specpdl_size
, old_depth
= max_lisp_eval_depth
;
288 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
289 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
291 /* While debugging Bug#16603, previous value of 100 was found
292 too small to avoid specpdl overflow in the debugger itself. */
293 if (max_specpdl_size
- 200 < count
)
294 max_specpdl_size
= count
+ 200;
296 if (old_max
== count
)
298 /* We can enter the debugger due to specpdl overflow (Bug#16603). */
303 /* Restore limits after leaving the debugger. */
304 record_unwind_protect (restore_stack_limits
,
305 Fcons (make_number (old_max
),
306 make_number (old_depth
)));
308 #ifdef HAVE_WINDOW_SYSTEM
309 if (display_hourglass_p
)
313 debug_on_next_call
= 0;
314 when_entered_debugger
= num_nonmacro_input_events
;
316 /* Resetting redisplaying_p to 0 makes sure that debug output is
317 displayed if the debugger is invoked during redisplay. */
318 debug_while_redisplaying
= redisplaying_p
;
320 specbind (intern ("debugger-may-continue"),
321 debug_while_redisplaying
? Qnil
: Qt
);
322 specbind (Qinhibit_redisplay
, Qnil
);
323 specbind (Qinhibit_debugger
, Qt
);
325 #if 0 /* Binding this prevents execution of Lisp code during
326 redisplay, which necessarily leads to display problems. */
327 specbind (Qinhibit_eval_during_redisplay
, Qt
);
330 val
= apply1 (Vdebugger
, arg
);
332 /* Interrupting redisplay and resuming it later is not safe under
333 all circumstances. So, when the debugger returns, abort the
334 interrupted redisplay by going back to the top-level. */
335 if (debug_while_redisplaying
)
338 return unbind_to (count
, val
);
342 do_debug_on_call (Lisp_Object code
)
344 debug_on_next_call
= 0;
345 set_backtrace_debug_on_exit (specpdl_ptr
- 1, true);
346 call_debugger (list1 (code
));
349 /* NOTE!!! Every function that can call EVAL must protect its args
350 and temporaries from garbage collection while it needs them.
351 The definition of `For' shows what you have to do. */
353 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
354 doc
: /* Eval args until one of them yields non-nil, then return that value.
355 The remaining args are not evalled at all.
356 If all args return nil, return nil.
357 usage: (or CONDITIONS...) */)
360 register Lisp_Object val
= Qnil
;
367 val
= eval_sub (XCAR (args
));
377 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
378 doc
: /* Eval args until one of them yields nil, then return nil.
379 The remaining args are not evalled at all.
380 If no arg yields nil, return the last arg's value.
381 usage: (and CONDITIONS...) */)
384 register Lisp_Object val
= Qt
;
391 val
= eval_sub (XCAR (args
));
401 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
402 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
403 Returns the value of THEN or the value of the last of the ELSE's.
404 THEN must be one expression, but ELSE... can be zero or more expressions.
405 If COND yields nil, and there are no ELSE's, the value is nil.
406 usage: (if COND THEN ELSE...) */)
413 cond
= eval_sub (XCAR (args
));
417 return eval_sub (Fcar (XCDR (args
)));
418 return Fprogn (XCDR (XCDR (args
)));
421 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
422 doc
: /* Try each clause until one succeeds.
423 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
424 and, if the value is non-nil, this clause succeeds:
425 then the expressions in BODY are evaluated and the last one's
426 value is the value of the cond-form.
427 If a clause has one element, as in (CONDITION), then the cond-form
428 returns CONDITION's value, if that is non-nil.
429 If no clause succeeds, cond returns nil.
430 usage: (cond CLAUSES...) */)
433 Lisp_Object val
= args
;
439 Lisp_Object clause
= XCAR (args
);
440 val
= eval_sub (Fcar (clause
));
443 if (!NILP (XCDR (clause
)))
444 val
= Fprogn (XCDR (clause
));
454 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
455 doc
: /* Eval BODY forms sequentially and return value of last one.
456 usage: (progn BODY...) */)
459 Lisp_Object val
= Qnil
;
466 val
= eval_sub (XCAR (body
));
474 /* Evaluate BODY sequentially, discarding its value. Suitable for
475 record_unwind_protect. */
478 unwind_body (Lisp_Object body
)
483 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
484 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
485 The value of FIRST is saved during the evaluation of the remaining args,
486 whose values are discarded.
487 usage: (prog1 FIRST BODY...) */)
491 Lisp_Object args_left
;
492 struct gcpro gcpro1
, gcpro2
;
498 val
= eval_sub (XCAR (args_left
));
499 while (CONSP (args_left
= XCDR (args_left
)))
500 eval_sub (XCAR (args_left
));
506 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
507 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
508 The value of FORM2 is saved during the evaluation of the
509 remaining args, whose values are discarded.
510 usage: (prog2 FORM1 FORM2 BODY...) */)
516 eval_sub (XCAR (args
));
518 return Fprog1 (XCDR (args
));
521 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
522 doc
: /* Set each SYM to the value of its VAL.
523 The symbols SYM are variables; they are literal (not evaluated).
524 The values VAL are expressions; they are evaluated.
525 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
526 The second VAL is not computed until after the first SYM is set, and so on;
527 each VAL can use the new value of variables set earlier in the `setq'.
528 The return value of the `setq' form is the value of the last VAL.
529 usage: (setq [SYM VAL]...) */)
532 Lisp_Object val
, sym
, lex_binding
;
537 Lisp_Object args_left
= args
;
543 val
= eval_sub (Fcar (XCDR (args_left
)));
544 sym
= XCAR (args_left
);
546 /* Like for eval_sub, we do not check declared_special here since
547 it's been done when let-binding. */
548 if (!NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
550 && !NILP (lex_binding
551 = Fassq (sym
, Vinternal_interpreter_environment
)))
552 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
554 Fset (sym
, val
); /* SYM is dynamically bound. */
556 args_left
= Fcdr (XCDR (args_left
));
558 while (CONSP (args_left
));
566 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
567 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
568 Warning: `quote' does not construct its return value, but just returns
569 the value that was pre-constructed by the Lisp reader (see info node
570 `(elisp)Printed Representation').
571 This means that '(a . b) is not identical to (cons 'a 'b): the former
572 does not cons. Quoting should be reserved for constants that will
573 never be modified by side-effects, unless you like self-modifying code.
574 See the common pitfall in info node `(elisp)Rearrangement' for an example
575 of unexpected results when a quoted object is modified.
576 usage: (quote ARG) */)
579 if (CONSP (XCDR (args
)))
580 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
584 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
585 doc
: /* Like `quote', but preferred for objects which are functions.
586 In byte compilation, `function' causes its argument to be compiled.
587 `quote' cannot do that.
588 usage: (function ARG) */)
591 Lisp_Object quoted
= XCAR (args
);
593 if (CONSP (XCDR (args
)))
594 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
596 if (!NILP (Vinternal_interpreter_environment
)
598 && EQ (XCAR (quoted
), Qlambda
))
599 /* This is a lambda expression within a lexical environment;
600 return an interpreted closure instead of a simple lambda. */
601 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
604 /* Simply quote the argument. */
609 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
610 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
611 Aliased variables always have the same value; setting one sets the other.
612 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
613 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
614 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
615 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
616 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
617 The return value is BASE-VARIABLE. */)
618 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
620 struct Lisp_Symbol
*sym
;
622 CHECK_SYMBOL (new_alias
);
623 CHECK_SYMBOL (base_variable
);
625 sym
= XSYMBOL (new_alias
);
628 /* Not sure why, but why not? */
629 error ("Cannot make a constant an alias");
631 switch (sym
->redirect
)
633 case SYMBOL_FORWARDED
:
634 error ("Cannot make an internal variable an alias");
635 case SYMBOL_LOCALIZED
:
636 error ("Don't know how to make a localized variable an alias");
639 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
640 If n_a is bound, but b_v is not, set the value of b_v to n_a,
641 so that old-code that affects n_a before the aliasing is setup
643 if (NILP (Fboundp (base_variable
)))
644 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
647 union specbinding
*p
;
649 for (p
= specpdl_ptr
; p
> specpdl
; )
650 if ((--p
)->kind
>= SPECPDL_LET
651 && (EQ (new_alias
, specpdl_symbol (p
))))
652 error ("Don't know how to make a let-bound variable an alias");
655 sym
->declared_special
= 1;
656 XSYMBOL (base_variable
)->declared_special
= 1;
657 sym
->redirect
= SYMBOL_VARALIAS
;
658 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
659 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
660 LOADHIST_ATTACH (new_alias
);
661 /* Even if docstring is nil: remove old docstring. */
662 Fput (new_alias
, Qvariable_documentation
, docstring
);
664 return base_variable
;
667 static union specbinding
*
668 default_toplevel_binding (Lisp_Object symbol
)
670 union specbinding
*binding
= NULL
;
671 union specbinding
*pdl
= specpdl_ptr
;
672 while (pdl
> specpdl
)
674 switch ((--pdl
)->kind
)
676 case SPECPDL_LET_DEFAULT
:
678 if (EQ (specpdl_symbol (pdl
), symbol
))
686 DEFUN ("default-toplevel-value", Fdefault_toplevel_value
, Sdefault_toplevel_value
, 1, 1, 0,
687 doc
: /* Return SYMBOL's toplevel default value.
688 "Toplevel" means outside of any let binding. */)
691 union specbinding
*binding
= default_toplevel_binding (symbol
);
693 = binding
? specpdl_old_value (binding
) : Fdefault_value (symbol
);
694 if (!EQ (value
, Qunbound
))
696 xsignal1 (Qvoid_variable
, symbol
);
699 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value
,
700 Sset_default_toplevel_value
, 2, 2, 0,
701 doc
: /* Set SYMBOL's toplevel default value to VALUE.
702 "Toplevel" means outside of any let binding. */)
703 (Lisp_Object symbol
, Lisp_Object value
)
705 union specbinding
*binding
= default_toplevel_binding (symbol
);
707 set_specpdl_old_value (binding
, value
);
709 Fset_default (symbol
, value
);
713 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
714 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
715 You are not required to define a variable in order to use it, but
716 defining it lets you supply an initial value and documentation, which
717 can be referred to by the Emacs help facilities and other programming
718 tools. The `defvar' form also declares the variable as \"special\",
719 so that it is always dynamically bound even if `lexical-binding' is t.
721 The optional argument INITVALUE is evaluated, and used to set SYMBOL,
722 only if SYMBOL's value is void. If SYMBOL is buffer-local, its
723 default value is what is set; buffer-local values are not affected.
724 If INITVALUE is missing, SYMBOL's value is not set.
726 If SYMBOL has a local binding, then this form affects the local
727 binding. This is usually not what you want. Thus, if you need to
728 load a file defining variables, with this form or with `defconst' or
729 `defcustom', you should always load that file _outside_ any bindings
730 for these variables. \(`defconst' and `defcustom' behave similarly in
733 The optional argument DOCSTRING is a documentation string for the
736 To define a user option, use `defcustom' instead of `defvar'.
737 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
740 Lisp_Object sym
, tem
, tail
;
747 if (CONSP (XCDR (tail
)) && CONSP (XCDR (XCDR (tail
))))
748 error ("Too many arguments");
750 tem
= Fdefault_boundp (sym
);
752 /* Do it before evaluating the initial value, for self-references. */
753 XSYMBOL (sym
)->declared_special
= 1;
756 Fset_default (sym
, eval_sub (XCAR (tail
)));
758 { /* Check if there is really a global binding rather than just a let
759 binding that shadows the global unboundness of the var. */
760 union specbinding
*binding
= default_toplevel_binding (sym
);
761 if (binding
&& EQ (specpdl_old_value (binding
), Qunbound
))
763 set_specpdl_old_value (binding
, eval_sub (XCAR (tail
)));
770 if (!NILP (Vpurify_flag
))
771 tem
= Fpurecopy (tem
);
772 Fput (sym
, Qvariable_documentation
, tem
);
774 LOADHIST_ATTACH (sym
);
776 else if (!NILP (Vinternal_interpreter_environment
)
777 && !XSYMBOL (sym
)->declared_special
)
778 /* A simple (defvar foo) with lexical scoping does "nothing" except
779 declare that var to be dynamically scoped *locally* (i.e. within
780 the current file or let-block). */
781 Vinternal_interpreter_environment
782 = Fcons (sym
, Vinternal_interpreter_environment
);
785 /* Simple (defvar <var>) should not count as a definition at all.
786 It could get in the way of other definitions, and unloading this
787 package could try to make the variable unbound. */
793 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
794 doc
: /* Define SYMBOL as a constant variable.
795 This declares that neither programs nor users should ever change the
796 value. This constancy is not actually enforced by Emacs Lisp, but
797 SYMBOL is marked as a special variable so that it is never lexically
800 The `defconst' form always sets the value of SYMBOL to the result of
801 evalling INITVALUE. If SYMBOL is buffer-local, its default value is
802 what is set; buffer-local values are not affected. If SYMBOL has a
803 local binding, then this form sets the local binding's value.
804 However, you should normally not make local bindings for variables
805 defined with this form.
807 The optional DOCSTRING specifies the variable's documentation string.
808 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
811 Lisp_Object sym
, tem
;
814 if (CONSP (Fcdr (XCDR (XCDR (args
)))))
815 error ("Too many arguments");
817 tem
= eval_sub (Fcar (XCDR (args
)));
818 if (!NILP (Vpurify_flag
))
819 tem
= Fpurecopy (tem
);
820 Fset_default (sym
, tem
);
821 XSYMBOL (sym
)->declared_special
= 1;
822 tem
= Fcar (XCDR (XCDR (args
)));
825 if (!NILP (Vpurify_flag
))
826 tem
= Fpurecopy (tem
);
827 Fput (sym
, Qvariable_documentation
, tem
);
829 Fput (sym
, Qrisky_local_variable
, Qt
);
830 LOADHIST_ATTACH (sym
);
834 /* Make SYMBOL lexically scoped. */
835 DEFUN ("internal-make-var-non-special", Fmake_var_non_special
,
836 Smake_var_non_special
, 1, 1, 0,
837 doc
: /* Internal function. */)
840 CHECK_SYMBOL (symbol
);
841 XSYMBOL (symbol
)->declared_special
= 0;
846 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
847 doc
: /* Bind variables according to VARLIST then eval BODY.
848 The value of the last form in BODY is returned.
849 Each element of VARLIST is a symbol (which is bound to nil)
850 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
851 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
852 usage: (let* VARLIST BODY...) */)
855 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
856 ptrdiff_t count
= SPECPDL_INDEX ();
857 struct gcpro gcpro1
, gcpro2
, gcpro3
;
859 GCPRO3 (args
, elt
, varlist
);
861 lexenv
= Vinternal_interpreter_environment
;
863 varlist
= XCAR (args
);
864 while (CONSP (varlist
))
868 elt
= XCAR (varlist
);
874 else if (! NILP (Fcdr (Fcdr (elt
))))
875 signal_error ("`let' bindings can have only one value-form", elt
);
879 val
= eval_sub (Fcar (Fcdr (elt
)));
882 if (!NILP (lexenv
) && SYMBOLP (var
)
883 && !XSYMBOL (var
)->declared_special
884 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
885 /* Lexically bind VAR by adding it to the interpreter's binding
889 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
890 if (EQ (Vinternal_interpreter_environment
, lexenv
))
891 /* Save the old lexical environment on the specpdl stack,
892 but only for the first lexical binding, since we'll never
893 need to revert to one of the intermediate ones. */
894 specbind (Qinternal_interpreter_environment
, newenv
);
896 Vinternal_interpreter_environment
= newenv
;
901 varlist
= XCDR (varlist
);
904 val
= Fprogn (XCDR (args
));
905 return unbind_to (count
, val
);
908 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
909 doc
: /* Bind variables according to VARLIST then eval BODY.
910 The value of the last form in BODY is returned.
911 Each element of VARLIST is a symbol (which is bound to nil)
912 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
913 All the VALUEFORMs are evalled before any symbols are bound.
914 usage: (let VARLIST BODY...) */)
917 Lisp_Object
*temps
, tem
, lexenv
;
918 register Lisp_Object elt
, varlist
;
919 ptrdiff_t count
= SPECPDL_INDEX ();
921 struct gcpro gcpro1
, gcpro2
;
924 varlist
= XCAR (args
);
926 /* Make space to hold the values to give the bound variables. */
927 elt
= Flength (varlist
);
928 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
930 /* Compute the values and store them in `temps'. */
932 GCPRO2 (args
, *temps
);
935 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
938 elt
= XCAR (varlist
);
940 temps
[argnum
++] = Qnil
;
941 else if (! NILP (Fcdr (Fcdr (elt
))))
942 signal_error ("`let' bindings can have only one value-form", elt
);
944 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
945 gcpro2
.nvars
= argnum
;
949 lexenv
= Vinternal_interpreter_environment
;
951 varlist
= XCAR (args
);
952 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
956 elt
= XCAR (varlist
);
957 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
958 tem
= temps
[argnum
++];
960 if (!NILP (lexenv
) && SYMBOLP (var
)
961 && !XSYMBOL (var
)->declared_special
962 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
963 /* Lexically bind VAR by adding it to the lexenv alist. */
964 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
966 /* Dynamically bind VAR. */
970 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
971 /* Instantiate a new lexical environment. */
972 specbind (Qinternal_interpreter_environment
, lexenv
);
974 elt
= Fprogn (XCDR (args
));
976 return unbind_to (count
, elt
);
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 _Noreturn
void
1147 unwind_to_catch (struct handler
*catch, Lisp_Object value
)
1151 eassert (catch->next
);
1153 /* Save the value in the tag. */
1156 /* Restore certain special C variables. */
1157 set_poll_suppress_count (catch->poll_suppress_count
);
1158 unblock_input_to (catch->interrupt_input_blocked
);
1163 /* Unwind the specpdl stack, and then restore the proper set of
1165 unbind_to (handlerlist
->pdlcount
, Qnil
);
1166 last_time
= handlerlist
== catch;
1168 handlerlist
= handlerlist
->next
;
1170 while (! last_time
);
1172 eassert (handlerlist
== catch);
1174 byte_stack_list
= catch->byte_stack
;
1175 gcprolist
= catch->gcpro
;
1177 gcpro_level
= gcprolist
? gcprolist
->level
+ 1 : 0;
1179 lisp_eval_depth
= catch->lisp_eval_depth
;
1181 sys_longjmp (catch->jmp
, 1);
1184 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1185 doc
: /* Throw to the catch for TAG and return VALUE from it.
1186 Both TAG and VALUE are evalled. */)
1187 (register Lisp_Object tag
, Lisp_Object value
)
1192 for (c
= handlerlist
; c
; c
= c
->next
)
1194 if (c
->type
== CATCHER
&& EQ (c
->tag_or_ch
, tag
))
1195 unwind_to_catch (c
, value
);
1197 xsignal2 (Qno_catch
, tag
, value
);
1201 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1202 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1203 If BODYFORM completes normally, its value is returned
1204 after executing the UNWINDFORMS.
1205 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1206 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1210 ptrdiff_t count
= SPECPDL_INDEX ();
1212 record_unwind_protect (unwind_body
, XCDR (args
));
1213 val
= eval_sub (XCAR (args
));
1214 return unbind_to (count
, val
);
1217 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1218 doc
: /* Regain control when an error is signaled.
1219 Executes BODYFORM and returns its value if no error happens.
1220 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1221 where the BODY is made of Lisp expressions.
1223 A handler is applicable to an error
1224 if CONDITION-NAME is one of the error's condition names.
1225 If an error happens, the first applicable handler is run.
1227 The car of a handler may be a list of condition names instead of a
1228 single condition name; then it handles all of them. If the special
1229 condition name `debug' is present in this list, it allows another
1230 condition in the list to run the debugger if `debug-on-error' and the
1231 other usual mechanisms says it should (otherwise, `condition-case'
1232 suppresses the debugger).
1234 When a handler handles an error, control returns to the `condition-case'
1235 and it executes the handler's BODY...
1236 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1237 \(If VAR is nil, the handler can't access that information.)
1238 Then the value of the last BODY form is returned from the `condition-case'
1241 See also the function `signal' for more info.
1242 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1245 Lisp_Object var
= XCAR (args
);
1246 Lisp_Object bodyform
= XCAR (XCDR (args
));
1247 Lisp_Object handlers
= XCDR (XCDR (args
));
1249 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1252 /* Like Fcondition_case, but the args are separate
1253 rather than passed in a list. Used by Fbyte_code. */
1256 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1257 Lisp_Object handlers
)
1261 struct handler
*oldhandlerlist
= handlerlist
;
1266 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1268 Lisp_Object tem
= XCAR (val
);
1272 && (SYMBOLP (XCAR (tem
))
1273 || CONSP (XCAR (tem
))))))
1274 error ("Invalid condition handler: %s",
1275 SDATA (Fprin1_to_string (tem
, Qt
)));
1278 { /* The first clause is the one that should be checked first, so it should
1279 be added to handlerlist last. So we build in `clauses' a table that
1280 contains `handlers' but in reverse order. */
1281 Lisp_Object
*clauses
= alloca (clausenb
* sizeof (Lisp_Object
*));
1282 Lisp_Object
*volatile clauses_volatile
= clauses
;
1284 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1285 clauses
[--i
] = XCAR (val
);
1286 for (i
= 0; i
< clausenb
; i
++)
1288 Lisp_Object clause
= clauses
[i
];
1289 Lisp_Object condition
= XCAR (clause
);
1290 if (!CONSP (condition
))
1291 condition
= Fcons (condition
, Qnil
);
1292 PUSH_HANDLER (c
, condition
, CONDITION_CASE
);
1293 if (sys_setjmp (c
->jmp
))
1295 ptrdiff_t count
= SPECPDL_INDEX ();
1296 Lisp_Object val
= handlerlist
->val
;
1297 Lisp_Object
*chosen_clause
= clauses_volatile
;
1298 for (c
= handlerlist
->next
; c
!= oldhandlerlist
; c
= c
->next
)
1300 handlerlist
= oldhandlerlist
;
1303 if (!NILP (Vinternal_interpreter_environment
))
1304 specbind (Qinternal_interpreter_environment
,
1305 Fcons (Fcons (var
, val
),
1306 Vinternal_interpreter_environment
));
1308 specbind (var
, val
);
1310 val
= Fprogn (XCDR (*chosen_clause
));
1311 /* Note that this just undoes the binding of var; whoever
1312 longjumped to us unwound the stack to c.pdlcount before
1315 unbind_to (count
, Qnil
);
1321 val
= eval_sub (bodyform
);
1322 handlerlist
= oldhandlerlist
;
1326 /* Call the function BFUN with no arguments, catching errors within it
1327 according to HANDLERS. If there is an error, call HFUN with
1328 one argument which is the data that describes the error:
1331 HANDLERS can be a list of conditions to catch.
1332 If HANDLERS is Qt, catch all errors.
1333 If HANDLERS is Qerror, catch all errors
1334 but allow the debugger to run if that is enabled. */
1337 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1338 Lisp_Object (*hfun
) (Lisp_Object
))
1343 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1344 if (sys_setjmp (c
->jmp
))
1346 Lisp_Object val
= handlerlist
->val
;
1347 clobbered_eassert (handlerlist
== c
);
1348 handlerlist
= handlerlist
->next
;
1349 return (*hfun
) (val
);
1353 clobbered_eassert (handlerlist
== c
);
1354 handlerlist
= handlerlist
->next
;
1358 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1361 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1362 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1367 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1368 if (sys_setjmp (c
->jmp
))
1370 Lisp_Object val
= handlerlist
->val
;
1371 clobbered_eassert (handlerlist
== c
);
1372 handlerlist
= handlerlist
->next
;
1373 return (*hfun
) (val
);
1376 val
= (*bfun
) (arg
);
1377 clobbered_eassert (handlerlist
== c
);
1378 handlerlist
= handlerlist
->next
;
1382 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1386 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1389 Lisp_Object handlers
,
1390 Lisp_Object (*hfun
) (Lisp_Object
))
1395 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1396 if (sys_setjmp (c
->jmp
))
1398 Lisp_Object val
= handlerlist
->val
;
1399 clobbered_eassert (handlerlist
== c
);
1400 handlerlist
= handlerlist
->next
;
1401 return (*hfun
) (val
);
1404 val
= (*bfun
) (arg1
, arg2
);
1405 clobbered_eassert (handlerlist
== c
);
1406 handlerlist
= handlerlist
->next
;
1410 /* Like internal_condition_case but call BFUN with NARGS as first,
1411 and ARGS as second argument. */
1414 internal_condition_case_n (Lisp_Object (*bfun
) (ptrdiff_t, Lisp_Object
*),
1417 Lisp_Object handlers
,
1418 Lisp_Object (*hfun
) (Lisp_Object err
,
1425 PUSH_HANDLER (c
, handlers
, CONDITION_CASE
);
1426 if (sys_setjmp (c
->jmp
))
1428 Lisp_Object val
= handlerlist
->val
;
1429 clobbered_eassert (handlerlist
== c
);
1430 handlerlist
= handlerlist
->next
;
1431 return (*hfun
) (val
, nargs
, args
);
1434 val
= (*bfun
) (nargs
, args
);
1435 clobbered_eassert (handlerlist
== c
);
1436 handlerlist
= handlerlist
->next
;
1441 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
);
1442 static bool maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1446 process_quit_flag (void)
1448 Lisp_Object flag
= Vquit_flag
;
1450 if (EQ (flag
, Qkill_emacs
))
1452 if (EQ (Vthrow_on_input
, flag
))
1453 Fthrow (Vthrow_on_input
, Qt
);
1454 Fsignal (Qquit
, Qnil
);
1457 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1458 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1459 This function does not return.
1461 An error symbol is a symbol with an `error-conditions' property
1462 that is a list of condition names.
1463 A handler for any of those names will get to handle this signal.
1464 The symbol `error' should normally be one of them.
1466 DATA should be a list. Its elements are printed as part of the error message.
1467 See Info anchor `(elisp)Definition of signal' for some details on how this
1468 error message is constructed.
1469 If the signal is handled, DATA is made available to the handler.
1470 See also the function `condition-case'. */)
1471 (Lisp_Object error_symbol
, Lisp_Object data
)
1473 /* When memory is full, ERROR-SYMBOL is nil,
1474 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1475 That is a special case--don't do this in other situations. */
1476 Lisp_Object conditions
;
1478 Lisp_Object real_error_symbol
1479 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1480 register Lisp_Object clause
= Qnil
;
1485 if (gc_in_progress
|| waiting_for_input
)
1488 #if 0 /* rms: I don't know why this was here,
1489 but it is surely wrong for an error that is handled. */
1490 #ifdef HAVE_WINDOW_SYSTEM
1491 if (display_hourglass_p
)
1492 cancel_hourglass ();
1496 /* This hook is used by edebug. */
1497 if (! NILP (Vsignal_hook_function
)
1498 && ! NILP (error_symbol
))
1500 /* Edebug takes care of restoring these variables when it exits. */
1501 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1502 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1504 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1505 max_specpdl_size
= SPECPDL_INDEX () + 40;
1507 call2 (Vsignal_hook_function
, error_symbol
, data
);
1510 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1512 /* Remember from where signal was called. Skip over the frame for
1513 `signal' itself. If a frame for `error' follows, skip that,
1514 too. Don't do this when ERROR_SYMBOL is nil, because that
1515 is a memory-full error. */
1516 Vsignaling_function
= Qnil
;
1517 if (!NILP (error_symbol
))
1519 union specbinding
*pdl
= backtrace_next (backtrace_top ());
1520 if (backtrace_p (pdl
) && EQ (backtrace_function (pdl
), Qerror
))
1521 pdl
= backtrace_next (pdl
);
1522 if (backtrace_p (pdl
))
1523 Vsignaling_function
= backtrace_function (pdl
);
1526 for (h
= handlerlist
; h
; h
= h
->next
)
1528 if (h
->type
!= CONDITION_CASE
)
1530 clause
= find_handler_clause (h
->tag_or_ch
, conditions
);
1535 if (/* Don't run the debugger for a memory-full error.
1536 (There is no room in memory to do that!) */
1537 !NILP (error_symbol
)
1538 && (!NILP (Vdebug_on_signal
)
1539 /* If no handler is present now, try to run the debugger. */
1541 /* A `debug' symbol in the handler list disables the normal
1542 suppression of the debugger. */
1543 || (CONSP (clause
) && CONSP (clause
)
1544 && !NILP (Fmemq (Qdebug
, clause
)))
1545 /* Special handler that means "print a message and run debugger
1547 || EQ (h
->tag_or_ch
, Qerror
)))
1549 bool debugger_called
1550 = maybe_call_debugger (conditions
, error_symbol
, data
);
1551 /* We can't return values to code which signaled an error, but we
1552 can continue code which has signaled a quit. */
1553 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1559 Lisp_Object unwind_data
1560 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1562 unwind_to_catch (h
, unwind_data
);
1566 if (handlerlist
!= &handlerlist_sentinel
)
1567 /* FIXME: This will come right back here if there's no `top-level'
1568 catcher. A better solution would be to abort here, and instead
1569 add a catch-all condition handler so we never come here. */
1570 Fthrow (Qtop_level
, Qt
);
1573 if (! NILP (error_symbol
))
1574 data
= Fcons (error_symbol
, data
);
1576 string
= Ferror_message_string (data
);
1577 fatal ("%s", SDATA (string
));
1580 /* Internal version of Fsignal that never returns.
1581 Used for anything but Qquit (which can return from Fsignal). */
1584 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1586 Fsignal (error_symbol
, data
);
1590 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1593 xsignal0 (Lisp_Object error_symbol
)
1595 xsignal (error_symbol
, Qnil
);
1599 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1601 xsignal (error_symbol
, list1 (arg
));
1605 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1607 xsignal (error_symbol
, list2 (arg1
, arg2
));
1611 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1613 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1616 /* Signal `error' with message S, and additional arg ARG.
1617 If ARG is not a genuine list, make it a one-element list. */
1620 signal_error (const char *s
, Lisp_Object arg
)
1622 Lisp_Object tortoise
, hare
;
1624 hare
= tortoise
= arg
;
1625 while (CONSP (hare
))
1632 tortoise
= XCDR (tortoise
);
1634 if (EQ (hare
, tortoise
))
1641 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1645 /* Return true if LIST is a non-nil atom or
1646 a list containing one of CONDITIONS. */
1649 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1656 while (CONSP (conditions
))
1658 Lisp_Object
this, tail
;
1659 this = XCAR (conditions
);
1660 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1661 if (EQ (XCAR (tail
), this))
1663 conditions
= XCDR (conditions
);
1668 /* Return true if an error with condition-symbols CONDITIONS,
1669 and described by SIGNAL-DATA, should skip the debugger
1670 according to debugger-ignored-errors. */
1673 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1676 bool first_string
= 1;
1677 Lisp_Object error_message
;
1679 error_message
= Qnil
;
1680 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1682 if (STRINGP (XCAR (tail
)))
1686 error_message
= Ferror_message_string (data
);
1690 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1695 Lisp_Object contail
;
1697 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1698 if (EQ (XCAR (tail
), XCAR (contail
)))
1706 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1707 SIG and DATA describe the signal. There are two ways to pass them:
1708 = SIG is the error symbol, and DATA is the rest of the data.
1709 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1710 This is for memory-full errors only. */
1712 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1714 Lisp_Object combined_data
;
1716 combined_data
= Fcons (sig
, data
);
1719 /* Don't try to run the debugger with interrupts blocked.
1720 The editing loop would return anyway. */
1721 ! input_blocked_p ()
1722 && NILP (Vinhibit_debugger
)
1723 /* Does user want to enter debugger for this kind of error? */
1726 : wants_debugger (Vdebug_on_error
, conditions
))
1727 && ! skip_debugger (conditions
, combined_data
)
1728 /* RMS: What's this for? */
1729 && when_entered_debugger
< num_nonmacro_input_events
)
1731 call_debugger (list2 (Qerror
, combined_data
));
1739 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
)
1741 register Lisp_Object h
;
1743 /* t is used by handlers for all conditions, set up by C code. */
1744 if (EQ (handlers
, Qt
))
1747 /* error is used similarly, but means print an error message
1748 and run the debugger if that is enabled. */
1749 if (EQ (handlers
, Qerror
))
1752 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1754 Lisp_Object handler
= XCAR (h
);
1755 if (!NILP (Fmemq (handler
, conditions
)))
1763 /* Dump an error message; called like vprintf. */
1765 verror (const char *m
, va_list ap
)
1768 ptrdiff_t size
= sizeof buf
;
1769 ptrdiff_t size_max
= STRING_BYTES_BOUND
+ 1;
1774 used
= evxprintf (&buffer
, &size
, buf
, size_max
, m
, ap
);
1775 string
= make_string (buffer
, used
);
1779 xsignal1 (Qerror
, string
);
1783 /* Dump an error message; called like printf. */
1787 error (const char *m
, ...)
1794 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1795 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1796 This means it contains a description for how to read arguments to give it.
1797 The value is nil for an invalid function or a symbol with no function
1800 Interactively callable functions include strings and vectors (treated
1801 as keyboard macros), lambda-expressions that contain a top-level call
1802 to `interactive', autoload definitions made by `autoload' with non-nil
1803 fourth argument, and some of the built-in functions of Lisp.
1805 Also, a symbol satisfies `commandp' if its function definition does so.
1807 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1808 then strings and vectors are not accepted. */)
1809 (Lisp_Object function
, Lisp_Object for_call_interactively
)
1811 register Lisp_Object fun
;
1812 register Lisp_Object funcar
;
1813 Lisp_Object if_prop
= Qnil
;
1817 fun
= indirect_function (fun
); /* Check cycles. */
1821 /* Check an `interactive-form' property if present, analogous to the
1822 function-documentation property. */
1824 while (SYMBOLP (fun
))
1826 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
1829 fun
= Fsymbol_function (fun
);
1832 /* Emacs primitives are interactive if their DEFUN specifies an
1833 interactive spec. */
1835 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
1837 /* Bytecode objects are interactive if they are long enough to
1838 have an element whose index is COMPILED_INTERACTIVE, which is
1839 where the interactive spec is stored. */
1840 else if (COMPILEDP (fun
))
1841 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1844 /* Strings and vectors are keyboard macros. */
1845 if (STRINGP (fun
) || VECTORP (fun
))
1846 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
1848 /* Lists may represent commands. */
1851 funcar
= XCAR (fun
);
1852 if (EQ (funcar
, Qclosure
))
1853 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
1855 else if (EQ (funcar
, Qlambda
))
1856 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
1857 else if (EQ (funcar
, Qautoload
))
1858 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
1863 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1864 doc
: /* Define FUNCTION to autoload from FILE.
1865 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1866 Third arg DOCSTRING is documentation for the function.
1867 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1868 Fifth arg TYPE indicates the type of the object:
1869 nil or omitted says FUNCTION is a function,
1870 `keymap' says FUNCTION is really a keymap, and
1871 `macro' or t says FUNCTION is really a macro.
1872 Third through fifth args give info about the real definition.
1873 They default to nil.
1874 If FUNCTION is already defined other than as an autoload,
1875 this does nothing and returns nil. */)
1876 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
1878 CHECK_SYMBOL (function
);
1879 CHECK_STRING (file
);
1881 /* If function is defined and not as an autoload, don't override. */
1882 if (!NILP (XSYMBOL (function
)->function
)
1883 && !AUTOLOADP (XSYMBOL (function
)->function
))
1886 if (!NILP (Vpurify_flag
) && EQ (docstring
, make_number (0)))
1887 /* `read1' in lread.c has found the docstring starting with "\
1888 and assumed the docstring will be provided by Snarf-documentation, so it
1889 passed us 0 instead. But that leads to accidental sharing in purecopy's
1890 hash-consing, so we use a (hopefully) unique integer instead. */
1891 docstring
= make_number (XHASH (function
));
1892 return Fdefalias (function
,
1893 list5 (Qautoload
, file
, docstring
, interactive
, type
),
1898 un_autoload (Lisp_Object oldqueue
)
1900 Lisp_Object queue
, first
, second
;
1902 /* Queue to unwind is current value of Vautoload_queue.
1903 oldqueue is the shadowed value to leave in Vautoload_queue. */
1904 queue
= Vautoload_queue
;
1905 Vautoload_queue
= oldqueue
;
1906 while (CONSP (queue
))
1908 first
= XCAR (queue
);
1909 second
= Fcdr (first
);
1910 first
= Fcar (first
);
1911 if (EQ (first
, make_number (0)))
1914 Ffset (first
, second
);
1915 queue
= XCDR (queue
);
1919 /* Load an autoloaded function.
1920 FUNNAME is the symbol which is the function's name.
1921 FUNDEF is the autoload definition (a list). */
1923 DEFUN ("autoload-do-load", Fautoload_do_load
, Sautoload_do_load
, 1, 3, 0,
1924 doc
: /* Load FUNDEF which should be an autoload.
1925 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1926 in which case the function returns the new autoloaded function value.
1927 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1928 it is defines a macro. */)
1929 (Lisp_Object fundef
, Lisp_Object funname
, Lisp_Object macro_only
)
1931 ptrdiff_t count
= SPECPDL_INDEX ();
1932 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1934 if (!CONSP (fundef
) || !EQ (Qautoload
, XCAR (fundef
)))
1937 if (EQ (macro_only
, Qmacro
))
1939 Lisp_Object kind
= Fnth (make_number (4), fundef
);
1940 if (! (EQ (kind
, Qt
) || EQ (kind
, Qmacro
)))
1944 /* This is to make sure that loadup.el gives a clear picture
1945 of what files are preloaded and when. */
1946 if (! NILP (Vpurify_flag
))
1947 error ("Attempt to autoload %s while preparing to dump",
1948 SDATA (SYMBOL_NAME (funname
)));
1950 CHECK_SYMBOL (funname
);
1951 GCPRO3 (funname
, fundef
, macro_only
);
1953 /* Preserve the match data. */
1954 record_unwind_save_match_data ();
1956 /* If autoloading gets an error (which includes the error of failing
1957 to define the function being called), we use Vautoload_queue
1958 to undo function definitions and `provide' calls made by
1959 the function. We do this in the specific case of autoloading
1960 because autoloading is not an explicit request "load this file",
1961 but rather a request to "call this function".
1963 The value saved here is to be restored into Vautoload_queue. */
1964 record_unwind_protect (un_autoload
, Vautoload_queue
);
1965 Vautoload_queue
= Qt
;
1966 /* If `macro_only', assume this autoload to be a "best-effort",
1967 so don't signal an error if autoloading fails. */
1968 Fload (Fcar (Fcdr (fundef
)), macro_only
, Qt
, Qnil
, Qt
);
1970 /* Once loading finishes, don't undo it. */
1971 Vautoload_queue
= Qt
;
1972 unbind_to (count
, Qnil
);
1980 Lisp_Object fun
= Findirect_function (funname
, Qnil
);
1982 if (!NILP (Fequal (fun
, fundef
)))
1983 error ("Autoloading failed to define function %s",
1984 SDATA (SYMBOL_NAME (funname
)));
1991 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
1992 doc
: /* Evaluate FORM and return its value.
1993 If LEXICAL is t, evaluate using lexical scoping.
1994 LEXICAL can also be an actual lexical environment, in the form of an
1995 alist mapping symbols to their value. */)
1996 (Lisp_Object form
, Lisp_Object lexical
)
1998 ptrdiff_t count
= SPECPDL_INDEX ();
1999 specbind (Qinternal_interpreter_environment
,
2000 CONSP (lexical
) || NILP (lexical
) ? lexical
: list1 (Qt
));
2001 return unbind_to (count
, eval_sub (form
));
2004 /* Grow the specpdl stack by one entry.
2005 The caller should have already initialized the entry.
2006 Signal an error on stack overflow.
2008 Make sure that there is always one unused entry past the top of the
2009 stack, so that the just-initialized entry is safely unwound if
2010 memory exhausted and an error is signaled here. Also, allocate a
2011 never-used entry just before the bottom of the stack; sometimes its
2012 address is taken. */
2019 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2021 ptrdiff_t count
= SPECPDL_INDEX ();
2022 ptrdiff_t max_size
= min (max_specpdl_size
, PTRDIFF_MAX
- 1000);
2023 union specbinding
*pdlvec
= specpdl
- 1;
2024 ptrdiff_t pdlvecsize
= specpdl_size
+ 1;
2025 if (max_size
<= specpdl_size
)
2027 if (max_specpdl_size
< 400)
2028 max_size
= max_specpdl_size
= 400;
2029 if (max_size
<= specpdl_size
)
2030 signal_error ("Variable binding depth exceeds max-specpdl-size",
2033 pdlvec
= xpalloc (pdlvec
, &pdlvecsize
, 1, max_size
+ 1, sizeof *specpdl
);
2034 specpdl
= pdlvec
+ 1;
2035 specpdl_size
= pdlvecsize
- 1;
2036 specpdl_ptr
= specpdl
+ count
;
2041 record_in_backtrace (Lisp_Object function
, Lisp_Object
*args
, ptrdiff_t nargs
)
2043 eassert (nargs
>= UNEVALLED
);
2044 specpdl_ptr
->bt
.kind
= SPECPDL_BACKTRACE
;
2045 specpdl_ptr
->bt
.debug_on_exit
= false;
2046 specpdl_ptr
->bt
.function
= function
;
2047 specpdl_ptr
->bt
.args
= args
;
2048 specpdl_ptr
->bt
.nargs
= nargs
;
2052 /* Eval a sub-expression of the current expression (i.e. in the same
2055 eval_sub (Lisp_Object form
)
2057 Lisp_Object fun
, val
, original_fun
, original_args
;
2059 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2063 /* Look up its binding in the lexical environment.
2064 We do not pay attention to the declared_special flag here, since we
2065 already did that when let-binding the variable. */
2066 Lisp_Object lex_binding
2067 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2068 ? Fassq (form
, Vinternal_interpreter_environment
)
2070 if (CONSP (lex_binding
))
2071 return XCDR (lex_binding
);
2073 return Fsymbol_value (form
);
2085 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2087 if (max_lisp_eval_depth
< 100)
2088 max_lisp_eval_depth
= 100;
2089 if (lisp_eval_depth
> max_lisp_eval_depth
)
2090 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2093 original_fun
= XCAR (form
);
2094 original_args
= XCDR (form
);
2096 /* This also protects them from gc. */
2097 record_in_backtrace (original_fun
, &original_args
, UNEVALLED
);
2099 if (debug_on_next_call
)
2100 do_debug_on_call (Qt
);
2102 /* At this point, only original_fun and original_args
2103 have values that will be used below. */
2106 /* Optimize for no indirection. */
2109 fun
= Ffunction (Fcons (fun
, Qnil
));
2110 else if (!NILP (fun
) && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2111 fun
= indirect_function (fun
);
2115 Lisp_Object numargs
;
2116 Lisp_Object argvals
[8];
2117 Lisp_Object args_left
;
2118 register int i
, maxargs
;
2120 args_left
= original_args
;
2121 numargs
= Flength (args_left
);
2125 if (XINT (numargs
) < XSUBR (fun
)->min_args
2126 || (XSUBR (fun
)->max_args
>= 0
2127 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2128 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2130 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2131 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2132 else if (XSUBR (fun
)->max_args
== MANY
)
2134 /* Pass a vector of evaluated arguments. */
2136 ptrdiff_t argnum
= 0;
2139 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2141 GCPRO3 (args_left
, fun
, fun
);
2145 while (!NILP (args_left
))
2147 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2148 args_left
= Fcdr (args_left
);
2149 gcpro3
.nvars
= argnum
;
2152 set_backtrace_args (specpdl_ptr
- 1, vals
);
2153 set_backtrace_nargs (specpdl_ptr
- 1, XINT (numargs
));
2155 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2161 GCPRO3 (args_left
, fun
, fun
);
2162 gcpro3
.var
= argvals
;
2165 maxargs
= XSUBR (fun
)->max_args
;
2166 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2168 argvals
[i
] = eval_sub (Fcar (args_left
));
2174 set_backtrace_args (specpdl_ptr
- 1, argvals
);
2175 set_backtrace_nargs (specpdl_ptr
- 1, XINT (numargs
));
2180 val
= (XSUBR (fun
)->function
.a0 ());
2183 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2186 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2189 val
= (XSUBR (fun
)->function
.a3
2190 (argvals
[0], argvals
[1], argvals
[2]));
2193 val
= (XSUBR (fun
)->function
.a4
2194 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2197 val
= (XSUBR (fun
)->function
.a5
2198 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2202 val
= (XSUBR (fun
)->function
.a6
2203 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2204 argvals
[4], argvals
[5]));
2207 val
= (XSUBR (fun
)->function
.a7
2208 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2209 argvals
[4], argvals
[5], argvals
[6]));
2213 val
= (XSUBR (fun
)->function
.a8
2214 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2215 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2219 /* Someone has created a subr that takes more arguments than
2220 is supported by this code. We need to either rewrite the
2221 subr to use a different argument protocol, or add more
2222 cases to this switch. */
2227 else if (COMPILEDP (fun
))
2228 val
= apply_lambda (fun
, original_args
);
2232 xsignal1 (Qvoid_function
, original_fun
);
2234 xsignal1 (Qinvalid_function
, original_fun
);
2235 funcar
= XCAR (fun
);
2236 if (!SYMBOLP (funcar
))
2237 xsignal1 (Qinvalid_function
, original_fun
);
2238 if (EQ (funcar
, Qautoload
))
2240 Fautoload_do_load (fun
, original_fun
, Qnil
);
2243 if (EQ (funcar
, Qmacro
))
2245 ptrdiff_t count
= SPECPDL_INDEX ();
2247 /* Bind lexical-binding during expansion of the macro, so the
2248 macro can know reliably if the code it outputs will be
2249 interpreted using lexical-binding or not. */
2250 specbind (Qlexical_binding
,
2251 NILP (Vinternal_interpreter_environment
) ? Qnil
: Qt
);
2252 exp
= apply1 (Fcdr (fun
), original_args
);
2253 unbind_to (count
, Qnil
);
2254 val
= eval_sub (exp
);
2256 else if (EQ (funcar
, Qlambda
)
2257 || EQ (funcar
, Qclosure
))
2258 val
= apply_lambda (fun
, original_args
);
2260 xsignal1 (Qinvalid_function
, original_fun
);
2265 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2266 val
= call_debugger (list2 (Qexit
, val
));
2272 DEFUN ("apply", Fapply
, Sapply
, 1, MANY
, 0,
2273 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2274 Then return the value FUNCTION returns.
2275 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2276 usage: (apply FUNCTION &rest ARGUMENTS) */)
2277 (ptrdiff_t nargs
, Lisp_Object
*args
)
2281 register Lisp_Object spread_arg
;
2282 register Lisp_Object
*funcall_args
;
2283 Lisp_Object fun
, retval
;
2284 struct gcpro gcpro1
;
2289 spread_arg
= args
[nargs
- 1];
2290 CHECK_LIST (spread_arg
);
2292 numargs
= XINT (Flength (spread_arg
));
2295 return Ffuncall (nargs
- 1, args
);
2296 else if (numargs
== 1)
2298 args
[nargs
- 1] = XCAR (spread_arg
);
2299 return Ffuncall (nargs
, args
);
2302 numargs
+= nargs
- 2;
2304 /* Optimize for no indirection. */
2305 if (SYMBOLP (fun
) && !NILP (fun
)
2306 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2307 fun
= indirect_function (fun
);
2310 /* Let funcall get the error. */
2317 if (numargs
< XSUBR (fun
)->min_args
2318 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2319 goto funcall
; /* Let funcall get the error. */
2320 else if (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
> numargs
)
2322 /* Avoid making funcall cons up a yet another new vector of arguments
2323 by explicitly supplying nil's for optional values. */
2324 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2325 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2326 funcall_args
[++i
] = Qnil
;
2327 GCPRO1 (*funcall_args
);
2328 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2332 /* We add 1 to numargs because funcall_args includes the
2333 function itself as well as its arguments. */
2336 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2337 GCPRO1 (*funcall_args
);
2338 gcpro1
.nvars
= 1 + numargs
;
2341 memcpy (funcall_args
, args
, nargs
* word_size
);
2342 /* Spread the last arg we got. Its first element goes in
2343 the slot that it used to occupy, hence this value of I. */
2345 while (!NILP (spread_arg
))
2347 funcall_args
[i
++] = XCAR (spread_arg
);
2348 spread_arg
= XCDR (spread_arg
);
2351 /* By convention, the caller needs to gcpro Ffuncall's args. */
2352 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
2359 /* Run hook variables in various ways. */
2362 funcall_nil (ptrdiff_t nargs
, Lisp_Object
*args
)
2364 Ffuncall (nargs
, args
);
2368 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2369 doc
: /* Run each hook in HOOKS.
2370 Each argument should be a symbol, a hook variable.
2371 These symbols are processed in the order specified.
2372 If a hook symbol has a non-nil value, that value may be a function
2373 or a list of functions to be called to run the hook.
2374 If the value is a function, it is called with no arguments.
2375 If it is a list, the elements are called, in order, with no arguments.
2377 Major modes should not use this function directly to run their mode
2378 hook; they should use `run-mode-hooks' instead.
2380 Do not use `make-local-variable' to make a hook variable buffer-local.
2381 Instead, use `add-hook' and specify t for the LOCAL argument.
2382 usage: (run-hooks &rest HOOKS) */)
2383 (ptrdiff_t nargs
, Lisp_Object
*args
)
2385 Lisp_Object hook
[1];
2388 for (i
= 0; i
< nargs
; i
++)
2391 run_hook_with_args (1, hook
, funcall_nil
);
2397 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2398 Srun_hook_with_args
, 1, MANY
, 0,
2399 doc
: /* Run HOOK with the specified arguments ARGS.
2400 HOOK should be a symbol, a hook variable. The value of HOOK
2401 may be nil, a function, or a list of functions. Call each
2402 function in order with arguments ARGS. The final return value
2405 Do not use `make-local-variable' to make a hook variable buffer-local.
2406 Instead, use `add-hook' and specify t for the LOCAL argument.
2407 usage: (run-hook-with-args HOOK &rest ARGS) */)
2408 (ptrdiff_t nargs
, Lisp_Object
*args
)
2410 return run_hook_with_args (nargs
, args
, funcall_nil
);
2413 /* NB this one still documents a specific non-nil return value.
2414 (As did run-hook-with-args and run-hook-with-args-until-failure
2415 until they were changed in 24.1.) */
2416 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2417 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2418 doc
: /* Run HOOK with the specified arguments ARGS.
2419 HOOK should be a symbol, a hook variable. The value of HOOK
2420 may be nil, a function, or a list of functions. Call each
2421 function in order with arguments ARGS, stopping at the first
2422 one that returns non-nil, and return that value. Otherwise (if
2423 all functions return nil, or if there are no functions to call),
2426 Do not use `make-local-variable' to make a hook variable buffer-local.
2427 Instead, use `add-hook' and specify t for the LOCAL argument.
2428 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2429 (ptrdiff_t nargs
, Lisp_Object
*args
)
2431 return run_hook_with_args (nargs
, args
, Ffuncall
);
2435 funcall_not (ptrdiff_t nargs
, Lisp_Object
*args
)
2437 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2440 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2441 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2442 doc
: /* Run HOOK with the specified arguments ARGS.
2443 HOOK should be a symbol, a hook variable. The value of HOOK
2444 may be nil, a function, or a list of functions. Call each
2445 function in order with arguments ARGS, stopping at the first
2446 one that returns nil, and return nil. Otherwise (if all functions
2447 return non-nil, or if there are no functions to call), return non-nil
2448 \(do not rely on the precise return value in this case).
2450 Do not use `make-local-variable' to make a hook variable buffer-local.
2451 Instead, use `add-hook' and specify t for the LOCAL argument.
2452 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2453 (ptrdiff_t nargs
, Lisp_Object
*args
)
2455 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2459 run_hook_wrapped_funcall (ptrdiff_t nargs
, Lisp_Object
*args
)
2461 Lisp_Object tmp
= args
[0], ret
;
2464 ret
= Ffuncall (nargs
, args
);
2470 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2471 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2472 I.e. instead of calling each function FUN directly with arguments ARGS,
2473 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2474 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2475 aborts and returns that value.
2476 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2477 (ptrdiff_t nargs
, Lisp_Object
*args
)
2479 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2482 /* ARGS[0] should be a hook symbol.
2483 Call each of the functions in the hook value, passing each of them
2484 as arguments all the rest of ARGS (all NARGS - 1 elements).
2485 FUNCALL specifies how to call each function on the hook.
2486 The caller (or its caller, etc) must gcpro all of ARGS,
2487 except that it isn't necessary to gcpro ARGS[0]. */
2490 run_hook_with_args (ptrdiff_t nargs
, Lisp_Object
*args
,
2491 Lisp_Object (*funcall
) (ptrdiff_t nargs
, Lisp_Object
*args
))
2493 Lisp_Object sym
, val
, ret
= Qnil
;
2494 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2496 /* If we are dying or still initializing,
2497 don't do anything--it would probably crash if we tried. */
2498 if (NILP (Vrun_hooks
))
2502 val
= find_symbol_value (sym
);
2504 if (EQ (val
, Qunbound
) || NILP (val
))
2506 else if (!CONSP (val
) || FUNCTIONP (val
))
2509 return funcall (nargs
, args
);
2513 Lisp_Object global_vals
= Qnil
;
2514 GCPRO3 (sym
, val
, global_vals
);
2517 CONSP (val
) && NILP (ret
);
2520 if (EQ (XCAR (val
), Qt
))
2522 /* t indicates this hook has a local binding;
2523 it means to run the global binding too. */
2524 global_vals
= Fdefault_value (sym
);
2525 if (NILP (global_vals
)) continue;
2527 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2529 args
[0] = global_vals
;
2530 ret
= funcall (nargs
, args
);
2535 CONSP (global_vals
) && NILP (ret
);
2536 global_vals
= XCDR (global_vals
))
2538 args
[0] = XCAR (global_vals
);
2539 /* In a global value, t should not occur. If it does, we
2540 must ignore it to avoid an endless loop. */
2541 if (!EQ (args
[0], Qt
))
2542 ret
= funcall (nargs
, args
);
2548 args
[0] = XCAR (val
);
2549 ret
= funcall (nargs
, args
);
2558 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2561 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2563 Lisp_Object temp
[3];
2568 Frun_hook_with_args (3, temp
);
2571 /* Apply fn to arg. */
2573 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2575 struct gcpro gcpro1
;
2579 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2582 Lisp_Object args
[2];
2586 RETURN_UNGCPRO (Fapply (2, args
));
2590 /* Call function fn on no arguments. */
2592 call0 (Lisp_Object fn
)
2594 struct gcpro gcpro1
;
2597 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2600 /* Call function fn with 1 argument arg1. */
2603 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2605 struct gcpro gcpro1
;
2606 Lisp_Object args
[2];
2612 RETURN_UNGCPRO (Ffuncall (2, args
));
2615 /* Call function fn with 2 arguments arg1, arg2. */
2618 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2620 struct gcpro gcpro1
;
2621 Lisp_Object args
[3];
2627 RETURN_UNGCPRO (Ffuncall (3, args
));
2630 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2633 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2635 struct gcpro gcpro1
;
2636 Lisp_Object args
[4];
2643 RETURN_UNGCPRO (Ffuncall (4, args
));
2646 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2649 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2652 struct gcpro gcpro1
;
2653 Lisp_Object args
[5];
2661 RETURN_UNGCPRO (Ffuncall (5, args
));
2664 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2667 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2668 Lisp_Object arg4
, Lisp_Object arg5
)
2670 struct gcpro gcpro1
;
2671 Lisp_Object args
[6];
2680 RETURN_UNGCPRO (Ffuncall (6, args
));
2683 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2686 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2687 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2689 struct gcpro gcpro1
;
2690 Lisp_Object args
[7];
2700 RETURN_UNGCPRO (Ffuncall (7, args
));
2703 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2706 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2707 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2709 struct gcpro gcpro1
;
2710 Lisp_Object args
[8];
2721 RETURN_UNGCPRO (Ffuncall (8, args
));
2724 /* The caller should GCPRO all the elements of ARGS. */
2726 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2727 doc
: /* Non-nil if OBJECT is a function. */)
2728 (Lisp_Object object
)
2730 if (FUNCTIONP (object
))
2735 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2736 doc
: /* Call first argument as a function, passing remaining arguments to it.
2737 Return the value that function returns.
2738 Thus, (funcall 'cons 'x 'y) returns (x . y).
2739 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2740 (ptrdiff_t nargs
, Lisp_Object
*args
)
2742 Lisp_Object fun
, original_fun
;
2744 ptrdiff_t numargs
= nargs
- 1;
2745 Lisp_Object lisp_numargs
;
2747 register Lisp_Object
*internal_args
;
2752 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2754 if (max_lisp_eval_depth
< 100)
2755 max_lisp_eval_depth
= 100;
2756 if (lisp_eval_depth
> max_lisp_eval_depth
)
2757 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2760 /* This also GCPROs them. */
2761 record_in_backtrace (args
[0], &args
[1], nargs
- 1);
2763 /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
2766 if (debug_on_next_call
)
2767 do_debug_on_call (Qlambda
);
2771 original_fun
= args
[0];
2775 /* Optimize for no indirection. */
2777 if (SYMBOLP (fun
) && !NILP (fun
)
2778 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2779 fun
= indirect_function (fun
);
2783 if (numargs
< XSUBR (fun
)->min_args
2784 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2786 XSETFASTINT (lisp_numargs
, numargs
);
2787 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
2790 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2791 xsignal1 (Qinvalid_function
, original_fun
);
2793 else if (XSUBR (fun
)->max_args
== MANY
)
2794 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
2797 if (XSUBR (fun
)->max_args
> numargs
)
2799 internal_args
= alloca (XSUBR (fun
)->max_args
2800 * sizeof *internal_args
);
2801 memcpy (internal_args
, args
+ 1, numargs
* word_size
);
2802 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2803 internal_args
[i
] = Qnil
;
2806 internal_args
= args
+ 1;
2807 switch (XSUBR (fun
)->max_args
)
2810 val
= (XSUBR (fun
)->function
.a0 ());
2813 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
2816 val
= (XSUBR (fun
)->function
.a2
2817 (internal_args
[0], internal_args
[1]));
2820 val
= (XSUBR (fun
)->function
.a3
2821 (internal_args
[0], internal_args
[1], internal_args
[2]));
2824 val
= (XSUBR (fun
)->function
.a4
2825 (internal_args
[0], internal_args
[1], internal_args
[2],
2829 val
= (XSUBR (fun
)->function
.a5
2830 (internal_args
[0], internal_args
[1], internal_args
[2],
2831 internal_args
[3], internal_args
[4]));
2834 val
= (XSUBR (fun
)->function
.a6
2835 (internal_args
[0], internal_args
[1], internal_args
[2],
2836 internal_args
[3], internal_args
[4], internal_args
[5]));
2839 val
= (XSUBR (fun
)->function
.a7
2840 (internal_args
[0], internal_args
[1], internal_args
[2],
2841 internal_args
[3], internal_args
[4], internal_args
[5],
2846 val
= (XSUBR (fun
)->function
.a8
2847 (internal_args
[0], internal_args
[1], internal_args
[2],
2848 internal_args
[3], internal_args
[4], internal_args
[5],
2849 internal_args
[6], internal_args
[7]));
2854 /* If a subr takes more than 8 arguments without using MANY
2855 or UNEVALLED, we need to extend this function to support it.
2856 Until this is done, there is no way to call the function. */
2861 else if (COMPILEDP (fun
))
2862 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2866 xsignal1 (Qvoid_function
, original_fun
);
2868 xsignal1 (Qinvalid_function
, original_fun
);
2869 funcar
= XCAR (fun
);
2870 if (!SYMBOLP (funcar
))
2871 xsignal1 (Qinvalid_function
, original_fun
);
2872 if (EQ (funcar
, Qlambda
)
2873 || EQ (funcar
, Qclosure
))
2874 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2875 else if (EQ (funcar
, Qautoload
))
2877 Fautoload_do_load (fun
, original_fun
, Qnil
);
2882 xsignal1 (Qinvalid_function
, original_fun
);
2886 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2887 val
= call_debugger (list2 (Qexit
, val
));
2893 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
2895 Lisp_Object args_left
;
2898 register Lisp_Object
*arg_vector
;
2899 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2900 register Lisp_Object tem
;
2903 numargs
= XFASTINT (Flength (args
));
2904 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
2907 GCPRO3 (*arg_vector
, args_left
, fun
);
2910 for (i
= 0; i
< numargs
; )
2912 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2913 tem
= eval_sub (tem
);
2914 arg_vector
[i
++] = tem
;
2920 set_backtrace_args (specpdl_ptr
- 1, arg_vector
);
2921 set_backtrace_nargs (specpdl_ptr
- 1, i
);
2922 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
2924 /* Do the debug-on-exit now, while arg_vector still exists. */
2925 if (backtrace_debug_on_exit (specpdl_ptr
- 1))
2927 /* Don't do it again when we return to eval. */
2928 set_backtrace_debug_on_exit (specpdl_ptr
- 1, false);
2929 tem
= call_debugger (list2 (Qexit
, tem
));
2935 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2936 and return the result of evaluation.
2937 FUN must be either a lambda-expression or a compiled-code object. */
2940 funcall_lambda (Lisp_Object fun
, ptrdiff_t nargs
,
2941 register Lisp_Object
*arg_vector
)
2943 Lisp_Object val
, syms_left
, next
, lexenv
;
2944 ptrdiff_t count
= SPECPDL_INDEX ();
2946 bool optional
, rest
;
2950 if (EQ (XCAR (fun
), Qclosure
))
2952 fun
= XCDR (fun
); /* Drop `closure'. */
2953 lexenv
= XCAR (fun
);
2954 CHECK_LIST_CONS (fun
, fun
);
2958 syms_left
= XCDR (fun
);
2959 if (CONSP (syms_left
))
2960 syms_left
= XCAR (syms_left
);
2962 xsignal1 (Qinvalid_function
, fun
);
2964 else if (COMPILEDP (fun
))
2966 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2967 if (INTEGERP (syms_left
))
2968 /* A byte-code object with a non-nil `push args' slot means we
2969 shouldn't bind any arguments, instead just call the byte-code
2970 interpreter directly; it will push arguments as necessary.
2972 Byte-code objects with either a non-existent, or a nil value for
2973 the `push args' slot (the default), have dynamically-bound
2974 arguments, and use the argument-binding code below instead (as do
2975 all interpreted functions, even lexically bound ones). */
2977 /* If we have not actually read the bytecode string
2978 and constants vector yet, fetch them from the file. */
2979 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2980 Ffetch_bytecode (fun
);
2981 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
2982 AREF (fun
, COMPILED_CONSTANTS
),
2983 AREF (fun
, COMPILED_STACK_DEPTH
),
2992 i
= optional
= rest
= 0;
2993 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2997 next
= XCAR (syms_left
);
2998 if (!SYMBOLP (next
))
2999 xsignal1 (Qinvalid_function
, fun
);
3001 if (EQ (next
, Qand_rest
))
3003 else if (EQ (next
, Qand_optional
))
3010 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
3014 arg
= arg_vector
[i
++];
3016 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3020 /* Bind the argument. */
3021 if (!NILP (lexenv
) && SYMBOLP (next
))
3022 /* Lexically bind NEXT by adding it to the lexenv alist. */
3023 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
3025 /* Dynamically bind NEXT. */
3026 specbind (next
, arg
);
3030 if (!NILP (syms_left
))
3031 xsignal1 (Qinvalid_function
, fun
);
3033 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3035 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3036 /* Instantiate a new lexical environment. */
3037 specbind (Qinternal_interpreter_environment
, lexenv
);
3040 val
= Fprogn (XCDR (XCDR (fun
)));
3043 /* If we have not actually read the bytecode string
3044 and constants vector yet, fetch them from the file. */
3045 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3046 Ffetch_bytecode (fun
);
3047 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3048 AREF (fun
, COMPILED_CONSTANTS
),
3049 AREF (fun
, COMPILED_STACK_DEPTH
),
3053 return unbind_to (count
, val
);
3056 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3058 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3059 (Lisp_Object object
)
3063 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3065 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3068 tem
= AREF (object
, COMPILED_BYTECODE
);
3069 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3070 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3072 error ("Invalid byte code");
3074 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3075 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3080 /* Return true if SYMBOL currently has a let-binding
3081 which was made in the buffer that is now current. */
3084 let_shadows_buffer_binding_p (struct Lisp_Symbol
*symbol
)
3086 union specbinding
*p
;
3087 Lisp_Object buf
= Fcurrent_buffer ();
3089 for (p
= specpdl_ptr
; p
> specpdl
; )
3090 if ((--p
)->kind
> SPECPDL_LET
)
3092 struct Lisp_Symbol
*let_bound_symbol
= XSYMBOL (specpdl_symbol (p
));
3093 eassert (let_bound_symbol
->redirect
!= SYMBOL_VARALIAS
);
3094 if (symbol
== let_bound_symbol
3095 && EQ (specpdl_where (p
), buf
))
3103 let_shadows_global_binding_p (Lisp_Object symbol
)
3105 union specbinding
*p
;
3107 for (p
= specpdl_ptr
; p
> specpdl
; )
3108 if ((--p
)->kind
>= SPECPDL_LET
&& EQ (specpdl_symbol (p
), symbol
))
3114 /* `specpdl_ptr' describes which variable is
3115 let-bound, so it can be properly undone when we unbind_to.
3116 It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
3117 - SYMBOL is the variable being bound. Note that it should not be
3118 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3120 - WHERE tells us in which buffer the binding took place.
3121 This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
3122 buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
3123 i.e. bindings to the default value of a variable which can be
3127 specbind (Lisp_Object symbol
, Lisp_Object value
)
3129 struct Lisp_Symbol
*sym
;
3131 CHECK_SYMBOL (symbol
);
3132 sym
= XSYMBOL (symbol
);
3135 switch (sym
->redirect
)
3137 case SYMBOL_VARALIAS
:
3138 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3139 case SYMBOL_PLAINVAL
:
3140 /* The most common case is that of a non-constant symbol with a
3141 trivial value. Make that as fast as we can. */
3142 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3143 specpdl_ptr
->let
.symbol
= symbol
;
3144 specpdl_ptr
->let
.old_value
= SYMBOL_VAL (sym
);
3147 SET_SYMBOL_VAL (sym
, value
);
3149 set_internal (symbol
, value
, Qnil
, 1);
3151 case SYMBOL_LOCALIZED
:
3152 if (SYMBOL_BLV (sym
)->frame_local
)
3153 error ("Frame-local vars cannot be let-bound");
3154 case SYMBOL_FORWARDED
:
3156 Lisp_Object ovalue
= find_symbol_value (symbol
);
3157 specpdl_ptr
->let
.kind
= SPECPDL_LET_LOCAL
;
3158 specpdl_ptr
->let
.symbol
= symbol
;
3159 specpdl_ptr
->let
.old_value
= ovalue
;
3160 specpdl_ptr
->let
.where
= Fcurrent_buffer ();
3162 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3163 || (EQ (SYMBOL_BLV (sym
)->where
, Fcurrent_buffer ())));
3165 if (sym
->redirect
== SYMBOL_LOCALIZED
)
3167 if (!blv_found (SYMBOL_BLV (sym
)))
3168 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3170 else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3172 /* If SYMBOL is a per-buffer variable which doesn't have a
3173 buffer-local value here, make the `let' change the global
3174 value by changing the value of SYMBOL in all buffers not
3175 having their own value. This is consistent with what
3176 happens with other buffer-local variables. */
3177 if (NILP (Flocal_variable_p (symbol
, Qnil
)))
3179 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3181 Fset_default (symbol
, value
);
3186 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3189 set_internal (symbol
, value
, Qnil
, 1);
3192 default: emacs_abort ();
3196 /* Push unwind-protect entries of various types. */
3199 record_unwind_protect (void (*function
) (Lisp_Object
), Lisp_Object arg
)
3201 specpdl_ptr
->unwind
.kind
= SPECPDL_UNWIND
;
3202 specpdl_ptr
->unwind
.func
= function
;
3203 specpdl_ptr
->unwind
.arg
= arg
;
3208 record_unwind_protect_ptr (void (*function
) (void *), void *arg
)
3210 specpdl_ptr
->unwind_ptr
.kind
= SPECPDL_UNWIND_PTR
;
3211 specpdl_ptr
->unwind_ptr
.func
= function
;
3212 specpdl_ptr
->unwind_ptr
.arg
= arg
;
3217 record_unwind_protect_int (void (*function
) (int), int arg
)
3219 specpdl_ptr
->unwind_int
.kind
= SPECPDL_UNWIND_INT
;
3220 specpdl_ptr
->unwind_int
.func
= function
;
3221 specpdl_ptr
->unwind_int
.arg
= arg
;
3226 record_unwind_protect_void (void (*function
) (void))
3228 specpdl_ptr
->unwind_void
.kind
= SPECPDL_UNWIND_VOID
;
3229 specpdl_ptr
->unwind_void
.func
= function
;
3237 /* Push an unwind-protect entry that does nothing, so that
3238 set_unwind_protect_ptr can overwrite it later. */
3241 record_unwind_protect_nothing (void)
3243 record_unwind_protect_void (do_nothing
);
3246 /* Clear the unwind-protect entry COUNT, so that it does nothing.
3247 It need not be at the top of the stack. */
3250 clear_unwind_protect (ptrdiff_t count
)
3252 union specbinding
*p
= specpdl
+ count
;
3253 p
->unwind_void
.kind
= SPECPDL_UNWIND_VOID
;
3254 p
->unwind_void
.func
= do_nothing
;
3257 /* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
3258 It need not be at the top of the stack. Discard the entry's
3259 previous value without invoking it. */
3262 set_unwind_protect (ptrdiff_t count
, void (*func
) (Lisp_Object
),
3265 union specbinding
*p
= specpdl
+ count
;
3266 p
->unwind
.kind
= SPECPDL_UNWIND
;
3267 p
->unwind
.func
= func
;
3268 p
->unwind
.arg
= arg
;
3272 set_unwind_protect_ptr (ptrdiff_t count
, void (*func
) (void *), void *arg
)
3274 union specbinding
*p
= specpdl
+ count
;
3275 p
->unwind_ptr
.kind
= SPECPDL_UNWIND_PTR
;
3276 p
->unwind_ptr
.func
= func
;
3277 p
->unwind_ptr
.arg
= arg
;
3280 /* Pop and execute entries from the unwind-protect stack until the
3281 depth COUNT is reached. Return VALUE. */
3284 unbind_to (ptrdiff_t count
, Lisp_Object value
)
3286 Lisp_Object quitf
= Vquit_flag
;
3287 struct gcpro gcpro1
, gcpro2
;
3289 GCPRO2 (value
, quitf
);
3292 while (specpdl_ptr
!= specpdl
+ count
)
3294 /* Decrement specpdl_ptr before we do the work to unbind it, so
3295 that an error in unbinding won't try to unbind the same entry
3296 again. Take care to copy any parts of the binding needed
3297 before invoking any code that can make more bindings. */
3301 switch (specpdl_ptr
->kind
)
3303 case SPECPDL_UNWIND
:
3304 specpdl_ptr
->unwind
.func (specpdl_ptr
->unwind
.arg
);
3306 case SPECPDL_UNWIND_PTR
:
3307 specpdl_ptr
->unwind_ptr
.func (specpdl_ptr
->unwind_ptr
.arg
);
3309 case SPECPDL_UNWIND_INT
:
3310 specpdl_ptr
->unwind_int
.func (specpdl_ptr
->unwind_int
.arg
);
3312 case SPECPDL_UNWIND_VOID
:
3313 specpdl_ptr
->unwind_void
.func ();
3315 case SPECPDL_BACKTRACE
:
3318 { /* If variable has a trivial value (no forwarding), we can
3319 just set it. No need to check for constant symbols here,
3320 since that was already done by specbind. */
3321 struct Lisp_Symbol
*sym
= XSYMBOL (specpdl_symbol (specpdl_ptr
));
3322 if (sym
->redirect
== SYMBOL_PLAINVAL
)
3324 SET_SYMBOL_VAL (sym
, specpdl_old_value (specpdl_ptr
));
3329 NOTE: we only ever come here if make_local_foo was used for
3330 the first time on this var within this let. */
3333 case SPECPDL_LET_DEFAULT
:
3334 Fset_default (specpdl_symbol (specpdl_ptr
),
3335 specpdl_old_value (specpdl_ptr
));
3337 case SPECPDL_LET_LOCAL
:
3339 Lisp_Object symbol
= specpdl_symbol (specpdl_ptr
);
3340 Lisp_Object where
= specpdl_where (specpdl_ptr
);
3341 Lisp_Object old_value
= specpdl_old_value (specpdl_ptr
);
3342 eassert (BUFFERP (where
));
3344 /* If this was a local binding, reset the value in the appropriate
3345 buffer, but only if that buffer's binding still exists. */
3346 if (!NILP (Flocal_variable_p (symbol
, where
)))
3347 set_internal (symbol
, old_value
, where
, 1);
3353 if (NILP (Vquit_flag
) && !NILP (quitf
))
3360 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3361 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3362 A special variable is one that will be bound dynamically, even in a
3363 context where binding is lexical by default. */)
3364 (Lisp_Object symbol
)
3366 CHECK_SYMBOL (symbol
);
3367 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3371 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3372 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3373 The debugger is entered when that frame exits, if the flag is non-nil. */)
3374 (Lisp_Object level
, Lisp_Object flag
)
3376 union specbinding
*pdl
= backtrace_top ();
3377 register EMACS_INT i
;
3379 CHECK_NUMBER (level
);
3381 for (i
= 0; backtrace_p (pdl
) && i
< XINT (level
); i
++)
3382 pdl
= backtrace_next (pdl
);
3384 if (backtrace_p (pdl
))
3385 set_backtrace_debug_on_exit (pdl
, !NILP (flag
));
3390 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3391 doc
: /* Print a trace of Lisp function calls currently active.
3392 Output stream used is value of `standard-output'. */)
3395 union specbinding
*pdl
= backtrace_top ();
3397 Lisp_Object old_print_level
= Vprint_level
;
3399 if (NILP (Vprint_level
))
3400 XSETFASTINT (Vprint_level
, 8);
3402 while (backtrace_p (pdl
))
3404 write_string (backtrace_debug_on_exit (pdl
) ? "* " : " ", 2);
3405 if (backtrace_nargs (pdl
) == UNEVALLED
)
3407 Fprin1 (Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)),
3409 write_string ("\n", -1);
3413 tem
= backtrace_function (pdl
);
3414 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3415 write_string ("(", -1);
3418 for (i
= 0; i
< backtrace_nargs (pdl
); i
++)
3420 if (i
) write_string (" ", -1);
3421 Fprin1 (backtrace_args (pdl
)[i
], Qnil
);
3424 write_string (")\n", -1);
3426 pdl
= backtrace_next (pdl
);
3429 Vprint_level
= old_print_level
;
3433 static union specbinding
*
3434 get_backtrace_frame (Lisp_Object nframes
, Lisp_Object base
)
3436 union specbinding
*pdl
= backtrace_top ();
3437 register EMACS_INT i
;
3439 CHECK_NATNUM (nframes
);
3442 { /* Skip up to `base'. */
3443 base
= Findirect_function (base
, Qt
);
3444 while (backtrace_p (pdl
)
3445 && !EQ (base
, Findirect_function (backtrace_function (pdl
), Qt
)))
3446 pdl
= backtrace_next (pdl
);
3449 /* Find the frame requested. */
3450 for (i
= XFASTINT (nframes
); i
> 0 && backtrace_p (pdl
); i
--)
3451 pdl
= backtrace_next (pdl
);
3456 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 2, NULL
,
3457 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3458 If that frame has not evaluated the arguments yet (or is a special form),
3459 the value is (nil FUNCTION ARG-FORMS...).
3460 If that frame has evaluated its arguments and called its function already,
3461 the value is (t FUNCTION ARG-VALUES...).
3462 A &rest arg is represented as the tail of the list ARG-VALUES.
3463 FUNCTION is whatever was supplied as car of evaluated list,
3464 or a lambda expression for macro calls.
3465 If NFRAMES is more than the number of frames, the value is nil.
3466 If BASE is non-nil, it should be a function and NFRAMES counts from its
3467 nearest activation frame. */)
3468 (Lisp_Object nframes
, Lisp_Object base
)
3470 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3472 if (!backtrace_p (pdl
))
3474 if (backtrace_nargs (pdl
) == UNEVALLED
)
3476 Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)));
3479 Lisp_Object tem
= Flist (backtrace_nargs (pdl
), backtrace_args (pdl
));
3481 return Fcons (Qt
, Fcons (backtrace_function (pdl
), tem
));
3485 /* For backtrace-eval, we want to temporarily unwind the last few elements of
3486 the specpdl stack, and then rewind them. We store the pre-unwind values
3487 directly in the pre-existing specpdl elements (i.e. we swap the current
3488 value and the old value stored in the specpdl), kind of like the inplace
3489 pointer-reversal trick. As it turns out, the rewind does the same as the
3490 unwind, except it starts from the other end of the specpdl stack, so we use
3491 the same function for both unwind and rewind. */
3493 backtrace_eval_unrewind (int distance
)
3495 union specbinding
*tmp
= specpdl_ptr
;
3498 { /* It's a rewind rather than unwind. */
3499 tmp
+= distance
- 1;
3501 distance
= -distance
;
3504 for (; distance
> 0; distance
--)
3510 /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
3511 unwind_protect, but the problem is that we don't know how to
3512 rewind them afterwards. */
3513 case SPECPDL_UNWIND
:
3514 case SPECPDL_UNWIND_PTR
:
3515 case SPECPDL_UNWIND_INT
:
3516 case SPECPDL_UNWIND_VOID
:
3517 case SPECPDL_BACKTRACE
:
3520 { /* If variable has a trivial value (no forwarding), we can
3521 just set it. No need to check for constant symbols here,
3522 since that was already done by specbind. */
3523 struct Lisp_Symbol
*sym
= XSYMBOL (specpdl_symbol (tmp
));
3524 if (sym
->redirect
== SYMBOL_PLAINVAL
)
3526 Lisp_Object old_value
= specpdl_old_value (tmp
);
3527 set_specpdl_old_value (tmp
, SYMBOL_VAL (sym
));
3528 SET_SYMBOL_VAL (sym
, old_value
);
3533 NOTE: we only ever come here if make_local_foo was used for
3534 the first time on this var within this let. */
3537 case SPECPDL_LET_DEFAULT
:
3539 Lisp_Object sym
= specpdl_symbol (tmp
);
3540 Lisp_Object old_value
= specpdl_old_value (tmp
);
3541 set_specpdl_old_value (tmp
, Fdefault_value (sym
));
3542 Fset_default (sym
, old_value
);
3545 case SPECPDL_LET_LOCAL
:
3547 Lisp_Object symbol
= specpdl_symbol (tmp
);
3548 Lisp_Object where
= specpdl_where (tmp
);
3549 Lisp_Object old_value
= specpdl_old_value (tmp
);
3550 eassert (BUFFERP (where
));
3552 /* If this was a local binding, reset the value in the appropriate
3553 buffer, but only if that buffer's binding still exists. */
3554 if (!NILP (Flocal_variable_p (symbol
, where
)))
3556 set_specpdl_old_value
3557 (tmp
, Fbuffer_local_value (symbol
, where
));
3558 set_internal (symbol
, old_value
, where
, 1);
3566 DEFUN ("backtrace-eval", Fbacktrace_eval
, Sbacktrace_eval
, 2, 3, NULL
,
3567 doc
: /* Evaluate EXP in the context of some activation frame.
3568 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3569 (Lisp_Object exp
, Lisp_Object nframes
, Lisp_Object base
)
3571 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3572 ptrdiff_t count
= SPECPDL_INDEX ();
3573 ptrdiff_t distance
= specpdl_ptr
- pdl
;
3574 eassert (distance
>= 0);
3576 if (!backtrace_p (pdl
))
3577 error ("Activation frame not found!");
3579 backtrace_eval_unrewind (distance
);
3580 record_unwind_protect_int (backtrace_eval_unrewind
, -distance
);
3582 /* Use eval_sub rather than Feval since the main motivation behind
3583 backtrace-eval is to be able to get/set the value of lexical variables
3584 from the debugger. */
3585 return unbind_to (count
, eval_sub (exp
));
3588 DEFUN ("backtrace--locals", Fbacktrace__locals
, Sbacktrace__locals
, 1, 2, NULL
,
3589 doc
: /* Return names and values of local variables of a stack frame.
3590 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3591 (Lisp_Object nframes
, Lisp_Object base
)
3593 union specbinding
*frame
= get_backtrace_frame (nframes
, base
);
3594 union specbinding
*prevframe
3595 = get_backtrace_frame (make_number (XFASTINT (nframes
) - 1), base
);
3596 ptrdiff_t distance
= specpdl_ptr
- frame
;
3597 Lisp_Object result
= Qnil
;
3598 eassert (distance
>= 0);
3600 if (!backtrace_p (prevframe
))
3601 error ("Activation frame not found!");
3602 if (!backtrace_p (frame
))
3603 error ("Activation frame not found!");
3605 /* The specpdl entries normally contain the symbol being bound along with its
3606 `old_value', so it can be restored. The new value to which it is bound is
3607 available in one of two places: either in the current value of the
3608 variable (if it hasn't been rebound yet) or in the `old_value' slot of the
3609 next specpdl entry for it.
3610 `backtrace_eval_unrewind' happens to swap the role of `old_value'
3611 and "new value", so we abuse it here, to fetch the new value.
3612 It's ugly (we'd rather not modify global data) and a bit inefficient,
3613 but it does the job for now. */
3614 backtrace_eval_unrewind (distance
);
3618 union specbinding
*tmp
= prevframe
;
3619 for (; tmp
> frame
; tmp
--)
3624 case SPECPDL_LET_DEFAULT
:
3625 case SPECPDL_LET_LOCAL
:
3627 Lisp_Object sym
= specpdl_symbol (tmp
);
3628 Lisp_Object val
= specpdl_old_value (tmp
);
3629 if (EQ (sym
, Qinternal_interpreter_environment
))
3631 Lisp_Object env
= val
;
3632 for (; CONSP (env
); env
= XCDR (env
))
3634 Lisp_Object binding
= XCAR (env
);
3635 if (CONSP (binding
))
3636 result
= Fcons (Fcons (XCAR (binding
),
3642 result
= Fcons (Fcons (sym
, val
), result
);
3648 /* Restore values from specpdl to original place. */
3649 backtrace_eval_unrewind (-distance
);
3658 union specbinding
*pdl
;
3659 for (pdl
= specpdl
; pdl
!= specpdl_ptr
; pdl
++)
3663 case SPECPDL_UNWIND
:
3664 mark_object (specpdl_arg (pdl
));
3667 case SPECPDL_BACKTRACE
:
3669 ptrdiff_t nargs
= backtrace_nargs (pdl
);
3670 mark_object (backtrace_function (pdl
));
3671 if (nargs
== UNEVALLED
)
3674 mark_object (backtrace_args (pdl
)[nargs
]);
3678 case SPECPDL_LET_DEFAULT
:
3679 case SPECPDL_LET_LOCAL
:
3680 mark_object (specpdl_where (pdl
));
3683 mark_object (specpdl_symbol (pdl
));
3684 mark_object (specpdl_old_value (pdl
));
3691 get_backtrace (Lisp_Object array
)
3693 union specbinding
*pdl
= backtrace_next (backtrace_top ());
3694 ptrdiff_t i
= 0, asize
= ASIZE (array
);
3696 /* Copy the backtrace contents into working memory. */
3697 for (; i
< asize
; i
++)
3699 if (backtrace_p (pdl
))
3701 ASET (array
, i
, backtrace_function (pdl
));
3702 pdl
= backtrace_next (pdl
);
3705 ASET (array
, i
, Qnil
);
3709 Lisp_Object
backtrace_top_function (void)
3711 union specbinding
*pdl
= backtrace_top ();
3712 return (backtrace_p (pdl
) ? backtrace_function (pdl
) : Qnil
);
3718 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3719 doc
: /* Limit on number of Lisp variable bindings and `unwind-protect's.
3720 If Lisp code tries to increase the total number past this amount,
3721 an error is signaled.
3722 You can safely use a value considerably larger than the default value,
3723 if that proves inconveniently small. However, if you increase it too far,
3724 Emacs could run out of memory trying to make the stack bigger. */);
3726 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3727 doc
: /* Limit on depth in `eval', `apply' and `funcall' before error.
3729 This limit serves to catch infinite recursions for you before they cause
3730 actual stack overflow in C, which would be fatal for Emacs.
3731 You can safely make it considerably larger than its default value,
3732 if that proves inconveniently small. However, if you increase it too far,
3733 Emacs could overflow the real C stack, and crash. */);
3735 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3736 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3737 If the value is t, that means do an ordinary quit.
3738 If the value equals `throw-on-input', that means quit by throwing
3739 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3740 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3741 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3744 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3745 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3746 Note that `quit-flag' will still be set by typing C-g,
3747 so a quit will be signaled as soon as `inhibit-quit' is nil.
3748 To prevent this happening, set `quit-flag' to nil
3749 before making `inhibit-quit' nil. */);
3750 Vinhibit_quit
= Qnil
;
3752 DEFSYM (Qinhibit_quit
, "inhibit-quit");
3753 DEFSYM (Qautoload
, "autoload");
3754 DEFSYM (Qinhibit_debugger
, "inhibit-debugger");
3755 DEFSYM (Qmacro
, "macro");
3756 DEFSYM (Qdeclare
, "declare");
3758 /* Note that the process handling also uses Qexit, but we don't want
3759 to staticpro it twice, so we just do it here. */
3760 DEFSYM (Qexit
, "exit");
3762 DEFSYM (Qinteractive
, "interactive");
3763 DEFSYM (Qcommandp
, "commandp");
3764 DEFSYM (Qand_rest
, "&rest");
3765 DEFSYM (Qand_optional
, "&optional");
3766 DEFSYM (Qclosure
, "closure");
3767 DEFSYM (Qdebug
, "debug");
3769 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger
,
3770 doc
: /* Non-nil means never enter the debugger.
3771 Normally set while the debugger is already active, to avoid recursive
3773 Vinhibit_debugger
= Qnil
;
3775 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3776 doc
: /* Non-nil means enter debugger if an error is signaled.
3777 Does not apply to errors handled by `condition-case' or those
3778 matched by `debug-ignored-errors'.
3779 If the value is a list, an error only means to enter the debugger
3780 if one of its condition symbols appears in the list.
3781 When you evaluate an expression interactively, this variable
3782 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3783 The command `toggle-debug-on-error' toggles this.
3784 See also the variable `debug-on-quit' and `inhibit-debugger'. */);
3785 Vdebug_on_error
= Qnil
;
3787 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3788 doc
: /* List of errors for which the debugger should not be called.
3789 Each element may be a condition-name or a regexp that matches error messages.
3790 If any element applies to a given error, that error skips the debugger
3791 and just returns to top level.
3792 This overrides the variable `debug-on-error'.
3793 It does not apply to errors handled by `condition-case'. */);
3794 Vdebug_ignored_errors
= Qnil
;
3796 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3797 doc
: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
3798 Does not apply if quit is handled by a `condition-case'. */);
3801 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3802 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3804 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3805 doc
: /* Non-nil means debugger may continue execution.
3806 This is nil when the debugger is called under circumstances where it
3807 might not be safe to continue. */);
3808 debugger_may_continue
= 1;
3810 DEFVAR_LISP ("debugger", Vdebugger
,
3811 doc
: /* Function to call to invoke debugger.
3812 If due to frame exit, args are `exit' and the value being returned;
3813 this function's value will be returned instead of that.
3814 If due to error, args are `error' and a list of the args to `signal'.
3815 If due to `apply' or `funcall' entry, one arg, `lambda'.
3816 If due to `eval' entry, one arg, t. */);
3819 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3820 doc
: /* If non-nil, this is a function for `signal' to call.
3821 It receives the same arguments that `signal' was given.
3822 The Edebug package uses this to regain control. */);
3823 Vsignal_hook_function
= Qnil
;
3825 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3826 doc
: /* Non-nil means call the debugger regardless of condition handlers.
3827 Note that `debug-on-error', `debug-on-quit' and friends
3828 still determine whether to handle the particular condition. */);
3829 Vdebug_on_signal
= Qnil
;
3831 /* When lexical binding is being used,
3832 Vinternal_interpreter_environment is non-nil, and contains an alist
3833 of lexically-bound variable, or (t), indicating an empty
3834 environment. The lisp name of this variable would be
3835 `internal-interpreter-environment' if it weren't hidden.
3836 Every element of this list can be either a cons (VAR . VAL)
3837 specifying a lexical binding, or a single symbol VAR indicating
3838 that this variable should use dynamic scoping. */
3839 DEFSYM (Qinternal_interpreter_environment
,
3840 "internal-interpreter-environment");
3841 DEFVAR_LISP ("internal-interpreter-environment",
3842 Vinternal_interpreter_environment
,
3843 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3844 When lexical binding is not being used, this variable is nil.
3845 A value of `(t)' indicates an empty environment, otherwise it is an
3846 alist of active lexical bindings. */);
3847 Vinternal_interpreter_environment
= Qnil
;
3848 /* Don't export this variable to Elisp, so no one can mess with it
3849 (Just imagine if someone makes it buffer-local). */
3850 Funintern (Qinternal_interpreter_environment
, Qnil
);
3852 DEFSYM (Vrun_hooks
, "run-hooks");
3854 staticpro (&Vautoload_queue
);
3855 Vautoload_queue
= Qnil
;
3856 staticpro (&Vsignaling_function
);
3857 Vsignaling_function
= Qnil
;
3859 inhibit_lisp_code
= Qnil
;
3870 defsubr (&Sfunction
);
3871 defsubr (&Sdefault_toplevel_value
);
3872 defsubr (&Sset_default_toplevel_value
);
3874 defsubr (&Sdefvaralias
);
3875 defsubr (&Sdefconst
);
3876 defsubr (&Smake_var_non_special
);
3880 defsubr (&Smacroexpand
);
3883 defsubr (&Sunwind_protect
);
3884 defsubr (&Scondition_case
);
3886 defsubr (&Scommandp
);
3887 defsubr (&Sautoload
);
3888 defsubr (&Sautoload_do_load
);
3891 defsubr (&Sfuncall
);
3892 defsubr (&Srun_hooks
);
3893 defsubr (&Srun_hook_with_args
);
3894 defsubr (&Srun_hook_with_args_until_success
);
3895 defsubr (&Srun_hook_with_args_until_failure
);
3896 defsubr (&Srun_hook_wrapped
);
3897 defsubr (&Sfetch_bytecode
);
3898 defsubr (&Sbacktrace_debug
);
3899 defsubr (&Sbacktrace
);
3900 defsubr (&Sbacktrace_frame
);
3901 defsubr (&Sbacktrace_eval
);
3902 defsubr (&Sbacktrace__locals
);
3903 defsubr (&Sspecial_variable_p
);
3904 defsubr (&Sfunctionp
);