1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include "blockinput.h"
28 #include "dispextern.h"
29 #include "frame.h" /* For XFRAME. */
36 # define SIZE_MAX ((size_t) -1)
39 /* This definition is duplicated in alloc.c and keyboard.c. */
40 /* Putting it in lisp.h makes cc bomb out! */
44 struct backtrace
*next
;
45 Lisp_Object
*function
;
46 Lisp_Object
*args
; /* Points to vector of args. */
47 #define NARGS_BITS (BITS_PER_INT - 2)
48 /* Let's not use size_t because we want to allow negative values (for
49 UNEVALLED). Also let's steal 2 bits so we save a word (or more for
50 alignment). In any case I doubt Emacs would survive a function call with
51 more than 500M arguments. */
52 int nargs
: NARGS_BITS
; /* Length of vector.
53 If nargs is UNEVALLED, args points
54 to slot holding list of unevalled args. */
56 /* Nonzero means call value of debugger when done with this operation. */
57 char debug_on_exit
: 1;
60 static struct backtrace
*backtrace_list
;
65 struct catchtag
*catchlist
;
67 /* Chain of condition handlers currently in effect.
68 The elements of this chain are contained in the stack frames
69 of Fcondition_case and internal_condition_case.
70 When an error is signaled (by calling Fsignal, below),
71 this chain is searched for an element that applies. */
76 struct handler
*handlerlist
;
79 /* Count levels of GCPRO to detect failure to UNGCPRO. */
83 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
84 Lisp_Object Qinhibit_quit
;
85 Lisp_Object Qand_rest
;
86 static Lisp_Object Qand_optional
;
87 static Lisp_Object Qdebug_on_error
;
88 static Lisp_Object Qdeclare
;
89 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
91 static Lisp_Object Qdebug
;
93 /* This holds either the symbol `run-hooks' or nil.
94 It is nil at an early stage of startup, and when Emacs
97 Lisp_Object Vrun_hooks
;
99 /* Non-nil means record all fset's and provide's, to be undone
100 if the file being autoloaded is not fully loaded.
101 They are recorded by being consed onto the front of Vautoload_queue:
102 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
104 Lisp_Object Vautoload_queue
;
106 /* Current number of specbindings allocated in specpdl. */
108 EMACS_INT specpdl_size
;
110 /* Pointer to beginning of specpdl. */
112 struct specbinding
*specpdl
;
114 /* Pointer to first unused element in specpdl. */
116 struct specbinding
*specpdl_ptr
;
118 /* Depth in Lisp evaluations and function calls. */
120 static EMACS_INT lisp_eval_depth
;
122 /* The value of num_nonmacro_input_events as of the last time we
123 started to enter the debugger. If we decide to enter the debugger
124 again when this is still equal to num_nonmacro_input_events, then we
125 know that the debugger itself has an error, and we should just
126 signal the error instead of entering an infinite loop of debugger
129 static int when_entered_debugger
;
131 /* The function from which the last `signal' was called. Set in
134 Lisp_Object Vsignaling_function
;
136 /* Set to non-zero while processing X events. Checked in Feval to
137 make sure the Lisp interpreter isn't called from a signal handler,
138 which is unsafe because the interpreter isn't reentrant. */
142 static Lisp_Object
funcall_lambda (Lisp_Object
, size_t, Lisp_Object
*);
143 static void unwind_to_catch (struct catchtag
*, Lisp_Object
) NO_RETURN
;
144 static int interactive_p (int);
145 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
146 static Lisp_Object
Ffetch_bytecode (Lisp_Object
);
149 init_eval_once (void)
152 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
153 specpdl_ptr
= specpdl
;
154 /* Don't forget to update docs (lispref node "Local Variables"). */
155 max_specpdl_size
= 1300; /* 1000 is not enough for CEDET's c-by.el. */
156 max_lisp_eval_depth
= 600;
164 specpdl_ptr
= specpdl
;
169 debug_on_next_call
= 0;
174 /* This is less than the initial value of num_nonmacro_input_events. */
175 when_entered_debugger
= -1;
178 /* Unwind-protect function used by call_debugger. */
181 restore_stack_limits (Lisp_Object data
)
183 max_specpdl_size
= XINT (XCAR (data
));
184 max_lisp_eval_depth
= XINT (XCDR (data
));
188 /* Call the Lisp debugger, giving it argument ARG. */
191 call_debugger (Lisp_Object arg
)
193 int debug_while_redisplaying
;
194 int count
= SPECPDL_INDEX ();
196 EMACS_INT old_max
= max_specpdl_size
;
198 /* Temporarily bump up the stack limits,
199 so the debugger won't run out of stack. */
201 max_specpdl_size
+= 1;
202 record_unwind_protect (restore_stack_limits
,
203 Fcons (make_number (old_max
),
204 make_number (max_lisp_eval_depth
)));
205 max_specpdl_size
= old_max
;
207 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
208 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
210 if (SPECPDL_INDEX () + 100 > max_specpdl_size
)
211 max_specpdl_size
= SPECPDL_INDEX () + 100;
213 #ifdef HAVE_WINDOW_SYSTEM
214 if (display_hourglass_p
)
218 debug_on_next_call
= 0;
219 when_entered_debugger
= num_nonmacro_input_events
;
221 /* Resetting redisplaying_p to 0 makes sure that debug output is
222 displayed if the debugger is invoked during redisplay. */
223 debug_while_redisplaying
= redisplaying_p
;
225 specbind (intern ("debugger-may-continue"),
226 debug_while_redisplaying
? Qnil
: Qt
);
227 specbind (Qinhibit_redisplay
, Qnil
);
228 specbind (Qdebug_on_error
, Qnil
);
230 #if 0 /* Binding this prevents execution of Lisp code during
231 redisplay, which necessarily leads to display problems. */
232 specbind (Qinhibit_eval_during_redisplay
, Qt
);
235 val
= apply1 (Vdebugger
, arg
);
237 /* Interrupting redisplay and resuming it later is not safe under
238 all circumstances. So, when the debugger returns, abort the
239 interrupted redisplay by going back to the top-level. */
240 if (debug_while_redisplaying
)
243 return unbind_to (count
, val
);
247 do_debug_on_call (Lisp_Object code
)
249 debug_on_next_call
= 0;
250 backtrace_list
->debug_on_exit
= 1;
251 call_debugger (Fcons (code
, Qnil
));
254 /* NOTE!!! Every function that can call EVAL must protect its args
255 and temporaries from garbage collection while it needs them.
256 The definition of `For' shows what you have to do. */
258 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
259 doc
: /* Eval args until one of them yields non-nil, then return that value.
260 The remaining args are not evalled at all.
261 If all args return nil, return nil.
262 usage: (or CONDITIONS...) */)
265 register Lisp_Object val
= Qnil
;
272 val
= eval_sub (XCAR (args
));
282 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
283 doc
: /* Eval args until one of them yields nil, then return nil.
284 The remaining args are not evalled at all.
285 If no arg yields nil, return the last arg's value.
286 usage: (and CONDITIONS...) */)
289 register Lisp_Object val
= Qt
;
296 val
= eval_sub (XCAR (args
));
306 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
307 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
308 Returns the value of THEN or the value of the last of the ELSE's.
309 THEN must be one expression, but ELSE... can be zero or more expressions.
310 If COND yields nil, and there are no ELSE's, the value is nil.
311 usage: (if COND THEN ELSE...) */)
314 register Lisp_Object cond
;
318 cond
= eval_sub (Fcar (args
));
322 return eval_sub (Fcar (Fcdr (args
)));
323 return Fprogn (Fcdr (Fcdr (args
)));
326 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
327 doc
: /* Try each clause until one succeeds.
328 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
329 and, if the value is non-nil, this clause succeeds:
330 then the expressions in BODY are evaluated and the last one's
331 value is the value of the cond-form.
332 If no clause succeeds, cond returns nil.
333 If a clause has one element, as in (CONDITION),
334 CONDITION's value if non-nil is returned from the cond-form.
335 usage: (cond CLAUSES...) */)
338 register Lisp_Object clause
, val
;
345 clause
= Fcar (args
);
346 val
= eval_sub (Fcar (clause
));
349 if (!EQ (XCDR (clause
), Qnil
))
350 val
= Fprogn (XCDR (clause
));
360 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
361 doc
: /* Eval BODY forms sequentially and return value of last one.
362 usage: (progn BODY...) */)
365 register Lisp_Object val
= Qnil
;
372 val
= eval_sub (XCAR (args
));
380 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
381 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
382 The value of FIRST is saved during the evaluation of the remaining args,
383 whose values are discarded.
384 usage: (prog1 FIRST BODY...) */)
388 register Lisp_Object args_left
;
389 struct gcpro gcpro1
, gcpro2
;
390 register int argnum
= 0;
401 Lisp_Object tem
= eval_sub (XCAR (args_left
));
404 args_left
= XCDR (args_left
);
406 while (CONSP (args_left
));
412 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
413 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
414 The value of FORM2 is saved during the evaluation of the
415 remaining args, whose values are discarded.
416 usage: (prog2 FORM1 FORM2 BODY...) */)
420 register Lisp_Object args_left
;
421 struct gcpro gcpro1
, gcpro2
;
422 register int argnum
= -1;
435 Lisp_Object tem
= eval_sub (XCAR (args_left
));
438 args_left
= XCDR (args_left
);
440 while (CONSP (args_left
));
446 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
447 doc
: /* Set each SYM to the value of its VAL.
448 The symbols SYM are variables; they are literal (not evaluated).
449 The values VAL are expressions; they are evaluated.
450 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
451 The second VAL is not computed until after the first SYM is set, and so on;
452 each VAL can use the new value of variables set earlier in the `setq'.
453 The return value of the `setq' form is the value of the last VAL.
454 usage: (setq [SYM VAL]...) */)
457 register Lisp_Object args_left
;
458 register Lisp_Object val
, sym
, lex_binding
;
469 val
= eval_sub (Fcar (Fcdr (args_left
)));
470 sym
= Fcar (args_left
);
472 /* Like for eval_sub, we do not check declared_special here since
473 it's been done when let-binding. */
474 if (!NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
476 && !NILP (lex_binding
477 = Fassq (sym
, Vinternal_interpreter_environment
)))
478 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
480 Fset (sym
, val
); /* SYM is dynamically bound. */
482 args_left
= Fcdr (Fcdr (args_left
));
484 while (!NILP(args_left
));
490 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
491 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
492 usage: (quote ARG) */)
495 if (!NILP (Fcdr (args
)))
496 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
500 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
501 doc
: /* Like `quote', but preferred for objects which are functions.
502 In byte compilation, `function' causes its argument to be compiled.
503 `quote' cannot do that.
504 usage: (function ARG) */)
507 Lisp_Object quoted
= XCAR (args
);
509 if (!NILP (Fcdr (args
)))
510 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
512 if (!NILP (Vinternal_interpreter_environment
)
514 && EQ (XCAR (quoted
), Qlambda
))
515 /* This is a lambda expression within a lexical environment;
516 return an interpreted closure instead of a simple lambda. */
517 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
520 /* Simply quote the argument. */
525 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
526 doc
: /* Return t if the containing function was run directly by user input.
527 This means that the function was called with `call-interactively'
528 \(which includes being called as the binding of a key)
529 and input is currently coming from the keyboard (not a keyboard macro),
530 and Emacs is not running in batch mode (`noninteractive' is nil).
532 The only known proper use of `interactive-p' is in deciding whether to
533 display a helpful message, or how to display it. If you're thinking
534 of using it for any other purpose, it is quite likely that you're
535 making a mistake. Think: what do you want to do when the command is
536 called from a keyboard macro?
538 To test whether your function was called with `call-interactively',
539 either (i) add an extra optional argument and give it an `interactive'
540 spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
541 use `called-interactively-p'. */)
544 return interactive_p (1) ? Qt
: Qnil
;
548 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 1, 0,
549 doc
: /* Return t if the containing function was called by `call-interactively'.
550 If KIND is `interactive', then only return t if the call was made
551 interactively by the user, i.e. not in `noninteractive' mode nor
552 when `executing-kbd-macro'.
553 If KIND is `any', on the other hand, it will return t for any kind of
554 interactive call, including being called as the binding of a key, or
555 from a keyboard macro, or in `noninteractive' mode.
557 The only known proper use of `interactive' for KIND is in deciding
558 whether to display a helpful message, or how to display it. If you're
559 thinking of using it for any other purpose, it is quite likely that
560 you're making a mistake. Think: what do you want to do when the
561 command is called from a keyboard macro?
563 This function is meant for implementing advice and other
564 function-modifying features. Instead of using this, it is sometimes
565 cleaner to give your function an extra optional argument whose
566 `interactive' spec specifies non-nil unconditionally (\"p\" is a good
567 way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
570 return ((INTERACTIVE
|| !EQ (kind
, intern ("interactive")))
571 && interactive_p (1)) ? Qt
: Qnil
;
575 /* Return 1 if function in which this appears was called using
578 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
579 called is a built-in. */
582 interactive_p (int exclude_subrs_p
)
584 struct backtrace
*btp
;
587 btp
= backtrace_list
;
589 /* If this isn't a byte-compiled function, there may be a frame at
590 the top for Finteractive_p. If so, skip it. */
591 fun
= Findirect_function (*btp
->function
, Qnil
);
592 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
593 || XSUBR (fun
) == &Scalled_interactively_p
))
596 /* If we're running an Emacs 18-style byte-compiled function, there
597 may be a frame for Fbytecode at the top level. In any version of
598 Emacs there can be Fbytecode frames for subexpressions evaluated
599 inside catch and condition-case. Skip past them.
601 If this isn't a byte-compiled function, then we may now be
602 looking at several frames for special forms. Skip past them. */
604 && (EQ (*btp
->function
, Qbytecode
)
605 || btp
->nargs
== UNEVALLED
))
608 /* `btp' now points at the frame of the innermost function that isn't
609 a special form, ignoring frames for Finteractive_p and/or
610 Fbytecode at the top. If this frame is for a built-in function
611 (such as load or eval-region) return nil. */
612 fun
= Findirect_function (*btp
->function
, Qnil
);
613 if (exclude_subrs_p
&& SUBRP (fun
))
616 /* `btp' points to the frame of a Lisp function that called interactive-p.
617 Return t if that function was called interactively. */
618 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
624 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
625 doc
: /* Define NAME as a function.
626 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
627 See also the function `interactive'.
628 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
631 register Lisp_Object fn_name
;
632 register Lisp_Object defn
;
634 fn_name
= Fcar (args
);
635 CHECK_SYMBOL (fn_name
);
636 defn
= Fcons (Qlambda
, Fcdr (args
));
637 if (!NILP (Vinternal_interpreter_environment
)) /* Mere optimization! */
638 defn
= Ffunction (Fcons (defn
, Qnil
));
639 if (!NILP (Vpurify_flag
))
640 defn
= Fpurecopy (defn
);
641 if (CONSP (XSYMBOL (fn_name
)->function
)
642 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
643 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
644 Ffset (fn_name
, defn
);
645 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
649 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
650 doc
: /* Define NAME as a macro.
651 The actual definition looks like
652 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
653 When the macro is called, as in (NAME ARGS...),
654 the function (lambda ARGLIST BODY...) is applied to
655 the list ARGS... as it appears in the expression,
656 and the result should be a form to be evaluated instead of the original.
658 DECL is a declaration, optional, which can specify how to indent
659 calls to this macro, how Edebug should handle it, and which argument
660 should be treated as documentation. It looks like this:
662 The elements can look like this:
664 Set NAME's `lisp-indent-function' property to INDENT.
667 Set NAME's `edebug-form-spec' property to DEBUG. (This is
668 equivalent to writing a `def-edebug-spec' for the macro.)
671 Set NAME's `doc-string-elt' property to ELT.
673 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
676 register Lisp_Object fn_name
;
677 register Lisp_Object defn
;
678 Lisp_Object lambda_list
, doc
, tail
;
680 fn_name
= Fcar (args
);
681 CHECK_SYMBOL (fn_name
);
682 lambda_list
= Fcar (Fcdr (args
));
683 tail
= Fcdr (Fcdr (args
));
686 if (STRINGP (Fcar (tail
)))
692 if (CONSP (Fcar (tail
))
693 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
695 if (!NILP (Vmacro_declaration_function
))
699 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
707 tail
= Fcons (lambda_list
, tail
);
709 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
711 defn
= Fcons (Qlambda
, tail
);
712 if (!NILP (Vinternal_interpreter_environment
)) /* Mere optimization! */
713 defn
= Ffunction (Fcons (defn
, Qnil
));
714 defn
= Fcons (Qmacro
, defn
);
716 if (!NILP (Vpurify_flag
))
717 defn
= Fpurecopy (defn
);
718 if (CONSP (XSYMBOL (fn_name
)->function
)
719 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
720 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
721 Ffset (fn_name
, defn
);
722 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
727 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
728 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
729 Aliased variables always have the same value; setting one sets the other.
730 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
731 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
732 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
733 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
734 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
735 The return value is BASE-VARIABLE. */)
736 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
738 struct Lisp_Symbol
*sym
;
740 CHECK_SYMBOL (new_alias
);
741 CHECK_SYMBOL (base_variable
);
743 sym
= XSYMBOL (new_alias
);
746 /* Not sure why, but why not? */
747 error ("Cannot make a constant an alias");
749 switch (sym
->redirect
)
751 case SYMBOL_FORWARDED
:
752 error ("Cannot make an internal variable an alias");
753 case SYMBOL_LOCALIZED
:
754 error ("Don't know how to make a localized variable an alias");
757 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
758 If n_a is bound, but b_v is not, set the value of b_v to n_a,
759 so that old-code that affects n_a before the aliasing is setup
761 if (NILP (Fboundp (base_variable
)))
762 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
765 struct specbinding
*p
;
767 for (p
= specpdl_ptr
- 1; p
>= specpdl
; p
--)
770 CONSP (p
->symbol
) ? XCAR (p
->symbol
) : p
->symbol
)))
771 error ("Don't know how to make a let-bound variable an alias");
774 sym
->declared_special
= 1;
775 XSYMBOL (base_variable
)->declared_special
= 1;
776 sym
->redirect
= SYMBOL_VARALIAS
;
777 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
778 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
779 LOADHIST_ATTACH (new_alias
);
780 /* Even if docstring is nil: remove old docstring. */
781 Fput (new_alias
, Qvariable_documentation
, docstring
);
783 return base_variable
;
787 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
788 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
789 You are not required to define a variable in order to use it,
790 but the definition can supply documentation and an initial value
791 in a way that tags can recognize.
793 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
794 If SYMBOL is buffer-local, its default value is what is set;
795 buffer-local values are not affected.
796 INITVALUE and DOCSTRING are optional.
797 If DOCSTRING starts with *, this variable is identified as a user option.
798 This means that M-x set-variable recognizes it.
799 See also `user-variable-p'.
800 If INITVALUE is missing, SYMBOL's value is not set.
802 If SYMBOL has a local binding, then this form affects the local
803 binding. This is usually not what you want. Thus, if you need to
804 load a file defining variables, with this form or with `defconst' or
805 `defcustom', you should always load that file _outside_ any bindings
806 for these variables. \(`defconst' and `defcustom' behave similarly in
808 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
811 register Lisp_Object sym
, tem
, tail
;
815 if (!NILP (Fcdr (Fcdr (tail
))))
816 error ("Too many arguments");
818 tem
= Fdefault_boundp (sym
);
821 /* Do it before evaluating the initial value, for self-references. */
822 XSYMBOL (sym
)->declared_special
= 1;
824 if (SYMBOL_CONSTANT_P (sym
))
826 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
827 Lisp_Object tem1
= Fcar (tail
);
829 && EQ (XCAR (tem1
), Qquote
)
830 && CONSP (XCDR (tem1
))
831 && EQ (XCAR (XCDR (tem1
)), sym
)))
832 error ("Constant symbol `%s' specified in defvar",
833 SDATA (SYMBOL_NAME (sym
)));
837 Fset_default (sym
, eval_sub (Fcar (tail
)));
839 { /* Check if there is really a global binding rather than just a let
840 binding that shadows the global unboundness of the var. */
841 volatile struct specbinding
*pdl
= specpdl_ptr
;
842 while (--pdl
>= specpdl
)
844 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
845 && EQ (pdl
->old_value
, Qunbound
))
847 message_with_string ("Warning: defvar ignored because %s is let-bound",
848 SYMBOL_NAME (sym
), 1);
857 if (!NILP (Vpurify_flag
))
858 tem
= Fpurecopy (tem
);
859 Fput (sym
, Qvariable_documentation
, tem
);
861 LOADHIST_ATTACH (sym
);
863 else if (!NILP (Vinternal_interpreter_environment
)
864 && !XSYMBOL (sym
)->declared_special
)
865 /* A simple (defvar foo) with lexical scoping does "nothing" except
866 declare that var to be dynamically scoped *locally* (i.e. within
867 the current file or let-block). */
868 Vinternal_interpreter_environment
=
869 Fcons (sym
, Vinternal_interpreter_environment
);
872 /* Simple (defvar <var>) should not count as a definition at all.
873 It could get in the way of other definitions, and unloading this
874 package could try to make the variable unbound. */
880 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
881 doc
: /* Define SYMBOL as a constant variable.
882 The intent is that neither programs nor users should ever change this value.
883 Always sets the value of SYMBOL to the result of evalling INITVALUE.
884 If SYMBOL is buffer-local, its default value is what is set;
885 buffer-local values are not affected.
886 DOCSTRING is optional.
888 If SYMBOL has a local binding, then this form sets the local binding's
889 value. However, you should normally not make local bindings for
890 variables defined with this form.
891 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
894 register Lisp_Object sym
, tem
;
897 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
898 error ("Too many arguments");
900 tem
= eval_sub (Fcar (Fcdr (args
)));
901 if (!NILP (Vpurify_flag
))
902 tem
= Fpurecopy (tem
);
903 Fset_default (sym
, tem
);
904 XSYMBOL (sym
)->declared_special
= 1;
905 tem
= Fcar (Fcdr (Fcdr (args
)));
908 if (!NILP (Vpurify_flag
))
909 tem
= Fpurecopy (tem
);
910 Fput (sym
, Qvariable_documentation
, tem
);
912 Fput (sym
, Qrisky_local_variable
, Qt
);
913 LOADHIST_ATTACH (sym
);
917 /* Error handler used in Fuser_variable_p. */
919 user_variable_p_eh (Lisp_Object ignore
)
925 lisp_indirect_variable (Lisp_Object sym
)
927 struct Lisp_Symbol
*s
= indirect_variable (XSYMBOL (sym
));
932 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
933 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
934 \(The alternative is a variable used internally in a Lisp program.)
935 A variable is a user variable if
936 \(1) the first character of its documentation is `*', or
937 \(2) it is customizable (its property list contains a non-nil value
938 of `standard-value' or `custom-autoload'), or
939 \(3) it is an alias for another user variable.
940 Return nil if VARIABLE is an alias and there is a loop in the
941 chain of symbols. */)
942 (Lisp_Object variable
)
944 Lisp_Object documentation
;
946 if (!SYMBOLP (variable
))
949 /* If indirect and there's an alias loop, don't check anything else. */
950 if (XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
951 && NILP (internal_condition_case_1 (lisp_indirect_variable
, variable
,
952 Qt
, user_variable_p_eh
)))
957 documentation
= Fget (variable
, Qvariable_documentation
);
958 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
960 if (STRINGP (documentation
)
961 && ((unsigned char) SREF (documentation
, 0) == '*'))
963 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
964 if (CONSP (documentation
)
965 && STRINGP (XCAR (documentation
))
966 && INTEGERP (XCDR (documentation
))
967 && XINT (XCDR (documentation
)) < 0)
969 /* Customizable? See `custom-variable-p'. */
970 if ((!NILP (Fget (variable
, intern ("standard-value"))))
971 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
974 if (!(XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
))
977 /* An indirect variable? Let's follow the chain. */
978 XSETSYMBOL (variable
, SYMBOL_ALIAS (XSYMBOL (variable
)));
982 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
983 doc
: /* Bind variables according to VARLIST then eval BODY.
984 The value of the last form in BODY is returned.
985 Each element of VARLIST is a symbol (which is bound to nil)
986 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
987 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
988 usage: (let* VARLIST BODY...) */)
991 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
992 int count
= SPECPDL_INDEX ();
993 struct gcpro gcpro1
, gcpro2
, gcpro3
;
995 GCPRO3 (args
, elt
, varlist
);
997 lexenv
= Vinternal_interpreter_environment
;
999 varlist
= Fcar (args
);
1000 while (CONSP (varlist
))
1004 elt
= XCAR (varlist
);
1010 else if (! NILP (Fcdr (Fcdr (elt
))))
1011 signal_error ("`let' bindings can have only one value-form", elt
);
1015 val
= eval_sub (Fcar (Fcdr (elt
)));
1018 if (!NILP (lexenv
) && SYMBOLP (var
)
1019 && !XSYMBOL (var
)->declared_special
1020 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1021 /* Lexically bind VAR by adding it to the interpreter's binding
1025 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
1026 if (EQ (Vinternal_interpreter_environment
, lexenv
))
1027 /* Save the old lexical environment on the specpdl stack,
1028 but only for the first lexical binding, since we'll never
1029 need to revert to one of the intermediate ones. */
1030 specbind (Qinternal_interpreter_environment
, newenv
);
1032 Vinternal_interpreter_environment
= newenv
;
1035 specbind (var
, val
);
1037 varlist
= XCDR (varlist
);
1040 val
= Fprogn (Fcdr (args
));
1041 return unbind_to (count
, val
);
1044 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
1045 doc
: /* Bind variables according to VARLIST then eval BODY.
1046 The value of the last form in BODY is returned.
1047 Each element of VARLIST is a symbol (which is bound to nil)
1048 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1049 All the VALUEFORMs are evalled before any symbols are bound.
1050 usage: (let VARLIST BODY...) */)
1053 Lisp_Object
*temps
, tem
, lexenv
;
1054 register Lisp_Object elt
, varlist
;
1055 int count
= SPECPDL_INDEX ();
1056 register size_t argnum
;
1057 struct gcpro gcpro1
, gcpro2
;
1060 varlist
= Fcar (args
);
1062 /* Make space to hold the values to give the bound variables. */
1063 elt
= Flength (varlist
);
1064 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
1066 /* Compute the values and store them in `temps'. */
1068 GCPRO2 (args
, *temps
);
1071 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1074 elt
= XCAR (varlist
);
1076 temps
[argnum
++] = Qnil
;
1077 else if (! NILP (Fcdr (Fcdr (elt
))))
1078 signal_error ("`let' bindings can have only one value-form", elt
);
1080 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
1081 gcpro2
.nvars
= argnum
;
1085 lexenv
= Vinternal_interpreter_environment
;
1087 varlist
= Fcar (args
);
1088 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1092 elt
= XCAR (varlist
);
1093 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
1094 tem
= temps
[argnum
++];
1096 if (!NILP (lexenv
) && SYMBOLP (var
)
1097 && !XSYMBOL (var
)->declared_special
1098 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1099 /* Lexically bind VAR by adding it to the lexenv alist. */
1100 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
1102 /* Dynamically bind VAR. */
1103 specbind (var
, tem
);
1106 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
1107 /* Instantiate a new lexical environment. */
1108 specbind (Qinternal_interpreter_environment
, lexenv
);
1110 elt
= Fprogn (Fcdr (args
));
1112 return unbind_to (count
, elt
);
1115 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1116 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1117 The order of execution is thus TEST, BODY, TEST, BODY and so on
1118 until TEST returns nil.
1119 usage: (while TEST BODY...) */)
1122 Lisp_Object test
, body
;
1123 struct gcpro gcpro1
, gcpro2
;
1125 GCPRO2 (test
, body
);
1129 while (!NILP (eval_sub (test
)))
1139 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1140 doc
: /* Return result of expanding macros at top level of FORM.
1141 If FORM is not a macro call, it is returned unchanged.
1142 Otherwise, the macro is expanded and the expansion is considered
1143 in place of FORM. When a non-macro-call results, it is returned.
1145 The second optional arg ENVIRONMENT specifies an environment of macro
1146 definitions to shadow the loaded ones for use in file byte-compilation. */)
1147 (Lisp_Object form
, Lisp_Object environment
)
1149 /* With cleanups from Hallvard Furuseth. */
1150 register Lisp_Object expander
, sym
, def
, tem
;
1154 /* Come back here each time we expand a macro call,
1155 in case it expands into another macro call. */
1158 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1159 def
= sym
= XCAR (form
);
1161 /* Trace symbols aliases to other symbols
1162 until we get a symbol that is not an alias. */
1163 while (SYMBOLP (def
))
1167 tem
= Fassq (sym
, environment
);
1170 def
= XSYMBOL (sym
)->function
;
1171 if (!EQ (def
, Qunbound
))
1176 /* Right now TEM is the result from SYM in ENVIRONMENT,
1177 and if TEM is nil then DEF is SYM's function definition. */
1180 /* SYM is not mentioned in ENVIRONMENT.
1181 Look at its function definition. */
1182 if (EQ (def
, Qunbound
) || !CONSP (def
))
1183 /* Not defined or definition not suitable. */
1185 if (EQ (XCAR (def
), Qautoload
))
1187 /* Autoloading function: will it be a macro when loaded? */
1188 tem
= Fnth (make_number (4), def
);
1189 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1190 /* Yes, load it and try again. */
1192 struct gcpro gcpro1
;
1194 do_autoload (def
, sym
);
1201 else if (!EQ (XCAR (def
), Qmacro
))
1203 else expander
= XCDR (def
);
1207 expander
= XCDR (tem
);
1208 if (NILP (expander
))
1211 form
= apply1 (expander
, XCDR (form
));
1216 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1217 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1218 TAG is evalled to get the tag to use; it must not be nil.
1220 Then the BODY is executed.
1221 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1222 If no throw happens, `catch' returns the value of the last BODY form.
1223 If a throw happens, it specifies the value to return from `catch'.
1224 usage: (catch TAG BODY...) */)
1227 register Lisp_Object tag
;
1228 struct gcpro gcpro1
;
1231 tag
= eval_sub (Fcar (args
));
1233 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1236 /* Set up a catch, then call C function FUNC on argument ARG.
1237 FUNC should return a Lisp_Object.
1238 This is how catches are done from within C code. */
1241 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1243 /* This structure is made part of the chain `catchlist'. */
1246 /* Fill in the components of c, and put it on the list. */
1250 c
.backlist
= backtrace_list
;
1251 c
.handlerlist
= handlerlist
;
1252 c
.lisp_eval_depth
= lisp_eval_depth
;
1253 c
.pdlcount
= SPECPDL_INDEX ();
1254 c
.poll_suppress_count
= poll_suppress_count
;
1255 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1256 c
.gcpro
= gcprolist
;
1257 c
.byte_stack
= byte_stack_list
;
1261 if (! _setjmp (c
.jmp
))
1262 c
.val
= (*func
) (arg
);
1264 /* Throw works by a longjmp that comes right here. */
1269 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1270 jump to that CATCH, returning VALUE as the value of that catch.
1272 This is the guts Fthrow and Fsignal; they differ only in the way
1273 they choose the catch tag to throw to. A catch tag for a
1274 condition-case form has a TAG of Qnil.
1276 Before each catch is discarded, unbind all special bindings and
1277 execute all unwind-protect clauses made above that catch. Unwind
1278 the handler stack as we go, so that the proper handlers are in
1279 effect for each unwind-protect clause we run. At the end, restore
1280 some static info saved in CATCH, and longjmp to the location
1283 This is used for correct unwinding in Fthrow and Fsignal. */
1286 unwind_to_catch (struct catchtag
*catch, Lisp_Object value
)
1288 register int last_time
;
1290 /* Save the value in the tag. */
1293 /* Restore certain special C variables. */
1294 set_poll_suppress_count (catch->poll_suppress_count
);
1295 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1296 handling_signal
= 0;
1301 last_time
= catchlist
== catch;
1303 /* Unwind the specpdl stack, and then restore the proper set of
1305 unbind_to (catchlist
->pdlcount
, Qnil
);
1306 handlerlist
= catchlist
->handlerlist
;
1307 catchlist
= catchlist
->next
;
1309 while (! last_time
);
1312 /* If x_catch_errors was done, turn it off now.
1313 (First we give unbind_to a chance to do that.) */
1314 #if 0 /* This would disable x_catch_errors after x_connection_closed.
1315 The catch must remain in effect during that delicate
1316 state. --lorentey */
1317 x_fully_uncatch_errors ();
1321 byte_stack_list
= catch->byte_stack
;
1322 gcprolist
= catch->gcpro
;
1324 gcpro_level
= gcprolist
? gcprolist
->level
+ 1 : 0;
1326 backtrace_list
= catch->backlist
;
1327 lisp_eval_depth
= catch->lisp_eval_depth
;
1329 _longjmp (catch->jmp
, 1);
1332 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1333 doc
: /* Throw to the catch for TAG and return VALUE from it.
1334 Both TAG and VALUE are evalled. */)
1335 (register Lisp_Object tag
, Lisp_Object value
)
1337 register struct catchtag
*c
;
1340 for (c
= catchlist
; c
; c
= c
->next
)
1342 if (EQ (c
->tag
, tag
))
1343 unwind_to_catch (c
, value
);
1345 xsignal2 (Qno_catch
, tag
, value
);
1349 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1350 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1351 If BODYFORM completes normally, its value is returned
1352 after executing the UNWINDFORMS.
1353 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1354 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1358 int count
= SPECPDL_INDEX ();
1360 record_unwind_protect (Fprogn
, Fcdr (args
));
1361 val
= eval_sub (Fcar (args
));
1362 return unbind_to (count
, val
);
1365 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1366 doc
: /* Regain control when an error is signaled.
1367 Executes BODYFORM and returns its value if no error happens.
1368 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1369 where the BODY is made of Lisp expressions.
1371 A handler is applicable to an error
1372 if CONDITION-NAME is one of the error's condition names.
1373 If an error happens, the first applicable handler is run.
1375 The car of a handler may be a list of condition names
1376 instead of a single condition name. Then it handles all of them.
1378 When a handler handles an error, control returns to the `condition-case'
1379 and it executes the handler's BODY...
1380 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1381 \(If VAR is nil, the handler can't access that information.)
1382 Then the value of the last BODY form is returned from the `condition-case'
1385 See also the function `signal' for more info.
1386 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1389 register Lisp_Object bodyform
, handlers
;
1390 volatile Lisp_Object var
;
1393 bodyform
= Fcar (Fcdr (args
));
1394 handlers
= Fcdr (Fcdr (args
));
1396 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1399 /* Like Fcondition_case, but the args are separate
1400 rather than passed in a list. Used by Fbyte_code. */
1403 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1404 Lisp_Object handlers
)
1412 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1418 && (SYMBOLP (XCAR (tem
))
1419 || CONSP (XCAR (tem
))))))
1420 error ("Invalid condition handler: %s",
1421 SDATA (Fprin1_to_string (tem
, Qt
)));
1426 c
.backlist
= backtrace_list
;
1427 c
.handlerlist
= handlerlist
;
1428 c
.lisp_eval_depth
= lisp_eval_depth
;
1429 c
.pdlcount
= SPECPDL_INDEX ();
1430 c
.poll_suppress_count
= poll_suppress_count
;
1431 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1432 c
.gcpro
= gcprolist
;
1433 c
.byte_stack
= byte_stack_list
;
1434 if (_setjmp (c
.jmp
))
1437 specbind (h
.var
, c
.val
);
1438 val
= Fprogn (Fcdr (h
.chosen_clause
));
1440 /* Note that this just undoes the binding of h.var; whoever
1441 longjumped to us unwound the stack to c.pdlcount before
1443 unbind_to (c
.pdlcount
, Qnil
);
1450 h
.handler
= handlers
;
1451 h
.next
= handlerlist
;
1455 val
= eval_sub (bodyform
);
1457 handlerlist
= h
.next
;
1461 /* Call the function BFUN with no arguments, catching errors within it
1462 according to HANDLERS. If there is an error, call HFUN with
1463 one argument which is the data that describes the error:
1466 HANDLERS can be a list of conditions to catch.
1467 If HANDLERS is Qt, catch all errors.
1468 If HANDLERS is Qerror, catch all errors
1469 but allow the debugger to run if that is enabled. */
1472 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1473 Lisp_Object (*hfun
) (Lisp_Object
))
1479 /* Since Fsignal will close off all calls to x_catch_errors,
1480 we will get the wrong results if some are not closed now. */
1482 if (x_catching_errors ())
1488 c
.backlist
= backtrace_list
;
1489 c
.handlerlist
= handlerlist
;
1490 c
.lisp_eval_depth
= lisp_eval_depth
;
1491 c
.pdlcount
= SPECPDL_INDEX ();
1492 c
.poll_suppress_count
= poll_suppress_count
;
1493 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1494 c
.gcpro
= gcprolist
;
1495 c
.byte_stack
= byte_stack_list
;
1496 if (_setjmp (c
.jmp
))
1498 return (*hfun
) (c
.val
);
1502 h
.handler
= handlers
;
1504 h
.next
= handlerlist
;
1510 handlerlist
= h
.next
;
1514 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1517 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1518 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1524 /* Since Fsignal will close off all calls to x_catch_errors,
1525 we will get the wrong results if some are not closed now. */
1527 if (x_catching_errors ())
1533 c
.backlist
= backtrace_list
;
1534 c
.handlerlist
= handlerlist
;
1535 c
.lisp_eval_depth
= lisp_eval_depth
;
1536 c
.pdlcount
= SPECPDL_INDEX ();
1537 c
.poll_suppress_count
= poll_suppress_count
;
1538 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1539 c
.gcpro
= gcprolist
;
1540 c
.byte_stack
= byte_stack_list
;
1541 if (_setjmp (c
.jmp
))
1543 return (*hfun
) (c
.val
);
1547 h
.handler
= handlers
;
1549 h
.next
= handlerlist
;
1553 val
= (*bfun
) (arg
);
1555 handlerlist
= h
.next
;
1559 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1563 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1566 Lisp_Object handlers
,
1567 Lisp_Object (*hfun
) (Lisp_Object
))
1573 /* Since Fsignal will close off all calls to x_catch_errors,
1574 we will get the wrong results if some are not closed now. */
1576 if (x_catching_errors ())
1582 c
.backlist
= backtrace_list
;
1583 c
.handlerlist
= handlerlist
;
1584 c
.lisp_eval_depth
= lisp_eval_depth
;
1585 c
.pdlcount
= SPECPDL_INDEX ();
1586 c
.poll_suppress_count
= poll_suppress_count
;
1587 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1588 c
.gcpro
= gcprolist
;
1589 c
.byte_stack
= byte_stack_list
;
1590 if (_setjmp (c
.jmp
))
1592 return (*hfun
) (c
.val
);
1596 h
.handler
= handlers
;
1598 h
.next
= handlerlist
;
1602 val
= (*bfun
) (arg1
, arg2
);
1604 handlerlist
= h
.next
;
1608 /* Like internal_condition_case but call BFUN with NARGS as first,
1609 and ARGS as second argument. */
1612 internal_condition_case_n (Lisp_Object (*bfun
) (size_t, Lisp_Object
*),
1615 Lisp_Object handlers
,
1616 Lisp_Object (*hfun
) (Lisp_Object
))
1622 /* Since Fsignal will close off all calls to x_catch_errors,
1623 we will get the wrong results if some are not closed now. */
1625 if (x_catching_errors ())
1631 c
.backlist
= backtrace_list
;
1632 c
.handlerlist
= handlerlist
;
1633 c
.lisp_eval_depth
= lisp_eval_depth
;
1634 c
.pdlcount
= SPECPDL_INDEX ();
1635 c
.poll_suppress_count
= poll_suppress_count
;
1636 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1637 c
.gcpro
= gcprolist
;
1638 c
.byte_stack
= byte_stack_list
;
1639 if (_setjmp (c
.jmp
))
1641 return (*hfun
) (c
.val
);
1645 h
.handler
= handlers
;
1647 h
.next
= handlerlist
;
1651 val
= (*bfun
) (nargs
, args
);
1653 handlerlist
= h
.next
;
1658 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
,
1659 Lisp_Object
, Lisp_Object
);
1660 static int maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1663 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1664 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1665 This function does not return.
1667 An error symbol is a symbol with an `error-conditions' property
1668 that is a list of condition names.
1669 A handler for any of those names will get to handle this signal.
1670 The symbol `error' should normally be one of them.
1672 DATA should be a list. Its elements are printed as part of the error message.
1673 See Info anchor `(elisp)Definition of signal' for some details on how this
1674 error message is constructed.
1675 If the signal is handled, DATA is made available to the handler.
1676 See also the function `condition-case'. */)
1677 (Lisp_Object error_symbol
, Lisp_Object data
)
1679 /* When memory is full, ERROR-SYMBOL is nil,
1680 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1681 That is a special case--don't do this in other situations. */
1682 Lisp_Object conditions
;
1684 Lisp_Object real_error_symbol
1685 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1686 register Lisp_Object clause
= Qnil
;
1688 struct backtrace
*bp
;
1690 immediate_quit
= handling_signal
= 0;
1692 if (gc_in_progress
|| waiting_for_input
)
1695 #if 0 /* rms: I don't know why this was here,
1696 but it is surely wrong for an error that is handled. */
1697 #ifdef HAVE_WINDOW_SYSTEM
1698 if (display_hourglass_p
)
1699 cancel_hourglass ();
1703 /* This hook is used by edebug. */
1704 if (! NILP (Vsignal_hook_function
)
1705 && ! NILP (error_symbol
))
1707 /* Edebug takes care of restoring these variables when it exits. */
1708 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1709 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1711 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1712 max_specpdl_size
= SPECPDL_INDEX () + 40;
1714 call2 (Vsignal_hook_function
, error_symbol
, data
);
1717 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1719 /* Remember from where signal was called. Skip over the frame for
1720 `signal' itself. If a frame for `error' follows, skip that,
1721 too. Don't do this when ERROR_SYMBOL is nil, because that
1722 is a memory-full error. */
1723 Vsignaling_function
= Qnil
;
1724 if (backtrace_list
&& !NILP (error_symbol
))
1726 bp
= backtrace_list
->next
;
1727 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1729 if (bp
&& bp
->function
)
1730 Vsignaling_function
= *bp
->function
;
1733 for (h
= handlerlist
; h
; h
= h
->next
)
1735 clause
= find_handler_clause (h
->handler
, conditions
,
1736 error_symbol
, data
);
1741 if (/* Don't run the debugger for a memory-full error.
1742 (There is no room in memory to do that!) */
1743 !NILP (error_symbol
)
1744 && (!NILP (Vdebug_on_signal
)
1745 /* If no handler is present now, try to run the debugger. */
1747 /* Special handler that means "print a message and run debugger
1749 || EQ (h
->handler
, Qerror
)))
1752 = maybe_call_debugger (conditions
, error_symbol
, data
);
1753 /* We can't return values to code which signaled an error, but we
1754 can continue code which has signaled a quit. */
1755 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1761 Lisp_Object unwind_data
1762 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1764 h
->chosen_clause
= clause
;
1765 unwind_to_catch (h
->tag
, unwind_data
);
1770 Fthrow (Qtop_level
, Qt
);
1773 if (! NILP (error_symbol
))
1774 data
= Fcons (error_symbol
, data
);
1776 string
= Ferror_message_string (data
);
1777 fatal ("%s", SDATA (string
));
1780 /* Internal version of Fsignal that never returns.
1781 Used for anything but Qquit (which can return from Fsignal). */
1784 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1786 Fsignal (error_symbol
, data
);
1790 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1793 xsignal0 (Lisp_Object error_symbol
)
1795 xsignal (error_symbol
, Qnil
);
1799 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1801 xsignal (error_symbol
, list1 (arg
));
1805 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1807 xsignal (error_symbol
, list2 (arg1
, arg2
));
1811 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1813 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1816 /* Signal `error' with message S, and additional arg ARG.
1817 If ARG is not a genuine list, make it a one-element list. */
1820 signal_error (const char *s
, Lisp_Object arg
)
1822 Lisp_Object tortoise
, hare
;
1824 hare
= tortoise
= arg
;
1825 while (CONSP (hare
))
1832 tortoise
= XCDR (tortoise
);
1834 if (EQ (hare
, tortoise
))
1839 arg
= Fcons (arg
, Qnil
); /* Make it a list. */
1841 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1845 /* Return nonzero if LIST is a non-nil atom or
1846 a list containing one of CONDITIONS. */
1849 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1856 while (CONSP (conditions
))
1858 Lisp_Object
this, tail
;
1859 this = XCAR (conditions
);
1860 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1861 if (EQ (XCAR (tail
), this))
1863 conditions
= XCDR (conditions
);
1868 /* Return 1 if an error with condition-symbols CONDITIONS,
1869 and described by SIGNAL-DATA, should skip the debugger
1870 according to debugger-ignored-errors. */
1873 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1876 int first_string
= 1;
1877 Lisp_Object error_message
;
1879 error_message
= Qnil
;
1880 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1882 if (STRINGP (XCAR (tail
)))
1886 error_message
= Ferror_message_string (data
);
1890 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1895 Lisp_Object contail
;
1897 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1898 if (EQ (XCAR (tail
), XCAR (contail
)))
1906 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1907 SIG and DATA describe the signal, as in find_handler_clause. */
1910 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1912 Lisp_Object combined_data
;
1914 combined_data
= Fcons (sig
, data
);
1917 /* Don't try to run the debugger with interrupts blocked.
1918 The editing loop would return anyway. */
1920 /* Does user want to enter debugger for this kind of error? */
1923 : wants_debugger (Vdebug_on_error
, conditions
))
1924 && ! skip_debugger (conditions
, combined_data
)
1925 /* RMS: What's this for? */
1926 && when_entered_debugger
< num_nonmacro_input_events
)
1928 call_debugger (Fcons (Qerror
, Fcons (combined_data
, Qnil
)));
1935 /* Value of Qlambda means we have called debugger and user has continued.
1936 There are two ways to pass SIG and DATA:
1937 = SIG is the error symbol, and DATA is the rest of the data.
1938 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1939 This is for memory-full errors only.
1941 We need to increase max_specpdl_size temporarily around
1942 anything we do that can push on the specpdl, so as not to get
1943 a second error here in case we're handling specpdl overflow. */
1946 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
,
1947 Lisp_Object sig
, Lisp_Object data
)
1949 register Lisp_Object h
;
1951 /* t is used by handlers for all conditions, set up by C code. */
1952 if (EQ (handlers
, Qt
))
1955 /* error is used similarly, but means print an error message
1956 and run the debugger if that is enabled. */
1957 if (EQ (handlers
, Qerror
))
1960 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1962 Lisp_Object handler
= XCAR (h
);
1963 Lisp_Object condit
, tem
;
1965 if (!CONSP (handler
))
1967 condit
= XCAR (handler
);
1968 /* Handle a single condition name in handler HANDLER. */
1969 if (SYMBOLP (condit
))
1971 tem
= Fmemq (Fcar (handler
), conditions
);
1975 /* Handle a list of condition names in handler HANDLER. */
1976 else if (CONSP (condit
))
1979 for (tail
= condit
; CONSP (tail
); tail
= XCDR (tail
))
1981 tem
= Fmemq (XCAR (tail
), conditions
);
1992 /* Dump an error message; called like vprintf. */
1994 verror (const char *m
, va_list ap
)
1997 size_t size
= sizeof buf
;
1998 size_t size_max
= STRING_BYTES_MAX
+ 1;
1999 size_t mlen
= strlen (m
);
2007 va_copy (ap_copy
, ap
);
2008 used
= doprnt (buffer
, size
, m
, m
+ mlen
, ap_copy
);
2011 /* Note: the -1 below is because `doprnt' returns the number of bytes
2012 excluding the terminating null byte, and it always terminates with a
2013 null byte, even when producing a truncated message. */
2014 if (used
< size
- 1)
2016 if (size
<= size_max
/ 2)
2018 else if (size
< size_max
)
2021 break; /* and leave the message truncated */
2025 buffer
= (char *) xmalloc (size
);
2028 string
= make_string (buffer
, used
);
2032 xsignal1 (Qerror
, string
);
2036 /* Dump an error message; called like printf. */
2040 error (const char *m
, ...)
2048 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
2049 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
2050 This means it contains a description for how to read arguments to give it.
2051 The value is nil for an invalid function or a symbol with no function
2054 Interactively callable functions include strings and vectors (treated
2055 as keyboard macros), lambda-expressions that contain a top-level call
2056 to `interactive', autoload definitions made by `autoload' with non-nil
2057 fourth argument, and some of the built-in functions of Lisp.
2059 Also, a symbol satisfies `commandp' if its function definition does so.
2061 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2062 then strings and vectors are not accepted. */)
2063 (Lisp_Object function
, Lisp_Object for_call_interactively
)
2065 register Lisp_Object fun
;
2066 register Lisp_Object funcar
;
2067 Lisp_Object if_prop
= Qnil
;
2071 fun
= indirect_function (fun
); /* Check cycles. */
2072 if (NILP (fun
) || EQ (fun
, Qunbound
))
2075 /* Check an `interactive-form' property if present, analogous to the
2076 function-documentation property. */
2078 while (SYMBOLP (fun
))
2080 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
2083 fun
= Fsymbol_function (fun
);
2086 /* Emacs primitives are interactive if their DEFUN specifies an
2087 interactive spec. */
2089 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
2091 /* Bytecode objects are interactive if they are long enough to
2092 have an element whose index is COMPILED_INTERACTIVE, which is
2093 where the interactive spec is stored. */
2094 else if (COMPILEDP (fun
))
2095 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
2098 /* Strings and vectors are keyboard macros. */
2099 if (STRINGP (fun
) || VECTORP (fun
))
2100 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
2102 /* Lists may represent commands. */
2105 funcar
= XCAR (fun
);
2106 if (EQ (funcar
, Qclosure
))
2107 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
2109 else if (EQ (funcar
, Qlambda
))
2110 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
2111 else if (EQ (funcar
, Qautoload
))
2112 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
2117 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
2118 doc
: /* Define FUNCTION to autoload from FILE.
2119 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2120 Third arg DOCSTRING is documentation for the function.
2121 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2122 Fifth arg TYPE indicates the type of the object:
2123 nil or omitted says FUNCTION is a function,
2124 `keymap' says FUNCTION is really a keymap, and
2125 `macro' or t says FUNCTION is really a macro.
2126 Third through fifth args give info about the real definition.
2127 They default to nil.
2128 If FUNCTION is already defined other than as an autoload,
2129 this does nothing and returns nil. */)
2130 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
2132 CHECK_SYMBOL (function
);
2133 CHECK_STRING (file
);
2135 /* If function is defined and not as an autoload, don't override. */
2136 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
2137 && !(CONSP (XSYMBOL (function
)->function
)
2138 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
2141 if (NILP (Vpurify_flag
))
2142 /* Only add entries after dumping, because the ones before are
2143 not useful and else we get loads of them from the loaddefs.el. */
2144 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
2146 /* We don't want the docstring in purespace (instead,
2147 Snarf-documentation should (hopefully) overwrite it).
2148 We used to use 0 here, but that leads to accidental sharing in
2149 purecopy's hash-consing, so we use a (hopefully) unique integer
2151 docstring
= make_number (XPNTR (function
));
2152 return Ffset (function
,
2153 Fpurecopy (list5 (Qautoload
, file
, docstring
,
2154 interactive
, type
)));
2158 un_autoload (Lisp_Object oldqueue
)
2160 register Lisp_Object queue
, first
, second
;
2162 /* Queue to unwind is current value of Vautoload_queue.
2163 oldqueue is the shadowed value to leave in Vautoload_queue. */
2164 queue
= Vautoload_queue
;
2165 Vautoload_queue
= oldqueue
;
2166 while (CONSP (queue
))
2168 first
= XCAR (queue
);
2169 second
= Fcdr (first
);
2170 first
= Fcar (first
);
2171 if (EQ (first
, make_number (0)))
2174 Ffset (first
, second
);
2175 queue
= XCDR (queue
);
2180 /* Load an autoloaded function.
2181 FUNNAME is the symbol which is the function's name.
2182 FUNDEF is the autoload definition (a list). */
2185 do_autoload (Lisp_Object fundef
, Lisp_Object funname
)
2187 int count
= SPECPDL_INDEX ();
2189 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2191 /* This is to make sure that loadup.el gives a clear picture
2192 of what files are preloaded and when. */
2193 if (! NILP (Vpurify_flag
))
2194 error ("Attempt to autoload %s while preparing to dump",
2195 SDATA (SYMBOL_NAME (funname
)));
2198 CHECK_SYMBOL (funname
);
2199 GCPRO3 (fun
, funname
, fundef
);
2201 /* Preserve the match data. */
2202 record_unwind_save_match_data ();
2204 /* If autoloading gets an error (which includes the error of failing
2205 to define the function being called), we use Vautoload_queue
2206 to undo function definitions and `provide' calls made by
2207 the function. We do this in the specific case of autoloading
2208 because autoloading is not an explicit request "load this file",
2209 but rather a request to "call this function".
2211 The value saved here is to be restored into Vautoload_queue. */
2212 record_unwind_protect (un_autoload
, Vautoload_queue
);
2213 Vautoload_queue
= Qt
;
2214 Fload (Fcar (Fcdr (fundef
)), Qnil
, Qt
, Qnil
, Qt
);
2216 /* Once loading finishes, don't undo it. */
2217 Vautoload_queue
= Qt
;
2218 unbind_to (count
, Qnil
);
2220 fun
= Findirect_function (fun
, Qnil
);
2222 if (!NILP (Fequal (fun
, fundef
)))
2223 error ("Autoloading failed to define function %s",
2224 SDATA (SYMBOL_NAME (funname
)));
2229 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
2230 doc
: /* Evaluate FORM and return its value.
2231 If LEXICAL is t, evaluate using lexical scoping. */)
2232 (Lisp_Object form
, Lisp_Object lexical
)
2234 int count
= SPECPDL_INDEX ();
2235 specbind (Qinternal_interpreter_environment
,
2236 NILP (lexical
) ? Qnil
: Fcons (Qt
, Qnil
));
2237 return unbind_to (count
, eval_sub (form
));
2240 /* Eval a sub-expression of the current expression (i.e. in the same
2243 eval_sub (Lisp_Object form
)
2245 Lisp_Object fun
, val
, original_fun
, original_args
;
2247 struct backtrace backtrace
;
2248 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2250 if (handling_signal
)
2255 /* Look up its binding in the lexical environment.
2256 We do not pay attention to the declared_special flag here, since we
2257 already did that when let-binding the variable. */
2258 Lisp_Object lex_binding
2259 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2260 ? Fassq (form
, Vinternal_interpreter_environment
)
2262 if (CONSP (lex_binding
))
2263 return XCDR (lex_binding
);
2265 return Fsymbol_value (form
);
2272 if ((consing_since_gc
> gc_cons_threshold
2273 && consing_since_gc
> gc_relative_threshold
)
2275 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2278 Fgarbage_collect ();
2282 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2284 if (max_lisp_eval_depth
< 100)
2285 max_lisp_eval_depth
= 100;
2286 if (lisp_eval_depth
> max_lisp_eval_depth
)
2287 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2290 original_fun
= Fcar (form
);
2291 original_args
= Fcdr (form
);
2293 backtrace
.next
= backtrace_list
;
2294 backtrace_list
= &backtrace
;
2295 backtrace
.function
= &original_fun
; /* This also protects them from gc. */
2296 backtrace
.args
= &original_args
;
2297 backtrace
.nargs
= UNEVALLED
;
2298 backtrace
.evalargs
= 1;
2299 backtrace
.debug_on_exit
= 0;
2301 if (debug_on_next_call
)
2302 do_debug_on_call (Qt
);
2304 /* At this point, only original_fun and original_args
2305 have values that will be used below. */
2308 /* Optimize for no indirection. */
2310 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2311 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2312 fun
= indirect_function (fun
);
2316 Lisp_Object numargs
;
2317 Lisp_Object argvals
[8];
2318 Lisp_Object args_left
;
2319 register int i
, maxargs
;
2321 args_left
= original_args
;
2322 numargs
= Flength (args_left
);
2326 if (XINT (numargs
) < XSUBR (fun
)->min_args
2327 || (XSUBR (fun
)->max_args
>= 0
2328 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2329 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2331 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2333 backtrace
.evalargs
= 0;
2334 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2336 else if (XSUBR (fun
)->max_args
== MANY
)
2338 /* Pass a vector of evaluated arguments. */
2340 register size_t argnum
= 0;
2343 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2345 GCPRO3 (args_left
, fun
, fun
);
2349 while (!NILP (args_left
))
2351 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2352 args_left
= Fcdr (args_left
);
2353 gcpro3
.nvars
= argnum
;
2356 backtrace
.args
= vals
;
2357 backtrace
.nargs
= XINT (numargs
);
2359 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2365 GCPRO3 (args_left
, fun
, fun
);
2366 gcpro3
.var
= argvals
;
2369 maxargs
= XSUBR (fun
)->max_args
;
2370 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2372 argvals
[i
] = eval_sub (Fcar (args_left
));
2378 backtrace
.args
= argvals
;
2379 backtrace
.nargs
= XINT (numargs
);
2384 val
= (XSUBR (fun
)->function
.a0 ());
2387 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2390 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2393 val
= (XSUBR (fun
)->function
.a3
2394 (argvals
[0], argvals
[1], argvals
[2]));
2397 val
= (XSUBR (fun
)->function
.a4
2398 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2401 val
= (XSUBR (fun
)->function
.a5
2402 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2406 val
= (XSUBR (fun
)->function
.a6
2407 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2408 argvals
[4], argvals
[5]));
2411 val
= (XSUBR (fun
)->function
.a7
2412 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2413 argvals
[4], argvals
[5], argvals
[6]));
2417 val
= (XSUBR (fun
)->function
.a8
2418 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2419 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2423 /* Someone has created a subr that takes more arguments than
2424 is supported by this code. We need to either rewrite the
2425 subr to use a different argument protocol, or add more
2426 cases to this switch. */
2431 else if (COMPILEDP (fun
))
2432 val
= apply_lambda (fun
, original_args
);
2435 if (EQ (fun
, Qunbound
))
2436 xsignal1 (Qvoid_function
, original_fun
);
2438 xsignal1 (Qinvalid_function
, original_fun
);
2439 funcar
= XCAR (fun
);
2440 if (!SYMBOLP (funcar
))
2441 xsignal1 (Qinvalid_function
, original_fun
);
2442 if (EQ (funcar
, Qautoload
))
2444 do_autoload (fun
, original_fun
);
2447 if (EQ (funcar
, Qmacro
))
2448 val
= eval_sub (apply1 (Fcdr (fun
), original_args
));
2449 else if (EQ (funcar
, Qlambda
)
2450 || EQ (funcar
, Qclosure
))
2451 val
= apply_lambda (fun
, original_args
);
2453 xsignal1 (Qinvalid_function
, original_fun
);
2458 if (backtrace
.debug_on_exit
)
2459 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2460 backtrace_list
= backtrace
.next
;
2465 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2466 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2467 Then return the value FUNCTION returns.
2468 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2469 usage: (apply FUNCTION &rest ARGUMENTS) */)
2470 (size_t nargs
, Lisp_Object
*args
)
2472 register size_t i
, numargs
;
2473 register Lisp_Object spread_arg
;
2474 register Lisp_Object
*funcall_args
;
2475 Lisp_Object fun
, retval
;
2476 struct gcpro gcpro1
;
2481 spread_arg
= args
[nargs
- 1];
2482 CHECK_LIST (spread_arg
);
2484 numargs
= XINT (Flength (spread_arg
));
2487 return Ffuncall (nargs
- 1, args
);
2488 else if (numargs
== 1)
2490 args
[nargs
- 1] = XCAR (spread_arg
);
2491 return Ffuncall (nargs
, args
);
2494 numargs
+= nargs
- 2;
2496 /* Optimize for no indirection. */
2497 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2498 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2499 fun
= indirect_function (fun
);
2500 if (EQ (fun
, Qunbound
))
2502 /* Let funcall get the error. */
2509 if (numargs
< XSUBR (fun
)->min_args
2510 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2511 goto funcall
; /* Let funcall get the error. */
2512 else if (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
> numargs
)
2514 /* Avoid making funcall cons up a yet another new vector of arguments
2515 by explicitly supplying nil's for optional values. */
2516 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2517 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2518 funcall_args
[++i
] = Qnil
;
2519 GCPRO1 (*funcall_args
);
2520 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2524 /* We add 1 to numargs because funcall_args includes the
2525 function itself as well as its arguments. */
2528 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2529 GCPRO1 (*funcall_args
);
2530 gcpro1
.nvars
= 1 + numargs
;
2533 memcpy (funcall_args
, args
, nargs
* sizeof (Lisp_Object
));
2534 /* Spread the last arg we got. Its first element goes in
2535 the slot that it used to occupy, hence this value of I. */
2537 while (!NILP (spread_arg
))
2539 funcall_args
[i
++] = XCAR (spread_arg
);
2540 spread_arg
= XCDR (spread_arg
);
2543 /* By convention, the caller needs to gcpro Ffuncall's args. */
2544 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
2551 /* Run hook variables in various ways. */
2554 funcall_nil (size_t nargs
, Lisp_Object
*args
)
2556 Ffuncall (nargs
, args
);
2560 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2561 doc
: /* Run each hook in HOOKS.
2562 Each argument should be a symbol, a hook variable.
2563 These symbols are processed in the order specified.
2564 If a hook symbol has a non-nil value, that value may be a function
2565 or a list of functions to be called to run the hook.
2566 If the value is a function, it is called with no arguments.
2567 If it is a list, the elements are called, in order, with no arguments.
2569 Major modes should not use this function directly to run their mode
2570 hook; they should use `run-mode-hooks' instead.
2572 Do not use `make-local-variable' to make a hook variable buffer-local.
2573 Instead, use `add-hook' and specify t for the LOCAL argument.
2574 usage: (run-hooks &rest HOOKS) */)
2575 (size_t nargs
, Lisp_Object
*args
)
2577 Lisp_Object hook
[1];
2580 for (i
= 0; i
< nargs
; i
++)
2583 run_hook_with_args (1, hook
, funcall_nil
);
2589 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2590 Srun_hook_with_args
, 1, MANY
, 0,
2591 doc
: /* Run HOOK with the specified arguments ARGS.
2592 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2593 value, that value may be a function or a list of functions to be
2594 called to run the hook. If the value is a function, it is called with
2595 the given arguments and its return value is returned. If it is a list
2596 of functions, those functions are called, in order,
2597 with the given arguments ARGS.
2598 It is best not to depend on the value returned by `run-hook-with-args',
2601 Do not use `make-local-variable' to make a hook variable buffer-local.
2602 Instead, use `add-hook' and specify t for the LOCAL argument.
2603 usage: (run-hook-with-args HOOK &rest ARGS) */)
2604 (size_t nargs
, Lisp_Object
*args
)
2606 return run_hook_with_args (nargs
, args
, funcall_nil
);
2609 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2610 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2611 doc
: /* Run HOOK with the specified arguments ARGS.
2612 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2613 value, that value may be a function or a list of functions to be
2614 called to run the hook. If the value is a function, it is called with
2615 the given arguments and its return value is returned.
2616 If it is a list of functions, those functions are called, in order,
2617 with the given arguments ARGS, until one of them
2618 returns a non-nil value. Then we return that value.
2619 However, if they all return nil, we return nil.
2621 Do not use `make-local-variable' to make a hook variable buffer-local.
2622 Instead, use `add-hook' and specify t for the LOCAL argument.
2623 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2624 (size_t nargs
, Lisp_Object
*args
)
2626 return run_hook_with_args (nargs
, args
, Ffuncall
);
2630 funcall_not (size_t nargs
, Lisp_Object
*args
)
2632 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2635 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2636 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2637 doc
: /* Run HOOK with the specified arguments ARGS.
2638 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2639 value, that value may be a function or a list of functions to be
2640 called to run the hook. If the value is a function, it is called with
2641 the given arguments and its return value is returned.
2642 If it is a list of functions, those functions are called, in order,
2643 with the given arguments ARGS, until one of them returns nil.
2644 Then we return nil. However, if they all return non-nil, we return non-nil.
2646 Do not use `make-local-variable' to make a hook variable buffer-local.
2647 Instead, use `add-hook' and specify t for the LOCAL argument.
2648 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2649 (size_t nargs
, Lisp_Object
*args
)
2651 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2655 run_hook_wrapped_funcall (size_t nargs
, Lisp_Object
*args
)
2657 Lisp_Object tmp
= args
[0], ret
;
2660 ret
= Ffuncall (nargs
, args
);
2666 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2667 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2668 I.e. instead of calling each function FUN directly with arguments ARGS,
2669 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2670 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2671 aborts and returns that value.
2672 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2673 (size_t nargs
, Lisp_Object
*args
)
2675 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2678 /* ARGS[0] should be a hook symbol.
2679 Call each of the functions in the hook value, passing each of them
2680 as arguments all the rest of ARGS (all NARGS - 1 elements).
2681 FUNCALL specifies how to call each function on the hook.
2682 The caller (or its caller, etc) must gcpro all of ARGS,
2683 except that it isn't necessary to gcpro ARGS[0]. */
2686 run_hook_with_args (size_t nargs
, Lisp_Object
*args
,
2687 Lisp_Object (*funcall
) (size_t nargs
, Lisp_Object
*args
))
2689 Lisp_Object sym
, val
, ret
= Qnil
;
2690 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2692 /* If we are dying or still initializing,
2693 don't do anything--it would probably crash if we tried. */
2694 if (NILP (Vrun_hooks
))
2698 val
= find_symbol_value (sym
);
2700 if (EQ (val
, Qunbound
) || NILP (val
))
2702 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2705 return funcall (nargs
, args
);
2709 Lisp_Object global_vals
= Qnil
;
2710 GCPRO3 (sym
, val
, global_vals
);
2713 CONSP (val
) && NILP (ret
);
2716 if (EQ (XCAR (val
), Qt
))
2718 /* t indicates this hook has a local binding;
2719 it means to run the global binding too. */
2720 global_vals
= Fdefault_value (sym
);
2721 if (NILP (global_vals
)) continue;
2723 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2725 args
[0] = global_vals
;
2726 ret
= funcall (nargs
, args
);
2731 CONSP (global_vals
) && NILP (ret
);
2732 global_vals
= XCDR (global_vals
))
2734 args
[0] = XCAR (global_vals
);
2735 /* In a global value, t should not occur. If it does, we
2736 must ignore it to avoid an endless loop. */
2737 if (!EQ (args
[0], Qt
))
2738 ret
= funcall (nargs
, args
);
2744 args
[0] = XCAR (val
);
2745 ret
= funcall (nargs
, args
);
2754 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2757 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2759 Lisp_Object temp
[3];
2764 Frun_hook_with_args (3, temp
);
2767 /* Apply fn to arg. */
2769 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2771 struct gcpro gcpro1
;
2775 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2778 Lisp_Object args
[2];
2782 RETURN_UNGCPRO (Fapply (2, args
));
2786 /* Call function fn on no arguments. */
2788 call0 (Lisp_Object fn
)
2790 struct gcpro gcpro1
;
2793 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2796 /* Call function fn with 1 argument arg1. */
2799 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2801 struct gcpro gcpro1
;
2802 Lisp_Object args
[2];
2808 RETURN_UNGCPRO (Ffuncall (2, args
));
2811 /* Call function fn with 2 arguments arg1, arg2. */
2814 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2816 struct gcpro gcpro1
;
2817 Lisp_Object args
[3];
2823 RETURN_UNGCPRO (Ffuncall (3, args
));
2826 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2829 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2831 struct gcpro gcpro1
;
2832 Lisp_Object args
[4];
2839 RETURN_UNGCPRO (Ffuncall (4, args
));
2842 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2845 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2848 struct gcpro gcpro1
;
2849 Lisp_Object args
[5];
2857 RETURN_UNGCPRO (Ffuncall (5, args
));
2860 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2863 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2864 Lisp_Object arg4
, Lisp_Object arg5
)
2866 struct gcpro gcpro1
;
2867 Lisp_Object args
[6];
2876 RETURN_UNGCPRO (Ffuncall (6, args
));
2879 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2882 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2883 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2885 struct gcpro gcpro1
;
2886 Lisp_Object args
[7];
2896 RETURN_UNGCPRO (Ffuncall (7, args
));
2899 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2902 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2903 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2905 struct gcpro gcpro1
;
2906 Lisp_Object args
[8];
2917 RETURN_UNGCPRO (Ffuncall (8, args
));
2920 /* The caller should GCPRO all the elements of ARGS. */
2922 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2923 doc
: /* Non-nil if OBJECT is a function. */)
2924 (Lisp_Object object
)
2926 if (SYMBOLP (object
) && !NILP (Ffboundp (object
)))
2928 object
= Findirect_function (object
, Qt
);
2930 if (CONSP (object
) && EQ (XCAR (object
), Qautoload
))
2932 /* Autoloaded symbols are functions, except if they load
2933 macros or keymaps. */
2935 for (i
= 0; i
< 4 && CONSP (object
); i
++)
2936 object
= XCDR (object
);
2938 return (CONSP (object
) && !NILP (XCAR (object
))) ? Qnil
: Qt
;
2943 return (XSUBR (object
)->max_args
!= UNEVALLED
) ? Qt
: Qnil
;
2944 else if (COMPILEDP (object
))
2946 else if (CONSP (object
))
2948 Lisp_Object car
= XCAR (object
);
2949 return (EQ (car
, Qlambda
) || EQ (car
, Qclosure
)) ? Qt
: Qnil
;
2955 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2956 doc
: /* Call first argument as a function, passing remaining arguments to it.
2957 Return the value that function returns.
2958 Thus, (funcall 'cons 'x 'y) returns (x . y).
2959 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2960 (size_t nargs
, Lisp_Object
*args
)
2962 Lisp_Object fun
, original_fun
;
2964 size_t numargs
= nargs
- 1;
2965 Lisp_Object lisp_numargs
;
2967 struct backtrace backtrace
;
2968 register Lisp_Object
*internal_args
;
2972 if ((consing_since_gc
> gc_cons_threshold
2973 && consing_since_gc
> gc_relative_threshold
)
2975 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2976 Fgarbage_collect ();
2978 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2980 if (max_lisp_eval_depth
< 100)
2981 max_lisp_eval_depth
= 100;
2982 if (lisp_eval_depth
> max_lisp_eval_depth
)
2983 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2986 backtrace
.next
= backtrace_list
;
2987 backtrace_list
= &backtrace
;
2988 backtrace
.function
= &args
[0];
2989 backtrace
.args
= &args
[1];
2990 backtrace
.nargs
= nargs
- 1;
2991 backtrace
.evalargs
= 0;
2992 backtrace
.debug_on_exit
= 0;
2994 if (debug_on_next_call
)
2995 do_debug_on_call (Qlambda
);
2999 original_fun
= args
[0];
3003 /* Optimize for no indirection. */
3005 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
3006 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
3007 fun
= indirect_function (fun
);
3011 if (numargs
< XSUBR (fun
)->min_args
3012 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
3014 XSETFASTINT (lisp_numargs
, numargs
);
3015 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
3018 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
3019 xsignal1 (Qinvalid_function
, original_fun
);
3021 else if (XSUBR (fun
)->max_args
== MANY
)
3022 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
3025 if (XSUBR (fun
)->max_args
> numargs
)
3027 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
3028 memcpy (internal_args
, args
+ 1, numargs
* sizeof (Lisp_Object
));
3029 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
3030 internal_args
[i
] = Qnil
;
3033 internal_args
= args
+ 1;
3034 switch (XSUBR (fun
)->max_args
)
3037 val
= (XSUBR (fun
)->function
.a0 ());
3040 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
3043 val
= (XSUBR (fun
)->function
.a2
3044 (internal_args
[0], internal_args
[1]));
3047 val
= (XSUBR (fun
)->function
.a3
3048 (internal_args
[0], internal_args
[1], internal_args
[2]));
3051 val
= (XSUBR (fun
)->function
.a4
3052 (internal_args
[0], internal_args
[1], internal_args
[2],
3056 val
= (XSUBR (fun
)->function
.a5
3057 (internal_args
[0], internal_args
[1], internal_args
[2],
3058 internal_args
[3], internal_args
[4]));
3061 val
= (XSUBR (fun
)->function
.a6
3062 (internal_args
[0], internal_args
[1], internal_args
[2],
3063 internal_args
[3], internal_args
[4], internal_args
[5]));
3066 val
= (XSUBR (fun
)->function
.a7
3067 (internal_args
[0], internal_args
[1], internal_args
[2],
3068 internal_args
[3], internal_args
[4], internal_args
[5],
3073 val
= (XSUBR (fun
)->function
.a8
3074 (internal_args
[0], internal_args
[1], internal_args
[2],
3075 internal_args
[3], internal_args
[4], internal_args
[5],
3076 internal_args
[6], internal_args
[7]));
3081 /* If a subr takes more than 8 arguments without using MANY
3082 or UNEVALLED, we need to extend this function to support it.
3083 Until this is done, there is no way to call the function. */
3088 else if (COMPILEDP (fun
))
3089 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3092 if (EQ (fun
, Qunbound
))
3093 xsignal1 (Qvoid_function
, original_fun
);
3095 xsignal1 (Qinvalid_function
, original_fun
);
3096 funcar
= XCAR (fun
);
3097 if (!SYMBOLP (funcar
))
3098 xsignal1 (Qinvalid_function
, original_fun
);
3099 if (EQ (funcar
, Qlambda
)
3100 || EQ (funcar
, Qclosure
))
3101 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3102 else if (EQ (funcar
, Qautoload
))
3104 do_autoload (fun
, original_fun
);
3109 xsignal1 (Qinvalid_function
, original_fun
);
3113 if (backtrace
.debug_on_exit
)
3114 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
3115 backtrace_list
= backtrace
.next
;
3120 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
3122 Lisp_Object args_left
;
3124 register Lisp_Object
*arg_vector
;
3125 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3127 register Lisp_Object tem
;
3130 numargs
= XINT (Flength (args
));
3131 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
3134 GCPRO3 (*arg_vector
, args_left
, fun
);
3137 for (i
= 0; i
< numargs
; )
3139 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
3140 tem
= eval_sub (tem
);
3141 arg_vector
[i
++] = tem
;
3147 backtrace_list
->args
= arg_vector
;
3148 backtrace_list
->nargs
= i
;
3149 backtrace_list
->evalargs
= 0;
3150 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
3152 /* Do the debug-on-exit now, while arg_vector still exists. */
3153 if (backtrace_list
->debug_on_exit
)
3154 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
3155 /* Don't do it again when we return to eval. */
3156 backtrace_list
->debug_on_exit
= 0;
3161 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3162 and return the result of evaluation.
3163 FUN must be either a lambda-expression or a compiled-code object. */
3166 funcall_lambda (Lisp_Object fun
, size_t nargs
,
3167 register Lisp_Object
*arg_vector
)
3169 Lisp_Object val
, syms_left
, next
, lexenv
;
3170 int count
= SPECPDL_INDEX ();
3176 if (EQ (XCAR (fun
), Qclosure
))
3178 fun
= XCDR (fun
); /* Drop `closure'. */
3179 lexenv
= XCAR (fun
);
3180 CHECK_LIST_CONS (fun
, fun
);
3184 syms_left
= XCDR (fun
);
3185 if (CONSP (syms_left
))
3186 syms_left
= XCAR (syms_left
);
3188 xsignal1 (Qinvalid_function
, fun
);
3190 else if (COMPILEDP (fun
))
3192 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3193 if (INTEGERP (syms_left
))
3194 /* A byte-code object with a non-nil `push args' slot means we
3195 shouldn't bind any arguments, instead just call the byte-code
3196 interpreter directly; it will push arguments as necessary.
3198 Byte-code objects with either a non-existant, or a nil value for
3199 the `push args' slot (the default), have dynamically-bound
3200 arguments, and use the argument-binding code below instead (as do
3201 all interpreted functions, even lexically bound ones). */
3203 /* If we have not actually read the bytecode string
3204 and constants vector yet, fetch them from the file. */
3205 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3206 Ffetch_bytecode (fun
);
3207 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3208 AREF (fun
, COMPILED_CONSTANTS
),
3209 AREF (fun
, COMPILED_STACK_DEPTH
),
3218 i
= optional
= rest
= 0;
3219 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3223 next
= XCAR (syms_left
);
3224 if (!SYMBOLP (next
))
3225 xsignal1 (Qinvalid_function
, fun
);
3227 if (EQ (next
, Qand_rest
))
3229 else if (EQ (next
, Qand_optional
))
3236 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
3240 arg
= arg_vector
[i
++];
3242 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3246 /* Bind the argument. */
3247 if (!NILP (lexenv
) && SYMBOLP (next
))
3248 /* Lexically bind NEXT by adding it to the lexenv alist. */
3249 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
3251 /* Dynamically bind NEXT. */
3252 specbind (next
, arg
);
3256 if (!NILP (syms_left
))
3257 xsignal1 (Qinvalid_function
, fun
);
3259 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3261 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3262 /* Instantiate a new lexical environment. */
3263 specbind (Qinternal_interpreter_environment
, lexenv
);
3266 val
= Fprogn (XCDR (XCDR (fun
)));
3269 /* If we have not actually read the bytecode string
3270 and constants vector yet, fetch them from the file. */
3271 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3272 Ffetch_bytecode (fun
);
3273 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3274 AREF (fun
, COMPILED_CONSTANTS
),
3275 AREF (fun
, COMPILED_STACK_DEPTH
),
3279 return unbind_to (count
, val
);
3282 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3284 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3285 (Lisp_Object object
)
3289 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3291 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3294 tem
= AREF (object
, COMPILED_BYTECODE
);
3295 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3296 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3298 error ("Invalid byte code");
3300 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3301 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3309 register int count
= SPECPDL_INDEX ();
3310 if (specpdl_size
>= max_specpdl_size
)
3312 if (max_specpdl_size
< 400)
3313 max_specpdl_size
= 400;
3314 if (specpdl_size
>= max_specpdl_size
)
3315 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil
);
3318 if (specpdl_size
> max_specpdl_size
)
3319 specpdl_size
= max_specpdl_size
;
3320 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3321 specpdl_ptr
= specpdl
+ count
;
3324 /* `specpdl_ptr->symbol' is a field which describes which variable is
3325 let-bound, so it can be properly undone when we unbind_to.
3326 It can have the following two shapes:
3327 - SYMBOL : if it's a plain symbol, it means that we have let-bound
3328 a symbol that is not buffer-local (at least at the time
3329 the let binding started). Note also that it should not be
3330 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3332 - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
3333 variable SYMBOL which can be buffer-local. WHERE tells us
3334 which buffer is affected (or nil if the let-binding affects the
3335 global value of the variable) and BUFFER tells us which buffer was
3336 current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
3337 BUFFER did not yet have a buffer-local value). */
3340 specbind (Lisp_Object symbol
, Lisp_Object value
)
3342 struct Lisp_Symbol
*sym
;
3344 eassert (!handling_signal
);
3346 CHECK_SYMBOL (symbol
);
3347 sym
= XSYMBOL (symbol
);
3348 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3352 switch (sym
->redirect
)
3354 case SYMBOL_VARALIAS
:
3355 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3356 case SYMBOL_PLAINVAL
:
3357 /* The most common case is that of a non-constant symbol with a
3358 trivial value. Make that as fast as we can. */
3359 specpdl_ptr
->symbol
= symbol
;
3360 specpdl_ptr
->old_value
= SYMBOL_VAL (sym
);
3361 specpdl_ptr
->func
= NULL
;
3364 SET_SYMBOL_VAL (sym
, value
);
3366 set_internal (symbol
, value
, Qnil
, 1);
3368 case SYMBOL_LOCALIZED
:
3369 if (SYMBOL_BLV (sym
)->frame_local
)
3370 error ("Frame-local vars cannot be let-bound");
3371 case SYMBOL_FORWARDED
:
3373 Lisp_Object ovalue
= find_symbol_value (symbol
);
3374 specpdl_ptr
->func
= 0;
3375 specpdl_ptr
->old_value
= ovalue
;
3377 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3378 || (EQ (SYMBOL_BLV (sym
)->where
,
3379 SYMBOL_BLV (sym
)->frame_local
?
3380 Fselected_frame () : Fcurrent_buffer ())));
3382 if (sym
->redirect
== SYMBOL_LOCALIZED
3383 || BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3385 Lisp_Object where
, cur_buf
= Fcurrent_buffer ();
3387 /* For a local variable, record both the symbol and which
3388 buffer's or frame's value we are saving. */
3389 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3391 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3392 || (BLV_FOUND (SYMBOL_BLV (sym
))
3393 && EQ (cur_buf
, SYMBOL_BLV (sym
)->where
)));
3396 else if (sym
->redirect
== SYMBOL_LOCALIZED
3397 && BLV_FOUND (SYMBOL_BLV (sym
)))
3398 where
= SYMBOL_BLV (sym
)->where
;
3402 /* We're not using the `unused' slot in the specbinding
3403 structure because this would mean we have to do more
3404 work for simple variables. */
3405 /* FIXME: The third value `current_buffer' is only used in
3406 let_shadows_buffer_binding_p which is itself only used
3407 in set_internal for local_if_set. */
3408 eassert (NILP (where
) || EQ (where
, cur_buf
));
3409 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, cur_buf
));
3411 /* If SYMBOL is a per-buffer variable which doesn't have a
3412 buffer-local value here, make the `let' change the global
3413 value by changing the value of SYMBOL in all buffers not
3414 having their own value. This is consistent with what
3415 happens with other buffer-local variables. */
3417 && sym
->redirect
== SYMBOL_FORWARDED
)
3419 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)));
3421 Fset_default (symbol
, value
);
3426 specpdl_ptr
->symbol
= symbol
;
3429 set_internal (symbol
, value
, Qnil
, 1);
3437 record_unwind_protect (Lisp_Object (*function
) (Lisp_Object
), Lisp_Object arg
)
3439 eassert (!handling_signal
);
3441 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3443 specpdl_ptr
->func
= function
;
3444 specpdl_ptr
->symbol
= Qnil
;
3445 specpdl_ptr
->old_value
= arg
;
3450 unbind_to (int count
, Lisp_Object value
)
3452 Lisp_Object quitf
= Vquit_flag
;
3453 struct gcpro gcpro1
, gcpro2
;
3455 GCPRO2 (value
, quitf
);
3458 while (specpdl_ptr
!= specpdl
+ count
)
3460 /* Copy the binding, and decrement specpdl_ptr, before we do
3461 the work to unbind it. We decrement first
3462 so that an error in unbinding won't try to unbind
3463 the same entry again, and we copy the binding first
3464 in case more bindings are made during some of the code we run. */
3466 struct specbinding this_binding
;
3467 this_binding
= *--specpdl_ptr
;
3469 if (this_binding
.func
!= 0)
3470 (*this_binding
.func
) (this_binding
.old_value
);
3471 /* If the symbol is a list, it is really (SYMBOL WHERE
3472 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3473 frame. If WHERE is a buffer or frame, this indicates we
3474 bound a variable that had a buffer-local or frame-local
3475 binding. WHERE nil means that the variable had the default
3476 value when it was bound. CURRENT-BUFFER is the buffer that
3477 was current when the variable was bound. */
3478 else if (CONSP (this_binding
.symbol
))
3480 Lisp_Object symbol
, where
;
3482 symbol
= XCAR (this_binding
.symbol
);
3483 where
= XCAR (XCDR (this_binding
.symbol
));
3486 Fset_default (symbol
, this_binding
.old_value
);
3487 /* If `where' is non-nil, reset the value in the appropriate
3488 local binding, but only if that binding still exists. */
3489 else if (BUFFERP (where
)
3490 ? !NILP (Flocal_variable_p (symbol
, where
))
3491 : !NILP (Fassq (symbol
, XFRAME (where
)->param_alist
)))
3492 set_internal (symbol
, this_binding
.old_value
, where
, 1);
3494 /* If variable has a trivial value (no forwarding), we can
3495 just set it. No need to check for constant symbols here,
3496 since that was already done by specbind. */
3497 else if (XSYMBOL (this_binding
.symbol
)->redirect
== SYMBOL_PLAINVAL
)
3498 SET_SYMBOL_VAL (XSYMBOL (this_binding
.symbol
),
3499 this_binding
.old_value
);
3501 /* NOTE: we only ever come here if make_local_foo was used for
3502 the first time on this var within this let. */
3503 Fset_default (this_binding
.symbol
, this_binding
.old_value
);
3506 if (NILP (Vquit_flag
) && !NILP (quitf
))
3513 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3514 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3515 A special variable is one that will be bound dynamically, even in a
3516 context where binding is lexical by default. */)
3517 (Lisp_Object symbol
)
3519 CHECK_SYMBOL (symbol
);
3520 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3524 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3525 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3526 The debugger is entered when that frame exits, if the flag is non-nil. */)
3527 (Lisp_Object level
, Lisp_Object flag
)
3529 register struct backtrace
*backlist
= backtrace_list
;
3532 CHECK_NUMBER (level
);
3534 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3536 backlist
= backlist
->next
;
3540 backlist
->debug_on_exit
= !NILP (flag
);
3545 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3546 doc
: /* Print a trace of Lisp function calls currently active.
3547 Output stream used is value of `standard-output'. */)
3550 register struct backtrace
*backlist
= backtrace_list
;
3553 struct gcpro gcpro1
;
3554 Lisp_Object old_print_level
= Vprint_level
;
3556 if (NILP (Vprint_level
))
3557 XSETFASTINT (Vprint_level
, 8);
3564 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3565 if (backlist
->nargs
== UNEVALLED
)
3567 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3568 write_string ("\n", -1);
3572 tem
= *backlist
->function
;
3573 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3574 write_string ("(", -1);
3575 if (backlist
->nargs
== MANY
)
3576 { /* FIXME: Can this happen? */
3578 for (tail
= *backlist
->args
, i
= 0;
3580 tail
= Fcdr (tail
), i
= 1)
3582 if (i
) write_string (" ", -1);
3583 Fprin1 (Fcar (tail
), Qnil
);
3589 for (i
= 0; i
< backlist
->nargs
; i
++)
3591 if (i
) write_string (" ", -1);
3592 Fprin1 (backlist
->args
[i
], Qnil
);
3595 write_string (")\n", -1);
3597 backlist
= backlist
->next
;
3600 Vprint_level
= old_print_level
;
3605 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3606 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3607 If that frame has not evaluated the arguments yet (or is a special form),
3608 the value is (nil FUNCTION ARG-FORMS...).
3609 If that frame has evaluated its arguments and called its function already,
3610 the value is (t FUNCTION ARG-VALUES...).
3611 A &rest arg is represented as the tail of the list ARG-VALUES.
3612 FUNCTION is whatever was supplied as car of evaluated list,
3613 or a lambda expression for macro calls.
3614 If NFRAMES is more than the number of frames, the value is nil. */)
3615 (Lisp_Object nframes
)
3617 register struct backtrace
*backlist
= backtrace_list
;
3618 register EMACS_INT i
;
3621 CHECK_NATNUM (nframes
);
3623 /* Find the frame requested. */
3624 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3625 backlist
= backlist
->next
;
3629 if (backlist
->nargs
== UNEVALLED
)
3630 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3633 if (backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3634 tem
= *backlist
->args
;
3636 tem
= Flist (backlist
->nargs
, backlist
->args
);
3638 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3645 mark_backtrace (void)
3647 register struct backtrace
*backlist
;
3650 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3652 mark_object (*backlist
->function
);
3654 if (backlist
->nargs
== UNEVALLED
3655 || backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3658 i
= backlist
->nargs
;
3660 mark_object (backlist
->args
[i
]);
3668 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3669 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3670 If Lisp code tries to increase the total number past this amount,
3671 an error is signaled.
3672 You can safely use a value considerably larger than the default value,
3673 if that proves inconveniently small. However, if you increase it too far,
3674 Emacs could run out of memory trying to make the stack bigger. */);
3676 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3677 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3679 This limit serves to catch infinite recursions for you before they cause
3680 actual stack overflow in C, which would be fatal for Emacs.
3681 You can safely make it considerably larger than its default value,
3682 if that proves inconveniently small. However, if you increase it too far,
3683 Emacs could overflow the real C stack, and crash. */);
3685 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3686 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3687 If the value is t, that means do an ordinary quit.
3688 If the value equals `throw-on-input', that means quit by throwing
3689 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3690 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3691 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3694 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3695 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3696 Note that `quit-flag' will still be set by typing C-g,
3697 so a quit will be signaled as soon as `inhibit-quit' is nil.
3698 To prevent this happening, set `quit-flag' to nil
3699 before making `inhibit-quit' nil. */);
3700 Vinhibit_quit
= Qnil
;
3702 Qinhibit_quit
= intern_c_string ("inhibit-quit");
3703 staticpro (&Qinhibit_quit
);
3705 Qautoload
= intern_c_string ("autoload");
3706 staticpro (&Qautoload
);
3708 Qdebug_on_error
= intern_c_string ("debug-on-error");
3709 staticpro (&Qdebug_on_error
);
3711 Qmacro
= intern_c_string ("macro");
3712 staticpro (&Qmacro
);
3714 Qdeclare
= intern_c_string ("declare");
3715 staticpro (&Qdeclare
);
3717 /* Note that the process handling also uses Qexit, but we don't want
3718 to staticpro it twice, so we just do it here. */
3719 Qexit
= intern_c_string ("exit");
3722 Qinteractive
= intern_c_string ("interactive");
3723 staticpro (&Qinteractive
);
3725 Qcommandp
= intern_c_string ("commandp");
3726 staticpro (&Qcommandp
);
3728 Qdefun
= intern_c_string ("defun");
3729 staticpro (&Qdefun
);
3731 Qand_rest
= intern_c_string ("&rest");
3732 staticpro (&Qand_rest
);
3734 Qand_optional
= intern_c_string ("&optional");
3735 staticpro (&Qand_optional
);
3737 Qclosure
= intern_c_string ("closure");
3738 staticpro (&Qclosure
);
3740 Qdebug
= intern_c_string ("debug");
3741 staticpro (&Qdebug
);
3743 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3744 doc
: /* *Non-nil means enter debugger if an error is signaled.
3745 Does not apply to errors handled by `condition-case' or those
3746 matched by `debug-ignored-errors'.
3747 If the value is a list, an error only means to enter the debugger
3748 if one of its condition symbols appears in the list.
3749 When you evaluate an expression interactively, this variable
3750 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3751 The command `toggle-debug-on-error' toggles this.
3752 See also the variable `debug-on-quit'. */);
3753 Vdebug_on_error
= Qnil
;
3755 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3756 doc
: /* *List of errors for which the debugger should not be called.
3757 Each element may be a condition-name or a regexp that matches error messages.
3758 If any element applies to a given error, that error skips the debugger
3759 and just returns to top level.
3760 This overrides the variable `debug-on-error'.
3761 It does not apply to errors handled by `condition-case'. */);
3762 Vdebug_ignored_errors
= Qnil
;
3764 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3765 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3766 Does not apply if quit is handled by a `condition-case'. */);
3769 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3770 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3772 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3773 doc
: /* Non-nil means debugger may continue execution.
3774 This is nil when the debugger is called under circumstances where it
3775 might not be safe to continue. */);
3776 debugger_may_continue
= 1;
3778 DEFVAR_LISP ("debugger", Vdebugger
,
3779 doc
: /* Function to call to invoke debugger.
3780 If due to frame exit, args are `exit' and the value being returned;
3781 this function's value will be returned instead of that.
3782 If due to error, args are `error' and a list of the args to `signal'.
3783 If due to `apply' or `funcall' entry, one arg, `lambda'.
3784 If due to `eval' entry, one arg, t. */);
3787 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3788 doc
: /* If non-nil, this is a function for `signal' to call.
3789 It receives the same arguments that `signal' was given.
3790 The Edebug package uses this to regain control. */);
3791 Vsignal_hook_function
= Qnil
;
3793 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3794 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3795 Note that `debug-on-error', `debug-on-quit' and friends
3796 still determine whether to handle the particular condition. */);
3797 Vdebug_on_signal
= Qnil
;
3799 DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function
,
3800 doc
: /* Function to process declarations in a macro definition.
3801 The function will be called with two args MACRO and DECL.
3802 MACRO is the name of the macro being defined.
3803 DECL is a list `(declare ...)' containing the declarations.
3804 The value the function returns is not used. */);
3805 Vmacro_declaration_function
= Qnil
;
3807 /* When lexical binding is being used,
3808 vinternal_interpreter_environment is non-nil, and contains an alist
3809 of lexically-bound variable, or (t), indicating an empty
3810 environment. The lisp name of this variable would be
3811 `internal-interpreter-environment' if it weren't hidden.
3812 Every element of this list can be either a cons (VAR . VAL)
3813 specifying a lexical binding, or a single symbol VAR indicating
3814 that this variable should use dynamic scoping. */
3815 Qinternal_interpreter_environment
3816 = intern_c_string ("internal-interpreter-environment");
3817 staticpro (&Qinternal_interpreter_environment
);
3818 DEFVAR_LISP ("internal-interpreter-environment",
3819 Vinternal_interpreter_environment
,
3820 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3821 When lexical binding is not being used, this variable is nil.
3822 A value of `(t)' indicates an empty environment, otherwise it is an
3823 alist of active lexical bindings. */);
3824 Vinternal_interpreter_environment
= Qnil
;
3825 /* Don't export this variable to Elisp, so noone can mess with it
3826 (Just imagine if someone makes it buffer-local). */
3827 Funintern (Qinternal_interpreter_environment
, Qnil
);
3829 Vrun_hooks
= intern_c_string ("run-hooks");
3830 staticpro (&Vrun_hooks
);
3832 staticpro (&Vautoload_queue
);
3833 Vautoload_queue
= Qnil
;
3834 staticpro (&Vsignaling_function
);
3835 Vsignaling_function
= Qnil
;
3846 defsubr (&Sfunction
);
3848 defsubr (&Sdefmacro
);
3850 defsubr (&Sdefvaralias
);
3851 defsubr (&Sdefconst
);
3852 defsubr (&Suser_variable_p
);
3856 defsubr (&Smacroexpand
);
3859 defsubr (&Sunwind_protect
);
3860 defsubr (&Scondition_case
);
3862 defsubr (&Sinteractive_p
);
3863 defsubr (&Scalled_interactively_p
);
3864 defsubr (&Scommandp
);
3865 defsubr (&Sautoload
);
3868 defsubr (&Sfuncall
);
3869 defsubr (&Srun_hooks
);
3870 defsubr (&Srun_hook_with_args
);
3871 defsubr (&Srun_hook_with_args_until_success
);
3872 defsubr (&Srun_hook_with_args_until_failure
);
3873 defsubr (&Srun_hook_wrapped
);
3874 defsubr (&Sfetch_bytecode
);
3875 defsubr (&Sbacktrace_debug
);
3876 defsubr (&Sbacktrace
);
3877 defsubr (&Sbacktrace_frame
);
3878 defsubr (&Sspecial_variable_p
);
3879 defsubr (&Sfunctionp
);