1 /* Evaluator for GNU Emacs Lisp interpreter.
3 Copyright (C) 1985-1987, 1993-1995, 1999-2016 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 (at
11 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"
32 /* Chain of condition and catch handlers currently in effect. */
34 struct handler
*handlerlist
;
36 /* Non-nil means record all fset's and provide's, to be undone
37 if the file being autoloaded is not fully loaded.
38 They are recorded by being consed onto the front of Vautoload_queue:
39 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
41 Lisp_Object Vautoload_queue
;
43 /* This holds either the symbol `run-hooks' or nil.
44 It is nil at an early stage of startup, and when Emacs
46 Lisp_Object Vrun_hooks
;
48 /* Current number of specbindings allocated in specpdl, not counting
49 the dummy entry specpdl[-1]. */
51 ptrdiff_t specpdl_size
;
53 /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists
54 only so that its address can be taken. */
56 union specbinding
*specpdl
;
58 /* Pointer to first unused element in specpdl. */
60 union specbinding
*specpdl_ptr
;
62 /* Depth in Lisp evaluations and function calls. */
64 static EMACS_INT lisp_eval_depth
;
66 /* The value of num_nonmacro_input_events as of the last time we
67 started to enter the debugger. If we decide to enter the debugger
68 again when this is still equal to num_nonmacro_input_events, then we
69 know that the debugger itself has an error, and we should just
70 signal the error instead of entering an infinite loop of debugger
73 static EMACS_INT when_entered_debugger
;
75 /* The function from which the last `signal' was called. Set in
77 /* FIXME: We should probably get rid of this! */
78 Lisp_Object Vsignaling_function
;
80 /* If non-nil, Lisp code must not be run since some part of Emacs is in
81 an inconsistent state. Currently unused. */
82 Lisp_Object inhibit_lisp_code
;
84 /* These would ordinarily be static, but they need to be visible to GDB. */
85 bool backtrace_p (union specbinding
*) EXTERNALLY_VISIBLE
;
86 Lisp_Object
*backtrace_args (union specbinding
*) EXTERNALLY_VISIBLE
;
87 Lisp_Object
backtrace_function (union specbinding
*) EXTERNALLY_VISIBLE
;
88 union specbinding
*backtrace_next (union specbinding
*) EXTERNALLY_VISIBLE
;
89 union specbinding
*backtrace_top (void) EXTERNALLY_VISIBLE
;
91 static Lisp_Object
funcall_lambda (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
92 static Lisp_Object
apply_lambda (Lisp_Object
, Lisp_Object
, ptrdiff_t);
95 specpdl_symbol (union specbinding
*pdl
)
97 eassert (pdl
->kind
>= SPECPDL_LET
);
98 return pdl
->let
.symbol
;
102 specpdl_old_value (union specbinding
*pdl
)
104 eassert (pdl
->kind
>= SPECPDL_LET
);
105 return pdl
->let
.old_value
;
109 set_specpdl_old_value (union specbinding
*pdl
, Lisp_Object val
)
111 eassert (pdl
->kind
>= SPECPDL_LET
);
112 pdl
->let
.old_value
= val
;
116 specpdl_where (union specbinding
*pdl
)
118 eassert (pdl
->kind
> SPECPDL_LET
);
119 return pdl
->let
.where
;
123 specpdl_arg (union specbinding
*pdl
)
125 eassert (pdl
->kind
== SPECPDL_UNWIND
);
126 return pdl
->unwind
.arg
;
130 backtrace_function (union specbinding
*pdl
)
132 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
133 return pdl
->bt
.function
;
137 backtrace_nargs (union specbinding
*pdl
)
139 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
140 return pdl
->bt
.nargs
;
144 backtrace_args (union specbinding
*pdl
)
146 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
151 backtrace_debug_on_exit (union specbinding
*pdl
)
153 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
154 return pdl
->bt
.debug_on_exit
;
157 /* Functions to modify slots of backtrace records. */
160 set_backtrace_args (union specbinding
*pdl
, Lisp_Object
*args
, ptrdiff_t nargs
)
162 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
164 pdl
->bt
.nargs
= nargs
;
168 set_backtrace_debug_on_exit (union specbinding
*pdl
, bool doe
)
170 eassert (pdl
->kind
== SPECPDL_BACKTRACE
);
171 pdl
->bt
.debug_on_exit
= doe
;
174 /* Helper functions to scan the backtrace. */
177 backtrace_p (union specbinding
*pdl
)
178 { return pdl
>= specpdl
; }
183 union specbinding
*pdl
= specpdl_ptr
- 1;
184 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
190 backtrace_next (union specbinding
*pdl
)
193 while (backtrace_p (pdl
) && pdl
->kind
!= SPECPDL_BACKTRACE
)
198 /* Return a pointer to somewhere near the top of the C stack. */
200 near_C_stack_top (void)
202 return backtrace_args (backtrace_top ());
206 init_eval_once (void)
209 union specbinding
*pdlvec
= xmalloc ((size
+ 1) * sizeof *specpdl
);
211 specpdl
= specpdl_ptr
= pdlvec
+ 1;
212 /* Don't forget to update docs (lispref node "Local Variables"). */
213 max_specpdl_size
= 1300; /* 1000 is not enough for CEDET's c-by.el. */
214 max_lisp_eval_depth
= 800;
219 static struct handler handlerlist_sentinel
;
225 specpdl_ptr
= specpdl
;
226 { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
227 This is important since handlerlist->nextfree holds the freelist
228 which would otherwise leak every time we unwind back to top-level. */
229 handlerlist
= handlerlist_sentinel
.nextfree
= &handlerlist_sentinel
;
230 struct handler
*c
= push_handler (Qunbound
, CATCHER
);
231 eassert (c
== &handlerlist_sentinel
);
232 handlerlist_sentinel
.nextfree
= NULL
;
233 handlerlist_sentinel
.next
= NULL
;
236 debug_on_next_call
= 0;
238 /* This is less than the initial value of num_nonmacro_input_events. */
239 when_entered_debugger
= -1;
242 /* Unwind-protect function used by call_debugger. */
245 restore_stack_limits (Lisp_Object data
)
247 max_specpdl_size
= XINT (XCAR (data
));
248 max_lisp_eval_depth
= XINT (XCDR (data
));
251 static void grow_specpdl (void);
253 /* Call the Lisp debugger, giving it argument ARG. */
256 call_debugger (Lisp_Object arg
)
258 bool debug_while_redisplaying
;
259 ptrdiff_t count
= SPECPDL_INDEX ();
261 EMACS_INT old_depth
= max_lisp_eval_depth
;
262 /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
263 EMACS_INT old_max
= max (max_specpdl_size
, count
);
265 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
266 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
268 /* While debugging Bug#16603, previous value of 100 was found
269 too small to avoid specpdl overflow in the debugger itself. */
270 if (max_specpdl_size
- 200 < count
)
271 max_specpdl_size
= count
+ 200;
273 if (old_max
== count
)
275 /* We can enter the debugger due to specpdl overflow (Bug#16603). */
280 /* Restore limits after leaving the debugger. */
281 record_unwind_protect (restore_stack_limits
,
282 Fcons (make_number (old_max
),
283 make_number (old_depth
)));
285 #ifdef HAVE_WINDOW_SYSTEM
286 if (display_hourglass_p
)
290 debug_on_next_call
= 0;
291 when_entered_debugger
= num_nonmacro_input_events
;
293 /* Resetting redisplaying_p to 0 makes sure that debug output is
294 displayed if the debugger is invoked during redisplay. */
295 debug_while_redisplaying
= redisplaying_p
;
297 specbind (intern ("debugger-may-continue"),
298 debug_while_redisplaying
? Qnil
: Qt
);
299 specbind (Qinhibit_redisplay
, Qnil
);
300 specbind (Qinhibit_debugger
, Qt
);
302 #if 0 /* Binding this prevents execution of Lisp code during
303 redisplay, which necessarily leads to display problems. */
304 specbind (Qinhibit_eval_during_redisplay
, Qt
);
307 val
= apply1 (Vdebugger
, arg
);
309 /* Interrupting redisplay and resuming it later is not safe under
310 all circumstances. So, when the debugger returns, abort the
311 interrupted redisplay by going back to the top-level. */
312 if (debug_while_redisplaying
)
315 return unbind_to (count
, val
);
319 do_debug_on_call (Lisp_Object code
, ptrdiff_t count
)
321 debug_on_next_call
= 0;
322 set_backtrace_debug_on_exit (specpdl
+ count
, true);
323 call_debugger (list1 (code
));
326 /* NOTE!!! Every function that can call EVAL must protect its args
327 and temporaries from garbage collection while it needs them.
328 The definition of `For' shows what you have to do. */
330 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
331 doc
: /* Eval args until one of them yields non-nil, then return that value.
332 The remaining args are not evalled at all.
333 If all args return nil, return nil.
334 usage: (or CONDITIONS...) */)
337 Lisp_Object val
= Qnil
;
341 val
= eval_sub (XCAR (args
));
350 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
351 doc
: /* Eval args until one of them yields nil, then return nil.
352 The remaining args are not evalled at all.
353 If no arg yields nil, return the last arg's value.
354 usage: (and CONDITIONS...) */)
357 Lisp_Object val
= Qt
;
361 val
= eval_sub (XCAR (args
));
370 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
371 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
372 Returns the value of THEN or the value of the last of the ELSE's.
373 THEN must be one expression, but ELSE... can be zero or more expressions.
374 If COND yields nil, and there are no ELSE's, the value is nil.
375 usage: (if COND THEN ELSE...) */)
380 cond
= eval_sub (XCAR (args
));
383 return eval_sub (Fcar (XCDR (args
)));
384 return Fprogn (XCDR (XCDR (args
)));
387 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
388 doc
: /* Try each clause until one succeeds.
389 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
390 and, if the value is non-nil, this clause succeeds:
391 then the expressions in BODY are evaluated and the last one's
392 value is the value of the cond-form.
393 If a clause has one element, as in (CONDITION), then the cond-form
394 returns CONDITION's value, if that is non-nil.
395 If no clause succeeds, cond returns nil.
396 usage: (cond CLAUSES...) */)
399 Lisp_Object val
= args
;
403 Lisp_Object clause
= XCAR (args
);
404 val
= eval_sub (Fcar (clause
));
407 if (!NILP (XCDR (clause
)))
408 val
= Fprogn (XCDR (clause
));
417 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
418 doc
: /* Eval BODY forms sequentially and return value of last one.
419 usage: (progn BODY...) */)
422 Lisp_Object val
= Qnil
;
426 val
= eval_sub (XCAR (body
));
433 /* Evaluate BODY sequentially, discarding its value. Suitable for
434 record_unwind_protect. */
437 unwind_body (Lisp_Object body
)
442 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
443 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
444 The value of FIRST is saved during the evaluation of the remaining args,
445 whose values are discarded.
446 usage: (prog1 FIRST BODY...) */)
450 Lisp_Object args_left
;
455 val
= eval_sub (XCAR (args_left
));
456 while (CONSP (args_left
= XCDR (args_left
)))
457 eval_sub (XCAR (args_left
));
462 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
463 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
464 The value of FORM2 is saved during the evaluation of the
465 remaining args, whose values are discarded.
466 usage: (prog2 FORM1 FORM2 BODY...) */)
469 eval_sub (XCAR (args
));
470 return Fprog1 (XCDR (args
));
473 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
474 doc
: /* Set each SYM to the value of its VAL.
475 The symbols SYM are variables; they are literal (not evaluated).
476 The values VAL are expressions; they are evaluated.
477 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
478 The second VAL is not computed until after the first SYM is set, and so on;
479 each VAL can use the new value of variables set earlier in the `setq'.
480 The return value of the `setq' form is the value of the last VAL.
481 usage: (setq [SYM VAL]...) */)
484 Lisp_Object val
, sym
, lex_binding
;
489 Lisp_Object args_left
= args
;
490 Lisp_Object numargs
= Flength (args
);
492 if (XINT (numargs
) & 1)
493 xsignal2 (Qwrong_number_of_arguments
, Qsetq
, numargs
);
497 val
= eval_sub (Fcar (XCDR (args_left
)));
498 sym
= XCAR (args_left
);
500 /* Like for eval_sub, we do not check declared_special here since
501 it's been done when let-binding. */
502 if (!NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
504 && !NILP (lex_binding
505 = Fassq (sym
, Vinternal_interpreter_environment
)))
506 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
508 Fset (sym
, val
); /* SYM is dynamically bound. */
510 args_left
= Fcdr (XCDR (args_left
));
512 while (CONSP (args_left
));
518 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
519 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
520 Warning: `quote' does not construct its return value, but just returns
521 the value that was pre-constructed by the Lisp reader (see info node
522 `(elisp)Printed Representation').
523 This means that \\='(a . b) is not identical to (cons \\='a \\='b): the former
524 does not cons. Quoting should be reserved for constants that will
525 never be modified by side-effects, unless you like self-modifying code.
526 See the common pitfall in info node `(elisp)Rearrangement' for an example
527 of unexpected results when a quoted object is modified.
528 usage: (quote ARG) */)
531 if (CONSP (XCDR (args
)))
532 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
536 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
537 doc
: /* Like `quote', but preferred for objects which are functions.
538 In byte compilation, `function' causes its argument to be compiled.
539 `quote' cannot do that.
540 usage: (function ARG) */)
543 Lisp_Object quoted
= XCAR (args
);
545 if (CONSP (XCDR (args
)))
546 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
548 if (!NILP (Vinternal_interpreter_environment
)
550 && EQ (XCAR (quoted
), Qlambda
))
551 { /* This is a lambda expression within a lexical environment;
552 return an interpreted closure instead of a simple lambda. */
553 Lisp_Object cdr
= XCDR (quoted
);
554 Lisp_Object tmp
= cdr
;
556 && (tmp
= XCDR (tmp
), CONSP (tmp
))
557 && (tmp
= XCAR (tmp
), CONSP (tmp
))
558 && (EQ (QCdocumentation
, XCAR (tmp
))))
559 { /* Handle the special (:documentation <form>) to build the docstring
561 Lisp_Object docstring
= eval_sub (Fcar (XCDR (tmp
)));
562 CHECK_STRING (docstring
);
563 cdr
= Fcons (XCAR (cdr
), Fcons (docstring
, XCDR (XCDR (cdr
))));
565 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
569 /* Simply quote the argument. */
574 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
575 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
576 Aliased variables always have the same value; setting one sets the other.
577 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
578 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
579 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
580 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
581 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
582 The return value is BASE-VARIABLE. */)
583 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
585 struct Lisp_Symbol
*sym
;
587 CHECK_SYMBOL (new_alias
);
588 CHECK_SYMBOL (base_variable
);
590 sym
= XSYMBOL (new_alias
);
593 /* Not sure why, but why not? */
594 error ("Cannot make a constant an alias");
596 switch (sym
->redirect
)
598 case SYMBOL_FORWARDED
:
599 error ("Cannot make an internal variable an alias");
600 case SYMBOL_LOCALIZED
:
601 error ("Don't know how to make a localized variable an alias");
602 case SYMBOL_PLAINVAL
:
603 case SYMBOL_VARALIAS
:
609 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
610 If n_a is bound, but b_v is not, set the value of b_v to n_a,
611 so that old-code that affects n_a before the aliasing is setup
613 if (NILP (Fboundp (base_variable
)))
614 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
617 union specbinding
*p
;
619 for (p
= specpdl_ptr
; p
> specpdl
; )
620 if ((--p
)->kind
>= SPECPDL_LET
621 && (EQ (new_alias
, specpdl_symbol (p
))))
622 error ("Don't know how to make a let-bound variable an alias");
625 sym
->declared_special
= 1;
626 XSYMBOL (base_variable
)->declared_special
= 1;
627 sym
->redirect
= SYMBOL_VARALIAS
;
628 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
629 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
630 LOADHIST_ATTACH (new_alias
);
631 /* Even if docstring is nil: remove old docstring. */
632 Fput (new_alias
, Qvariable_documentation
, docstring
);
634 return base_variable
;
637 static union specbinding
*
638 default_toplevel_binding (Lisp_Object symbol
)
640 union specbinding
*binding
= NULL
;
641 union specbinding
*pdl
= specpdl_ptr
;
642 while (pdl
> specpdl
)
644 switch ((--pdl
)->kind
)
646 case SPECPDL_LET_DEFAULT
:
648 if (EQ (specpdl_symbol (pdl
), symbol
))
653 case SPECPDL_UNWIND_PTR
:
654 case SPECPDL_UNWIND_INT
:
655 case SPECPDL_UNWIND_VOID
:
656 case SPECPDL_BACKTRACE
:
657 case SPECPDL_LET_LOCAL
:
667 DEFUN ("default-toplevel-value", Fdefault_toplevel_value
, Sdefault_toplevel_value
, 1, 1, 0,
668 doc
: /* Return SYMBOL's toplevel default value.
669 "Toplevel" means outside of any let binding. */)
672 union specbinding
*binding
= default_toplevel_binding (symbol
);
674 = binding
? specpdl_old_value (binding
) : Fdefault_value (symbol
);
675 if (!EQ (value
, Qunbound
))
677 xsignal1 (Qvoid_variable
, symbol
);
680 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value
,
681 Sset_default_toplevel_value
, 2, 2, 0,
682 doc
: /* Set SYMBOL's toplevel default value to VALUE.
683 "Toplevel" means outside of any let binding. */)
684 (Lisp_Object symbol
, Lisp_Object value
)
686 union specbinding
*binding
= default_toplevel_binding (symbol
);
688 set_specpdl_old_value (binding
, value
);
690 Fset_default (symbol
, value
);
694 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
695 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
696 You are not required to define a variable in order to use it, but
697 defining it lets you supply an initial value and documentation, which
698 can be referred to by the Emacs help facilities and other programming
699 tools. The `defvar' form also declares the variable as \"special\",
700 so that it is always dynamically bound even if `lexical-binding' is t.
702 The optional argument INITVALUE is evaluated, and used to set SYMBOL,
703 only if SYMBOL's value is void. If SYMBOL is buffer-local, its
704 default value is what is set; buffer-local values are not affected.
705 If INITVALUE is missing, SYMBOL's value is not set.
707 If SYMBOL has a local binding, then this form affects the local
708 binding. This is usually not what you want. Thus, if you need to
709 load a file defining variables, with this form or with `defconst' or
710 `defcustom', you should always load that file _outside_ any bindings
711 for these variables. (`defconst' and `defcustom' behave similarly in
714 The optional argument DOCSTRING is a documentation string for the
717 To define a user option, use `defcustom' instead of `defvar'.
718 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
721 Lisp_Object sym
, tem
, tail
;
728 if (CONSP (XCDR (tail
)) && CONSP (XCDR (XCDR (tail
))))
729 error ("Too many arguments");
731 tem
= Fdefault_boundp (sym
);
733 /* Do it before evaluating the initial value, for self-references. */
734 XSYMBOL (sym
)->declared_special
= 1;
737 Fset_default (sym
, eval_sub (XCAR (tail
)));
739 { /* Check if there is really a global binding rather than just a let
740 binding that shadows the global unboundness of the var. */
741 union specbinding
*binding
= default_toplevel_binding (sym
);
742 if (binding
&& EQ (specpdl_old_value (binding
), Qunbound
))
744 set_specpdl_old_value (binding
, eval_sub (XCAR (tail
)));
751 if (!NILP (Vpurify_flag
))
752 tem
= Fpurecopy (tem
);
753 Fput (sym
, Qvariable_documentation
, tem
);
755 LOADHIST_ATTACH (sym
);
757 else if (!NILP (Vinternal_interpreter_environment
)
758 && !XSYMBOL (sym
)->declared_special
)
759 /* A simple (defvar foo) with lexical scoping does "nothing" except
760 declare that var to be dynamically scoped *locally* (i.e. within
761 the current file or let-block). */
762 Vinternal_interpreter_environment
763 = Fcons (sym
, Vinternal_interpreter_environment
);
766 /* Simple (defvar <var>) should not count as a definition at all.
767 It could get in the way of other definitions, and unloading this
768 package could try to make the variable unbound. */
774 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
775 doc
: /* Define SYMBOL as a constant variable.
776 This declares that neither programs nor users should ever change the
777 value. This constancy is not actually enforced by Emacs Lisp, but
778 SYMBOL is marked as a special variable so that it is never lexically
781 The `defconst' form always sets the value of SYMBOL to the result of
782 evalling INITVALUE. If SYMBOL is buffer-local, its default value is
783 what is set; buffer-local values are not affected. If SYMBOL has a
784 local binding, then this form sets the local binding's value.
785 However, you should normally not make local bindings for variables
786 defined with this form.
788 The optional DOCSTRING specifies the variable's documentation string.
789 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
792 Lisp_Object sym
, tem
;
795 if (CONSP (Fcdr (XCDR (XCDR (args
)))))
796 error ("Too many arguments");
798 tem
= eval_sub (Fcar (XCDR (args
)));
799 if (!NILP (Vpurify_flag
))
800 tem
= Fpurecopy (tem
);
801 Fset_default (sym
, tem
);
802 XSYMBOL (sym
)->declared_special
= 1;
803 tem
= Fcar (XCDR (XCDR (args
)));
806 if (!NILP (Vpurify_flag
))
807 tem
= Fpurecopy (tem
);
808 Fput (sym
, Qvariable_documentation
, tem
);
810 Fput (sym
, Qrisky_local_variable
, Qt
);
811 LOADHIST_ATTACH (sym
);
815 /* Make SYMBOL lexically scoped. */
816 DEFUN ("internal-make-var-non-special", Fmake_var_non_special
,
817 Smake_var_non_special
, 1, 1, 0,
818 doc
: /* Internal function. */)
821 CHECK_SYMBOL (symbol
);
822 XSYMBOL (symbol
)->declared_special
= 0;
827 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
828 doc
: /* Bind variables according to VARLIST then eval BODY.
829 The value of the last form in BODY is returned.
830 Each element of VARLIST is a symbol (which is bound to nil)
831 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
832 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
833 usage: (let* VARLIST BODY...) */)
836 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
837 ptrdiff_t count
= SPECPDL_INDEX ();
839 lexenv
= Vinternal_interpreter_environment
;
841 varlist
= XCAR (args
);
842 while (CONSP (varlist
))
846 elt
= XCAR (varlist
);
852 else if (! NILP (Fcdr (Fcdr (elt
))))
853 signal_error ("`let' bindings can have only one value-form", elt
);
857 val
= eval_sub (Fcar (Fcdr (elt
)));
860 if (!NILP (lexenv
) && SYMBOLP (var
)
861 && !XSYMBOL (var
)->declared_special
862 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
863 /* Lexically bind VAR by adding it to the interpreter's binding
867 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
868 if (EQ (Vinternal_interpreter_environment
, lexenv
))
869 /* Save the old lexical environment on the specpdl stack,
870 but only for the first lexical binding, since we'll never
871 need to revert to one of the intermediate ones. */
872 specbind (Qinternal_interpreter_environment
, newenv
);
874 Vinternal_interpreter_environment
= newenv
;
879 varlist
= XCDR (varlist
);
882 val
= Fprogn (XCDR (args
));
883 return unbind_to (count
, val
);
886 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
887 doc
: /* Bind variables according to VARLIST then eval BODY.
888 The value of the last form in BODY is returned.
889 Each element of VARLIST is a symbol (which is bound to nil)
890 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
891 All the VALUEFORMs are evalled before any symbols are bound.
892 usage: (let VARLIST BODY...) */)
895 Lisp_Object
*temps
, tem
, lexenv
;
896 Lisp_Object elt
, varlist
;
897 ptrdiff_t count
= SPECPDL_INDEX ();
901 varlist
= XCAR (args
);
903 /* Make space to hold the values to give the bound variables. */
904 elt
= Flength (varlist
);
905 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
907 /* Compute the values and store them in `temps'. */
909 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
912 elt
= XCAR (varlist
);
914 temps
[argnum
++] = Qnil
;
915 else if (! NILP (Fcdr (Fcdr (elt
))))
916 signal_error ("`let' bindings can have only one value-form", elt
);
918 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
921 lexenv
= Vinternal_interpreter_environment
;
923 varlist
= XCAR (args
);
924 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
928 elt
= XCAR (varlist
);
929 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
930 tem
= temps
[argnum
++];
932 if (!NILP (lexenv
) && SYMBOLP (var
)
933 && !XSYMBOL (var
)->declared_special
934 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
935 /* Lexically bind VAR by adding it to the lexenv alist. */
936 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
938 /* Dynamically bind VAR. */
942 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
943 /* Instantiate a new lexical environment. */
944 specbind (Qinternal_interpreter_environment
, lexenv
);
946 elt
= Fprogn (XCDR (args
));
948 return unbind_to (count
, elt
);
951 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
952 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
953 The order of execution is thus TEST, BODY, TEST, BODY and so on
954 until TEST returns nil.
955 usage: (while TEST BODY...) */)
958 Lisp_Object test
, body
;
962 while (!NILP (eval_sub (test
)))
971 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
972 doc
: /* Return result of expanding macros at top level of FORM.
973 If FORM is not a macro call, it is returned unchanged.
974 Otherwise, the macro is expanded and the expansion is considered
975 in place of FORM. When a non-macro-call results, it is returned.
977 The second optional arg ENVIRONMENT specifies an environment of macro
978 definitions to shadow the loaded ones for use in file byte-compilation. */)
979 (Lisp_Object form
, Lisp_Object environment
)
981 /* With cleanups from Hallvard Furuseth. */
982 register Lisp_Object expander
, sym
, def
, tem
;
986 /* Come back here each time we expand a macro call,
987 in case it expands into another macro call. */
990 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
991 def
= sym
= XCAR (form
);
993 /* Trace symbols aliases to other symbols
994 until we get a symbol that is not an alias. */
995 while (SYMBOLP (def
))
999 tem
= Fassq (sym
, environment
);
1002 def
= XSYMBOL (sym
)->function
;
1008 /* Right now TEM is the result from SYM in ENVIRONMENT,
1009 and if TEM is nil then DEF is SYM's function definition. */
1012 /* SYM is not mentioned in ENVIRONMENT.
1013 Look at its function definition. */
1014 def
= Fautoload_do_load (def
, sym
, Qmacro
);
1016 /* Not defined or definition not suitable. */
1018 if (!EQ (XCAR (def
), Qmacro
))
1020 else expander
= XCDR (def
);
1024 expander
= XCDR (tem
);
1025 if (NILP (expander
))
1029 Lisp_Object newform
= apply1 (expander
, XCDR (form
));
1030 if (EQ (form
, newform
))
1039 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1040 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1041 TAG is evalled to get the tag to use; it must not be nil.
1043 Then the BODY is executed.
1044 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1045 If no throw happens, `catch' returns the value of the last BODY form.
1046 If a throw happens, it specifies the value to return from `catch'.
1047 usage: (catch TAG BODY...) */)
1050 Lisp_Object tag
= eval_sub (XCAR (args
));
1051 return internal_catch (tag
, Fprogn
, XCDR (args
));
1054 /* Assert that E is true, as a comment only. Use this instead of
1055 eassert (E) when E contains variables that might be clobbered by a
1058 #define clobbered_eassert(E) ((void) 0)
1060 /* Set up a catch, then call C function FUNC on argument ARG.
1061 FUNC should return a Lisp_Object.
1062 This is how catches are done from within C code. */
1065 internal_catch (Lisp_Object tag
,
1066 Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1068 /* This structure is made part of the chain `catchlist'. */
1069 struct handler
*c
= push_handler (tag
, CATCHER
);
1072 if (! sys_setjmp (c
->jmp
))
1074 Lisp_Object val
= func (arg
);
1075 clobbered_eassert (handlerlist
== c
);
1076 handlerlist
= handlerlist
->next
;
1080 { /* Throw works by a longjmp that comes right here. */
1081 Lisp_Object val
= handlerlist
->val
;
1082 clobbered_eassert (handlerlist
== c
);
1083 handlerlist
= handlerlist
->next
;
1088 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1089 jump to that CATCH, returning VALUE as the value of that catch.
1091 This is the guts of Fthrow and Fsignal; they differ only in the way
1092 they choose the catch tag to throw to. A catch tag for a
1093 condition-case form has a TAG of Qnil.
1095 Before each catch is discarded, unbind all special bindings and
1096 execute all unwind-protect clauses made above that catch. Unwind
1097 the handler stack as we go, so that the proper handlers are in
1098 effect for each unwind-protect clause we run. At the end, restore
1099 some static info saved in CATCH, and longjmp to the location
1102 This is used for correct unwinding in Fthrow and Fsignal. */
1104 static _Noreturn
void
1105 unwind_to_catch (struct handler
*catch, Lisp_Object value
)
1109 eassert (catch->next
);
1111 /* Save the value in the tag. */
1114 /* Restore certain special C variables. */
1115 set_poll_suppress_count (catch->poll_suppress_count
);
1116 unblock_input_to (catch->interrupt_input_blocked
);
1121 /* Unwind the specpdl stack, and then restore the proper set of
1123 unbind_to (handlerlist
->pdlcount
, Qnil
);
1124 last_time
= handlerlist
== catch;
1126 handlerlist
= handlerlist
->next
;
1128 while (! last_time
);
1130 eassert (handlerlist
== catch);
1132 byte_stack_list
= catch->byte_stack
;
1133 lisp_eval_depth
= catch->lisp_eval_depth
;
1135 sys_longjmp (catch->jmp
, 1);
1138 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1139 doc
: /* Throw to the catch for TAG and return VALUE from it.
1140 Both TAG and VALUE are evalled. */
1141 attributes
: noreturn
)
1142 (register Lisp_Object tag
, Lisp_Object value
)
1147 for (c
= handlerlist
; c
; c
= c
->next
)
1149 if (c
->type
== CATCHER_ALL
)
1150 unwind_to_catch (c
, Fcons (tag
, value
));
1151 if (c
->type
== CATCHER
&& EQ (c
->tag_or_ch
, tag
))
1152 unwind_to_catch (c
, value
);
1154 xsignal2 (Qno_catch
, tag
, value
);
1158 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1159 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1160 If BODYFORM completes normally, its value is returned
1161 after executing the UNWINDFORMS.
1162 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1163 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1167 ptrdiff_t count
= SPECPDL_INDEX ();
1169 record_unwind_protect (unwind_body
, XCDR (args
));
1170 val
= eval_sub (XCAR (args
));
1171 return unbind_to (count
, val
);
1174 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1175 doc
: /* Regain control when an error is signaled.
1176 Executes BODYFORM and returns its value if no error happens.
1177 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1178 where the BODY is made of Lisp expressions.
1180 A handler is applicable to an error
1181 if CONDITION-NAME is one of the error's condition names.
1182 If an error happens, the first applicable handler is run.
1184 The car of a handler may be a list of condition names instead of a
1185 single condition name; then it handles all of them. If the special
1186 condition name `debug' is present in this list, it allows another
1187 condition in the list to run the debugger if `debug-on-error' and the
1188 other usual mechanisms says it should (otherwise, `condition-case'
1189 suppresses the debugger).
1191 When a handler handles an error, control returns to the `condition-case'
1192 and it executes the handler's BODY...
1193 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1194 \(If VAR is nil, the handler can't access that information.)
1195 Then the value of the last BODY form is returned from the `condition-case'
1198 See also the function `signal' for more info.
1199 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1202 Lisp_Object var
= XCAR (args
);
1203 Lisp_Object bodyform
= XCAR (XCDR (args
));
1204 Lisp_Object handlers
= XCDR (XCDR (args
));
1206 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1209 /* Like Fcondition_case, but the args are separate
1210 rather than passed in a list. Used by Fbyte_code. */
1213 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1214 Lisp_Object handlers
)
1217 struct handler
*oldhandlerlist
= handlerlist
;
1222 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1224 Lisp_Object tem
= XCAR (val
);
1228 && (SYMBOLP (XCAR (tem
))
1229 || CONSP (XCAR (tem
))))))
1230 error ("Invalid condition handler: %s",
1231 SDATA (Fprin1_to_string (tem
, Qt
)));
1234 { /* The first clause is the one that should be checked first, so it should
1235 be added to handlerlist last. So we build in `clauses' a table that
1236 contains `handlers' but in reverse order. SAFE_ALLOCA won't work
1237 here due to the setjmp, so impose a MAX_ALLOCA limit. */
1238 if (MAX_ALLOCA
/ word_size
< clausenb
)
1239 memory_full (SIZE_MAX
);
1240 Lisp_Object
*clauses
= alloca (clausenb
* sizeof *clauses
);
1241 Lisp_Object
*volatile clauses_volatile
= clauses
;
1243 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1244 clauses
[--i
] = XCAR (val
);
1245 for (i
= 0; i
< clausenb
; i
++)
1247 Lisp_Object clause
= clauses
[i
];
1248 Lisp_Object condition
= CONSP (clause
) ? XCAR (clause
) : Qnil
;
1249 if (!CONSP (condition
))
1250 condition
= Fcons (condition
, Qnil
);
1251 struct handler
*c
= push_handler (condition
, CONDITION_CASE
);
1252 if (sys_setjmp (c
->jmp
))
1254 ptrdiff_t count
= SPECPDL_INDEX ();
1255 Lisp_Object val
= handlerlist
->val
;
1256 Lisp_Object
*chosen_clause
= clauses_volatile
;
1257 for (c
= handlerlist
->next
; c
!= oldhandlerlist
; c
= c
->next
)
1259 handlerlist
= oldhandlerlist
;
1262 if (!NILP (Vinternal_interpreter_environment
))
1263 specbind (Qinternal_interpreter_environment
,
1264 Fcons (Fcons (var
, val
),
1265 Vinternal_interpreter_environment
));
1267 specbind (var
, val
);
1269 val
= Fprogn (XCDR (*chosen_clause
));
1270 /* Note that this just undoes the binding of var; whoever
1271 longjumped to us unwound the stack to c.pdlcount before
1274 unbind_to (count
, Qnil
);
1280 val
= eval_sub (bodyform
);
1281 handlerlist
= oldhandlerlist
;
1285 /* Call the function BFUN with no arguments, catching errors within it
1286 according to HANDLERS. If there is an error, call HFUN with
1287 one argument which is the data that describes the error:
1290 HANDLERS can be a list of conditions to catch.
1291 If HANDLERS is Qt, catch all errors.
1292 If HANDLERS is Qerror, catch all errors
1293 but allow the debugger to run if that is enabled. */
1296 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1297 Lisp_Object (*hfun
) (Lisp_Object
))
1299 struct handler
*c
= push_handler (handlers
, CONDITION_CASE
);
1300 if (sys_setjmp (c
->jmp
))
1302 Lisp_Object val
= handlerlist
->val
;
1303 clobbered_eassert (handlerlist
== c
);
1304 handlerlist
= handlerlist
->next
;
1309 Lisp_Object val
= bfun ();
1310 clobbered_eassert (handlerlist
== c
);
1311 handlerlist
= handlerlist
->next
;
1316 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1319 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1320 Lisp_Object handlers
,
1321 Lisp_Object (*hfun
) (Lisp_Object
))
1323 struct handler
*c
= push_handler (handlers
, CONDITION_CASE
);
1324 if (sys_setjmp (c
->jmp
))
1326 Lisp_Object val
= handlerlist
->val
;
1327 clobbered_eassert (handlerlist
== c
);
1328 handlerlist
= handlerlist
->next
;
1333 Lisp_Object val
= bfun (arg
);
1334 clobbered_eassert (handlerlist
== c
);
1335 handlerlist
= handlerlist
->next
;
1340 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1344 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1347 Lisp_Object handlers
,
1348 Lisp_Object (*hfun
) (Lisp_Object
))
1350 struct handler
*c
= push_handler (handlers
, CONDITION_CASE
);
1351 if (sys_setjmp (c
->jmp
))
1353 Lisp_Object val
= handlerlist
->val
;
1354 clobbered_eassert (handlerlist
== c
);
1355 handlerlist
= handlerlist
->next
;
1360 Lisp_Object val
= bfun (arg1
, arg2
);
1361 clobbered_eassert (handlerlist
== c
);
1362 handlerlist
= handlerlist
->next
;
1367 /* Like internal_condition_case but call BFUN with NARGS as first,
1368 and ARGS as second argument. */
1371 internal_condition_case_n (Lisp_Object (*bfun
) (ptrdiff_t, Lisp_Object
*),
1374 Lisp_Object handlers
,
1375 Lisp_Object (*hfun
) (Lisp_Object err
,
1379 struct handler
*c
= push_handler (handlers
, CONDITION_CASE
);
1380 if (sys_setjmp (c
->jmp
))
1382 Lisp_Object val
= handlerlist
->val
;
1383 clobbered_eassert (handlerlist
== c
);
1384 handlerlist
= handlerlist
->next
;
1385 return hfun (val
, nargs
, args
);
1389 Lisp_Object val
= bfun (nargs
, args
);
1390 clobbered_eassert (handlerlist
== c
);
1391 handlerlist
= handlerlist
->next
;
1397 push_handler (Lisp_Object tag_ch_val
, enum handlertype handlertype
)
1399 struct handler
*c
= push_handler_nosignal (tag_ch_val
, handlertype
);
1401 memory_full (sizeof *c
);
1406 push_handler_nosignal (Lisp_Object tag_ch_val
, enum handlertype handlertype
)
1408 struct handler
*c
= handlerlist
->nextfree
;
1411 c
= malloc (sizeof *c
);
1414 if (profiler_memory_running
)
1415 malloc_probe (sizeof *c
);
1417 handlerlist
->nextfree
= c
;
1419 c
->type
= handlertype
;
1420 c
->tag_or_ch
= tag_ch_val
;
1422 c
->next
= handlerlist
;
1423 c
->lisp_eval_depth
= lisp_eval_depth
;
1424 c
->pdlcount
= SPECPDL_INDEX ();
1425 c
->poll_suppress_count
= poll_suppress_count
;
1426 c
->interrupt_input_blocked
= interrupt_input_blocked
;
1427 c
->byte_stack
= byte_stack_list
;
1433 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
);
1434 static bool maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1438 process_quit_flag (void)
1440 Lisp_Object flag
= Vquit_flag
;
1442 if (EQ (flag
, Qkill_emacs
))
1444 if (EQ (Vthrow_on_input
, flag
))
1445 Fthrow (Vthrow_on_input
, Qt
);
1446 Fsignal (Qquit
, Qnil
);
1449 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1450 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1451 This function does not return.
1453 An error symbol is a symbol with an `error-conditions' property
1454 that is a list of condition names.
1455 A handler for any of those names will get to handle this signal.
1456 The symbol `error' should normally be one of them.
1458 DATA should be a list. Its elements are printed as part of the error message.
1459 See Info anchor `(elisp)Definition of signal' for some details on how this
1460 error message is constructed.
1461 If the signal is handled, DATA is made available to the handler.
1462 See also the function `condition-case'. */)
1463 (Lisp_Object error_symbol
, Lisp_Object data
)
1465 /* When memory is full, ERROR-SYMBOL is nil,
1466 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1467 That is a special case--don't do this in other situations. */
1468 Lisp_Object conditions
;
1470 Lisp_Object real_error_symbol
1471 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1472 register Lisp_Object clause
= Qnil
;
1477 if (gc_in_progress
|| waiting_for_input
)
1480 #if 0 /* rms: I don't know why this was here,
1481 but it is surely wrong for an error that is handled. */
1482 #ifdef HAVE_WINDOW_SYSTEM
1483 if (display_hourglass_p
)
1484 cancel_hourglass ();
1488 /* This hook is used by edebug. */
1489 if (! NILP (Vsignal_hook_function
)
1490 && ! NILP (error_symbol
))
1492 /* Edebug takes care of restoring these variables when it exits. */
1493 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1494 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1496 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1497 max_specpdl_size
= SPECPDL_INDEX () + 40;
1499 call2 (Vsignal_hook_function
, error_symbol
, data
);
1502 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1504 /* Remember from where signal was called. Skip over the frame for
1505 `signal' itself. If a frame for `error' follows, skip that,
1506 too. Don't do this when ERROR_SYMBOL is nil, because that
1507 is a memory-full error. */
1508 Vsignaling_function
= Qnil
;
1509 if (!NILP (error_symbol
))
1511 union specbinding
*pdl
= backtrace_next (backtrace_top ());
1512 if (backtrace_p (pdl
) && EQ (backtrace_function (pdl
), Qerror
))
1513 pdl
= backtrace_next (pdl
);
1514 if (backtrace_p (pdl
))
1515 Vsignaling_function
= backtrace_function (pdl
);
1518 for (h
= handlerlist
; h
; h
= h
->next
)
1520 if (h
->type
!= CONDITION_CASE
)
1522 clause
= find_handler_clause (h
->tag_or_ch
, conditions
);
1527 if (/* Don't run the debugger for a memory-full error.
1528 (There is no room in memory to do that!) */
1529 !NILP (error_symbol
)
1530 && (!NILP (Vdebug_on_signal
)
1531 /* If no handler is present now, try to run the debugger. */
1533 /* A `debug' symbol in the handler list disables the normal
1534 suppression of the debugger. */
1535 || (CONSP (clause
) && !NILP (Fmemq (Qdebug
, clause
)))
1536 /* Special handler that means "print a message and run debugger
1538 || EQ (h
->tag_or_ch
, Qerror
)))
1540 bool debugger_called
1541 = maybe_call_debugger (conditions
, error_symbol
, data
);
1542 /* We can't return values to code which signaled an error, but we
1543 can continue code which has signaled a quit. */
1544 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1550 Lisp_Object unwind_data
1551 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1553 unwind_to_catch (h
, unwind_data
);
1557 if (handlerlist
!= &handlerlist_sentinel
)
1558 /* FIXME: This will come right back here if there's no `top-level'
1559 catcher. A better solution would be to abort here, and instead
1560 add a catch-all condition handler so we never come here. */
1561 Fthrow (Qtop_level
, Qt
);
1564 if (! NILP (error_symbol
))
1565 data
= Fcons (error_symbol
, data
);
1567 string
= Ferror_message_string (data
);
1568 fatal ("%s", SDATA (string
));
1571 /* Internal version of Fsignal that never returns.
1572 Used for anything but Qquit (which can return from Fsignal). */
1575 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1577 Fsignal (error_symbol
, data
);
1581 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1584 xsignal0 (Lisp_Object error_symbol
)
1586 xsignal (error_symbol
, Qnil
);
1590 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1592 xsignal (error_symbol
, list1 (arg
));
1596 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1598 xsignal (error_symbol
, list2 (arg1
, arg2
));
1602 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1604 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1607 /* Signal `error' with message S, and additional arg ARG.
1608 If ARG is not a genuine list, make it a one-element list. */
1611 signal_error (const char *s
, Lisp_Object arg
)
1613 Lisp_Object tortoise
, hare
;
1615 hare
= tortoise
= arg
;
1616 while (CONSP (hare
))
1623 tortoise
= XCDR (tortoise
);
1625 if (EQ (hare
, tortoise
))
1632 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1636 /* Return true if LIST is a non-nil atom or
1637 a list containing one of CONDITIONS. */
1640 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1647 while (CONSP (conditions
))
1649 Lisp_Object
this, tail
;
1650 this = XCAR (conditions
);
1651 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1652 if (EQ (XCAR (tail
), this))
1654 conditions
= XCDR (conditions
);
1659 /* Return true if an error with condition-symbols CONDITIONS,
1660 and described by SIGNAL-DATA, should skip the debugger
1661 according to debugger-ignored-errors. */
1664 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1667 bool first_string
= 1;
1668 Lisp_Object error_message
;
1670 error_message
= Qnil
;
1671 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1673 if (STRINGP (XCAR (tail
)))
1677 error_message
= Ferror_message_string (data
);
1681 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1686 Lisp_Object contail
;
1688 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1689 if (EQ (XCAR (tail
), XCAR (contail
)))
1697 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1698 SIG and DATA describe the signal. There are two ways to pass them:
1699 = SIG is the error symbol, and DATA is the rest of the data.
1700 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1701 This is for memory-full errors only. */
1703 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1705 Lisp_Object combined_data
;
1707 combined_data
= Fcons (sig
, data
);
1710 /* Don't try to run the debugger with interrupts blocked.
1711 The editing loop would return anyway. */
1712 ! input_blocked_p ()
1713 && NILP (Vinhibit_debugger
)
1714 /* Does user want to enter debugger for this kind of error? */
1717 : wants_debugger (Vdebug_on_error
, conditions
))
1718 && ! skip_debugger (conditions
, combined_data
)
1719 /* RMS: What's this for? */
1720 && when_entered_debugger
< num_nonmacro_input_events
)
1722 call_debugger (list2 (Qerror
, combined_data
));
1730 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
)
1732 register Lisp_Object h
;
1734 /* t is used by handlers for all conditions, set up by C code. */
1735 if (EQ (handlers
, Qt
))
1738 /* error is used similarly, but means print an error message
1739 and run the debugger if that is enabled. */
1740 if (EQ (handlers
, Qerror
))
1743 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1745 Lisp_Object handler
= XCAR (h
);
1746 if (!NILP (Fmemq (handler
, conditions
)))
1754 /* Format and return a string; called like vprintf. */
1756 vformat_string (const char *m
, va_list ap
)
1759 ptrdiff_t size
= sizeof buf
;
1760 ptrdiff_t size_max
= STRING_BYTES_BOUND
+ 1;
1765 used
= evxprintf (&buffer
, &size
, buf
, size_max
, m
, ap
);
1766 string
= make_string (buffer
, used
);
1773 /* Dump an error message; called like vprintf. */
1775 verror (const char *m
, va_list ap
)
1777 xsignal1 (Qerror
, vformat_string (m
, ap
));
1781 /* Dump an error message; called like printf. */
1785 error (const char *m
, ...)
1792 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1793 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1794 This means it contains a description for how to read arguments to give it.
1795 The value is nil for an invalid function or a symbol with no function
1798 Interactively callable functions include strings and vectors (treated
1799 as keyboard macros), lambda-expressions that contain a top-level call
1800 to `interactive', autoload definitions made by `autoload' with non-nil
1801 fourth argument, and some of the built-in functions of Lisp.
1803 Also, a symbol satisfies `commandp' if its function definition does so.
1805 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1806 then strings and vectors are not accepted. */)
1807 (Lisp_Object function
, Lisp_Object for_call_interactively
)
1809 register Lisp_Object fun
;
1810 register Lisp_Object funcar
;
1811 Lisp_Object if_prop
= Qnil
;
1815 fun
= indirect_function (fun
); /* Check cycles. */
1819 /* Check an `interactive-form' property if present, analogous to the
1820 function-documentation property. */
1822 while (SYMBOLP (fun
))
1824 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
1827 fun
= Fsymbol_function (fun
);
1830 /* Emacs primitives are interactive if their DEFUN specifies an
1831 interactive spec. */
1833 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
1835 /* Bytecode objects are interactive if they are long enough to
1836 have an element whose index is COMPILED_INTERACTIVE, which is
1837 where the interactive spec is stored. */
1838 else if (COMPILEDP (fun
))
1839 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1842 /* Strings and vectors are keyboard macros. */
1843 if (STRINGP (fun
) || VECTORP (fun
))
1844 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
1846 /* Lists may represent commands. */
1849 funcar
= XCAR (fun
);
1850 if (EQ (funcar
, Qclosure
))
1851 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
1853 else if (EQ (funcar
, Qlambda
))
1854 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
1855 else if (EQ (funcar
, Qautoload
))
1856 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
1861 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1862 doc
: /* Define FUNCTION to autoload from FILE.
1863 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1864 Third arg DOCSTRING is documentation for the function.
1865 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1866 Fifth arg TYPE indicates the type of the object:
1867 nil or omitted says FUNCTION is a function,
1868 `keymap' says FUNCTION is really a keymap, and
1869 `macro' or t says FUNCTION is really a macro.
1870 Third through fifth args give info about the real definition.
1871 They default to nil.
1872 If FUNCTION is already defined other than as an autoload,
1873 this does nothing and returns nil. */)
1874 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
1876 CHECK_SYMBOL (function
);
1877 CHECK_STRING (file
);
1879 /* If function is defined and not as an autoload, don't override. */
1880 if (!NILP (XSYMBOL (function
)->function
)
1881 && !AUTOLOADP (XSYMBOL (function
)->function
))
1884 if (!NILP (Vpurify_flag
) && EQ (docstring
, make_number (0)))
1885 /* `read1' in lread.c has found the docstring starting with "\
1886 and assumed the docstring will be provided by Snarf-documentation, so it
1887 passed us 0 instead. But that leads to accidental sharing in purecopy's
1888 hash-consing, so we use a (hopefully) unique integer instead. */
1889 docstring
= make_number (XHASH (function
));
1890 return Fdefalias (function
,
1891 list5 (Qautoload
, file
, docstring
, interactive
, type
),
1896 un_autoload (Lisp_Object oldqueue
)
1898 Lisp_Object queue
, first
, second
;
1900 /* Queue to unwind is current value of Vautoload_queue.
1901 oldqueue is the shadowed value to leave in Vautoload_queue. */
1902 queue
= Vautoload_queue
;
1903 Vautoload_queue
= oldqueue
;
1904 while (CONSP (queue
))
1906 first
= XCAR (queue
);
1907 second
= Fcdr (first
);
1908 first
= Fcar (first
);
1909 if (EQ (first
, make_number (0)))
1912 Ffset (first
, second
);
1913 queue
= XCDR (queue
);
1917 /* Load an autoloaded function.
1918 FUNNAME is the symbol which is the function's name.
1919 FUNDEF is the autoload definition (a list). */
1921 DEFUN ("autoload-do-load", Fautoload_do_load
, Sautoload_do_load
, 1, 3, 0,
1922 doc
: /* Load FUNDEF which should be an autoload.
1923 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1924 in which case the function returns the new autoloaded function value.
1925 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1926 it defines a macro. */)
1927 (Lisp_Object fundef
, Lisp_Object funname
, Lisp_Object macro_only
)
1929 ptrdiff_t count
= SPECPDL_INDEX ();
1931 if (!CONSP (fundef
) || !EQ (Qautoload
, XCAR (fundef
)))
1934 if (EQ (macro_only
, Qmacro
))
1936 Lisp_Object kind
= Fnth (make_number (4), fundef
);
1937 if (! (EQ (kind
, Qt
) || EQ (kind
, Qmacro
)))
1941 /* This is to make sure that loadup.el gives a clear picture
1942 of what files are preloaded and when. */
1943 if (! NILP (Vpurify_flag
))
1944 error ("Attempt to autoload %s while preparing to dump",
1945 SDATA (SYMBOL_NAME (funname
)));
1947 CHECK_SYMBOL (funname
);
1949 /* Preserve the match data. */
1950 record_unwind_save_match_data ();
1952 /* If autoloading gets an error (which includes the error of failing
1953 to define the function being called), we use Vautoload_queue
1954 to undo function definitions and `provide' calls made by
1955 the function. We do this in the specific case of autoloading
1956 because autoloading is not an explicit request "load this file",
1957 but rather a request to "call this function".
1959 The value saved here is to be restored into Vautoload_queue. */
1960 record_unwind_protect (un_autoload
, Vautoload_queue
);
1961 Vautoload_queue
= Qt
;
1962 /* If `macro_only', assume this autoload to be a "best-effort",
1963 so don't signal an error if autoloading fails. */
1964 Fload (Fcar (Fcdr (fundef
)), macro_only
, Qt
, Qnil
, Qt
);
1966 /* Once loading finishes, don't undo it. */
1967 Vautoload_queue
= Qt
;
1968 unbind_to (count
, Qnil
);
1974 Lisp_Object fun
= Findirect_function (funname
, Qnil
);
1976 if (!NILP (Fequal (fun
, fundef
)))
1977 error ("Autoloading failed to define function %s",
1978 SDATA (SYMBOL_NAME (funname
)));
1985 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
1986 doc
: /* Evaluate FORM and return its value.
1987 If LEXICAL is t, evaluate using lexical scoping.
1988 LEXICAL can also be an actual lexical environment, in the form of an
1989 alist mapping symbols to their value. */)
1990 (Lisp_Object form
, Lisp_Object lexical
)
1992 ptrdiff_t count
= SPECPDL_INDEX ();
1993 specbind (Qinternal_interpreter_environment
,
1994 CONSP (lexical
) || NILP (lexical
) ? lexical
: list1 (Qt
));
1995 return unbind_to (count
, eval_sub (form
));
1998 /* Grow the specpdl stack by one entry.
1999 The caller should have already initialized the entry.
2000 Signal an error on stack overflow.
2002 Make sure that there is always one unused entry past the top of the
2003 stack, so that the just-initialized entry is safely unwound if
2004 memory exhausted and an error is signaled here. Also, allocate a
2005 never-used entry just before the bottom of the stack; sometimes its
2006 address is taken. */
2013 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2015 ptrdiff_t count
= SPECPDL_INDEX ();
2016 ptrdiff_t max_size
= min (max_specpdl_size
, PTRDIFF_MAX
- 1000);
2017 union specbinding
*pdlvec
= specpdl
- 1;
2018 ptrdiff_t pdlvecsize
= specpdl_size
+ 1;
2019 if (max_size
<= specpdl_size
)
2021 if (max_specpdl_size
< 400)
2022 max_size
= max_specpdl_size
= 400;
2023 if (max_size
<= specpdl_size
)
2024 signal_error ("Variable binding depth exceeds max-specpdl-size",
2027 pdlvec
= xpalloc (pdlvec
, &pdlvecsize
, 1, max_size
+ 1, sizeof *specpdl
);
2028 specpdl
= pdlvec
+ 1;
2029 specpdl_size
= pdlvecsize
- 1;
2030 specpdl_ptr
= specpdl
+ count
;
2035 record_in_backtrace (Lisp_Object function
, Lisp_Object
*args
, ptrdiff_t nargs
)
2037 ptrdiff_t count
= SPECPDL_INDEX ();
2039 eassert (nargs
>= UNEVALLED
);
2040 specpdl_ptr
->bt
.kind
= SPECPDL_BACKTRACE
;
2041 specpdl_ptr
->bt
.debug_on_exit
= false;
2042 specpdl_ptr
->bt
.function
= function
;
2043 specpdl_ptr
->bt
.args
= args
;
2044 specpdl_ptr
->bt
.nargs
= nargs
;
2050 /* Eval a sub-expression of the current expression (i.e. in the same
2053 eval_sub (Lisp_Object form
)
2055 Lisp_Object fun
, val
, original_fun
, original_args
;
2059 /* Declare here, as this array may be accessed by call_debugger near
2060 the end of this function. See Bug#21245. */
2061 Lisp_Object argvals
[8];
2065 /* Look up its binding in the lexical environment.
2066 We do not pay attention to the declared_special flag here, since we
2067 already did that when let-binding the variable. */
2068 Lisp_Object lex_binding
2069 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2070 ? Fassq (form
, Vinternal_interpreter_environment
)
2072 if (CONSP (lex_binding
))
2073 return XCDR (lex_binding
);
2075 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 count
= record_in_backtrace (original_fun
, &original_args
, UNEVALLED
);
2099 if (debug_on_next_call
)
2100 do_debug_on_call (Qt
, count
);
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 args_left
= original_args
;
2116 Lisp_Object numargs
= Flength (args_left
);
2120 if (XINT (numargs
) < XSUBR (fun
)->min_args
2121 || (XSUBR (fun
)->max_args
>= 0
2122 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2123 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2125 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2126 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2127 else if (XSUBR (fun
)->max_args
== MANY
)
2129 /* Pass a vector of evaluated arguments. */
2131 ptrdiff_t argnum
= 0;
2134 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2136 while (!NILP (args_left
))
2138 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2139 args_left
= Fcdr (args_left
);
2142 set_backtrace_args (specpdl
+ count
, vals
, XINT (numargs
));
2144 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2148 /* Do the debug-on-exit now, while VALS still exists. */
2149 if (backtrace_debug_on_exit (specpdl
+ count
))
2150 val
= call_debugger (list2 (Qexit
, val
));
2157 int i
, maxargs
= XSUBR (fun
)->max_args
;
2159 for (i
= 0; i
< maxargs
; i
++)
2161 argvals
[i
] = eval_sub (Fcar (args_left
));
2162 args_left
= Fcdr (args_left
);
2165 set_backtrace_args (specpdl
+ count
, argvals
, XINT (numargs
));
2170 val
= (XSUBR (fun
)->function
.a0 ());
2173 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2176 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2179 val
= (XSUBR (fun
)->function
.a3
2180 (argvals
[0], argvals
[1], argvals
[2]));
2183 val
= (XSUBR (fun
)->function
.a4
2184 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2187 val
= (XSUBR (fun
)->function
.a5
2188 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2192 val
= (XSUBR (fun
)->function
.a6
2193 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2194 argvals
[4], argvals
[5]));
2197 val
= (XSUBR (fun
)->function
.a7
2198 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2199 argvals
[4], argvals
[5], argvals
[6]));
2203 val
= (XSUBR (fun
)->function
.a8
2204 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2205 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2209 /* Someone has created a subr that takes more arguments than
2210 is supported by this code. We need to either rewrite the
2211 subr to use a different argument protocol, or add more
2212 cases to this switch. */
2217 else if (COMPILEDP (fun
))
2218 return apply_lambda (fun
, original_args
, count
);
2222 xsignal1 (Qvoid_function
, original_fun
);
2224 xsignal1 (Qinvalid_function
, original_fun
);
2225 funcar
= XCAR (fun
);
2226 if (!SYMBOLP (funcar
))
2227 xsignal1 (Qinvalid_function
, original_fun
);
2228 if (EQ (funcar
, Qautoload
))
2230 Fautoload_do_load (fun
, original_fun
, Qnil
);
2233 if (EQ (funcar
, Qmacro
))
2235 ptrdiff_t count1
= SPECPDL_INDEX ();
2237 /* Bind lexical-binding during expansion of the macro, so the
2238 macro can know reliably if the code it outputs will be
2239 interpreted using lexical-binding or not. */
2240 specbind (Qlexical_binding
,
2241 NILP (Vinternal_interpreter_environment
) ? Qnil
: Qt
);
2242 exp
= apply1 (Fcdr (fun
), original_args
);
2243 unbind_to (count1
, Qnil
);
2244 val
= eval_sub (exp
);
2246 else if (EQ (funcar
, Qlambda
)
2247 || EQ (funcar
, Qclosure
))
2248 return apply_lambda (fun
, original_args
, count
);
2250 xsignal1 (Qinvalid_function
, original_fun
);
2255 if (backtrace_debug_on_exit (specpdl
+ count
))
2256 val
= call_debugger (list2 (Qexit
, val
));
2262 DEFUN ("apply", Fapply
, Sapply
, 1, MANY
, 0,
2263 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2264 Then return the value FUNCTION returns.
2265 Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10.
2266 usage: (apply FUNCTION &rest ARGUMENTS) */)
2267 (ptrdiff_t nargs
, Lisp_Object
*args
)
2269 ptrdiff_t i
, numargs
, funcall_nargs
;
2270 register Lisp_Object
*funcall_args
= NULL
;
2271 register Lisp_Object spread_arg
= args
[nargs
- 1];
2272 Lisp_Object fun
= args
[0];
2276 CHECK_LIST (spread_arg
);
2278 numargs
= XINT (Flength (spread_arg
));
2281 return Ffuncall (nargs
- 1, args
);
2282 else if (numargs
== 1)
2284 args
[nargs
- 1] = XCAR (spread_arg
);
2285 return Ffuncall (nargs
, args
);
2288 numargs
+= nargs
- 2;
2290 /* Optimize for no indirection. */
2291 if (SYMBOLP (fun
) && !NILP (fun
)
2292 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2294 fun
= indirect_function (fun
);
2296 /* Let funcall get the error. */
2300 if (SUBRP (fun
) && XSUBR (fun
)->max_args
> numargs
2301 /* Don't hide an error by adding missing arguments. */
2302 && numargs
>= XSUBR (fun
)->min_args
)
2304 /* Avoid making funcall cons up a yet another new vector of arguments
2305 by explicitly supplying nil's for optional values. */
2306 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2307 memclear (funcall_args
+ numargs
+ 1,
2308 (XSUBR (fun
)->max_args
- numargs
) * word_size
);
2309 funcall_nargs
= 1 + XSUBR (fun
)->max_args
;
2312 { /* We add 1 to numargs because funcall_args includes the
2313 function itself as well as its arguments. */
2314 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2315 funcall_nargs
= 1 + numargs
;
2318 memcpy (funcall_args
, args
, nargs
* word_size
);
2319 /* Spread the last arg we got. Its first element goes in
2320 the slot that it used to occupy, hence this value of I. */
2322 while (!NILP (spread_arg
))
2324 funcall_args
[i
++] = XCAR (spread_arg
);
2325 spread_arg
= XCDR (spread_arg
);
2328 retval
= Ffuncall (funcall_nargs
, funcall_args
);
2334 /* Run hook variables in various ways. */
2337 funcall_nil (ptrdiff_t nargs
, Lisp_Object
*args
)
2339 Ffuncall (nargs
, args
);
2343 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2344 doc
: /* Run each hook in HOOKS.
2345 Each argument should be a symbol, a hook variable.
2346 These symbols are processed in the order specified.
2347 If a hook symbol has a non-nil value, that value may be a function
2348 or a list of functions to be called to run the hook.
2349 If the value is a function, it is called with no arguments.
2350 If it is a list, the elements are called, in order, with no arguments.
2352 Major modes should not use this function directly to run their mode
2353 hook; they should use `run-mode-hooks' instead.
2355 Do not use `make-local-variable' to make a hook variable buffer-local.
2356 Instead, use `add-hook' and specify t for the LOCAL argument.
2357 usage: (run-hooks &rest HOOKS) */)
2358 (ptrdiff_t nargs
, Lisp_Object
*args
)
2362 for (i
= 0; i
< nargs
; i
++)
2368 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2369 Srun_hook_with_args
, 1, MANY
, 0,
2370 doc
: /* Run HOOK with the specified arguments ARGS.
2371 HOOK should be a symbol, a hook variable. The value of HOOK
2372 may be nil, a function, or a list of functions. Call each
2373 function in order with arguments ARGS. The final return value
2376 Do not use `make-local-variable' to make a hook variable buffer-local.
2377 Instead, use `add-hook' and specify t for the LOCAL argument.
2378 usage: (run-hook-with-args HOOK &rest ARGS) */)
2379 (ptrdiff_t nargs
, Lisp_Object
*args
)
2381 return run_hook_with_args (nargs
, args
, funcall_nil
);
2384 /* NB this one still documents a specific non-nil return value.
2385 (As did run-hook-with-args and run-hook-with-args-until-failure
2386 until they were changed in 24.1.) */
2387 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2388 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2389 doc
: /* Run HOOK with the specified arguments ARGS.
2390 HOOK should be a symbol, a hook variable. The value of HOOK
2391 may be nil, a function, or a list of functions. Call each
2392 function in order with arguments ARGS, stopping at the first
2393 one that returns non-nil, and return that value. Otherwise (if
2394 all functions return nil, or if there are no functions to call),
2397 Do not use `make-local-variable' to make a hook variable buffer-local.
2398 Instead, use `add-hook' and specify t for the LOCAL argument.
2399 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2400 (ptrdiff_t nargs
, Lisp_Object
*args
)
2402 return run_hook_with_args (nargs
, args
, Ffuncall
);
2406 funcall_not (ptrdiff_t nargs
, Lisp_Object
*args
)
2408 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2411 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2412 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2413 doc
: /* Run HOOK with the specified arguments ARGS.
2414 HOOK should be a symbol, a hook variable. The value of HOOK
2415 may be nil, a function, or a list of functions. Call each
2416 function in order with arguments ARGS, stopping at the first
2417 one that returns nil, and return nil. Otherwise (if all functions
2418 return non-nil, or if there are no functions to call), return non-nil
2419 \(do not rely on the precise return value in this case).
2421 Do not use `make-local-variable' to make a hook variable buffer-local.
2422 Instead, use `add-hook' and specify t for the LOCAL argument.
2423 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2424 (ptrdiff_t nargs
, Lisp_Object
*args
)
2426 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2430 run_hook_wrapped_funcall (ptrdiff_t nargs
, Lisp_Object
*args
)
2432 Lisp_Object tmp
= args
[0], ret
;
2435 ret
= Ffuncall (nargs
, args
);
2441 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2442 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2443 I.e. instead of calling each function FUN directly with arguments ARGS,
2444 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2445 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2446 aborts and returns that value.
2447 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2448 (ptrdiff_t nargs
, Lisp_Object
*args
)
2450 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2453 /* ARGS[0] should be a hook symbol.
2454 Call each of the functions in the hook value, passing each of them
2455 as arguments all the rest of ARGS (all NARGS - 1 elements).
2456 FUNCALL specifies how to call each function on the hook. */
2459 run_hook_with_args (ptrdiff_t nargs
, Lisp_Object
*args
,
2460 Lisp_Object (*funcall
) (ptrdiff_t nargs
, Lisp_Object
*args
))
2462 Lisp_Object sym
, val
, ret
= Qnil
;
2464 /* If we are dying or still initializing,
2465 don't do anything--it would probably crash if we tried. */
2466 if (NILP (Vrun_hooks
))
2470 val
= find_symbol_value (sym
);
2472 if (EQ (val
, Qunbound
) || NILP (val
))
2474 else if (!CONSP (val
) || FUNCTIONP (val
))
2477 return funcall (nargs
, args
);
2481 Lisp_Object global_vals
= Qnil
;
2484 CONSP (val
) && NILP (ret
);
2487 if (EQ (XCAR (val
), Qt
))
2489 /* t indicates this hook has a local binding;
2490 it means to run the global binding too. */
2491 global_vals
= Fdefault_value (sym
);
2492 if (NILP (global_vals
)) continue;
2494 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2496 args
[0] = global_vals
;
2497 ret
= funcall (nargs
, args
);
2502 CONSP (global_vals
) && NILP (ret
);
2503 global_vals
= XCDR (global_vals
))
2505 args
[0] = XCAR (global_vals
);
2506 /* In a global value, t should not occur. If it does, we
2507 must ignore it to avoid an endless loop. */
2508 if (!EQ (args
[0], Qt
))
2509 ret
= funcall (nargs
, args
);
2515 args
[0] = XCAR (val
);
2516 ret
= funcall (nargs
, args
);
2524 /* Run the hook HOOK, giving each function no args. */
2527 run_hook (Lisp_Object hook
)
2529 Frun_hook_with_args (1, &hook
);
2532 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2535 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2537 CALLN (Frun_hook_with_args
, hook
, arg1
, arg2
);
2540 /* Apply fn to arg. */
2542 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2544 return NILP (arg
) ? Ffuncall (1, &fn
) : CALLN (Fapply
, fn
, arg
);
2547 /* Call function fn on no arguments. */
2549 call0 (Lisp_Object fn
)
2551 return Ffuncall (1, &fn
);
2554 /* Call function fn with 1 argument arg1. */
2557 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2559 return CALLN (Ffuncall
, fn
, arg1
);
2562 /* Call function fn with 2 arguments arg1, arg2. */
2565 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2567 return CALLN (Ffuncall
, fn
, arg1
, arg2
);
2570 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2573 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2575 return CALLN (Ffuncall
, fn
, arg1
, arg2
, arg3
);
2578 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2581 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2584 return CALLN (Ffuncall
, fn
, arg1
, arg2
, arg3
, arg4
);
2587 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2590 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2591 Lisp_Object arg4
, Lisp_Object arg5
)
2593 return CALLN (Ffuncall
, fn
, arg1
, arg2
, arg3
, arg4
, arg5
);
2596 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2599 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2600 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2602 return CALLN (Ffuncall
, fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
);
2605 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2608 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2609 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2611 return CALLN (Ffuncall
, fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
, arg7
);
2614 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2615 doc
: /* Non-nil if OBJECT is a function. */)
2616 (Lisp_Object object
)
2618 if (FUNCTIONP (object
))
2623 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2624 doc
: /* Call first argument as a function, passing remaining arguments to it.
2625 Return the value that function returns.
2626 Thus, (funcall \\='cons \\='x \\='y) returns (x . y).
2627 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2628 (ptrdiff_t nargs
, Lisp_Object
*args
)
2630 Lisp_Object fun
, original_fun
;
2632 ptrdiff_t numargs
= nargs
- 1;
2633 Lisp_Object lisp_numargs
;
2635 Lisp_Object
*internal_args
;
2640 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2642 if (max_lisp_eval_depth
< 100)
2643 max_lisp_eval_depth
= 100;
2644 if (lisp_eval_depth
> max_lisp_eval_depth
)
2645 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2648 count
= record_in_backtrace (args
[0], &args
[1], nargs
- 1);
2652 if (debug_on_next_call
)
2653 do_debug_on_call (Qlambda
, count
);
2657 original_fun
= args
[0];
2661 /* Optimize for no indirection. */
2663 if (SYMBOLP (fun
) && !NILP (fun
)
2664 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2665 fun
= indirect_function (fun
);
2669 if (numargs
< XSUBR (fun
)->min_args
2670 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2672 XSETFASTINT (lisp_numargs
, numargs
);
2673 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
2676 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2677 xsignal1 (Qinvalid_function
, original_fun
);
2679 else if (XSUBR (fun
)->max_args
== MANY
)
2680 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
2683 Lisp_Object internal_argbuf
[8];
2684 if (XSUBR (fun
)->max_args
> numargs
)
2686 eassert (XSUBR (fun
)->max_args
<= ARRAYELTS (internal_argbuf
));
2687 internal_args
= internal_argbuf
;
2688 memcpy (internal_args
, args
+ 1, numargs
* word_size
);
2689 memclear (internal_args
+ numargs
,
2690 (XSUBR (fun
)->max_args
- numargs
) * word_size
);
2693 internal_args
= args
+ 1;
2694 switch (XSUBR (fun
)->max_args
)
2697 val
= (XSUBR (fun
)->function
.a0 ());
2700 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
2703 val
= (XSUBR (fun
)->function
.a2
2704 (internal_args
[0], internal_args
[1]));
2707 val
= (XSUBR (fun
)->function
.a3
2708 (internal_args
[0], internal_args
[1], internal_args
[2]));
2711 val
= (XSUBR (fun
)->function
.a4
2712 (internal_args
[0], internal_args
[1], internal_args
[2],
2716 val
= (XSUBR (fun
)->function
.a5
2717 (internal_args
[0], internal_args
[1], internal_args
[2],
2718 internal_args
[3], internal_args
[4]));
2721 val
= (XSUBR (fun
)->function
.a6
2722 (internal_args
[0], internal_args
[1], internal_args
[2],
2723 internal_args
[3], internal_args
[4], internal_args
[5]));
2726 val
= (XSUBR (fun
)->function
.a7
2727 (internal_args
[0], internal_args
[1], internal_args
[2],
2728 internal_args
[3], internal_args
[4], internal_args
[5],
2733 val
= (XSUBR (fun
)->function
.a8
2734 (internal_args
[0], internal_args
[1], internal_args
[2],
2735 internal_args
[3], internal_args
[4], internal_args
[5],
2736 internal_args
[6], internal_args
[7]));
2741 /* If a subr takes more than 8 arguments without using MANY
2742 or UNEVALLED, we need to extend this function to support it.
2743 Until this is done, there is no way to call the function. */
2748 else if (COMPILEDP (fun
))
2749 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2753 xsignal1 (Qvoid_function
, original_fun
);
2755 xsignal1 (Qinvalid_function
, original_fun
);
2756 funcar
= XCAR (fun
);
2757 if (!SYMBOLP (funcar
))
2758 xsignal1 (Qinvalid_function
, original_fun
);
2759 if (EQ (funcar
, Qlambda
)
2760 || EQ (funcar
, Qclosure
))
2761 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2762 else if (EQ (funcar
, Qautoload
))
2764 Fautoload_do_load (fun
, original_fun
, Qnil
);
2769 xsignal1 (Qinvalid_function
, original_fun
);
2773 if (backtrace_debug_on_exit (specpdl
+ count
))
2774 val
= call_debugger (list2 (Qexit
, val
));
2780 apply_lambda (Lisp_Object fun
, Lisp_Object args
, ptrdiff_t count
)
2782 Lisp_Object args_left
;
2785 Lisp_Object
*arg_vector
;
2789 numargs
= XFASTINT (Flength (args
));
2790 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
2793 for (i
= 0; i
< numargs
; )
2795 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2796 tem
= eval_sub (tem
);
2797 arg_vector
[i
++] = tem
;
2800 set_backtrace_args (specpdl
+ count
, arg_vector
, i
);
2801 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
2805 /* Do the debug-on-exit now, while arg_vector still exists. */
2806 if (backtrace_debug_on_exit (specpdl
+ count
))
2807 tem
= call_debugger (list2 (Qexit
, tem
));
2813 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2814 and return the result of evaluation.
2815 FUN must be either a lambda-expression or a compiled-code object. */
2818 funcall_lambda (Lisp_Object fun
, ptrdiff_t nargs
,
2819 register Lisp_Object
*arg_vector
)
2821 Lisp_Object val
, syms_left
, next
, lexenv
;
2822 ptrdiff_t count
= SPECPDL_INDEX ();
2824 bool optional
, rest
;
2828 if (EQ (XCAR (fun
), Qclosure
))
2830 fun
= XCDR (fun
); /* Drop `closure'. */
2831 lexenv
= XCAR (fun
);
2832 CHECK_LIST_CONS (fun
, fun
);
2836 syms_left
= XCDR (fun
);
2837 if (CONSP (syms_left
))
2838 syms_left
= XCAR (syms_left
);
2840 xsignal1 (Qinvalid_function
, fun
);
2842 else if (COMPILEDP (fun
))
2844 ptrdiff_t size
= ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
;
2845 if (size
<= COMPILED_STACK_DEPTH
)
2846 xsignal1 (Qinvalid_function
, fun
);
2847 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2848 if (INTEGERP (syms_left
))
2849 /* A byte-code object with a non-nil `push args' slot means we
2850 shouldn't bind any arguments, instead just call the byte-code
2851 interpreter directly; it will push arguments as necessary.
2853 Byte-code objects with either a non-existent, or a nil value for
2854 the `push args' slot (the default), have dynamically-bound
2855 arguments, and use the argument-binding code below instead (as do
2856 all interpreted functions, even lexically bound ones). */
2858 /* If we have not actually read the bytecode string
2859 and constants vector yet, fetch them from the file. */
2860 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2861 Ffetch_bytecode (fun
);
2862 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
2863 AREF (fun
, COMPILED_CONSTANTS
),
2864 AREF (fun
, COMPILED_STACK_DEPTH
),
2873 i
= optional
= rest
= 0;
2874 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2878 next
= XCAR (syms_left
);
2879 if (!SYMBOLP (next
))
2880 xsignal1 (Qinvalid_function
, fun
);
2882 if (EQ (next
, Qand_rest
))
2884 else if (EQ (next
, Qand_optional
))
2891 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
2895 arg
= arg_vector
[i
++];
2897 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2901 /* Bind the argument. */
2902 if (!NILP (lexenv
) && SYMBOLP (next
))
2903 /* Lexically bind NEXT by adding it to the lexenv alist. */
2904 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
2906 /* Dynamically bind NEXT. */
2907 specbind (next
, arg
);
2911 if (!NILP (syms_left
))
2912 xsignal1 (Qinvalid_function
, fun
);
2914 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2916 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
2917 /* Instantiate a new lexical environment. */
2918 specbind (Qinternal_interpreter_environment
, lexenv
);
2921 val
= Fprogn (XCDR (XCDR (fun
)));
2924 /* If we have not actually read the bytecode string
2925 and constants vector yet, fetch them from the file. */
2926 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2927 Ffetch_bytecode (fun
);
2928 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
2929 AREF (fun
, COMPILED_CONSTANTS
),
2930 AREF (fun
, COMPILED_STACK_DEPTH
),
2934 return unbind_to (count
, val
);
2937 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2939 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2940 (Lisp_Object object
)
2944 if (COMPILEDP (object
))
2946 ptrdiff_t size
= ASIZE (object
) & PSEUDOVECTOR_SIZE_MASK
;
2947 if (size
<= COMPILED_STACK_DEPTH
)
2948 xsignal1 (Qinvalid_function
, object
);
2949 if (CONSP (AREF (object
, COMPILED_BYTECODE
)))
2951 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2954 tem
= AREF (object
, COMPILED_BYTECODE
);
2955 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2956 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2958 error ("Invalid byte code");
2960 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
2961 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
2967 /* Return true if SYMBOL currently has a let-binding
2968 which was made in the buffer that is now current. */
2971 let_shadows_buffer_binding_p (struct Lisp_Symbol
*symbol
)
2973 union specbinding
*p
;
2974 Lisp_Object buf
= Fcurrent_buffer ();
2976 for (p
= specpdl_ptr
; p
> specpdl
; )
2977 if ((--p
)->kind
> SPECPDL_LET
)
2979 struct Lisp_Symbol
*let_bound_symbol
= XSYMBOL (specpdl_symbol (p
));
2980 eassert (let_bound_symbol
->redirect
!= SYMBOL_VARALIAS
);
2981 if (symbol
== let_bound_symbol
2982 && EQ (specpdl_where (p
), buf
))
2990 let_shadows_global_binding_p (Lisp_Object symbol
)
2992 union specbinding
*p
;
2994 for (p
= specpdl_ptr
; p
> specpdl
; )
2995 if ((--p
)->kind
>= SPECPDL_LET
&& EQ (specpdl_symbol (p
), symbol
))
3001 /* `specpdl_ptr' describes which variable is
3002 let-bound, so it can be properly undone when we unbind_to.
3003 It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
3004 - SYMBOL is the variable being bound. Note that it should not be
3005 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3007 - WHERE tells us in which buffer the binding took place.
3008 This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
3009 buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
3010 i.e. bindings to the default value of a variable which can be
3014 specbind (Lisp_Object symbol
, Lisp_Object value
)
3016 struct Lisp_Symbol
*sym
;
3018 CHECK_SYMBOL (symbol
);
3019 sym
= XSYMBOL (symbol
);
3022 switch (sym
->redirect
)
3024 case SYMBOL_VARALIAS
:
3025 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3026 case SYMBOL_PLAINVAL
:
3027 /* The most common case is that of a non-constant symbol with a
3028 trivial value. Make that as fast as we can. */
3029 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3030 specpdl_ptr
->let
.symbol
= symbol
;
3031 specpdl_ptr
->let
.old_value
= SYMBOL_VAL (sym
);
3034 SET_SYMBOL_VAL (sym
, value
);
3036 set_internal (symbol
, value
, Qnil
, 1);
3038 case SYMBOL_LOCALIZED
:
3039 if (SYMBOL_BLV (sym
)->frame_local
)
3040 error ("Frame-local vars cannot be let-bound");
3041 case SYMBOL_FORWARDED
:
3043 Lisp_Object ovalue
= find_symbol_value (symbol
);
3044 specpdl_ptr
->let
.kind
= SPECPDL_LET_LOCAL
;
3045 specpdl_ptr
->let
.symbol
= symbol
;
3046 specpdl_ptr
->let
.old_value
= ovalue
;
3047 specpdl_ptr
->let
.where
= Fcurrent_buffer ();
3049 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3050 || (EQ (SYMBOL_BLV (sym
)->where
, Fcurrent_buffer ())));
3052 if (sym
->redirect
== SYMBOL_LOCALIZED
)
3054 if (!blv_found (SYMBOL_BLV (sym
)))
3055 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3057 else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3059 /* If SYMBOL is a per-buffer variable which doesn't have a
3060 buffer-local value here, make the `let' change the global
3061 value by changing the value of SYMBOL in all buffers not
3062 having their own value. This is consistent with what
3063 happens with other buffer-local variables. */
3064 if (NILP (Flocal_variable_p (symbol
, Qnil
)))
3066 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
3068 Fset_default (symbol
, value
);
3073 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
3076 set_internal (symbol
, value
, Qnil
, 1);
3079 default: emacs_abort ();
3083 /* Push unwind-protect entries of various types. */
3086 record_unwind_protect (void (*function
) (Lisp_Object
), Lisp_Object arg
)
3088 specpdl_ptr
->unwind
.kind
= SPECPDL_UNWIND
;
3089 specpdl_ptr
->unwind
.func
= function
;
3090 specpdl_ptr
->unwind
.arg
= arg
;
3095 record_unwind_protect_ptr (void (*function
) (void *), void *arg
)
3097 specpdl_ptr
->unwind_ptr
.kind
= SPECPDL_UNWIND_PTR
;
3098 specpdl_ptr
->unwind_ptr
.func
= function
;
3099 specpdl_ptr
->unwind_ptr
.arg
= arg
;
3104 record_unwind_protect_int (void (*function
) (int), int arg
)
3106 specpdl_ptr
->unwind_int
.kind
= SPECPDL_UNWIND_INT
;
3107 specpdl_ptr
->unwind_int
.func
= function
;
3108 specpdl_ptr
->unwind_int
.arg
= arg
;
3113 record_unwind_protect_void (void (*function
) (void))
3115 specpdl_ptr
->unwind_void
.kind
= SPECPDL_UNWIND_VOID
;
3116 specpdl_ptr
->unwind_void
.func
= function
;
3124 /* Push an unwind-protect entry that does nothing, so that
3125 set_unwind_protect_ptr can overwrite it later. */
3128 record_unwind_protect_nothing (void)
3130 record_unwind_protect_void (do_nothing
);
3133 /* Clear the unwind-protect entry COUNT, so that it does nothing.
3134 It need not be at the top of the stack. */
3137 clear_unwind_protect (ptrdiff_t count
)
3139 union specbinding
*p
= specpdl
+ count
;
3140 p
->unwind_void
.kind
= SPECPDL_UNWIND_VOID
;
3141 p
->unwind_void
.func
= do_nothing
;
3144 /* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
3145 It need not be at the top of the stack. Discard the entry's
3146 previous value without invoking it. */
3149 set_unwind_protect (ptrdiff_t count
, void (*func
) (Lisp_Object
),
3152 union specbinding
*p
= specpdl
+ count
;
3153 p
->unwind
.kind
= SPECPDL_UNWIND
;
3154 p
->unwind
.func
= func
;
3155 p
->unwind
.arg
= arg
;
3159 set_unwind_protect_ptr (ptrdiff_t count
, void (*func
) (void *), void *arg
)
3161 union specbinding
*p
= specpdl
+ count
;
3162 p
->unwind_ptr
.kind
= SPECPDL_UNWIND_PTR
;
3163 p
->unwind_ptr
.func
= func
;
3164 p
->unwind_ptr
.arg
= arg
;
3167 /* Pop and execute entries from the unwind-protect stack until the
3168 depth COUNT is reached. Return VALUE. */
3171 unbind_to (ptrdiff_t count
, Lisp_Object value
)
3173 Lisp_Object quitf
= Vquit_flag
;
3177 while (specpdl_ptr
!= specpdl
+ count
)
3179 /* Decrement specpdl_ptr before we do the work to unbind it, so
3180 that an error in unbinding won't try to unbind the same entry
3181 again. Take care to copy any parts of the binding needed
3182 before invoking any code that can make more bindings. */
3186 switch (specpdl_ptr
->kind
)
3188 case SPECPDL_UNWIND
:
3189 specpdl_ptr
->unwind
.func (specpdl_ptr
->unwind
.arg
);
3191 case SPECPDL_UNWIND_PTR
:
3192 specpdl_ptr
->unwind_ptr
.func (specpdl_ptr
->unwind_ptr
.arg
);
3194 case SPECPDL_UNWIND_INT
:
3195 specpdl_ptr
->unwind_int
.func (specpdl_ptr
->unwind_int
.arg
);
3197 case SPECPDL_UNWIND_VOID
:
3198 specpdl_ptr
->unwind_void
.func ();
3200 case SPECPDL_BACKTRACE
:
3203 { /* If variable has a trivial value (no forwarding), we can
3204 just set it. No need to check for constant symbols here,
3205 since that was already done by specbind. */
3206 Lisp_Object sym
= specpdl_symbol (specpdl_ptr
);
3207 if (SYMBOLP (sym
) && XSYMBOL (sym
)->redirect
== SYMBOL_PLAINVAL
)
3209 SET_SYMBOL_VAL (XSYMBOL (sym
),
3210 specpdl_old_value (specpdl_ptr
));
3215 NOTE: we only ever come here if make_local_foo was used for
3216 the first time on this var within this let. */
3219 case SPECPDL_LET_DEFAULT
:
3220 Fset_default (specpdl_symbol (specpdl_ptr
),
3221 specpdl_old_value (specpdl_ptr
));
3223 case SPECPDL_LET_LOCAL
:
3225 Lisp_Object symbol
= specpdl_symbol (specpdl_ptr
);
3226 Lisp_Object where
= specpdl_where (specpdl_ptr
);
3227 Lisp_Object old_value
= specpdl_old_value (specpdl_ptr
);
3228 eassert (BUFFERP (where
));
3230 /* If this was a local binding, reset the value in the appropriate
3231 buffer, but only if that buffer's binding still exists. */
3232 if (!NILP (Flocal_variable_p (symbol
, where
)))
3233 set_internal (symbol
, old_value
, where
, 1);
3239 if (NILP (Vquit_flag
) && !NILP (quitf
))
3245 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3246 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3247 A special variable is one that will be bound dynamically, even in a
3248 context where binding is lexical by default. */)
3249 (Lisp_Object symbol
)
3251 CHECK_SYMBOL (symbol
);
3252 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3256 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3257 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3258 The debugger is entered when that frame exits, if the flag is non-nil. */)
3259 (Lisp_Object level
, Lisp_Object flag
)
3261 union specbinding
*pdl
= backtrace_top ();
3262 register EMACS_INT i
;
3264 CHECK_NUMBER (level
);
3266 for (i
= 0; backtrace_p (pdl
) && i
< XINT (level
); i
++)
3267 pdl
= backtrace_next (pdl
);
3269 if (backtrace_p (pdl
))
3270 set_backtrace_debug_on_exit (pdl
, !NILP (flag
));
3275 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3276 doc
: /* Print a trace of Lisp function calls currently active.
3277 Output stream used is value of `standard-output'. */)
3280 union specbinding
*pdl
= backtrace_top ();
3282 Lisp_Object old_print_level
= Vprint_level
;
3284 if (NILP (Vprint_level
))
3285 XSETFASTINT (Vprint_level
, 8);
3287 while (backtrace_p (pdl
))
3289 write_string (backtrace_debug_on_exit (pdl
) ? "* " : " ");
3290 if (backtrace_nargs (pdl
) == UNEVALLED
)
3292 Fprin1 (Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)),
3294 write_string ("\n");
3298 tem
= backtrace_function (pdl
);
3299 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3303 for (i
= 0; i
< backtrace_nargs (pdl
); i
++)
3305 if (i
) write_string (" ");
3306 Fprin1 (backtrace_args (pdl
)[i
], Qnil
);
3309 write_string (")\n");
3311 pdl
= backtrace_next (pdl
);
3314 Vprint_level
= old_print_level
;
3318 static union specbinding
*
3319 get_backtrace_frame (Lisp_Object nframes
, Lisp_Object base
)
3321 union specbinding
*pdl
= backtrace_top ();
3322 register EMACS_INT i
;
3324 CHECK_NATNUM (nframes
);
3327 { /* Skip up to `base'. */
3328 base
= Findirect_function (base
, Qt
);
3329 while (backtrace_p (pdl
)
3330 && !EQ (base
, Findirect_function (backtrace_function (pdl
), Qt
)))
3331 pdl
= backtrace_next (pdl
);
3334 /* Find the frame requested. */
3335 for (i
= XFASTINT (nframes
); i
> 0 && backtrace_p (pdl
); i
--)
3336 pdl
= backtrace_next (pdl
);
3341 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 2, NULL
,
3342 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3343 If that frame has not evaluated the arguments yet (or is a special form),
3344 the value is (nil FUNCTION ARG-FORMS...).
3345 If that frame has evaluated its arguments and called its function already,
3346 the value is (t FUNCTION ARG-VALUES...).
3347 A &rest arg is represented as the tail of the list ARG-VALUES.
3348 FUNCTION is whatever was supplied as car of evaluated list,
3349 or a lambda expression for macro calls.
3350 If NFRAMES is more than the number of frames, the value is nil.
3351 If BASE is non-nil, it should be a function and NFRAMES counts from its
3352 nearest activation frame. */)
3353 (Lisp_Object nframes
, Lisp_Object base
)
3355 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3357 if (!backtrace_p (pdl
))
3359 if (backtrace_nargs (pdl
) == UNEVALLED
)
3361 Fcons (backtrace_function (pdl
), *backtrace_args (pdl
)));
3364 Lisp_Object tem
= Flist (backtrace_nargs (pdl
), backtrace_args (pdl
));
3366 return Fcons (Qt
, Fcons (backtrace_function (pdl
), tem
));
3370 /* For backtrace-eval, we want to temporarily unwind the last few elements of
3371 the specpdl stack, and then rewind them. We store the pre-unwind values
3372 directly in the pre-existing specpdl elements (i.e. we swap the current
3373 value and the old value stored in the specpdl), kind of like the inplace
3374 pointer-reversal trick. As it turns out, the rewind does the same as the
3375 unwind, except it starts from the other end of the specpdl stack, so we use
3376 the same function for both unwind and rewind. */
3378 backtrace_eval_unrewind (int distance
)
3380 union specbinding
*tmp
= specpdl_ptr
;
3383 { /* It's a rewind rather than unwind. */
3384 tmp
+= distance
- 1;
3386 distance
= -distance
;
3389 for (; distance
> 0; distance
--)
3394 /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
3395 unwind_protect, but the problem is that we don't know how to
3396 rewind them afterwards. */
3397 case SPECPDL_UNWIND
:
3399 Lisp_Object oldarg
= tmp
->unwind
.arg
;
3400 if (tmp
->unwind
.func
== set_buffer_if_live
)
3401 tmp
->unwind
.arg
= Fcurrent_buffer ();
3402 else if (tmp
->unwind
.func
== save_excursion_restore
)
3403 tmp
->unwind
.arg
= save_excursion_save ();
3406 tmp
->unwind
.func (oldarg
);
3410 case SPECPDL_UNWIND_PTR
:
3411 case SPECPDL_UNWIND_INT
:
3412 case SPECPDL_UNWIND_VOID
:
3413 case SPECPDL_BACKTRACE
:
3416 { /* If variable has a trivial value (no forwarding), we can
3417 just set it. No need to check for constant symbols here,
3418 since that was already done by specbind. */
3419 Lisp_Object sym
= specpdl_symbol (tmp
);
3420 if (SYMBOLP (sym
) && XSYMBOL (sym
)->redirect
== SYMBOL_PLAINVAL
)
3422 Lisp_Object old_value
= specpdl_old_value (tmp
);
3423 set_specpdl_old_value (tmp
, SYMBOL_VAL (XSYMBOL (sym
)));
3424 SET_SYMBOL_VAL (XSYMBOL (sym
), old_value
);
3429 NOTE: we only ever come here if make_local_foo was used for
3430 the first time on this var within this let. */
3433 case SPECPDL_LET_DEFAULT
:
3435 Lisp_Object sym
= specpdl_symbol (tmp
);
3436 Lisp_Object old_value
= specpdl_old_value (tmp
);
3437 set_specpdl_old_value (tmp
, Fdefault_value (sym
));
3438 Fset_default (sym
, old_value
);
3441 case SPECPDL_LET_LOCAL
:
3443 Lisp_Object symbol
= specpdl_symbol (tmp
);
3444 Lisp_Object where
= specpdl_where (tmp
);
3445 Lisp_Object old_value
= specpdl_old_value (tmp
);
3446 eassert (BUFFERP (where
));
3448 /* If this was a local binding, reset the value in the appropriate
3449 buffer, but only if that buffer's binding still exists. */
3450 if (!NILP (Flocal_variable_p (symbol
, where
)))
3452 set_specpdl_old_value
3453 (tmp
, Fbuffer_local_value (symbol
, where
));
3454 set_internal (symbol
, old_value
, where
, 1);
3462 DEFUN ("backtrace-eval", Fbacktrace_eval
, Sbacktrace_eval
, 2, 3, NULL
,
3463 doc
: /* Evaluate EXP in the context of some activation frame.
3464 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3465 (Lisp_Object exp
, Lisp_Object nframes
, Lisp_Object base
)
3467 union specbinding
*pdl
= get_backtrace_frame (nframes
, base
);
3468 ptrdiff_t count
= SPECPDL_INDEX ();
3469 ptrdiff_t distance
= specpdl_ptr
- pdl
;
3470 eassert (distance
>= 0);
3472 if (!backtrace_p (pdl
))
3473 error ("Activation frame not found!");
3475 backtrace_eval_unrewind (distance
);
3476 record_unwind_protect_int (backtrace_eval_unrewind
, -distance
);
3478 /* Use eval_sub rather than Feval since the main motivation behind
3479 backtrace-eval is to be able to get/set the value of lexical variables
3480 from the debugger. */
3481 return unbind_to (count
, eval_sub (exp
));
3484 DEFUN ("backtrace--locals", Fbacktrace__locals
, Sbacktrace__locals
, 1, 2, NULL
,
3485 doc
: /* Return names and values of local variables of a stack frame.
3486 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
3487 (Lisp_Object nframes
, Lisp_Object base
)
3489 union specbinding
*frame
= get_backtrace_frame (nframes
, base
);
3490 union specbinding
*prevframe
3491 = get_backtrace_frame (make_number (XFASTINT (nframes
) - 1), base
);
3492 ptrdiff_t distance
= specpdl_ptr
- frame
;
3493 Lisp_Object result
= Qnil
;
3494 eassert (distance
>= 0);
3496 if (!backtrace_p (prevframe
))
3497 error ("Activation frame not found!");
3498 if (!backtrace_p (frame
))
3499 error ("Activation frame not found!");
3501 /* The specpdl entries normally contain the symbol being bound along with its
3502 `old_value', so it can be restored. The new value to which it is bound is
3503 available in one of two places: either in the current value of the
3504 variable (if it hasn't been rebound yet) or in the `old_value' slot of the
3505 next specpdl entry for it.
3506 `backtrace_eval_unrewind' happens to swap the role of `old_value'
3507 and "new value", so we abuse it here, to fetch the new value.
3508 It's ugly (we'd rather not modify global data) and a bit inefficient,
3509 but it does the job for now. */
3510 backtrace_eval_unrewind (distance
);
3514 union specbinding
*tmp
= prevframe
;
3515 for (; tmp
> frame
; tmp
--)
3520 case SPECPDL_LET_DEFAULT
:
3521 case SPECPDL_LET_LOCAL
:
3523 Lisp_Object sym
= specpdl_symbol (tmp
);
3524 Lisp_Object val
= specpdl_old_value (tmp
);
3525 if (EQ (sym
, Qinternal_interpreter_environment
))
3527 Lisp_Object env
= val
;
3528 for (; CONSP (env
); env
= XCDR (env
))
3530 Lisp_Object binding
= XCAR (env
);
3531 if (CONSP (binding
))
3532 result
= Fcons (Fcons (XCAR (binding
),
3538 result
= Fcons (Fcons (sym
, val
), result
);
3542 case SPECPDL_UNWIND
:
3543 case SPECPDL_UNWIND_PTR
:
3544 case SPECPDL_UNWIND_INT
:
3545 case SPECPDL_UNWIND_VOID
:
3546 case SPECPDL_BACKTRACE
:
3555 /* Restore values from specpdl to original place. */
3556 backtrace_eval_unrewind (-distance
);
3565 union specbinding
*pdl
;
3566 for (pdl
= specpdl
; pdl
!= specpdl_ptr
; pdl
++)
3570 case SPECPDL_UNWIND
:
3571 mark_object (specpdl_arg (pdl
));
3574 case SPECPDL_BACKTRACE
:
3576 ptrdiff_t nargs
= backtrace_nargs (pdl
);
3577 mark_object (backtrace_function (pdl
));
3578 if (nargs
== UNEVALLED
)
3581 mark_object (backtrace_args (pdl
)[nargs
]);
3585 case SPECPDL_LET_DEFAULT
:
3586 case SPECPDL_LET_LOCAL
:
3587 mark_object (specpdl_where (pdl
));
3590 mark_object (specpdl_symbol (pdl
));
3591 mark_object (specpdl_old_value (pdl
));
3594 case SPECPDL_UNWIND_PTR
:
3595 case SPECPDL_UNWIND_INT
:
3596 case SPECPDL_UNWIND_VOID
:
3606 get_backtrace (Lisp_Object array
)
3608 union specbinding
*pdl
= backtrace_next (backtrace_top ());
3609 ptrdiff_t i
= 0, asize
= ASIZE (array
);
3611 /* Copy the backtrace contents into working memory. */
3612 for (; i
< asize
; i
++)
3614 if (backtrace_p (pdl
))
3616 ASET (array
, i
, backtrace_function (pdl
));
3617 pdl
= backtrace_next (pdl
);
3620 ASET (array
, i
, Qnil
);
3624 Lisp_Object
backtrace_top_function (void)
3626 union specbinding
*pdl
= backtrace_top ();
3627 return (backtrace_p (pdl
) ? backtrace_function (pdl
) : Qnil
);
3633 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3634 doc
: /* Limit on number of Lisp variable bindings and `unwind-protect's.
3635 If Lisp code tries to increase the total number past this amount,
3636 an error is signaled.
3637 You can safely use a value considerably larger than the default value,
3638 if that proves inconveniently small. However, if you increase it too far,
3639 Emacs could run out of memory trying to make the stack bigger.
3640 Note that this limit may be silently increased by the debugger
3641 if `debug-on-error' or `debug-on-quit' is set. */);
3643 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3644 doc
: /* Limit on depth in `eval', `apply' and `funcall' before error.
3646 This limit serves to catch infinite recursions for you before they cause
3647 actual stack overflow in C, which would be fatal for Emacs.
3648 You can safely make it considerably larger than its default value,
3649 if that proves inconveniently small. However, if you increase it too far,
3650 Emacs could overflow the real C stack, and crash. */);
3652 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3653 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3654 If the value is t, that means do an ordinary quit.
3655 If the value equals `throw-on-input', that means quit by throwing
3656 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3657 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3658 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3661 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3662 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3663 Note that `quit-flag' will still be set by typing C-g,
3664 so a quit will be signaled as soon as `inhibit-quit' is nil.
3665 To prevent this happening, set `quit-flag' to nil
3666 before making `inhibit-quit' nil. */);
3667 Vinhibit_quit
= Qnil
;
3669 DEFSYM (Qsetq
, "setq");
3670 DEFSYM (Qinhibit_quit
, "inhibit-quit");
3671 DEFSYM (Qautoload
, "autoload");
3672 DEFSYM (Qinhibit_debugger
, "inhibit-debugger");
3673 DEFSYM (Qmacro
, "macro");
3675 /* Note that the process handling also uses Qexit, but we don't want
3676 to staticpro it twice, so we just do it here. */
3677 DEFSYM (Qexit
, "exit");
3679 DEFSYM (Qinteractive
, "interactive");
3680 DEFSYM (Qcommandp
, "commandp");
3681 DEFSYM (Qand_rest
, "&rest");
3682 DEFSYM (Qand_optional
, "&optional");
3683 DEFSYM (Qclosure
, "closure");
3684 DEFSYM (QCdocumentation
, ":documentation");
3685 DEFSYM (Qdebug
, "debug");
3687 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger
,
3688 doc
: /* Non-nil means never enter the debugger.
3689 Normally set while the debugger is already active, to avoid recursive
3691 Vinhibit_debugger
= Qnil
;
3693 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3694 doc
: /* Non-nil means enter debugger if an error is signaled.
3695 Does not apply to errors handled by `condition-case' or those
3696 matched by `debug-ignored-errors'.
3697 If the value is a list, an error only means to enter the debugger
3698 if one of its condition symbols appears in the list.
3699 When you evaluate an expression interactively, this variable
3700 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3701 The command `toggle-debug-on-error' toggles this.
3702 See also the variable `debug-on-quit' and `inhibit-debugger'. */);
3703 Vdebug_on_error
= Qnil
;
3705 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3706 doc
: /* List of errors for which the debugger should not be called.
3707 Each element may be a condition-name or a regexp that matches error messages.
3708 If any element applies to a given error, that error skips the debugger
3709 and just returns to top level.
3710 This overrides the variable `debug-on-error'.
3711 It does not apply to errors handled by `condition-case'. */);
3712 Vdebug_ignored_errors
= Qnil
;
3714 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3715 doc
: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
3716 Does not apply if quit is handled by a `condition-case'. */);
3719 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3720 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3722 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3723 doc
: /* Non-nil means debugger may continue execution.
3724 This is nil when the debugger is called under circumstances where it
3725 might not be safe to continue. */);
3726 debugger_may_continue
= 1;
3728 DEFVAR_LISP ("debugger", Vdebugger
,
3729 doc
: /* Function to call to invoke debugger.
3730 If due to frame exit, args are `exit' and the value being returned;
3731 this function's value will be returned instead of that.
3732 If due to error, args are `error' and a list of the args to `signal'.
3733 If due to `apply' or `funcall' entry, one arg, `lambda'.
3734 If due to `eval' entry, one arg, t. */);
3737 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3738 doc
: /* If non-nil, this is a function for `signal' to call.
3739 It receives the same arguments that `signal' was given.
3740 The Edebug package uses this to regain control. */);
3741 Vsignal_hook_function
= Qnil
;
3743 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3744 doc
: /* Non-nil means call the debugger regardless of condition handlers.
3745 Note that `debug-on-error', `debug-on-quit' and friends
3746 still determine whether to handle the particular condition. */);
3747 Vdebug_on_signal
= Qnil
;
3749 /* When lexical binding is being used,
3750 Vinternal_interpreter_environment is non-nil, and contains an alist
3751 of lexically-bound variable, or (t), indicating an empty
3752 environment. The lisp name of this variable would be
3753 `internal-interpreter-environment' if it weren't hidden.
3754 Every element of this list can be either a cons (VAR . VAL)
3755 specifying a lexical binding, or a single symbol VAR indicating
3756 that this variable should use dynamic scoping. */
3757 DEFSYM (Qinternal_interpreter_environment
,
3758 "internal-interpreter-environment");
3759 DEFVAR_LISP ("internal-interpreter-environment",
3760 Vinternal_interpreter_environment
,
3761 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3762 When lexical binding is not being used, this variable is nil.
3763 A value of `(t)' indicates an empty environment, otherwise it is an
3764 alist of active lexical bindings. */);
3765 Vinternal_interpreter_environment
= Qnil
;
3766 /* Don't export this variable to Elisp, so no one can mess with it
3767 (Just imagine if someone makes it buffer-local). */
3768 Funintern (Qinternal_interpreter_environment
, Qnil
);
3770 Vrun_hooks
= intern_c_string ("run-hooks");
3771 staticpro (&Vrun_hooks
);
3773 staticpro (&Vautoload_queue
);
3774 Vautoload_queue
= Qnil
;
3775 staticpro (&Vsignaling_function
);
3776 Vsignaling_function
= Qnil
;
3778 inhibit_lisp_code
= Qnil
;
3789 defsubr (&Sfunction
);
3790 defsubr (&Sdefault_toplevel_value
);
3791 defsubr (&Sset_default_toplevel_value
);
3793 defsubr (&Sdefvaralias
);
3794 defsubr (&Sdefconst
);
3795 defsubr (&Smake_var_non_special
);
3799 defsubr (&Smacroexpand
);
3802 defsubr (&Sunwind_protect
);
3803 defsubr (&Scondition_case
);
3805 defsubr (&Scommandp
);
3806 defsubr (&Sautoload
);
3807 defsubr (&Sautoload_do_load
);
3810 defsubr (&Sfuncall
);
3811 defsubr (&Srun_hooks
);
3812 defsubr (&Srun_hook_with_args
);
3813 defsubr (&Srun_hook_with_args_until_success
);
3814 defsubr (&Srun_hook_with_args_until_failure
);
3815 defsubr (&Srun_hook_wrapped
);
3816 defsubr (&Sfetch_bytecode
);
3817 defsubr (&Sbacktrace_debug
);
3818 defsubr (&Sbacktrace
);
3819 defsubr (&Sbacktrace_frame
);
3820 defsubr (&Sbacktrace_eval
);
3821 defsubr (&Sbacktrace__locals
);
3822 defsubr (&Sspecial_variable_p
);
3823 defsubr (&Sfunctionp
);