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 sym
->redirect
= SYMBOL_VARALIAS
;
776 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
777 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
778 LOADHIST_ATTACH (new_alias
);
779 /* Even if docstring is nil: remove old docstring. */
780 Fput (new_alias
, Qvariable_documentation
, docstring
);
782 return base_variable
;
786 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
787 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
788 You are not required to define a variable in order to use it,
789 but the definition can supply documentation and an initial value
790 in a way that tags can recognize.
792 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
793 If SYMBOL is buffer-local, its default value is what is set;
794 buffer-local values are not affected.
795 INITVALUE and DOCSTRING are optional.
796 If DOCSTRING starts with *, this variable is identified as a user option.
797 This means that M-x set-variable recognizes it.
798 See also `user-variable-p'.
799 If INITVALUE is missing, SYMBOL's value is not set.
801 If SYMBOL has a local binding, then this form affects the local
802 binding. This is usually not what you want. Thus, if you need to
803 load a file defining variables, with this form or with `defconst' or
804 `defcustom', you should always load that file _outside_ any bindings
805 for these variables. \(`defconst' and `defcustom' behave similarly in
807 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
810 register Lisp_Object sym
, tem
, tail
;
814 if (!NILP (Fcdr (Fcdr (tail
))))
815 error ("Too many arguments");
817 tem
= Fdefault_boundp (sym
);
820 /* Do it before evaluating the initial value, for self-references. */
821 XSYMBOL (sym
)->declared_special
= 1;
823 if (SYMBOL_CONSTANT_P (sym
))
825 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
826 Lisp_Object tem1
= Fcar (tail
);
828 && EQ (XCAR (tem1
), Qquote
)
829 && CONSP (XCDR (tem1
))
830 && EQ (XCAR (XCDR (tem1
)), sym
)))
831 error ("Constant symbol `%s' specified in defvar",
832 SDATA (SYMBOL_NAME (sym
)));
836 Fset_default (sym
, eval_sub (Fcar (tail
)));
838 { /* Check if there is really a global binding rather than just a let
839 binding that shadows the global unboundness of the var. */
840 volatile struct specbinding
*pdl
= specpdl_ptr
;
841 while (--pdl
>= specpdl
)
843 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
844 && EQ (pdl
->old_value
, Qunbound
))
846 message_with_string ("Warning: defvar ignored because %s is let-bound",
847 SYMBOL_NAME (sym
), 1);
856 if (!NILP (Vpurify_flag
))
857 tem
= Fpurecopy (tem
);
858 Fput (sym
, Qvariable_documentation
, tem
);
860 LOADHIST_ATTACH (sym
);
862 else if (!NILP (Vinternal_interpreter_environment
)
863 && !XSYMBOL (sym
)->declared_special
)
864 /* A simple (defvar foo) with lexical scoping does "nothing" except
865 declare that var to be dynamically scoped *locally* (i.e. within
866 the current file or let-block). */
867 Vinternal_interpreter_environment
=
868 Fcons (sym
, Vinternal_interpreter_environment
);
871 /* Simple (defvar <var>) should not count as a definition at all.
872 It could get in the way of other definitions, and unloading this
873 package could try to make the variable unbound. */
879 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
880 doc
: /* Define SYMBOL as a constant variable.
881 The intent is that neither programs nor users should ever change this value.
882 Always sets the value of SYMBOL to the result of evalling INITVALUE.
883 If SYMBOL is buffer-local, its default value is what is set;
884 buffer-local values are not affected.
885 DOCSTRING is optional.
887 If SYMBOL has a local binding, then this form sets the local binding's
888 value. However, you should normally not make local bindings for
889 variables defined with this form.
890 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
893 register Lisp_Object sym
, tem
;
896 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
897 error ("Too many arguments");
899 tem
= eval_sub (Fcar (Fcdr (args
)));
900 if (!NILP (Vpurify_flag
))
901 tem
= Fpurecopy (tem
);
902 Fset_default (sym
, tem
);
903 XSYMBOL (sym
)->declared_special
= 1;
904 tem
= Fcar (Fcdr (Fcdr (args
)));
907 if (!NILP (Vpurify_flag
))
908 tem
= Fpurecopy (tem
);
909 Fput (sym
, Qvariable_documentation
, tem
);
911 Fput (sym
, Qrisky_local_variable
, Qt
);
912 LOADHIST_ATTACH (sym
);
916 /* Error handler used in Fuser_variable_p. */
918 user_variable_p_eh (Lisp_Object ignore
)
924 lisp_indirect_variable (Lisp_Object sym
)
926 struct Lisp_Symbol
*s
= indirect_variable (XSYMBOL (sym
));
931 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
932 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
933 \(The alternative is a variable used internally in a Lisp program.)
934 A variable is a user variable if
935 \(1) the first character of its documentation is `*', or
936 \(2) it is customizable (its property list contains a non-nil value
937 of `standard-value' or `custom-autoload'), or
938 \(3) it is an alias for another user variable.
939 Return nil if VARIABLE is an alias and there is a loop in the
940 chain of symbols. */)
941 (Lisp_Object variable
)
943 Lisp_Object documentation
;
945 if (!SYMBOLP (variable
))
948 /* If indirect and there's an alias loop, don't check anything else. */
949 if (XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
950 && NILP (internal_condition_case_1 (lisp_indirect_variable
, variable
,
951 Qt
, user_variable_p_eh
)))
956 documentation
= Fget (variable
, Qvariable_documentation
);
957 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
959 if (STRINGP (documentation
)
960 && ((unsigned char) SREF (documentation
, 0) == '*'))
962 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
963 if (CONSP (documentation
)
964 && STRINGP (XCAR (documentation
))
965 && INTEGERP (XCDR (documentation
))
966 && XINT (XCDR (documentation
)) < 0)
968 /* Customizable? See `custom-variable-p'. */
969 if ((!NILP (Fget (variable
, intern ("standard-value"))))
970 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
973 if (!(XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
))
976 /* An indirect variable? Let's follow the chain. */
977 XSETSYMBOL (variable
, SYMBOL_ALIAS (XSYMBOL (variable
)));
981 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
982 doc
: /* Bind variables according to VARLIST then eval BODY.
983 The value of the last form in BODY is returned.
984 Each element of VARLIST is a symbol (which is bound to nil)
985 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
986 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
987 usage: (let* VARLIST BODY...) */)
990 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
991 int count
= SPECPDL_INDEX ();
992 struct gcpro gcpro1
, gcpro2
, gcpro3
;
994 GCPRO3 (args
, elt
, varlist
);
996 lexenv
= Vinternal_interpreter_environment
;
998 varlist
= Fcar (args
);
999 while (CONSP (varlist
))
1003 elt
= XCAR (varlist
);
1009 else if (! NILP (Fcdr (Fcdr (elt
))))
1010 signal_error ("`let' bindings can have only one value-form", elt
);
1014 val
= eval_sub (Fcar (Fcdr (elt
)));
1017 if (!NILP (lexenv
) && SYMBOLP (var
)
1018 && !XSYMBOL (var
)->declared_special
1019 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1020 /* Lexically bind VAR by adding it to the interpreter's binding
1024 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
1025 if (EQ (Vinternal_interpreter_environment
, lexenv
))
1026 /* Save the old lexical environment on the specpdl stack,
1027 but only for the first lexical binding, since we'll never
1028 need to revert to one of the intermediate ones. */
1029 specbind (Qinternal_interpreter_environment
, newenv
);
1031 Vinternal_interpreter_environment
= newenv
;
1034 specbind (var
, val
);
1036 varlist
= XCDR (varlist
);
1039 val
= Fprogn (Fcdr (args
));
1040 return unbind_to (count
, val
);
1043 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
1044 doc
: /* Bind variables according to VARLIST then eval BODY.
1045 The value of the last form in BODY is returned.
1046 Each element of VARLIST is a symbol (which is bound to nil)
1047 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1048 All the VALUEFORMs are evalled before any symbols are bound.
1049 usage: (let VARLIST BODY...) */)
1052 Lisp_Object
*temps
, tem
, lexenv
;
1053 register Lisp_Object elt
, varlist
;
1054 int count
= SPECPDL_INDEX ();
1055 register size_t argnum
;
1056 struct gcpro gcpro1
, gcpro2
;
1059 varlist
= Fcar (args
);
1061 /* Make space to hold the values to give the bound variables. */
1062 elt
= Flength (varlist
);
1063 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
1065 /* Compute the values and store them in `temps'. */
1067 GCPRO2 (args
, *temps
);
1070 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1073 elt
= XCAR (varlist
);
1075 temps
[argnum
++] = Qnil
;
1076 else if (! NILP (Fcdr (Fcdr (elt
))))
1077 signal_error ("`let' bindings can have only one value-form", elt
);
1079 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
1080 gcpro2
.nvars
= argnum
;
1084 lexenv
= Vinternal_interpreter_environment
;
1086 varlist
= Fcar (args
);
1087 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1091 elt
= XCAR (varlist
);
1092 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
1093 tem
= temps
[argnum
++];
1095 if (!NILP (lexenv
) && SYMBOLP (var
)
1096 && !XSYMBOL (var
)->declared_special
1097 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1098 /* Lexically bind VAR by adding it to the lexenv alist. */
1099 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
1101 /* Dynamically bind VAR. */
1102 specbind (var
, tem
);
1105 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
1106 /* Instantiate a new lexical environment. */
1107 specbind (Qinternal_interpreter_environment
, lexenv
);
1109 elt
= Fprogn (Fcdr (args
));
1111 return unbind_to (count
, elt
);
1114 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1115 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1116 The order of execution is thus TEST, BODY, TEST, BODY and so on
1117 until TEST returns nil.
1118 usage: (while TEST BODY...) */)
1121 Lisp_Object test
, body
;
1122 struct gcpro gcpro1
, gcpro2
;
1124 GCPRO2 (test
, body
);
1128 while (!NILP (eval_sub (test
)))
1138 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1139 doc
: /* Return result of expanding macros at top level of FORM.
1140 If FORM is not a macro call, it is returned unchanged.
1141 Otherwise, the macro is expanded and the expansion is considered
1142 in place of FORM. When a non-macro-call results, it is returned.
1144 The second optional arg ENVIRONMENT specifies an environment of macro
1145 definitions to shadow the loaded ones for use in file byte-compilation. */)
1146 (Lisp_Object form
, Lisp_Object environment
)
1148 /* With cleanups from Hallvard Furuseth. */
1149 register Lisp_Object expander
, sym
, def
, tem
;
1153 /* Come back here each time we expand a macro call,
1154 in case it expands into another macro call. */
1157 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1158 def
= sym
= XCAR (form
);
1160 /* Trace symbols aliases to other symbols
1161 until we get a symbol that is not an alias. */
1162 while (SYMBOLP (def
))
1166 tem
= Fassq (sym
, environment
);
1169 def
= XSYMBOL (sym
)->function
;
1170 if (!EQ (def
, Qunbound
))
1175 /* Right now TEM is the result from SYM in ENVIRONMENT,
1176 and if TEM is nil then DEF is SYM's function definition. */
1179 /* SYM is not mentioned in ENVIRONMENT.
1180 Look at its function definition. */
1181 if (EQ (def
, Qunbound
) || !CONSP (def
))
1182 /* Not defined or definition not suitable. */
1184 if (EQ (XCAR (def
), Qautoload
))
1186 /* Autoloading function: will it be a macro when loaded? */
1187 tem
= Fnth (make_number (4), def
);
1188 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1189 /* Yes, load it and try again. */
1191 struct gcpro gcpro1
;
1193 do_autoload (def
, sym
);
1200 else if (!EQ (XCAR (def
), Qmacro
))
1202 else expander
= XCDR (def
);
1206 expander
= XCDR (tem
);
1207 if (NILP (expander
))
1210 form
= apply1 (expander
, XCDR (form
));
1215 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1216 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1217 TAG is evalled to get the tag to use; it must not be nil.
1219 Then the BODY is executed.
1220 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1221 If no throw happens, `catch' returns the value of the last BODY form.
1222 If a throw happens, it specifies the value to return from `catch'.
1223 usage: (catch TAG BODY...) */)
1226 register Lisp_Object tag
;
1227 struct gcpro gcpro1
;
1230 tag
= eval_sub (Fcar (args
));
1232 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1235 /* Set up a catch, then call C function FUNC on argument ARG.
1236 FUNC should return a Lisp_Object.
1237 This is how catches are done from within C code. */
1240 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1242 /* This structure is made part of the chain `catchlist'. */
1245 /* Fill in the components of c, and put it on the list. */
1249 c
.backlist
= backtrace_list
;
1250 c
.handlerlist
= handlerlist
;
1251 c
.lisp_eval_depth
= lisp_eval_depth
;
1252 c
.pdlcount
= SPECPDL_INDEX ();
1253 c
.poll_suppress_count
= poll_suppress_count
;
1254 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1255 c
.gcpro
= gcprolist
;
1256 c
.byte_stack
= byte_stack_list
;
1260 if (! _setjmp (c
.jmp
))
1261 c
.val
= (*func
) (arg
);
1263 /* Throw works by a longjmp that comes right here. */
1268 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1269 jump to that CATCH, returning VALUE as the value of that catch.
1271 This is the guts Fthrow and Fsignal; they differ only in the way
1272 they choose the catch tag to throw to. A catch tag for a
1273 condition-case form has a TAG of Qnil.
1275 Before each catch is discarded, unbind all special bindings and
1276 execute all unwind-protect clauses made above that catch. Unwind
1277 the handler stack as we go, so that the proper handlers are in
1278 effect for each unwind-protect clause we run. At the end, restore
1279 some static info saved in CATCH, and longjmp to the location
1282 This is used for correct unwinding in Fthrow and Fsignal. */
1285 unwind_to_catch (struct catchtag
*catch, Lisp_Object value
)
1287 register int last_time
;
1289 /* Save the value in the tag. */
1292 /* Restore certain special C variables. */
1293 set_poll_suppress_count (catch->poll_suppress_count
);
1294 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1295 handling_signal
= 0;
1300 last_time
= catchlist
== catch;
1302 /* Unwind the specpdl stack, and then restore the proper set of
1304 unbind_to (catchlist
->pdlcount
, Qnil
);
1305 handlerlist
= catchlist
->handlerlist
;
1306 catchlist
= catchlist
->next
;
1308 while (! last_time
);
1311 /* If x_catch_errors was done, turn it off now.
1312 (First we give unbind_to a chance to do that.) */
1313 #if 0 /* This would disable x_catch_errors after x_connection_closed.
1314 The catch must remain in effect during that delicate
1315 state. --lorentey */
1316 x_fully_uncatch_errors ();
1320 byte_stack_list
= catch->byte_stack
;
1321 gcprolist
= catch->gcpro
;
1323 gcpro_level
= gcprolist
? gcprolist
->level
+ 1 : 0;
1325 backtrace_list
= catch->backlist
;
1326 lisp_eval_depth
= catch->lisp_eval_depth
;
1328 _longjmp (catch->jmp
, 1);
1331 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1332 doc
: /* Throw to the catch for TAG and return VALUE from it.
1333 Both TAG and VALUE are evalled. */)
1334 (register Lisp_Object tag
, Lisp_Object value
)
1336 register struct catchtag
*c
;
1339 for (c
= catchlist
; c
; c
= c
->next
)
1341 if (EQ (c
->tag
, tag
))
1342 unwind_to_catch (c
, value
);
1344 xsignal2 (Qno_catch
, tag
, value
);
1348 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1349 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1350 If BODYFORM completes normally, its value is returned
1351 after executing the UNWINDFORMS.
1352 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1353 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1357 int count
= SPECPDL_INDEX ();
1359 record_unwind_protect (Fprogn
, Fcdr (args
));
1360 val
= eval_sub (Fcar (args
));
1361 return unbind_to (count
, val
);
1364 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1365 doc
: /* Regain control when an error is signaled.
1366 Executes BODYFORM and returns its value if no error happens.
1367 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1368 where the BODY is made of Lisp expressions.
1370 A handler is applicable to an error
1371 if CONDITION-NAME is one of the error's condition names.
1372 If an error happens, the first applicable handler is run.
1374 The car of a handler may be a list of condition names
1375 instead of a single condition name. Then it handles all of them.
1377 When a handler handles an error, control returns to the `condition-case'
1378 and it executes the handler's BODY...
1379 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1380 \(If VAR is nil, the handler can't access that information.)
1381 Then the value of the last BODY form is returned from the `condition-case'
1384 See also the function `signal' for more info.
1385 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1388 register Lisp_Object bodyform
, handlers
;
1389 volatile Lisp_Object var
;
1392 bodyform
= Fcar (Fcdr (args
));
1393 handlers
= Fcdr (Fcdr (args
));
1395 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1398 /* Like Fcondition_case, but the args are separate
1399 rather than passed in a list. Used by Fbyte_code. */
1402 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1403 Lisp_Object handlers
)
1411 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1417 && (SYMBOLP (XCAR (tem
))
1418 || CONSP (XCAR (tem
))))))
1419 error ("Invalid condition handler");
1424 c
.backlist
= backtrace_list
;
1425 c
.handlerlist
= handlerlist
;
1426 c
.lisp_eval_depth
= lisp_eval_depth
;
1427 c
.pdlcount
= SPECPDL_INDEX ();
1428 c
.poll_suppress_count
= poll_suppress_count
;
1429 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1430 c
.gcpro
= gcprolist
;
1431 c
.byte_stack
= byte_stack_list
;
1432 if (_setjmp (c
.jmp
))
1435 specbind (h
.var
, c
.val
);
1436 val
= Fprogn (Fcdr (h
.chosen_clause
));
1438 /* Note that this just undoes the binding of h.var; whoever
1439 longjumped to us unwound the stack to c.pdlcount before
1441 unbind_to (c
.pdlcount
, Qnil
);
1448 h
.handler
= handlers
;
1449 h
.next
= handlerlist
;
1453 val
= eval_sub (bodyform
);
1455 handlerlist
= h
.next
;
1459 /* Call the function BFUN with no arguments, catching errors within it
1460 according to HANDLERS. If there is an error, call HFUN with
1461 one argument which is the data that describes the error:
1464 HANDLERS can be a list of conditions to catch.
1465 If HANDLERS is Qt, catch all errors.
1466 If HANDLERS is Qerror, catch all errors
1467 but allow the debugger to run if that is enabled. */
1470 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1471 Lisp_Object (*hfun
) (Lisp_Object
))
1477 /* Since Fsignal will close off all calls to x_catch_errors,
1478 we will get the wrong results if some are not closed now. */
1480 if (x_catching_errors ())
1486 c
.backlist
= backtrace_list
;
1487 c
.handlerlist
= handlerlist
;
1488 c
.lisp_eval_depth
= lisp_eval_depth
;
1489 c
.pdlcount
= SPECPDL_INDEX ();
1490 c
.poll_suppress_count
= poll_suppress_count
;
1491 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1492 c
.gcpro
= gcprolist
;
1493 c
.byte_stack
= byte_stack_list
;
1494 if (_setjmp (c
.jmp
))
1496 return (*hfun
) (c
.val
);
1500 h
.handler
= handlers
;
1502 h
.next
= handlerlist
;
1508 handlerlist
= h
.next
;
1512 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1515 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1516 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1522 /* Since Fsignal will close off all calls to x_catch_errors,
1523 we will get the wrong results if some are not closed now. */
1525 if (x_catching_errors ())
1531 c
.backlist
= backtrace_list
;
1532 c
.handlerlist
= handlerlist
;
1533 c
.lisp_eval_depth
= lisp_eval_depth
;
1534 c
.pdlcount
= SPECPDL_INDEX ();
1535 c
.poll_suppress_count
= poll_suppress_count
;
1536 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1537 c
.gcpro
= gcprolist
;
1538 c
.byte_stack
= byte_stack_list
;
1539 if (_setjmp (c
.jmp
))
1541 return (*hfun
) (c
.val
);
1545 h
.handler
= handlers
;
1547 h
.next
= handlerlist
;
1551 val
= (*bfun
) (arg
);
1553 handlerlist
= h
.next
;
1557 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1561 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1564 Lisp_Object handlers
,
1565 Lisp_Object (*hfun
) (Lisp_Object
))
1571 /* Since Fsignal will close off all calls to x_catch_errors,
1572 we will get the wrong results if some are not closed now. */
1574 if (x_catching_errors ())
1580 c
.backlist
= backtrace_list
;
1581 c
.handlerlist
= handlerlist
;
1582 c
.lisp_eval_depth
= lisp_eval_depth
;
1583 c
.pdlcount
= SPECPDL_INDEX ();
1584 c
.poll_suppress_count
= poll_suppress_count
;
1585 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1586 c
.gcpro
= gcprolist
;
1587 c
.byte_stack
= byte_stack_list
;
1588 if (_setjmp (c
.jmp
))
1590 return (*hfun
) (c
.val
);
1594 h
.handler
= handlers
;
1596 h
.next
= handlerlist
;
1600 val
= (*bfun
) (arg1
, arg2
);
1602 handlerlist
= h
.next
;
1606 /* Like internal_condition_case but call BFUN with NARGS as first,
1607 and ARGS as second argument. */
1610 internal_condition_case_n (Lisp_Object (*bfun
) (size_t, Lisp_Object
*),
1613 Lisp_Object handlers
,
1614 Lisp_Object (*hfun
) (Lisp_Object
))
1620 /* Since Fsignal will close off all calls to x_catch_errors,
1621 we will get the wrong results if some are not closed now. */
1623 if (x_catching_errors ())
1629 c
.backlist
= backtrace_list
;
1630 c
.handlerlist
= handlerlist
;
1631 c
.lisp_eval_depth
= lisp_eval_depth
;
1632 c
.pdlcount
= SPECPDL_INDEX ();
1633 c
.poll_suppress_count
= poll_suppress_count
;
1634 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1635 c
.gcpro
= gcprolist
;
1636 c
.byte_stack
= byte_stack_list
;
1637 if (_setjmp (c
.jmp
))
1639 return (*hfun
) (c
.val
);
1643 h
.handler
= handlers
;
1645 h
.next
= handlerlist
;
1649 val
= (*bfun
) (nargs
, args
);
1651 handlerlist
= h
.next
;
1656 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
,
1657 Lisp_Object
, Lisp_Object
);
1658 static int maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1661 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1662 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1663 This function does not return.
1665 An error symbol is a symbol with an `error-conditions' property
1666 that is a list of condition names.
1667 A handler for any of those names will get to handle this signal.
1668 The symbol `error' should normally be one of them.
1670 DATA should be a list. Its elements are printed as part of the error message.
1671 See Info anchor `(elisp)Definition of signal' for some details on how this
1672 error message is constructed.
1673 If the signal is handled, DATA is made available to the handler.
1674 See also the function `condition-case'. */)
1675 (Lisp_Object error_symbol
, Lisp_Object data
)
1677 /* When memory is full, ERROR-SYMBOL is nil,
1678 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1679 That is a special case--don't do this in other situations. */
1680 Lisp_Object conditions
;
1682 Lisp_Object real_error_symbol
1683 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1684 register Lisp_Object clause
= Qnil
;
1686 struct backtrace
*bp
;
1688 immediate_quit
= handling_signal
= 0;
1690 if (gc_in_progress
|| waiting_for_input
)
1693 #if 0 /* rms: I don't know why this was here,
1694 but it is surely wrong for an error that is handled. */
1695 #ifdef HAVE_WINDOW_SYSTEM
1696 if (display_hourglass_p
)
1697 cancel_hourglass ();
1701 /* This hook is used by edebug. */
1702 if (! NILP (Vsignal_hook_function
)
1703 && ! NILP (error_symbol
))
1705 /* Edebug takes care of restoring these variables when it exits. */
1706 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1707 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1709 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1710 max_specpdl_size
= SPECPDL_INDEX () + 40;
1712 call2 (Vsignal_hook_function
, error_symbol
, data
);
1715 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1717 /* Remember from where signal was called. Skip over the frame for
1718 `signal' itself. If a frame for `error' follows, skip that,
1719 too. Don't do this when ERROR_SYMBOL is nil, because that
1720 is a memory-full error. */
1721 Vsignaling_function
= Qnil
;
1722 if (backtrace_list
&& !NILP (error_symbol
))
1724 bp
= backtrace_list
->next
;
1725 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1727 if (bp
&& bp
->function
)
1728 Vsignaling_function
= *bp
->function
;
1731 for (h
= handlerlist
; h
; h
= h
->next
)
1733 clause
= find_handler_clause (h
->handler
, conditions
,
1734 error_symbol
, data
);
1739 if (/* Don't run the debugger for a memory-full error.
1740 (There is no room in memory to do that!) */
1741 !NILP (error_symbol
)
1742 && (!NILP (Vdebug_on_signal
)
1743 /* If no handler is present now, try to run the debugger. */
1745 /* Special handler that means "print a message and run debugger
1747 || EQ (h
->handler
, Qerror
)))
1750 = maybe_call_debugger (conditions
, error_symbol
, data
);
1751 /* We can't return values to code which signaled an error, but we
1752 can continue code which has signaled a quit. */
1753 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1759 Lisp_Object unwind_data
1760 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1762 h
->chosen_clause
= clause
;
1763 unwind_to_catch (h
->tag
, unwind_data
);
1768 Fthrow (Qtop_level
, Qt
);
1771 if (! NILP (error_symbol
))
1772 data
= Fcons (error_symbol
, data
);
1774 string
= Ferror_message_string (data
);
1775 fatal ("%s", SDATA (string
));
1778 /* Internal version of Fsignal that never returns.
1779 Used for anything but Qquit (which can return from Fsignal). */
1782 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1784 Fsignal (error_symbol
, data
);
1788 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1791 xsignal0 (Lisp_Object error_symbol
)
1793 xsignal (error_symbol
, Qnil
);
1797 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1799 xsignal (error_symbol
, list1 (arg
));
1803 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1805 xsignal (error_symbol
, list2 (arg1
, arg2
));
1809 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1811 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1814 /* Signal `error' with message S, and additional arg ARG.
1815 If ARG is not a genuine list, make it a one-element list. */
1818 signal_error (const char *s
, Lisp_Object arg
)
1820 Lisp_Object tortoise
, hare
;
1822 hare
= tortoise
= arg
;
1823 while (CONSP (hare
))
1830 tortoise
= XCDR (tortoise
);
1832 if (EQ (hare
, tortoise
))
1837 arg
= Fcons (arg
, Qnil
); /* Make it a list. */
1839 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1843 /* Return nonzero if LIST is a non-nil atom or
1844 a list containing one of CONDITIONS. */
1847 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1854 while (CONSP (conditions
))
1856 Lisp_Object
this, tail
;
1857 this = XCAR (conditions
);
1858 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1859 if (EQ (XCAR (tail
), this))
1861 conditions
= XCDR (conditions
);
1866 /* Return 1 if an error with condition-symbols CONDITIONS,
1867 and described by SIGNAL-DATA, should skip the debugger
1868 according to debugger-ignored-errors. */
1871 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1874 int first_string
= 1;
1875 Lisp_Object error_message
;
1877 error_message
= Qnil
;
1878 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1880 if (STRINGP (XCAR (tail
)))
1884 error_message
= Ferror_message_string (data
);
1888 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1893 Lisp_Object contail
;
1895 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1896 if (EQ (XCAR (tail
), XCAR (contail
)))
1904 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1905 SIG and DATA describe the signal, as in find_handler_clause. */
1908 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1910 Lisp_Object combined_data
;
1912 combined_data
= Fcons (sig
, data
);
1915 /* Don't try to run the debugger with interrupts blocked.
1916 The editing loop would return anyway. */
1918 /* Does user want to enter debugger for this kind of error? */
1921 : wants_debugger (Vdebug_on_error
, conditions
))
1922 && ! skip_debugger (conditions
, combined_data
)
1923 /* RMS: What's this for? */
1924 && when_entered_debugger
< num_nonmacro_input_events
)
1926 call_debugger (Fcons (Qerror
, Fcons (combined_data
, Qnil
)));
1933 /* Value of Qlambda means we have called debugger and user has continued.
1934 There are two ways to pass SIG and DATA:
1935 = SIG is the error symbol, and DATA is the rest of the data.
1936 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1937 This is for memory-full errors only.
1939 We need to increase max_specpdl_size temporarily around
1940 anything we do that can push on the specpdl, so as not to get
1941 a second error here in case we're handling specpdl overflow. */
1944 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
,
1945 Lisp_Object sig
, Lisp_Object data
)
1947 register Lisp_Object h
;
1949 /* t is used by handlers for all conditions, set up by C code. */
1950 if (EQ (handlers
, Qt
))
1953 /* error is used similarly, but means print an error message
1954 and run the debugger if that is enabled. */
1955 if (EQ (handlers
, Qerror
))
1958 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1960 Lisp_Object handler
= XCAR (h
);
1961 Lisp_Object condit
, tem
;
1963 if (!CONSP (handler
))
1965 condit
= XCAR (handler
);
1966 /* Handle a single condition name in handler HANDLER. */
1967 if (SYMBOLP (condit
))
1969 tem
= Fmemq (Fcar (handler
), conditions
);
1973 /* Handle a list of condition names in handler HANDLER. */
1974 else if (CONSP (condit
))
1977 for (tail
= condit
; CONSP (tail
); tail
= XCDR (tail
))
1979 tem
= Fmemq (XCAR (tail
), conditions
);
1990 /* Dump an error message; called like vprintf. */
1992 verror (const char *m
, va_list ap
)
1995 size_t size
= sizeof buf
;
1997 min (MOST_POSITIVE_FIXNUM
, min (INT_MAX
, SIZE_MAX
- 1)) + 1;
2004 used
= vsnprintf (buffer
, size
, m
, ap
);
2008 /* Non-C99 vsnprintf, such as w32, returns -1 when SIZE is too small.
2009 Guess a larger USED to work around the incompatibility. */
2010 used
= (size
<= size_max
/ 2 ? 2 * size
2011 : size
< size_max
? size_max
- 1
2014 else if (used
< size
)
2016 if (size_max
<= used
)
2022 buffer
= (char *) xmalloc (size
);
2025 string
= make_string (buffer
, used
);
2029 xsignal1 (Qerror
, string
);
2033 /* Dump an error message; called like printf. */
2037 error (const char *m
, ...)
2045 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
2046 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
2047 This means it contains a description for how to read arguments to give it.
2048 The value is nil for an invalid function or a symbol with no function
2051 Interactively callable functions include strings and vectors (treated
2052 as keyboard macros), lambda-expressions that contain a top-level call
2053 to `interactive', autoload definitions made by `autoload' with non-nil
2054 fourth argument, and some of the built-in functions of Lisp.
2056 Also, a symbol satisfies `commandp' if its function definition does so.
2058 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2059 then strings and vectors are not accepted. */)
2060 (Lisp_Object function
, Lisp_Object for_call_interactively
)
2062 register Lisp_Object fun
;
2063 register Lisp_Object funcar
;
2064 Lisp_Object if_prop
= Qnil
;
2068 fun
= indirect_function (fun
); /* Check cycles. */
2069 if (NILP (fun
) || EQ (fun
, Qunbound
))
2072 /* Check an `interactive-form' property if present, analogous to the
2073 function-documentation property. */
2075 while (SYMBOLP (fun
))
2077 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
2080 fun
= Fsymbol_function (fun
);
2083 /* Emacs primitives are interactive if their DEFUN specifies an
2084 interactive spec. */
2086 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
2088 /* Bytecode objects are interactive if they are long enough to
2089 have an element whose index is COMPILED_INTERACTIVE, which is
2090 where the interactive spec is stored. */
2091 else if (COMPILEDP (fun
))
2092 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
2095 /* Strings and vectors are keyboard macros. */
2096 if (STRINGP (fun
) || VECTORP (fun
))
2097 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
2099 /* Lists may represent commands. */
2102 funcar
= XCAR (fun
);
2103 if (EQ (funcar
, Qclosure
))
2104 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
2106 else if (EQ (funcar
, Qlambda
))
2107 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
2108 else if (EQ (funcar
, Qautoload
))
2109 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
2114 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
2115 doc
: /* Define FUNCTION to autoload from FILE.
2116 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2117 Third arg DOCSTRING is documentation for the function.
2118 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2119 Fifth arg TYPE indicates the type of the object:
2120 nil or omitted says FUNCTION is a function,
2121 `keymap' says FUNCTION is really a keymap, and
2122 `macro' or t says FUNCTION is really a macro.
2123 Third through fifth args give info about the real definition.
2124 They default to nil.
2125 If FUNCTION is already defined other than as an autoload,
2126 this does nothing and returns nil. */)
2127 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
2129 CHECK_SYMBOL (function
);
2130 CHECK_STRING (file
);
2132 /* If function is defined and not as an autoload, don't override. */
2133 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
2134 && !(CONSP (XSYMBOL (function
)->function
)
2135 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
2138 if (NILP (Vpurify_flag
))
2139 /* Only add entries after dumping, because the ones before are
2140 not useful and else we get loads of them from the loaddefs.el. */
2141 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
2143 /* We don't want the docstring in purespace (instead,
2144 Snarf-documentation should (hopefully) overwrite it).
2145 We used to use 0 here, but that leads to accidental sharing in
2146 purecopy's hash-consing, so we use a (hopefully) unique integer
2148 docstring
= make_number (XHASH (function
));
2149 return Ffset (function
,
2150 Fpurecopy (list5 (Qautoload
, file
, docstring
,
2151 interactive
, type
)));
2155 un_autoload (Lisp_Object oldqueue
)
2157 register Lisp_Object queue
, first
, second
;
2159 /* Queue to unwind is current value of Vautoload_queue.
2160 oldqueue is the shadowed value to leave in Vautoload_queue. */
2161 queue
= Vautoload_queue
;
2162 Vautoload_queue
= oldqueue
;
2163 while (CONSP (queue
))
2165 first
= XCAR (queue
);
2166 second
= Fcdr (first
);
2167 first
= Fcar (first
);
2168 if (EQ (first
, make_number (0)))
2171 Ffset (first
, second
);
2172 queue
= XCDR (queue
);
2177 /* Load an autoloaded function.
2178 FUNNAME is the symbol which is the function's name.
2179 FUNDEF is the autoload definition (a list). */
2182 do_autoload (Lisp_Object fundef
, Lisp_Object funname
)
2184 int count
= SPECPDL_INDEX ();
2186 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2188 /* This is to make sure that loadup.el gives a clear picture
2189 of what files are preloaded and when. */
2190 if (! NILP (Vpurify_flag
))
2191 error ("Attempt to autoload %s while preparing to dump",
2192 SDATA (SYMBOL_NAME (funname
)));
2195 CHECK_SYMBOL (funname
);
2196 GCPRO3 (fun
, funname
, fundef
);
2198 /* Preserve the match data. */
2199 record_unwind_save_match_data ();
2201 /* If autoloading gets an error (which includes the error of failing
2202 to define the function being called), we use Vautoload_queue
2203 to undo function definitions and `provide' calls made by
2204 the function. We do this in the specific case of autoloading
2205 because autoloading is not an explicit request "load this file",
2206 but rather a request to "call this function".
2208 The value saved here is to be restored into Vautoload_queue. */
2209 record_unwind_protect (un_autoload
, Vautoload_queue
);
2210 Vautoload_queue
= Qt
;
2211 Fload (Fcar (Fcdr (fundef
)), Qnil
, Qt
, Qnil
, Qt
);
2213 /* Once loading finishes, don't undo it. */
2214 Vautoload_queue
= Qt
;
2215 unbind_to (count
, Qnil
);
2217 fun
= Findirect_function (fun
, Qnil
);
2219 if (!NILP (Fequal (fun
, fundef
)))
2220 error ("Autoloading failed to define function %s",
2221 SDATA (SYMBOL_NAME (funname
)));
2226 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
2227 doc
: /* Evaluate FORM and return its value.
2228 If LEXICAL is t, evaluate using lexical scoping. */)
2229 (Lisp_Object form
, Lisp_Object lexical
)
2231 int count
= SPECPDL_INDEX ();
2232 specbind (Qinternal_interpreter_environment
,
2233 NILP (lexical
) ? Qnil
: Fcons (Qt
, Qnil
));
2234 return unbind_to (count
, eval_sub (form
));
2237 /* Eval a sub-expression of the current expression (i.e. in the same
2240 eval_sub (Lisp_Object form
)
2242 Lisp_Object fun
, val
, original_fun
, original_args
;
2244 struct backtrace backtrace
;
2245 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2247 if (handling_signal
)
2252 /* Look up its binding in the lexical environment.
2253 We do not pay attention to the declared_special flag here, since we
2254 already did that when let-binding the variable. */
2255 Lisp_Object lex_binding
2256 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2257 ? Fassq (form
, Vinternal_interpreter_environment
)
2259 if (CONSP (lex_binding
))
2260 return XCDR (lex_binding
);
2262 return Fsymbol_value (form
);
2269 if ((consing_since_gc
> gc_cons_threshold
2270 && consing_since_gc
> gc_relative_threshold
)
2272 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2275 Fgarbage_collect ();
2279 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2281 if (max_lisp_eval_depth
< 100)
2282 max_lisp_eval_depth
= 100;
2283 if (lisp_eval_depth
> max_lisp_eval_depth
)
2284 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2287 original_fun
= Fcar (form
);
2288 original_args
= Fcdr (form
);
2290 backtrace
.next
= backtrace_list
;
2291 backtrace_list
= &backtrace
;
2292 backtrace
.function
= &original_fun
; /* This also protects them from gc. */
2293 backtrace
.args
= &original_args
;
2294 backtrace
.nargs
= UNEVALLED
;
2295 backtrace
.evalargs
= 1;
2296 backtrace
.debug_on_exit
= 0;
2298 if (debug_on_next_call
)
2299 do_debug_on_call (Qt
);
2301 /* At this point, only original_fun and original_args
2302 have values that will be used below. */
2305 /* Optimize for no indirection. */
2307 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2308 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2309 fun
= indirect_function (fun
);
2313 Lisp_Object numargs
;
2314 Lisp_Object argvals
[8];
2315 Lisp_Object args_left
;
2316 register int i
, maxargs
;
2318 args_left
= original_args
;
2319 numargs
= Flength (args_left
);
2323 if (XINT (numargs
) < XSUBR (fun
)->min_args
2324 || (XSUBR (fun
)->max_args
>= 0
2325 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2326 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2328 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2330 backtrace
.evalargs
= 0;
2331 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2333 else if (XSUBR (fun
)->max_args
== MANY
)
2335 /* Pass a vector of evaluated arguments. */
2337 register size_t argnum
= 0;
2340 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2342 GCPRO3 (args_left
, fun
, fun
);
2346 while (!NILP (args_left
))
2348 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2349 args_left
= Fcdr (args_left
);
2350 gcpro3
.nvars
= argnum
;
2353 backtrace
.args
= vals
;
2354 backtrace
.nargs
= XINT (numargs
);
2356 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2362 GCPRO3 (args_left
, fun
, fun
);
2363 gcpro3
.var
= argvals
;
2366 maxargs
= XSUBR (fun
)->max_args
;
2367 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2369 argvals
[i
] = eval_sub (Fcar (args_left
));
2375 backtrace
.args
= argvals
;
2376 backtrace
.nargs
= XINT (numargs
);
2381 val
= (XSUBR (fun
)->function
.a0 ());
2384 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2387 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2390 val
= (XSUBR (fun
)->function
.a3
2391 (argvals
[0], argvals
[1], argvals
[2]));
2394 val
= (XSUBR (fun
)->function
.a4
2395 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2398 val
= (XSUBR (fun
)->function
.a5
2399 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2403 val
= (XSUBR (fun
)->function
.a6
2404 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2405 argvals
[4], argvals
[5]));
2408 val
= (XSUBR (fun
)->function
.a7
2409 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2410 argvals
[4], argvals
[5], argvals
[6]));
2414 val
= (XSUBR (fun
)->function
.a8
2415 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2416 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2420 /* Someone has created a subr that takes more arguments than
2421 is supported by this code. We need to either rewrite the
2422 subr to use a different argument protocol, or add more
2423 cases to this switch. */
2428 else if (COMPILEDP (fun
))
2429 val
= apply_lambda (fun
, original_args
);
2432 if (EQ (fun
, Qunbound
))
2433 xsignal1 (Qvoid_function
, original_fun
);
2435 xsignal1 (Qinvalid_function
, original_fun
);
2436 funcar
= XCAR (fun
);
2437 if (!SYMBOLP (funcar
))
2438 xsignal1 (Qinvalid_function
, original_fun
);
2439 if (EQ (funcar
, Qautoload
))
2441 do_autoload (fun
, original_fun
);
2444 if (EQ (funcar
, Qmacro
))
2445 val
= eval_sub (apply1 (Fcdr (fun
), original_args
));
2446 else if (EQ (funcar
, Qlambda
)
2447 || EQ (funcar
, Qclosure
))
2448 val
= apply_lambda (fun
, original_args
);
2450 xsignal1 (Qinvalid_function
, original_fun
);
2455 if (backtrace
.debug_on_exit
)
2456 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2457 backtrace_list
= backtrace
.next
;
2462 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2463 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2464 Then return the value FUNCTION returns.
2465 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2466 usage: (apply FUNCTION &rest ARGUMENTS) */)
2467 (size_t nargs
, Lisp_Object
*args
)
2469 register size_t i
, numargs
;
2470 register Lisp_Object spread_arg
;
2471 register Lisp_Object
*funcall_args
;
2472 Lisp_Object fun
, retval
;
2473 struct gcpro gcpro1
;
2478 spread_arg
= args
[nargs
- 1];
2479 CHECK_LIST (spread_arg
);
2481 numargs
= XINT (Flength (spread_arg
));
2484 return Ffuncall (nargs
- 1, args
);
2485 else if (numargs
== 1)
2487 args
[nargs
- 1] = XCAR (spread_arg
);
2488 return Ffuncall (nargs
, args
);
2491 numargs
+= nargs
- 2;
2493 /* Optimize for no indirection. */
2494 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2495 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2496 fun
= indirect_function (fun
);
2497 if (EQ (fun
, Qunbound
))
2499 /* Let funcall get the error. */
2506 if (numargs
< XSUBR (fun
)->min_args
2507 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2508 goto funcall
; /* Let funcall get the error. */
2509 else if (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
> numargs
)
2511 /* Avoid making funcall cons up a yet another new vector of arguments
2512 by explicitly supplying nil's for optional values. */
2513 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2514 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2515 funcall_args
[++i
] = Qnil
;
2516 GCPRO1 (*funcall_args
);
2517 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2521 /* We add 1 to numargs because funcall_args includes the
2522 function itself as well as its arguments. */
2525 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2526 GCPRO1 (*funcall_args
);
2527 gcpro1
.nvars
= 1 + numargs
;
2530 memcpy (funcall_args
, args
, nargs
* sizeof (Lisp_Object
));
2531 /* Spread the last arg we got. Its first element goes in
2532 the slot that it used to occupy, hence this value of I. */
2534 while (!NILP (spread_arg
))
2536 funcall_args
[i
++] = XCAR (spread_arg
);
2537 spread_arg
= XCDR (spread_arg
);
2540 /* By convention, the caller needs to gcpro Ffuncall's args. */
2541 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
2548 /* Run hook variables in various ways. */
2551 funcall_nil (size_t nargs
, Lisp_Object
*args
)
2553 Ffuncall (nargs
, args
);
2557 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2558 doc
: /* Run each hook in HOOKS.
2559 Each argument should be a symbol, a hook variable.
2560 These symbols are processed in the order specified.
2561 If a hook symbol has a non-nil value, that value may be a function
2562 or a list of functions to be called to run the hook.
2563 If the value is a function, it is called with no arguments.
2564 If it is a list, the elements are called, in order, with no arguments.
2566 Major modes should not use this function directly to run their mode
2567 hook; they should use `run-mode-hooks' instead.
2569 Do not use `make-local-variable' to make a hook variable buffer-local.
2570 Instead, use `add-hook' and specify t for the LOCAL argument.
2571 usage: (run-hooks &rest HOOKS) */)
2572 (size_t nargs
, Lisp_Object
*args
)
2574 Lisp_Object hook
[1];
2577 for (i
= 0; i
< nargs
; i
++)
2580 run_hook_with_args (1, hook
, funcall_nil
);
2586 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2587 Srun_hook_with_args
, 1, MANY
, 0,
2588 doc
: /* Run HOOK with the specified arguments ARGS.
2589 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2590 value, that value may be a function or a list of functions to be
2591 called to run the hook. If the value is a function, it is called with
2592 the given arguments and its return value is returned. If it is a list
2593 of functions, those functions are called, in order,
2594 with the given arguments ARGS.
2595 It is best not to depend on the value returned by `run-hook-with-args',
2598 Do not use `make-local-variable' to make a hook variable buffer-local.
2599 Instead, use `add-hook' and specify t for the LOCAL argument.
2600 usage: (run-hook-with-args HOOK &rest ARGS) */)
2601 (size_t nargs
, Lisp_Object
*args
)
2603 return run_hook_with_args (nargs
, args
, funcall_nil
);
2606 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2607 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2608 doc
: /* Run HOOK with the specified arguments ARGS.
2609 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2610 value, that value may be a function or a list of functions to be
2611 called to run the hook. If the value is a function, it is called with
2612 the given arguments and its return value is returned.
2613 If it is a list of functions, those functions are called, in order,
2614 with the given arguments ARGS, until one of them
2615 returns a non-nil value. Then we return that value.
2616 However, if they all return nil, we return nil.
2618 Do not use `make-local-variable' to make a hook variable buffer-local.
2619 Instead, use `add-hook' and specify t for the LOCAL argument.
2620 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2621 (size_t nargs
, Lisp_Object
*args
)
2623 return run_hook_with_args (nargs
, args
, Ffuncall
);
2627 funcall_not (size_t nargs
, Lisp_Object
*args
)
2629 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2632 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2633 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2634 doc
: /* Run HOOK with the specified arguments ARGS.
2635 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2636 value, that value may be a function or a list of functions to be
2637 called to run the hook. If the value is a function, it is called with
2638 the given arguments and its return value is returned.
2639 If it is a list of functions, those functions are called, in order,
2640 with the given arguments ARGS, until one of them returns nil.
2641 Then we return nil. However, if they all return non-nil, we return non-nil.
2643 Do not use `make-local-variable' to make a hook variable buffer-local.
2644 Instead, use `add-hook' and specify t for the LOCAL argument.
2645 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2646 (size_t nargs
, Lisp_Object
*args
)
2648 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2652 run_hook_wrapped_funcall (size_t nargs
, Lisp_Object
*args
)
2654 Lisp_Object tmp
= args
[0], ret
;
2657 ret
= Ffuncall (nargs
, args
);
2663 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2664 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2665 I.e. instead of calling each function FUN directly with arguments ARGS,
2666 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2667 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2668 aborts and returns that value.
2669 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2670 (size_t nargs
, Lisp_Object
*args
)
2672 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2675 /* ARGS[0] should be a hook symbol.
2676 Call each of the functions in the hook value, passing each of them
2677 as arguments all the rest of ARGS (all NARGS - 1 elements).
2678 FUNCALL specifies how to call each function on the hook.
2679 The caller (or its caller, etc) must gcpro all of ARGS,
2680 except that it isn't necessary to gcpro ARGS[0]. */
2683 run_hook_with_args (size_t nargs
, Lisp_Object
*args
,
2684 Lisp_Object (*funcall
) (size_t nargs
, Lisp_Object
*args
))
2686 Lisp_Object sym
, val
, ret
= Qnil
;
2687 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2689 /* If we are dying or still initializing,
2690 don't do anything--it would probably crash if we tried. */
2691 if (NILP (Vrun_hooks
))
2695 val
= find_symbol_value (sym
);
2697 if (EQ (val
, Qunbound
) || NILP (val
))
2699 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2702 return funcall (nargs
, args
);
2706 Lisp_Object global_vals
= Qnil
;
2707 GCPRO3 (sym
, val
, global_vals
);
2710 CONSP (val
) && NILP (ret
);
2713 if (EQ (XCAR (val
), Qt
))
2715 /* t indicates this hook has a local binding;
2716 it means to run the global binding too. */
2717 global_vals
= Fdefault_value (sym
);
2718 if (NILP (global_vals
)) continue;
2720 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2722 args
[0] = global_vals
;
2723 ret
= funcall (nargs
, args
);
2728 CONSP (global_vals
) && NILP (ret
);
2729 global_vals
= XCDR (global_vals
))
2731 args
[0] = XCAR (global_vals
);
2732 /* In a global value, t should not occur. If it does, we
2733 must ignore it to avoid an endless loop. */
2734 if (!EQ (args
[0], Qt
))
2735 ret
= funcall (nargs
, args
);
2741 args
[0] = XCAR (val
);
2742 ret
= funcall (nargs
, args
);
2751 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2754 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2756 Lisp_Object temp
[3];
2761 Frun_hook_with_args (3, temp
);
2764 /* Apply fn to arg. */
2766 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2768 struct gcpro gcpro1
;
2772 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2775 Lisp_Object args
[2];
2779 RETURN_UNGCPRO (Fapply (2, args
));
2783 /* Call function fn on no arguments. */
2785 call0 (Lisp_Object fn
)
2787 struct gcpro gcpro1
;
2790 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2793 /* Call function fn with 1 argument arg1. */
2796 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2798 struct gcpro gcpro1
;
2799 Lisp_Object args
[2];
2805 RETURN_UNGCPRO (Ffuncall (2, args
));
2808 /* Call function fn with 2 arguments arg1, arg2. */
2811 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2813 struct gcpro gcpro1
;
2814 Lisp_Object args
[3];
2820 RETURN_UNGCPRO (Ffuncall (3, args
));
2823 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2826 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2828 struct gcpro gcpro1
;
2829 Lisp_Object args
[4];
2836 RETURN_UNGCPRO (Ffuncall (4, args
));
2839 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2842 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2845 struct gcpro gcpro1
;
2846 Lisp_Object args
[5];
2854 RETURN_UNGCPRO (Ffuncall (5, args
));
2857 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2860 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2861 Lisp_Object arg4
, Lisp_Object arg5
)
2863 struct gcpro gcpro1
;
2864 Lisp_Object args
[6];
2873 RETURN_UNGCPRO (Ffuncall (6, args
));
2876 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2879 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2880 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2882 struct gcpro gcpro1
;
2883 Lisp_Object args
[7];
2893 RETURN_UNGCPRO (Ffuncall (7, args
));
2896 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2899 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2900 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2902 struct gcpro gcpro1
;
2903 Lisp_Object args
[8];
2914 RETURN_UNGCPRO (Ffuncall (8, args
));
2917 /* The caller should GCPRO all the elements of ARGS. */
2919 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2920 doc
: /* Non-nil if OBJECT is a function. */)
2921 (Lisp_Object object
)
2923 if (SYMBOLP (object
) && !NILP (Ffboundp (object
)))
2925 object
= Findirect_function (object
, Qt
);
2927 if (CONSP (object
) && EQ (XCAR (object
), Qautoload
))
2929 /* Autoloaded symbols are functions, except if they load
2930 macros or keymaps. */
2932 for (i
= 0; i
< 4 && CONSP (object
); i
++)
2933 object
= XCDR (object
);
2935 return (CONSP (object
) && !NILP (XCAR (object
))) ? Qnil
: Qt
;
2940 return (XSUBR (object
)->max_args
!= UNEVALLED
) ? Qt
: Qnil
;
2941 else if (COMPILEDP (object
))
2943 else if (CONSP (object
))
2945 Lisp_Object car
= XCAR (object
);
2946 return (EQ (car
, Qlambda
) || EQ (car
, Qclosure
)) ? Qt
: Qnil
;
2952 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2953 doc
: /* Call first argument as a function, passing remaining arguments to it.
2954 Return the value that function returns.
2955 Thus, (funcall 'cons 'x 'y) returns (x . y).
2956 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2957 (size_t nargs
, Lisp_Object
*args
)
2959 Lisp_Object fun
, original_fun
;
2961 size_t numargs
= nargs
- 1;
2962 Lisp_Object lisp_numargs
;
2964 struct backtrace backtrace
;
2965 register Lisp_Object
*internal_args
;
2969 if ((consing_since_gc
> gc_cons_threshold
2970 && consing_since_gc
> gc_relative_threshold
)
2972 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2973 Fgarbage_collect ();
2975 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2977 if (max_lisp_eval_depth
< 100)
2978 max_lisp_eval_depth
= 100;
2979 if (lisp_eval_depth
> max_lisp_eval_depth
)
2980 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2983 backtrace
.next
= backtrace_list
;
2984 backtrace_list
= &backtrace
;
2985 backtrace
.function
= &args
[0];
2986 backtrace
.args
= &args
[1];
2987 backtrace
.nargs
= nargs
- 1;
2988 backtrace
.evalargs
= 0;
2989 backtrace
.debug_on_exit
= 0;
2991 if (debug_on_next_call
)
2992 do_debug_on_call (Qlambda
);
2996 original_fun
= args
[0];
3000 /* Optimize for no indirection. */
3002 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
3003 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
3004 fun
= indirect_function (fun
);
3008 if (numargs
< XSUBR (fun
)->min_args
3009 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
3011 XSETFASTINT (lisp_numargs
, numargs
);
3012 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
3015 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
3016 xsignal1 (Qinvalid_function
, original_fun
);
3018 else if (XSUBR (fun
)->max_args
== MANY
)
3019 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
3022 if (XSUBR (fun
)->max_args
> numargs
)
3024 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
3025 memcpy (internal_args
, args
+ 1, numargs
* sizeof (Lisp_Object
));
3026 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
3027 internal_args
[i
] = Qnil
;
3030 internal_args
= args
+ 1;
3031 switch (XSUBR (fun
)->max_args
)
3034 val
= (XSUBR (fun
)->function
.a0 ());
3037 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
3040 val
= (XSUBR (fun
)->function
.a2
3041 (internal_args
[0], internal_args
[1]));
3044 val
= (XSUBR (fun
)->function
.a3
3045 (internal_args
[0], internal_args
[1], internal_args
[2]));
3048 val
= (XSUBR (fun
)->function
.a4
3049 (internal_args
[0], internal_args
[1], internal_args
[2],
3053 val
= (XSUBR (fun
)->function
.a5
3054 (internal_args
[0], internal_args
[1], internal_args
[2],
3055 internal_args
[3], internal_args
[4]));
3058 val
= (XSUBR (fun
)->function
.a6
3059 (internal_args
[0], internal_args
[1], internal_args
[2],
3060 internal_args
[3], internal_args
[4], internal_args
[5]));
3063 val
= (XSUBR (fun
)->function
.a7
3064 (internal_args
[0], internal_args
[1], internal_args
[2],
3065 internal_args
[3], internal_args
[4], internal_args
[5],
3070 val
= (XSUBR (fun
)->function
.a8
3071 (internal_args
[0], internal_args
[1], internal_args
[2],
3072 internal_args
[3], internal_args
[4], internal_args
[5],
3073 internal_args
[6], internal_args
[7]));
3078 /* If a subr takes more than 8 arguments without using MANY
3079 or UNEVALLED, we need to extend this function to support it.
3080 Until this is done, there is no way to call the function. */
3085 else if (COMPILEDP (fun
))
3086 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3089 if (EQ (fun
, Qunbound
))
3090 xsignal1 (Qvoid_function
, original_fun
);
3092 xsignal1 (Qinvalid_function
, original_fun
);
3093 funcar
= XCAR (fun
);
3094 if (!SYMBOLP (funcar
))
3095 xsignal1 (Qinvalid_function
, original_fun
);
3096 if (EQ (funcar
, Qlambda
)
3097 || EQ (funcar
, Qclosure
))
3098 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3099 else if (EQ (funcar
, Qautoload
))
3101 do_autoload (fun
, original_fun
);
3106 xsignal1 (Qinvalid_function
, original_fun
);
3110 if (backtrace
.debug_on_exit
)
3111 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
3112 backtrace_list
= backtrace
.next
;
3117 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
3119 Lisp_Object args_left
;
3121 register Lisp_Object
*arg_vector
;
3122 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3124 register Lisp_Object tem
;
3127 numargs
= XINT (Flength (args
));
3128 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
3131 GCPRO3 (*arg_vector
, args_left
, fun
);
3134 for (i
= 0; i
< numargs
; )
3136 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
3137 tem
= eval_sub (tem
);
3138 arg_vector
[i
++] = tem
;
3144 backtrace_list
->args
= arg_vector
;
3145 backtrace_list
->nargs
= i
;
3146 backtrace_list
->evalargs
= 0;
3147 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
3149 /* Do the debug-on-exit now, while arg_vector still exists. */
3150 if (backtrace_list
->debug_on_exit
)
3151 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
3152 /* Don't do it again when we return to eval. */
3153 backtrace_list
->debug_on_exit
= 0;
3158 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3159 and return the result of evaluation.
3160 FUN must be either a lambda-expression or a compiled-code object. */
3163 funcall_lambda (Lisp_Object fun
, size_t nargs
,
3164 register Lisp_Object
*arg_vector
)
3166 Lisp_Object val
, syms_left
, next
, lexenv
;
3167 int count
= SPECPDL_INDEX ();
3173 if (EQ (XCAR (fun
), Qclosure
))
3175 fun
= XCDR (fun
); /* Drop `closure'. */
3176 lexenv
= XCAR (fun
);
3177 CHECK_LIST_CONS (fun
, fun
);
3181 syms_left
= XCDR (fun
);
3182 if (CONSP (syms_left
))
3183 syms_left
= XCAR (syms_left
);
3185 xsignal1 (Qinvalid_function
, fun
);
3187 else if (COMPILEDP (fun
))
3189 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3190 if (INTEGERP (syms_left
))
3191 /* A byte-code object with a non-nil `push args' slot means we
3192 shouldn't bind any arguments, instead just call the byte-code
3193 interpreter directly; it will push arguments as necessary.
3195 Byte-code objects with either a non-existant, or a nil value for
3196 the `push args' slot (the default), have dynamically-bound
3197 arguments, and use the argument-binding code below instead (as do
3198 all interpreted functions, even lexically bound ones). */
3200 /* If we have not actually read the bytecode string
3201 and constants vector yet, fetch them from the file. */
3202 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3203 Ffetch_bytecode (fun
);
3204 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3205 AREF (fun
, COMPILED_CONSTANTS
),
3206 AREF (fun
, COMPILED_STACK_DEPTH
),
3215 i
= optional
= rest
= 0;
3216 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3220 next
= XCAR (syms_left
);
3221 if (!SYMBOLP (next
))
3222 xsignal1 (Qinvalid_function
, fun
);
3224 if (EQ (next
, Qand_rest
))
3226 else if (EQ (next
, Qand_optional
))
3233 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
3237 arg
= arg_vector
[i
++];
3239 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3243 /* Bind the argument. */
3244 if (!NILP (lexenv
) && SYMBOLP (next
))
3245 /* Lexically bind NEXT by adding it to the lexenv alist. */
3246 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
3248 /* Dynamically bind NEXT. */
3249 specbind (next
, arg
);
3253 if (!NILP (syms_left
))
3254 xsignal1 (Qinvalid_function
, fun
);
3256 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3258 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3259 /* Instantiate a new lexical environment. */
3260 specbind (Qinternal_interpreter_environment
, lexenv
);
3263 val
= Fprogn (XCDR (XCDR (fun
)));
3266 /* If we have not actually read the bytecode string
3267 and constants vector yet, fetch them from the file. */
3268 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3269 Ffetch_bytecode (fun
);
3270 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3271 AREF (fun
, COMPILED_CONSTANTS
),
3272 AREF (fun
, COMPILED_STACK_DEPTH
),
3276 return unbind_to (count
, val
);
3279 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3281 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3282 (Lisp_Object object
)
3286 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3288 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3291 tem
= AREF (object
, COMPILED_BYTECODE
);
3292 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3293 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3295 error ("Invalid byte code");
3297 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3298 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3306 register int count
= SPECPDL_INDEX ();
3307 if (specpdl_size
>= max_specpdl_size
)
3309 if (max_specpdl_size
< 400)
3310 max_specpdl_size
= 400;
3311 if (specpdl_size
>= max_specpdl_size
)
3312 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil
);
3315 if (specpdl_size
> max_specpdl_size
)
3316 specpdl_size
= max_specpdl_size
;
3317 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3318 specpdl_ptr
= specpdl
+ count
;
3321 /* `specpdl_ptr->symbol' is a field which describes which variable is
3322 let-bound, so it can be properly undone when we unbind_to.
3323 It can have the following two shapes:
3324 - SYMBOL : if it's a plain symbol, it means that we have let-bound
3325 a symbol that is not buffer-local (at least at the time
3326 the let binding started). Note also that it should not be
3327 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3329 - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
3330 variable SYMBOL which can be buffer-local. WHERE tells us
3331 which buffer is affected (or nil if the let-binding affects the
3332 global value of the variable) and BUFFER tells us which buffer was
3333 current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
3334 BUFFER did not yet have a buffer-local value). */
3337 specbind (Lisp_Object symbol
, Lisp_Object value
)
3339 struct Lisp_Symbol
*sym
;
3341 eassert (!handling_signal
);
3343 CHECK_SYMBOL (symbol
);
3344 sym
= XSYMBOL (symbol
);
3345 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3349 switch (sym
->redirect
)
3351 case SYMBOL_VARALIAS
:
3352 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3353 case SYMBOL_PLAINVAL
:
3354 /* The most common case is that of a non-constant symbol with a
3355 trivial value. Make that as fast as we can. */
3356 specpdl_ptr
->symbol
= symbol
;
3357 specpdl_ptr
->old_value
= SYMBOL_VAL (sym
);
3358 specpdl_ptr
->func
= NULL
;
3361 SET_SYMBOL_VAL (sym
, value
);
3363 set_internal (symbol
, value
, Qnil
, 1);
3365 case SYMBOL_LOCALIZED
:
3366 if (SYMBOL_BLV (sym
)->frame_local
)
3367 error ("Frame-local vars cannot be let-bound");
3368 case SYMBOL_FORWARDED
:
3370 Lisp_Object ovalue
= find_symbol_value (symbol
);
3371 specpdl_ptr
->func
= 0;
3372 specpdl_ptr
->old_value
= ovalue
;
3374 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3375 || (EQ (SYMBOL_BLV (sym
)->where
,
3376 SYMBOL_BLV (sym
)->frame_local
?
3377 Fselected_frame () : Fcurrent_buffer ())));
3379 if (sym
->redirect
== SYMBOL_LOCALIZED
3380 || BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3382 Lisp_Object where
, cur_buf
= Fcurrent_buffer ();
3384 /* For a local variable, record both the symbol and which
3385 buffer's or frame's value we are saving. */
3386 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3388 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3389 || (BLV_FOUND (SYMBOL_BLV (sym
))
3390 && EQ (cur_buf
, SYMBOL_BLV (sym
)->where
)));
3393 else if (sym
->redirect
== SYMBOL_LOCALIZED
3394 && BLV_FOUND (SYMBOL_BLV (sym
)))
3395 where
= SYMBOL_BLV (sym
)->where
;
3399 /* We're not using the `unused' slot in the specbinding
3400 structure because this would mean we have to do more
3401 work for simple variables. */
3402 /* FIXME: The third value `current_buffer' is only used in
3403 let_shadows_buffer_binding_p which is itself only used
3404 in set_internal for local_if_set. */
3405 eassert (NILP (where
) || EQ (where
, cur_buf
));
3406 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, cur_buf
));
3408 /* If SYMBOL is a per-buffer variable which doesn't have a
3409 buffer-local value here, make the `let' change the global
3410 value by changing the value of SYMBOL in all buffers not
3411 having their own value. This is consistent with what
3412 happens with other buffer-local variables. */
3414 && sym
->redirect
== SYMBOL_FORWARDED
)
3416 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)));
3418 Fset_default (symbol
, value
);
3423 specpdl_ptr
->symbol
= symbol
;
3426 set_internal (symbol
, value
, Qnil
, 1);
3434 record_unwind_protect (Lisp_Object (*function
) (Lisp_Object
), Lisp_Object arg
)
3436 eassert (!handling_signal
);
3438 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3440 specpdl_ptr
->func
= function
;
3441 specpdl_ptr
->symbol
= Qnil
;
3442 specpdl_ptr
->old_value
= arg
;
3447 unbind_to (int count
, Lisp_Object value
)
3449 Lisp_Object quitf
= Vquit_flag
;
3450 struct gcpro gcpro1
, gcpro2
;
3452 GCPRO2 (value
, quitf
);
3455 while (specpdl_ptr
!= specpdl
+ count
)
3457 /* Copy the binding, and decrement specpdl_ptr, before we do
3458 the work to unbind it. We decrement first
3459 so that an error in unbinding won't try to unbind
3460 the same entry again, and we copy the binding first
3461 in case more bindings are made during some of the code we run. */
3463 struct specbinding this_binding
;
3464 this_binding
= *--specpdl_ptr
;
3466 if (this_binding
.func
!= 0)
3467 (*this_binding
.func
) (this_binding
.old_value
);
3468 /* If the symbol is a list, it is really (SYMBOL WHERE
3469 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3470 frame. If WHERE is a buffer or frame, this indicates we
3471 bound a variable that had a buffer-local or frame-local
3472 binding. WHERE nil means that the variable had the default
3473 value when it was bound. CURRENT-BUFFER is the buffer that
3474 was current when the variable was bound. */
3475 else if (CONSP (this_binding
.symbol
))
3477 Lisp_Object symbol
, where
;
3479 symbol
= XCAR (this_binding
.symbol
);
3480 where
= XCAR (XCDR (this_binding
.symbol
));
3483 Fset_default (symbol
, this_binding
.old_value
);
3484 /* If `where' is non-nil, reset the value in the appropriate
3485 local binding, but only if that binding still exists. */
3486 else if (BUFFERP (where
)
3487 ? !NILP (Flocal_variable_p (symbol
, where
))
3488 : !NILP (Fassq (symbol
, XFRAME (where
)->param_alist
)))
3489 set_internal (symbol
, this_binding
.old_value
, where
, 1);
3491 /* If variable has a trivial value (no forwarding), we can
3492 just set it. No need to check for constant symbols here,
3493 since that was already done by specbind. */
3494 else if (XSYMBOL (this_binding
.symbol
)->redirect
== SYMBOL_PLAINVAL
)
3495 SET_SYMBOL_VAL (XSYMBOL (this_binding
.symbol
),
3496 this_binding
.old_value
);
3498 /* NOTE: we only ever come here if make_local_foo was used for
3499 the first time on this var within this let. */
3500 Fset_default (this_binding
.symbol
, this_binding
.old_value
);
3503 if (NILP (Vquit_flag
) && !NILP (quitf
))
3510 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3511 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3512 A special variable is one that will be bound dynamically, even in a
3513 context where binding is lexical by default. */)
3514 (Lisp_Object symbol
)
3516 CHECK_SYMBOL (symbol
);
3517 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3521 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3522 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3523 The debugger is entered when that frame exits, if the flag is non-nil. */)
3524 (Lisp_Object level
, Lisp_Object flag
)
3526 register struct backtrace
*backlist
= backtrace_list
;
3529 CHECK_NUMBER (level
);
3531 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3533 backlist
= backlist
->next
;
3537 backlist
->debug_on_exit
= !NILP (flag
);
3542 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3543 doc
: /* Print a trace of Lisp function calls currently active.
3544 Output stream used is value of `standard-output'. */)
3547 register struct backtrace
*backlist
= backtrace_list
;
3550 struct gcpro gcpro1
;
3551 Lisp_Object old_print_level
= Vprint_level
;
3553 if (NILP (Vprint_level
))
3554 XSETFASTINT (Vprint_level
, 8);
3561 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3562 if (backlist
->nargs
== UNEVALLED
)
3564 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3565 write_string ("\n", -1);
3569 tem
= *backlist
->function
;
3570 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3571 write_string ("(", -1);
3572 if (backlist
->nargs
== MANY
)
3573 { /* FIXME: Can this happen? */
3575 for (tail
= *backlist
->args
, i
= 0;
3577 tail
= Fcdr (tail
), i
= 1)
3579 if (i
) write_string (" ", -1);
3580 Fprin1 (Fcar (tail
), Qnil
);
3586 for (i
= 0; i
< backlist
->nargs
; i
++)
3588 if (i
) write_string (" ", -1);
3589 Fprin1 (backlist
->args
[i
], Qnil
);
3592 write_string (")\n", -1);
3594 backlist
= backlist
->next
;
3597 Vprint_level
= old_print_level
;
3602 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3603 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3604 If that frame has not evaluated the arguments yet (or is a special form),
3605 the value is (nil FUNCTION ARG-FORMS...).
3606 If that frame has evaluated its arguments and called its function already,
3607 the value is (t FUNCTION ARG-VALUES...).
3608 A &rest arg is represented as the tail of the list ARG-VALUES.
3609 FUNCTION is whatever was supplied as car of evaluated list,
3610 or a lambda expression for macro calls.
3611 If NFRAMES is more than the number of frames, the value is nil. */)
3612 (Lisp_Object nframes
)
3614 register struct backtrace
*backlist
= backtrace_list
;
3615 register EMACS_INT i
;
3618 CHECK_NATNUM (nframes
);
3620 /* Find the frame requested. */
3621 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3622 backlist
= backlist
->next
;
3626 if (backlist
->nargs
== UNEVALLED
)
3627 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3630 if (backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3631 tem
= *backlist
->args
;
3633 tem
= Flist (backlist
->nargs
, backlist
->args
);
3635 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3642 mark_backtrace (void)
3644 register struct backtrace
*backlist
;
3647 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3649 mark_object (*backlist
->function
);
3651 if (backlist
->nargs
== UNEVALLED
3652 || backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3655 i
= backlist
->nargs
;
3657 mark_object (backlist
->args
[i
]);
3665 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3666 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3667 If Lisp code tries to increase the total number past this amount,
3668 an error is signaled.
3669 You can safely use a value considerably larger than the default value,
3670 if that proves inconveniently small. However, if you increase it too far,
3671 Emacs could run out of memory trying to make the stack bigger. */);
3673 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3674 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3676 This limit serves to catch infinite recursions for you before they cause
3677 actual stack overflow in C, which would be fatal for Emacs.
3678 You can safely make it considerably larger than its default value,
3679 if that proves inconveniently small. However, if you increase it too far,
3680 Emacs could overflow the real C stack, and crash. */);
3682 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3683 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3684 If the value is t, that means do an ordinary quit.
3685 If the value equals `throw-on-input', that means quit by throwing
3686 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3687 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3688 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3691 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3692 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3693 Note that `quit-flag' will still be set by typing C-g,
3694 so a quit will be signaled as soon as `inhibit-quit' is nil.
3695 To prevent this happening, set `quit-flag' to nil
3696 before making `inhibit-quit' nil. */);
3697 Vinhibit_quit
= Qnil
;
3699 Qinhibit_quit
= intern_c_string ("inhibit-quit");
3700 staticpro (&Qinhibit_quit
);
3702 Qautoload
= intern_c_string ("autoload");
3703 staticpro (&Qautoload
);
3705 Qdebug_on_error
= intern_c_string ("debug-on-error");
3706 staticpro (&Qdebug_on_error
);
3708 Qmacro
= intern_c_string ("macro");
3709 staticpro (&Qmacro
);
3711 Qdeclare
= intern_c_string ("declare");
3712 staticpro (&Qdeclare
);
3714 /* Note that the process handling also uses Qexit, but we don't want
3715 to staticpro it twice, so we just do it here. */
3716 Qexit
= intern_c_string ("exit");
3719 Qinteractive
= intern_c_string ("interactive");
3720 staticpro (&Qinteractive
);
3722 Qcommandp
= intern_c_string ("commandp");
3723 staticpro (&Qcommandp
);
3725 Qdefun
= intern_c_string ("defun");
3726 staticpro (&Qdefun
);
3728 Qand_rest
= intern_c_string ("&rest");
3729 staticpro (&Qand_rest
);
3731 Qand_optional
= intern_c_string ("&optional");
3732 staticpro (&Qand_optional
);
3734 Qclosure
= intern_c_string ("closure");
3735 staticpro (&Qclosure
);
3737 Qdebug
= intern_c_string ("debug");
3738 staticpro (&Qdebug
);
3740 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3741 doc
: /* *Non-nil means enter debugger if an error is signaled.
3742 Does not apply to errors handled by `condition-case' or those
3743 matched by `debug-ignored-errors'.
3744 If the value is a list, an error only means to enter the debugger
3745 if one of its condition symbols appears in the list.
3746 When you evaluate an expression interactively, this variable
3747 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3748 The command `toggle-debug-on-error' toggles this.
3749 See also the variable `debug-on-quit'. */);
3750 Vdebug_on_error
= Qnil
;
3752 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3753 doc
: /* *List of errors for which the debugger should not be called.
3754 Each element may be a condition-name or a regexp that matches error messages.
3755 If any element applies to a given error, that error skips the debugger
3756 and just returns to top level.
3757 This overrides the variable `debug-on-error'.
3758 It does not apply to errors handled by `condition-case'. */);
3759 Vdebug_ignored_errors
= Qnil
;
3761 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3762 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3763 Does not apply if quit is handled by a `condition-case'. */);
3766 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3767 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3769 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3770 doc
: /* Non-nil means debugger may continue execution.
3771 This is nil when the debugger is called under circumstances where it
3772 might not be safe to continue. */);
3773 debugger_may_continue
= 1;
3775 DEFVAR_LISP ("debugger", Vdebugger
,
3776 doc
: /* Function to call to invoke debugger.
3777 If due to frame exit, args are `exit' and the value being returned;
3778 this function's value will be returned instead of that.
3779 If due to error, args are `error' and a list of the args to `signal'.
3780 If due to `apply' or `funcall' entry, one arg, `lambda'.
3781 If due to `eval' entry, one arg, t. */);
3784 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3785 doc
: /* If non-nil, this is a function for `signal' to call.
3786 It receives the same arguments that `signal' was given.
3787 The Edebug package uses this to regain control. */);
3788 Vsignal_hook_function
= Qnil
;
3790 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3791 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3792 Note that `debug-on-error', `debug-on-quit' and friends
3793 still determine whether to handle the particular condition. */);
3794 Vdebug_on_signal
= Qnil
;
3796 DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function
,
3797 doc
: /* Function to process declarations in a macro definition.
3798 The function will be called with two args MACRO and DECL.
3799 MACRO is the name of the macro being defined.
3800 DECL is a list `(declare ...)' containing the declarations.
3801 The value the function returns is not used. */);
3802 Vmacro_declaration_function
= Qnil
;
3804 /* When lexical binding is being used,
3805 vinternal_interpreter_environment is non-nil, and contains an alist
3806 of lexically-bound variable, or (t), indicating an empty
3807 environment. The lisp name of this variable would be
3808 `internal-interpreter-environment' if it weren't hidden.
3809 Every element of this list can be either a cons (VAR . VAL)
3810 specifying a lexical binding, or a single symbol VAR indicating
3811 that this variable should use dynamic scoping. */
3812 Qinternal_interpreter_environment
3813 = intern_c_string ("internal-interpreter-environment");
3814 staticpro (&Qinternal_interpreter_environment
);
3815 DEFVAR_LISP ("internal-interpreter-environment",
3816 Vinternal_interpreter_environment
,
3817 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3818 When lexical binding is not being used, this variable is nil.
3819 A value of `(t)' indicates an empty environment, otherwise it is an
3820 alist of active lexical bindings. */);
3821 Vinternal_interpreter_environment
= Qnil
;
3822 /* Don't export this variable to Elisp, so noone can mess with it
3823 (Just imagine if someone makes it buffer-local). */
3824 Funintern (Qinternal_interpreter_environment
, Qnil
);
3826 Vrun_hooks
= intern_c_string ("run-hooks");
3827 staticpro (&Vrun_hooks
);
3829 staticpro (&Vautoload_queue
);
3830 Vautoload_queue
= Qnil
;
3831 staticpro (&Vsignaling_function
);
3832 Vsignaling_function
= Qnil
;
3843 defsubr (&Sfunction
);
3845 defsubr (&Sdefmacro
);
3847 defsubr (&Sdefvaralias
);
3848 defsubr (&Sdefconst
);
3849 defsubr (&Suser_variable_p
);
3853 defsubr (&Smacroexpand
);
3856 defsubr (&Sunwind_protect
);
3857 defsubr (&Scondition_case
);
3859 defsubr (&Sinteractive_p
);
3860 defsubr (&Scalled_interactively_p
);
3861 defsubr (&Scommandp
);
3862 defsubr (&Sautoload
);
3865 defsubr (&Sfuncall
);
3866 defsubr (&Srun_hooks
);
3867 defsubr (&Srun_hook_with_args
);
3868 defsubr (&Srun_hook_with_args_until_success
);
3869 defsubr (&Srun_hook_with_args_until_failure
);
3870 defsubr (&Srun_hook_wrapped
);
3871 defsubr (&Sfetch_bytecode
);
3872 defsubr (&Sbacktrace_debug
);
3873 defsubr (&Sbacktrace
);
3874 defsubr (&Sbacktrace_frame
);
3875 defsubr (&Sspecial_variable_p
);
3876 defsubr (&Sfunctionp
);