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/>. */
24 #include "blockinput.h"
27 #include "dispextern.h"
28 #include "frame.h" /* For XFRAME. */
35 # define SIZE_MAX ((size_t) -1)
38 /* This definition is duplicated in alloc.c and keyboard.c. */
39 /* Putting it in lisp.h makes cc bomb out! */
43 struct backtrace
*next
;
44 Lisp_Object
*function
;
45 Lisp_Object
*args
; /* Points to vector of args. */
46 #define NARGS_BITS (BITS_PER_INT - 2)
47 /* Let's not use size_t because we want to allow negative values (for
48 UNEVALLED). Also let's steal 2 bits so we save a word (or more for
49 alignment). In any case I doubt Emacs would survive a function call with
50 more than 500M arguments. */
51 int nargs
: NARGS_BITS
; /* Length of vector.
52 If nargs is UNEVALLED, args points
53 to slot holding list of unevalled args. */
55 /* Nonzero means call value of debugger when done with this operation. */
56 char debug_on_exit
: 1;
59 struct backtrace
*backtrace_list
;
60 struct catchtag
*catchlist
;
63 /* Count levels of GCPRO to detect failure to UNGCPRO. */
67 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
68 Lisp_Object Qinhibit_quit
;
69 Lisp_Object Qand_rest
, Qand_optional
;
70 Lisp_Object Qdebug_on_error
;
72 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
76 /* This holds either the symbol `run-hooks' or nil.
77 It is nil at an early stage of startup, and when Emacs
80 Lisp_Object Vrun_hooks
;
82 /* Non-nil means record all fset's and provide's, to be undone
83 if the file being autoloaded is not fully loaded.
84 They are recorded by being consed onto the front of Vautoload_queue:
85 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
87 Lisp_Object Vautoload_queue
;
89 /* Current number of specbindings allocated in specpdl. */
91 EMACS_INT specpdl_size
;
93 /* Pointer to beginning of specpdl. */
95 struct specbinding
*specpdl
;
97 /* Pointer to first unused element in specpdl. */
99 struct specbinding
*specpdl_ptr
;
101 /* Depth in Lisp evaluations and function calls. */
103 EMACS_INT lisp_eval_depth
;
105 /* The value of num_nonmacro_input_events as of the last time we
106 started to enter the debugger. If we decide to enter the debugger
107 again when this is still equal to num_nonmacro_input_events, then we
108 know that the debugger itself has an error, and we should just
109 signal the error instead of entering an infinite loop of debugger
112 int when_entered_debugger
;
114 /* The function from which the last `signal' was called. Set in
117 Lisp_Object Vsignaling_function
;
119 /* Set to non-zero while processing X events. Checked in Feval to
120 make sure the Lisp interpreter isn't called from a signal handler,
121 which is unsafe because the interpreter isn't reentrant. */
125 static Lisp_Object
funcall_lambda (Lisp_Object
, size_t, Lisp_Object
*);
126 static void unwind_to_catch (struct catchtag
*, Lisp_Object
) NO_RETURN
;
127 static int interactive_p (int);
128 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
129 INFUN (Ffetch_bytecode
, 1);
132 init_eval_once (void)
135 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
136 specpdl_ptr
= specpdl
;
137 /* Don't forget to update docs (lispref node "Local Variables"). */
138 max_specpdl_size
= 1300; /* 1000 is not enough for CEDET's c-by.el. */
139 max_lisp_eval_depth
= 600;
147 specpdl_ptr
= specpdl
;
152 debug_on_next_call
= 0;
157 /* This is less than the initial value of num_nonmacro_input_events. */
158 when_entered_debugger
= -1;
161 /* Unwind-protect function used by call_debugger. */
164 restore_stack_limits (Lisp_Object data
)
166 max_specpdl_size
= XINT (XCAR (data
));
167 max_lisp_eval_depth
= XINT (XCDR (data
));
171 /* Call the Lisp debugger, giving it argument ARG. */
174 call_debugger (Lisp_Object arg
)
176 int debug_while_redisplaying
;
177 int count
= SPECPDL_INDEX ();
179 EMACS_INT old_max
= max_specpdl_size
;
181 /* Temporarily bump up the stack limits,
182 so the debugger won't run out of stack. */
184 max_specpdl_size
+= 1;
185 record_unwind_protect (restore_stack_limits
,
186 Fcons (make_number (old_max
),
187 make_number (max_lisp_eval_depth
)));
188 max_specpdl_size
= old_max
;
190 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
191 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
193 if (SPECPDL_INDEX () + 100 > max_specpdl_size
)
194 max_specpdl_size
= SPECPDL_INDEX () + 100;
196 #ifdef HAVE_WINDOW_SYSTEM
197 if (display_hourglass_p
)
201 debug_on_next_call
= 0;
202 when_entered_debugger
= num_nonmacro_input_events
;
204 /* Resetting redisplaying_p to 0 makes sure that debug output is
205 displayed if the debugger is invoked during redisplay. */
206 debug_while_redisplaying
= redisplaying_p
;
208 specbind (intern ("debugger-may-continue"),
209 debug_while_redisplaying
? Qnil
: Qt
);
210 specbind (Qinhibit_redisplay
, Qnil
);
211 specbind (Qdebug_on_error
, Qnil
);
213 #if 0 /* Binding this prevents execution of Lisp code during
214 redisplay, which necessarily leads to display problems. */
215 specbind (Qinhibit_eval_during_redisplay
, Qt
);
218 val
= apply1 (Vdebugger
, arg
);
220 /* Interrupting redisplay and resuming it later is not safe under
221 all circumstances. So, when the debugger returns, abort the
222 interrupted redisplay by going back to the top-level. */
223 if (debug_while_redisplaying
)
226 return unbind_to (count
, val
);
230 do_debug_on_call (Lisp_Object code
)
232 debug_on_next_call
= 0;
233 backtrace_list
->debug_on_exit
= 1;
234 call_debugger (Fcons (code
, Qnil
));
237 /* NOTE!!! Every function that can call EVAL must protect its args
238 and temporaries from garbage collection while it needs them.
239 The definition of `For' shows what you have to do. */
241 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
242 doc
: /* Eval args until one of them yields non-nil, then return that value.
243 The remaining args are not evalled at all.
244 If all args return nil, return nil.
245 usage: (or CONDITIONS...) */)
248 register Lisp_Object val
= Qnil
;
255 val
= eval_sub (XCAR (args
));
265 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
266 doc
: /* Eval args until one of them yields nil, then return nil.
267 The remaining args are not evalled at all.
268 If no arg yields nil, return the last arg's value.
269 usage: (and CONDITIONS...) */)
272 register Lisp_Object val
= Qt
;
279 val
= eval_sub (XCAR (args
));
289 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
290 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
291 Returns the value of THEN or the value of the last of the ELSE's.
292 THEN must be one expression, but ELSE... can be zero or more expressions.
293 If COND yields nil, and there are no ELSE's, the value is nil.
294 usage: (if COND THEN ELSE...) */)
297 register Lisp_Object cond
;
301 cond
= eval_sub (Fcar (args
));
305 return eval_sub (Fcar (Fcdr (args
)));
306 return Fprogn (Fcdr (Fcdr (args
)));
309 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
310 doc
: /* Try each clause until one succeeds.
311 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
312 and, if the value is non-nil, this clause succeeds:
313 then the expressions in BODY are evaluated and the last one's
314 value is the value of the cond-form.
315 If no clause succeeds, cond returns nil.
316 If a clause has one element, as in (CONDITION),
317 CONDITION's value if non-nil is returned from the cond-form.
318 usage: (cond CLAUSES...) */)
321 register Lisp_Object clause
, val
;
328 clause
= Fcar (args
);
329 val
= eval_sub (Fcar (clause
));
332 if (!EQ (XCDR (clause
), Qnil
))
333 val
= Fprogn (XCDR (clause
));
343 DEFUE ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
344 doc
: /* Eval BODY forms sequentially and return value of last one.
345 usage: (progn BODY...) */)
348 register Lisp_Object val
= Qnil
;
355 val
= eval_sub (XCAR (args
));
363 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
364 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
365 The value of FIRST is saved during the evaluation of the remaining args,
366 whose values are discarded.
367 usage: (prog1 FIRST BODY...) */)
371 register Lisp_Object args_left
;
372 struct gcpro gcpro1
, gcpro2
;
373 register int argnum
= 0;
384 Lisp_Object tem
= eval_sub (XCAR (args_left
));
387 args_left
= XCDR (args_left
);
389 while (CONSP (args_left
));
395 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
396 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
397 The value of FORM2 is saved during the evaluation of the
398 remaining args, whose values are discarded.
399 usage: (prog2 FORM1 FORM2 BODY...) */)
403 register Lisp_Object args_left
;
404 struct gcpro gcpro1
, gcpro2
;
405 register int argnum
= -1;
418 Lisp_Object tem
= eval_sub (XCAR (args_left
));
421 args_left
= XCDR (args_left
);
423 while (CONSP (args_left
));
429 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
430 doc
: /* Set each SYM to the value of its VAL.
431 The symbols SYM are variables; they are literal (not evaluated).
432 The values VAL are expressions; they are evaluated.
433 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
434 The second VAL is not computed until after the first SYM is set, and so on;
435 each VAL can use the new value of variables set earlier in the `setq'.
436 The return value of the `setq' form is the value of the last VAL.
437 usage: (setq [SYM VAL]...) */)
440 register Lisp_Object args_left
;
441 register Lisp_Object val
, sym
, lex_binding
;
452 val
= eval_sub (Fcar (Fcdr (args_left
)));
453 sym
= Fcar (args_left
);
455 /* Like for eval_sub, we do not check declared_special here since
456 it's been done when let-binding. */
457 if (!NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
459 && !NILP (lex_binding
460 = Fassq (sym
, Vinternal_interpreter_environment
)))
461 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
463 Fset (sym
, val
); /* SYM is dynamically bound. */
465 args_left
= Fcdr (Fcdr (args_left
));
467 while (!NILP(args_left
));
473 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
474 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
475 usage: (quote ARG) */)
478 if (!NILP (Fcdr (args
)))
479 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
483 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
484 doc
: /* Like `quote', but preferred for objects which are functions.
485 In byte compilation, `function' causes its argument to be compiled.
486 `quote' cannot do that.
487 usage: (function ARG) */)
490 Lisp_Object quoted
= XCAR (args
);
492 if (!NILP (Fcdr (args
)))
493 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
495 if (!NILP (Vinternal_interpreter_environment
)
497 && EQ (XCAR (quoted
), Qlambda
))
498 /* This is a lambda expression within a lexical environment;
499 return an interpreted closure instead of a simple lambda. */
500 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
503 /* Simply quote the argument. */
508 DEFUE ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
509 doc
: /* Return t if the containing function was run directly by user input.
510 This means that the function was called with `call-interactively'
511 \(which includes being called as the binding of a key)
512 and input is currently coming from the keyboard (not a keyboard macro),
513 and Emacs is not running in batch mode (`noninteractive' is nil).
515 The only known proper use of `interactive-p' is in deciding whether to
516 display a helpful message, or how to display it. If you're thinking
517 of using it for any other purpose, it is quite likely that you're
518 making a mistake. Think: what do you want to do when the command is
519 called from a keyboard macro?
521 To test whether your function was called with `call-interactively',
522 either (i) add an extra optional argument and give it an `interactive'
523 spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
524 use `called-interactively-p'. */)
527 return interactive_p (1) ? Qt
: Qnil
;
531 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 1, 0,
532 doc
: /* Return t if the containing function was called by `call-interactively'.
533 If KIND is `interactive', then only return t if the call was made
534 interactively by the user, i.e. not in `noninteractive' mode nor
535 when `executing-kbd-macro'.
536 If KIND is `any', on the other hand, it will return t for any kind of
537 interactive call, including being called as the binding of a key, or
538 from a keyboard macro, or in `noninteractive' mode.
540 The only known proper use of `interactive' for KIND is in deciding
541 whether to display a helpful message, or how to display it. If you're
542 thinking of using it for any other purpose, it is quite likely that
543 you're making a mistake. Think: what do you want to do when the
544 command is called from a keyboard macro?
546 This function is meant for implementing advice and other
547 function-modifying features. Instead of using this, it is sometimes
548 cleaner to give your function an extra optional argument whose
549 `interactive' spec specifies non-nil unconditionally (\"p\" is a good
550 way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
553 return ((INTERACTIVE
|| !EQ (kind
, intern ("interactive")))
554 && interactive_p (1)) ? Qt
: Qnil
;
558 /* Return 1 if function in which this appears was called using
561 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
562 called is a built-in. */
565 interactive_p (int exclude_subrs_p
)
567 struct backtrace
*btp
;
570 btp
= backtrace_list
;
572 /* If this isn't a byte-compiled function, there may be a frame at
573 the top for Finteractive_p. If so, skip it. */
574 fun
= Findirect_function (*btp
->function
, Qnil
);
575 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
576 || XSUBR (fun
) == &Scalled_interactively_p
))
579 /* If we're running an Emacs 18-style byte-compiled function, there
580 may be a frame for Fbytecode at the top level. In any version of
581 Emacs there can be Fbytecode frames for subexpressions evaluated
582 inside catch and condition-case. Skip past them.
584 If this isn't a byte-compiled function, then we may now be
585 looking at several frames for special forms. Skip past them. */
587 && (EQ (*btp
->function
, Qbytecode
)
588 || btp
->nargs
== UNEVALLED
))
591 /* `btp' now points at the frame of the innermost function that isn't
592 a special form, ignoring frames for Finteractive_p and/or
593 Fbytecode at the top. If this frame is for a built-in function
594 (such as load or eval-region) return nil. */
595 fun
= Findirect_function (*btp
->function
, Qnil
);
596 if (exclude_subrs_p
&& SUBRP (fun
))
599 /* `btp' points to the frame of a Lisp function that called interactive-p.
600 Return t if that function was called interactively. */
601 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
607 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
608 doc
: /* Define NAME as a function.
609 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
610 See also the function `interactive'.
611 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
614 register Lisp_Object fn_name
;
615 register Lisp_Object defn
;
617 fn_name
= Fcar (args
);
618 CHECK_SYMBOL (fn_name
);
619 defn
= Fcons (Qlambda
, Fcdr (args
));
620 if (!NILP (Vinternal_interpreter_environment
)) /* Mere optimization! */
621 defn
= Ffunction (Fcons (defn
, Qnil
));
622 if (!NILP (Vpurify_flag
))
623 defn
= Fpurecopy (defn
);
624 if (CONSP (XSYMBOL (fn_name
)->function
)
625 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
626 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
627 Ffset (fn_name
, defn
);
628 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
632 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
633 doc
: /* Define NAME as a macro.
634 The actual definition looks like
635 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
636 When the macro is called, as in (NAME ARGS...),
637 the function (lambda ARGLIST BODY...) is applied to
638 the list ARGS... as it appears in the expression,
639 and the result should be a form to be evaluated instead of the original.
641 DECL is a declaration, optional, which can specify how to indent
642 calls to this macro, how Edebug should handle it, and which argument
643 should be treated as documentation. It looks like this:
645 The elements can look like this:
647 Set NAME's `lisp-indent-function' property to INDENT.
650 Set NAME's `edebug-form-spec' property to DEBUG. (This is
651 equivalent to writing a `def-edebug-spec' for the macro.)
654 Set NAME's `doc-string-elt' property to ELT.
656 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
659 register Lisp_Object fn_name
;
660 register Lisp_Object defn
;
661 Lisp_Object lambda_list
, doc
, tail
;
663 fn_name
= Fcar (args
);
664 CHECK_SYMBOL (fn_name
);
665 lambda_list
= Fcar (Fcdr (args
));
666 tail
= Fcdr (Fcdr (args
));
669 if (STRINGP (Fcar (tail
)))
675 if (CONSP (Fcar (tail
))
676 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
678 if (!NILP (Vmacro_declaration_function
))
682 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
690 tail
= Fcons (lambda_list
, tail
);
692 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
694 defn
= Fcons (Qlambda
, tail
);
695 if (!NILP (Vinternal_interpreter_environment
)) /* Mere optimization! */
696 defn
= Ffunction (Fcons (defn
, Qnil
));
697 defn
= Fcons (Qmacro
, defn
);
699 if (!NILP (Vpurify_flag
))
700 defn
= Fpurecopy (defn
);
701 if (CONSP (XSYMBOL (fn_name
)->function
)
702 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
703 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
704 Ffset (fn_name
, defn
);
705 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
710 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
711 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
712 Aliased variables always have the same value; setting one sets the other.
713 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
714 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
715 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
716 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
717 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
718 The return value is BASE-VARIABLE. */)
719 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
721 struct Lisp_Symbol
*sym
;
723 CHECK_SYMBOL (new_alias
);
724 CHECK_SYMBOL (base_variable
);
726 sym
= XSYMBOL (new_alias
);
729 /* Not sure why, but why not? */
730 error ("Cannot make a constant an alias");
732 switch (sym
->redirect
)
734 case SYMBOL_FORWARDED
:
735 error ("Cannot make an internal variable an alias");
736 case SYMBOL_LOCALIZED
:
737 error ("Don't know how to make a localized variable an alias");
740 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
741 If n_a is bound, but b_v is not, set the value of b_v to n_a,
742 so that old-code that affects n_a before the aliasing is setup
744 if (NILP (Fboundp (base_variable
)))
745 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
748 struct specbinding
*p
;
750 for (p
= specpdl_ptr
- 1; p
>= specpdl
; p
--)
753 CONSP (p
->symbol
) ? XCAR (p
->symbol
) : p
->symbol
)))
754 error ("Don't know how to make a let-bound variable an alias");
757 sym
->declared_special
= 1;
758 sym
->redirect
= SYMBOL_VARALIAS
;
759 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
760 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
761 LOADHIST_ATTACH (new_alias
);
762 /* Even if docstring is nil: remove old docstring. */
763 Fput (new_alias
, Qvariable_documentation
, docstring
);
765 return base_variable
;
769 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
770 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
771 You are not required to define a variable in order to use it,
772 but the definition can supply documentation and an initial value
773 in a way that tags can recognize.
775 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
776 If SYMBOL is buffer-local, its default value is what is set;
777 buffer-local values are not affected.
778 INITVALUE and DOCSTRING are optional.
779 If DOCSTRING starts with *, this variable is identified as a user option.
780 This means that M-x set-variable recognizes it.
781 See also `user-variable-p'.
782 If INITVALUE is missing, SYMBOL's value is not set.
784 If SYMBOL has a local binding, then this form affects the local
785 binding. This is usually not what you want. Thus, if you need to
786 load a file defining variables, with this form or with `defconst' or
787 `defcustom', you should always load that file _outside_ any bindings
788 for these variables. \(`defconst' and `defcustom' behave similarly in
790 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
793 register Lisp_Object sym
, tem
, tail
;
797 if (!NILP (Fcdr (Fcdr (tail
))))
798 error ("Too many arguments");
800 tem
= Fdefault_boundp (sym
);
803 /* Do it before evaluating the initial value, for self-references. */
804 XSYMBOL (sym
)->declared_special
= 1;
806 if (SYMBOL_CONSTANT_P (sym
))
808 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
809 Lisp_Object tem1
= Fcar (tail
);
811 && EQ (XCAR (tem1
), Qquote
)
812 && CONSP (XCDR (tem1
))
813 && EQ (XCAR (XCDR (tem1
)), sym
)))
814 error ("Constant symbol `%s' specified in defvar",
815 SDATA (SYMBOL_NAME (sym
)));
819 Fset_default (sym
, eval_sub (Fcar (tail
)));
821 { /* Check if there is really a global binding rather than just a let
822 binding that shadows the global unboundness of the var. */
823 volatile struct specbinding
*pdl
= specpdl_ptr
;
824 while (--pdl
>= specpdl
)
826 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
827 && EQ (pdl
->old_value
, Qunbound
))
829 message_with_string ("Warning: defvar ignored because %s is let-bound",
830 SYMBOL_NAME (sym
), 1);
839 if (!NILP (Vpurify_flag
))
840 tem
= Fpurecopy (tem
);
841 Fput (sym
, Qvariable_documentation
, tem
);
843 LOADHIST_ATTACH (sym
);
845 else if (!NILP (Vinternal_interpreter_environment
)
846 && !XSYMBOL (sym
)->declared_special
)
847 /* A simple (defvar foo) with lexical scoping does "nothing" except
848 declare that var to be dynamically scoped *locally* (i.e. within
849 the current file or let-block). */
850 Vinternal_interpreter_environment
=
851 Fcons (sym
, Vinternal_interpreter_environment
);
854 /* Simple (defvar <var>) should not count as a definition at all.
855 It could get in the way of other definitions, and unloading this
856 package could try to make the variable unbound. */
862 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
863 doc
: /* Define SYMBOL as a constant variable.
864 The intent is that neither programs nor users should ever change this value.
865 Always sets the value of SYMBOL to the result of evalling INITVALUE.
866 If SYMBOL is buffer-local, its default value is what is set;
867 buffer-local values are not affected.
868 DOCSTRING is optional.
870 If SYMBOL has a local binding, then this form sets the local binding's
871 value. However, you should normally not make local bindings for
872 variables defined with this form.
873 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
876 register Lisp_Object sym
, tem
;
879 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
880 error ("Too many arguments");
882 tem
= eval_sub (Fcar (Fcdr (args
)));
883 if (!NILP (Vpurify_flag
))
884 tem
= Fpurecopy (tem
);
885 Fset_default (sym
, tem
);
886 XSYMBOL (sym
)->declared_special
= 1;
887 tem
= Fcar (Fcdr (Fcdr (args
)));
890 if (!NILP (Vpurify_flag
))
891 tem
= Fpurecopy (tem
);
892 Fput (sym
, Qvariable_documentation
, tem
);
894 Fput (sym
, Qrisky_local_variable
, Qt
);
895 LOADHIST_ATTACH (sym
);
899 /* Error handler used in Fuser_variable_p. */
901 user_variable_p_eh (Lisp_Object ignore
)
907 lisp_indirect_variable (Lisp_Object sym
)
909 struct Lisp_Symbol
*s
= indirect_variable (XSYMBOL (sym
));
914 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
915 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
916 \(The alternative is a variable used internally in a Lisp program.)
917 A variable is a user variable if
918 \(1) the first character of its documentation is `*', or
919 \(2) it is customizable (its property list contains a non-nil value
920 of `standard-value' or `custom-autoload'), or
921 \(3) it is an alias for another user variable.
922 Return nil if VARIABLE is an alias and there is a loop in the
923 chain of symbols. */)
924 (Lisp_Object variable
)
926 Lisp_Object documentation
;
928 if (!SYMBOLP (variable
))
931 /* If indirect and there's an alias loop, don't check anything else. */
932 if (XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
933 && NILP (internal_condition_case_1 (lisp_indirect_variable
, variable
,
934 Qt
, user_variable_p_eh
)))
939 documentation
= Fget (variable
, Qvariable_documentation
);
940 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
942 if (STRINGP (documentation
)
943 && ((unsigned char) SREF (documentation
, 0) == '*'))
945 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
946 if (CONSP (documentation
)
947 && STRINGP (XCAR (documentation
))
948 && INTEGERP (XCDR (documentation
))
949 && XINT (XCDR (documentation
)) < 0)
951 /* Customizable? See `custom-variable-p'. */
952 if ((!NILP (Fget (variable
, intern ("standard-value"))))
953 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
956 if (!(XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
))
959 /* An indirect variable? Let's follow the chain. */
960 XSETSYMBOL (variable
, SYMBOL_ALIAS (XSYMBOL (variable
)));
964 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
965 doc
: /* Bind variables according to VARLIST then eval BODY.
966 The value of the last form in BODY is returned.
967 Each element of VARLIST is a symbol (which is bound to nil)
968 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
969 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
970 usage: (let* VARLIST BODY...) */)
973 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
974 int count
= SPECPDL_INDEX ();
975 struct gcpro gcpro1
, gcpro2
, gcpro3
;
977 GCPRO3 (args
, elt
, varlist
);
979 lexenv
= Vinternal_interpreter_environment
;
981 varlist
= Fcar (args
);
982 while (CONSP (varlist
))
986 elt
= XCAR (varlist
);
992 else if (! NILP (Fcdr (Fcdr (elt
))))
993 signal_error ("`let' bindings can have only one value-form", elt
);
997 val
= eval_sub (Fcar (Fcdr (elt
)));
1000 if (!NILP (lexenv
) && SYMBOLP (var
)
1001 && !XSYMBOL (var
)->declared_special
1002 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1003 /* Lexically bind VAR by adding it to the interpreter's binding
1007 = Fcons (Fcons (var
, val
), Vinternal_interpreter_environment
);
1008 if (EQ (Vinternal_interpreter_environment
, lexenv
))
1009 /* Save the old lexical environment on the specpdl stack,
1010 but only for the first lexical binding, since we'll never
1011 need to revert to one of the intermediate ones. */
1012 specbind (Qinternal_interpreter_environment
, newenv
);
1014 Vinternal_interpreter_environment
= newenv
;
1017 specbind (var
, val
);
1019 varlist
= XCDR (varlist
);
1022 val
= Fprogn (Fcdr (args
));
1023 return unbind_to (count
, val
);
1026 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
1027 doc
: /* Bind variables according to VARLIST then eval BODY.
1028 The value of the last form in BODY is returned.
1029 Each element of VARLIST is a symbol (which is bound to nil)
1030 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1031 All the VALUEFORMs are evalled before any symbols are bound.
1032 usage: (let VARLIST BODY...) */)
1035 Lisp_Object
*temps
, tem
, lexenv
;
1036 register Lisp_Object elt
, varlist
;
1037 int count
= SPECPDL_INDEX ();
1038 register size_t argnum
;
1039 struct gcpro gcpro1
, gcpro2
;
1042 varlist
= Fcar (args
);
1044 /* Make space to hold the values to give the bound variables. */
1045 elt
= Flength (varlist
);
1046 SAFE_ALLOCA_LISP (temps
, XFASTINT (elt
));
1048 /* Compute the values and store them in `temps'. */
1050 GCPRO2 (args
, *temps
);
1053 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1056 elt
= XCAR (varlist
);
1058 temps
[argnum
++] = Qnil
;
1059 else if (! NILP (Fcdr (Fcdr (elt
))))
1060 signal_error ("`let' bindings can have only one value-form", elt
);
1062 temps
[argnum
++] = eval_sub (Fcar (Fcdr (elt
)));
1063 gcpro2
.nvars
= argnum
;
1067 lexenv
= Vinternal_interpreter_environment
;
1069 varlist
= Fcar (args
);
1070 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1074 elt
= XCAR (varlist
);
1075 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
1076 tem
= temps
[argnum
++];
1078 if (!NILP (lexenv
) && SYMBOLP (var
)
1079 && !XSYMBOL (var
)->declared_special
1080 && NILP (Fmemq (var
, Vinternal_interpreter_environment
)))
1081 /* Lexically bind VAR by adding it to the lexenv alist. */
1082 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
1084 /* Dynamically bind VAR. */
1085 specbind (var
, tem
);
1088 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
1089 /* Instantiate a new lexical environment. */
1090 specbind (Qinternal_interpreter_environment
, lexenv
);
1092 elt
= Fprogn (Fcdr (args
));
1094 return unbind_to (count
, elt
);
1097 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1098 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1099 The order of execution is thus TEST, BODY, TEST, BODY and so on
1100 until TEST returns nil.
1101 usage: (while TEST BODY...) */)
1104 Lisp_Object test
, body
;
1105 struct gcpro gcpro1
, gcpro2
;
1107 GCPRO2 (test
, body
);
1111 while (!NILP (eval_sub (test
)))
1121 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1122 doc
: /* Return result of expanding macros at top level of FORM.
1123 If FORM is not a macro call, it is returned unchanged.
1124 Otherwise, the macro is expanded and the expansion is considered
1125 in place of FORM. When a non-macro-call results, it is returned.
1127 The second optional arg ENVIRONMENT specifies an environment of macro
1128 definitions to shadow the loaded ones for use in file byte-compilation. */)
1129 (Lisp_Object form
, Lisp_Object environment
)
1131 /* With cleanups from Hallvard Furuseth. */
1132 register Lisp_Object expander
, sym
, def
, tem
;
1136 /* Come back here each time we expand a macro call,
1137 in case it expands into another macro call. */
1140 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1141 def
= sym
= XCAR (form
);
1143 /* Trace symbols aliases to other symbols
1144 until we get a symbol that is not an alias. */
1145 while (SYMBOLP (def
))
1149 tem
= Fassq (sym
, environment
);
1152 def
= XSYMBOL (sym
)->function
;
1153 if (!EQ (def
, Qunbound
))
1158 /* Right now TEM is the result from SYM in ENVIRONMENT,
1159 and if TEM is nil then DEF is SYM's function definition. */
1162 /* SYM is not mentioned in ENVIRONMENT.
1163 Look at its function definition. */
1164 if (EQ (def
, Qunbound
) || !CONSP (def
))
1165 /* Not defined or definition not suitable. */
1167 if (EQ (XCAR (def
), Qautoload
))
1169 /* Autoloading function: will it be a macro when loaded? */
1170 tem
= Fnth (make_number (4), def
);
1171 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1172 /* Yes, load it and try again. */
1174 struct gcpro gcpro1
;
1176 do_autoload (def
, sym
);
1183 else if (!EQ (XCAR (def
), Qmacro
))
1185 else expander
= XCDR (def
);
1189 expander
= XCDR (tem
);
1190 if (NILP (expander
))
1193 form
= apply1 (expander
, XCDR (form
));
1198 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1199 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1200 TAG is evalled to get the tag to use; it must not be nil.
1202 Then the BODY is executed.
1203 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1204 If no throw happens, `catch' returns the value of the last BODY form.
1205 If a throw happens, it specifies the value to return from `catch'.
1206 usage: (catch TAG BODY...) */)
1209 register Lisp_Object tag
;
1210 struct gcpro gcpro1
;
1213 tag
= eval_sub (Fcar (args
));
1215 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1218 /* Set up a catch, then call C function FUNC on argument ARG.
1219 FUNC should return a Lisp_Object.
1220 This is how catches are done from within C code. */
1223 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1225 /* This structure is made part of the chain `catchlist'. */
1228 /* Fill in the components of c, and put it on the list. */
1232 c
.backlist
= backtrace_list
;
1233 c
.handlerlist
= handlerlist
;
1234 c
.lisp_eval_depth
= lisp_eval_depth
;
1235 c
.pdlcount
= SPECPDL_INDEX ();
1236 c
.poll_suppress_count
= poll_suppress_count
;
1237 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1238 c
.gcpro
= gcprolist
;
1239 c
.byte_stack
= byte_stack_list
;
1243 if (! _setjmp (c
.jmp
))
1244 c
.val
= (*func
) (arg
);
1246 /* Throw works by a longjmp that comes right here. */
1251 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1252 jump to that CATCH, returning VALUE as the value of that catch.
1254 This is the guts Fthrow and Fsignal; they differ only in the way
1255 they choose the catch tag to throw to. A catch tag for a
1256 condition-case form has a TAG of Qnil.
1258 Before each catch is discarded, unbind all special bindings and
1259 execute all unwind-protect clauses made above that catch. Unwind
1260 the handler stack as we go, so that the proper handlers are in
1261 effect for each unwind-protect clause we run. At the end, restore
1262 some static info saved in CATCH, and longjmp to the location
1265 This is used for correct unwinding in Fthrow and Fsignal. */
1268 unwind_to_catch (struct catchtag
*catch, Lisp_Object value
)
1270 register int last_time
;
1272 /* Save the value in the tag. */
1275 /* Restore certain special C variables. */
1276 set_poll_suppress_count (catch->poll_suppress_count
);
1277 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1278 handling_signal
= 0;
1283 last_time
= catchlist
== catch;
1285 /* Unwind the specpdl stack, and then restore the proper set of
1287 unbind_to (catchlist
->pdlcount
, Qnil
);
1288 handlerlist
= catchlist
->handlerlist
;
1289 catchlist
= catchlist
->next
;
1291 while (! last_time
);
1294 /* If x_catch_errors was done, turn it off now.
1295 (First we give unbind_to a chance to do that.) */
1296 #if 0 /* This would disable x_catch_errors after x_connection_closed.
1297 The catch must remain in effect during that delicate
1298 state. --lorentey */
1299 x_fully_uncatch_errors ();
1303 byte_stack_list
= catch->byte_stack
;
1304 gcprolist
= catch->gcpro
;
1306 gcpro_level
= gcprolist
? gcprolist
->level
+ 1 : 0;
1308 backtrace_list
= catch->backlist
;
1309 lisp_eval_depth
= catch->lisp_eval_depth
;
1311 _longjmp (catch->jmp
, 1);
1314 DEFUE ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1315 doc
: /* Throw to the catch for TAG and return VALUE from it.
1316 Both TAG and VALUE are evalled. */)
1317 (register Lisp_Object tag
, Lisp_Object value
)
1319 register struct catchtag
*c
;
1322 for (c
= catchlist
; c
; c
= c
->next
)
1324 if (EQ (c
->tag
, tag
))
1325 unwind_to_catch (c
, value
);
1327 xsignal2 (Qno_catch
, tag
, value
);
1331 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1332 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1333 If BODYFORM completes normally, its value is returned
1334 after executing the UNWINDFORMS.
1335 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1336 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1340 int count
= SPECPDL_INDEX ();
1342 record_unwind_protect (Fprogn
, Fcdr (args
));
1343 val
= eval_sub (Fcar (args
));
1344 return unbind_to (count
, val
);
1347 /* Chain of condition handlers currently in effect.
1348 The elements of this chain are contained in the stack frames
1349 of Fcondition_case and internal_condition_case.
1350 When an error is signaled (by calling Fsignal, below),
1351 this chain is searched for an element that applies. */
1353 struct handler
*handlerlist
;
1355 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1356 doc
: /* Regain control when an error is signaled.
1357 Executes BODYFORM and returns its value if no error happens.
1358 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1359 where the BODY is made of Lisp expressions.
1361 A handler is applicable to an error
1362 if CONDITION-NAME is one of the error's condition names.
1363 If an error happens, the first applicable handler is run.
1365 The car of a handler may be a list of condition names
1366 instead of a single condition name. Then it handles all of them.
1368 When a handler handles an error, control returns to the `condition-case'
1369 and it executes the handler's BODY...
1370 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1371 \(If VAR is nil, the handler can't access that information.)
1372 Then the value of the last BODY form is returned from the `condition-case'
1375 See also the function `signal' for more info.
1376 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1379 register Lisp_Object bodyform
, handlers
;
1380 volatile Lisp_Object var
;
1383 bodyform
= Fcar (Fcdr (args
));
1384 handlers
= Fcdr (Fcdr (args
));
1386 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1389 /* Like Fcondition_case, but the args are separate
1390 rather than passed in a list. Used by Fbyte_code. */
1393 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1394 Lisp_Object handlers
)
1402 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1408 && (SYMBOLP (XCAR (tem
))
1409 || CONSP (XCAR (tem
))))))
1410 error ("Invalid condition handler");
1415 c
.backlist
= backtrace_list
;
1416 c
.handlerlist
= handlerlist
;
1417 c
.lisp_eval_depth
= lisp_eval_depth
;
1418 c
.pdlcount
= SPECPDL_INDEX ();
1419 c
.poll_suppress_count
= poll_suppress_count
;
1420 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1421 c
.gcpro
= gcprolist
;
1422 c
.byte_stack
= byte_stack_list
;
1423 if (_setjmp (c
.jmp
))
1426 specbind (h
.var
, c
.val
);
1427 val
= Fprogn (Fcdr (h
.chosen_clause
));
1429 /* Note that this just undoes the binding of h.var; whoever
1430 longjumped to us unwound the stack to c.pdlcount before
1432 unbind_to (c
.pdlcount
, Qnil
);
1439 h
.handler
= handlers
;
1440 h
.next
= handlerlist
;
1444 val
= eval_sub (bodyform
);
1446 handlerlist
= h
.next
;
1450 /* Call the function BFUN with no arguments, catching errors within it
1451 according to HANDLERS. If there is an error, call HFUN with
1452 one argument which is the data that describes the error:
1455 HANDLERS can be a list of conditions to catch.
1456 If HANDLERS is Qt, catch all errors.
1457 If HANDLERS is Qerror, catch all errors
1458 but allow the debugger to run if that is enabled. */
1461 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1462 Lisp_Object (*hfun
) (Lisp_Object
))
1468 /* Since Fsignal will close off all calls to x_catch_errors,
1469 we will get the wrong results if some are not closed now. */
1471 if (x_catching_errors ())
1477 c
.backlist
= backtrace_list
;
1478 c
.handlerlist
= handlerlist
;
1479 c
.lisp_eval_depth
= lisp_eval_depth
;
1480 c
.pdlcount
= SPECPDL_INDEX ();
1481 c
.poll_suppress_count
= poll_suppress_count
;
1482 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1483 c
.gcpro
= gcprolist
;
1484 c
.byte_stack
= byte_stack_list
;
1485 if (_setjmp (c
.jmp
))
1487 return (*hfun
) (c
.val
);
1491 h
.handler
= handlers
;
1493 h
.next
= handlerlist
;
1499 handlerlist
= h
.next
;
1503 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1506 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1507 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1513 /* Since Fsignal will close off all calls to x_catch_errors,
1514 we will get the wrong results if some are not closed now. */
1516 if (x_catching_errors ())
1522 c
.backlist
= backtrace_list
;
1523 c
.handlerlist
= handlerlist
;
1524 c
.lisp_eval_depth
= lisp_eval_depth
;
1525 c
.pdlcount
= SPECPDL_INDEX ();
1526 c
.poll_suppress_count
= poll_suppress_count
;
1527 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1528 c
.gcpro
= gcprolist
;
1529 c
.byte_stack
= byte_stack_list
;
1530 if (_setjmp (c
.jmp
))
1532 return (*hfun
) (c
.val
);
1536 h
.handler
= handlers
;
1538 h
.next
= handlerlist
;
1542 val
= (*bfun
) (arg
);
1544 handlerlist
= h
.next
;
1548 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1552 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1555 Lisp_Object handlers
,
1556 Lisp_Object (*hfun
) (Lisp_Object
))
1562 /* Since Fsignal will close off all calls to x_catch_errors,
1563 we will get the wrong results if some are not closed now. */
1565 if (x_catching_errors ())
1571 c
.backlist
= backtrace_list
;
1572 c
.handlerlist
= handlerlist
;
1573 c
.lisp_eval_depth
= lisp_eval_depth
;
1574 c
.pdlcount
= SPECPDL_INDEX ();
1575 c
.poll_suppress_count
= poll_suppress_count
;
1576 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1577 c
.gcpro
= gcprolist
;
1578 c
.byte_stack
= byte_stack_list
;
1579 if (_setjmp (c
.jmp
))
1581 return (*hfun
) (c
.val
);
1585 h
.handler
= handlers
;
1587 h
.next
= handlerlist
;
1591 val
= (*bfun
) (arg1
, arg2
);
1593 handlerlist
= h
.next
;
1597 /* Like internal_condition_case but call BFUN with NARGS as first,
1598 and ARGS as second argument. */
1601 internal_condition_case_n (Lisp_Object (*bfun
) (size_t, Lisp_Object
*),
1604 Lisp_Object handlers
,
1605 Lisp_Object (*hfun
) (Lisp_Object
))
1611 /* Since Fsignal will close off all calls to x_catch_errors,
1612 we will get the wrong results if some are not closed now. */
1614 if (x_catching_errors ())
1620 c
.backlist
= backtrace_list
;
1621 c
.handlerlist
= handlerlist
;
1622 c
.lisp_eval_depth
= lisp_eval_depth
;
1623 c
.pdlcount
= SPECPDL_INDEX ();
1624 c
.poll_suppress_count
= poll_suppress_count
;
1625 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1626 c
.gcpro
= gcprolist
;
1627 c
.byte_stack
= byte_stack_list
;
1628 if (_setjmp (c
.jmp
))
1630 return (*hfun
) (c
.val
);
1634 h
.handler
= handlers
;
1636 h
.next
= handlerlist
;
1640 val
= (*bfun
) (nargs
, args
);
1642 handlerlist
= h
.next
;
1647 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
,
1648 Lisp_Object
, Lisp_Object
);
1649 static int maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
1652 DEFUE ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1653 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1654 This function does not return.
1656 An error symbol is a symbol with an `error-conditions' property
1657 that is a list of condition names.
1658 A handler for any of those names will get to handle this signal.
1659 The symbol `error' should normally be one of them.
1661 DATA should be a list. Its elements are printed as part of the error message.
1662 See Info anchor `(elisp)Definition of signal' for some details on how this
1663 error message is constructed.
1664 If the signal is handled, DATA is made available to the handler.
1665 See also the function `condition-case'. */)
1666 (Lisp_Object error_symbol
, Lisp_Object data
)
1668 /* When memory is full, ERROR-SYMBOL is nil,
1669 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1670 That is a special case--don't do this in other situations. */
1671 Lisp_Object conditions
;
1673 Lisp_Object real_error_symbol
1674 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
1675 register Lisp_Object clause
= Qnil
;
1677 struct backtrace
*bp
;
1679 immediate_quit
= handling_signal
= 0;
1681 if (gc_in_progress
|| waiting_for_input
)
1684 #if 0 /* rms: I don't know why this was here,
1685 but it is surely wrong for an error that is handled. */
1686 #ifdef HAVE_WINDOW_SYSTEM
1687 if (display_hourglass_p
)
1688 cancel_hourglass ();
1692 /* This hook is used by edebug. */
1693 if (! NILP (Vsignal_hook_function
)
1694 && ! NILP (error_symbol
))
1696 /* Edebug takes care of restoring these variables when it exits. */
1697 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1698 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1700 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1701 max_specpdl_size
= SPECPDL_INDEX () + 40;
1703 call2 (Vsignal_hook_function
, error_symbol
, data
);
1706 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1708 /* Remember from where signal was called. Skip over the frame for
1709 `signal' itself. If a frame for `error' follows, skip that,
1710 too. Don't do this when ERROR_SYMBOL is nil, because that
1711 is a memory-full error. */
1712 Vsignaling_function
= Qnil
;
1713 if (backtrace_list
&& !NILP (error_symbol
))
1715 bp
= backtrace_list
->next
;
1716 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1718 if (bp
&& bp
->function
)
1719 Vsignaling_function
= *bp
->function
;
1722 for (h
= handlerlist
; h
; h
= h
->next
)
1724 clause
= find_handler_clause (h
->handler
, conditions
,
1725 error_symbol
, data
);
1730 if (/* Don't run the debugger for a memory-full error.
1731 (There is no room in memory to do that!) */
1732 !NILP (error_symbol
)
1733 && (!NILP (Vdebug_on_signal
)
1734 /* If no handler is present now, try to run the debugger. */
1736 /* Special handler that means "print a message and run debugger
1738 || EQ (h
->handler
, Qerror
)))
1741 = maybe_call_debugger (conditions
, error_symbol
, data
);
1742 /* We can't return values to code which signaled an error, but we
1743 can continue code which has signaled a quit. */
1744 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
1750 Lisp_Object unwind_data
1751 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
1753 h
->chosen_clause
= clause
;
1754 unwind_to_catch (h
->tag
, unwind_data
);
1759 Fthrow (Qtop_level
, Qt
);
1762 if (! NILP (error_symbol
))
1763 data
= Fcons (error_symbol
, data
);
1765 string
= Ferror_message_string (data
);
1766 fatal ("%s", SDATA (string
));
1769 /* Internal version of Fsignal that never returns.
1770 Used for anything but Qquit (which can return from Fsignal). */
1773 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1775 Fsignal (error_symbol
, data
);
1779 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1782 xsignal0 (Lisp_Object error_symbol
)
1784 xsignal (error_symbol
, Qnil
);
1788 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1790 xsignal (error_symbol
, list1 (arg
));
1794 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1796 xsignal (error_symbol
, list2 (arg1
, arg2
));
1800 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1802 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1805 /* Signal `error' with message S, and additional arg ARG.
1806 If ARG is not a genuine list, make it a one-element list. */
1809 signal_error (const char *s
, Lisp_Object arg
)
1811 Lisp_Object tortoise
, hare
;
1813 hare
= tortoise
= arg
;
1814 while (CONSP (hare
))
1821 tortoise
= XCDR (tortoise
);
1823 if (EQ (hare
, tortoise
))
1828 arg
= Fcons (arg
, Qnil
); /* Make it a list. */
1830 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1834 /* Return nonzero if LIST is a non-nil atom or
1835 a list containing one of CONDITIONS. */
1838 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1845 while (CONSP (conditions
))
1847 Lisp_Object
this, tail
;
1848 this = XCAR (conditions
);
1849 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1850 if (EQ (XCAR (tail
), this))
1852 conditions
= XCDR (conditions
);
1857 /* Return 1 if an error with condition-symbols CONDITIONS,
1858 and described by SIGNAL-DATA, should skip the debugger
1859 according to debugger-ignored-errors. */
1862 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1865 int first_string
= 1;
1866 Lisp_Object error_message
;
1868 error_message
= Qnil
;
1869 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1871 if (STRINGP (XCAR (tail
)))
1875 error_message
= Ferror_message_string (data
);
1879 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1884 Lisp_Object contail
;
1886 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1887 if (EQ (XCAR (tail
), XCAR (contail
)))
1895 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1896 SIG and DATA describe the signal, as in find_handler_clause. */
1899 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1901 Lisp_Object combined_data
;
1903 combined_data
= Fcons (sig
, data
);
1906 /* Don't try to run the debugger with interrupts blocked.
1907 The editing loop would return anyway. */
1909 /* Does user want to enter debugger for this kind of error? */
1912 : wants_debugger (Vdebug_on_error
, conditions
))
1913 && ! skip_debugger (conditions
, combined_data
)
1914 /* RMS: What's this for? */
1915 && when_entered_debugger
< num_nonmacro_input_events
)
1917 call_debugger (Fcons (Qerror
, Fcons (combined_data
, Qnil
)));
1924 /* Value of Qlambda means we have called debugger and user has continued.
1925 There are two ways to pass SIG and DATA:
1926 = SIG is the error symbol, and DATA is the rest of the data.
1927 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1928 This is for memory-full errors only.
1930 We need to increase max_specpdl_size temporarily around
1931 anything we do that can push on the specpdl, so as not to get
1932 a second error here in case we're handling specpdl overflow. */
1935 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
,
1936 Lisp_Object sig
, Lisp_Object data
)
1938 register Lisp_Object h
;
1940 /* t is used by handlers for all conditions, set up by C code. */
1941 if (EQ (handlers
, Qt
))
1944 /* error is used similarly, but means print an error message
1945 and run the debugger if that is enabled. */
1946 if (EQ (handlers
, Qerror
))
1949 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1951 Lisp_Object handler
= XCAR (h
);
1952 Lisp_Object condit
, tem
;
1954 if (!CONSP (handler
))
1956 condit
= XCAR (handler
);
1957 /* Handle a single condition name in handler HANDLER. */
1958 if (SYMBOLP (condit
))
1960 tem
= Fmemq (Fcar (handler
), conditions
);
1964 /* Handle a list of condition names in handler HANDLER. */
1965 else if (CONSP (condit
))
1968 for (tail
= condit
; CONSP (tail
); tail
= XCDR (tail
))
1970 tem
= Fmemq (XCAR (tail
), conditions
);
1981 /* Dump an error message; called like vprintf. */
1983 verror (const char *m
, va_list ap
)
1986 size_t size
= sizeof buf
;
1988 min (MOST_POSITIVE_FIXNUM
, min (INT_MAX
, SIZE_MAX
- 1)) + 1;
1995 used
= vsnprintf (buffer
, size
, m
, ap
);
1999 /* Non-C99 vsnprintf, such as w32, returns -1 when SIZE is too small.
2000 Guess a larger USED to work around the incompatibility. */
2001 used
= (size
<= size_max
/ 2 ? 2 * size
2002 : size
< size_max
? size_max
- 1
2005 else if (used
< size
)
2007 if (size_max
<= used
)
2013 buffer
= (char *) xmalloc (size
);
2016 string
= make_string (buffer
, used
);
2020 xsignal1 (Qerror
, string
);
2024 /* Dump an error message; called like printf. */
2028 error (const char *m
, ...)
2036 DEFUE ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
2037 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
2038 This means it contains a description for how to read arguments to give it.
2039 The value is nil for an invalid function or a symbol with no function
2042 Interactively callable functions include strings and vectors (treated
2043 as keyboard macros), lambda-expressions that contain a top-level call
2044 to `interactive', autoload definitions made by `autoload' with non-nil
2045 fourth argument, and some of the built-in functions of Lisp.
2047 Also, a symbol satisfies `commandp' if its function definition does so.
2049 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2050 then strings and vectors are not accepted. */)
2051 (Lisp_Object function
, Lisp_Object for_call_interactively
)
2053 register Lisp_Object fun
;
2054 register Lisp_Object funcar
;
2055 Lisp_Object if_prop
= Qnil
;
2059 fun
= indirect_function (fun
); /* Check cycles. */
2060 if (NILP (fun
) || EQ (fun
, Qunbound
))
2063 /* Check an `interactive-form' property if present, analogous to the
2064 function-documentation property. */
2066 while (SYMBOLP (fun
))
2068 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
2071 fun
= Fsymbol_function (fun
);
2074 /* Emacs primitives are interactive if their DEFUN specifies an
2075 interactive spec. */
2077 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
2079 /* Bytecode objects are interactive if they are long enough to
2080 have an element whose index is COMPILED_INTERACTIVE, which is
2081 where the interactive spec is stored. */
2082 else if (COMPILEDP (fun
))
2083 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
2086 /* Strings and vectors are keyboard macros. */
2087 if (STRINGP (fun
) || VECTORP (fun
))
2088 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
2090 /* Lists may represent commands. */
2093 funcar
= XCAR (fun
);
2094 if (EQ (funcar
, Qclosure
))
2095 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
2097 else if (EQ (funcar
, Qlambda
))
2098 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
2099 else if (EQ (funcar
, Qautoload
))
2100 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
2105 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
2106 doc
: /* Define FUNCTION to autoload from FILE.
2107 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2108 Third arg DOCSTRING is documentation for the function.
2109 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2110 Fifth arg TYPE indicates the type of the object:
2111 nil or omitted says FUNCTION is a function,
2112 `keymap' says FUNCTION is really a keymap, and
2113 `macro' or t says FUNCTION is really a macro.
2114 Third through fifth args give info about the real definition.
2115 They default to nil.
2116 If FUNCTION is already defined other than as an autoload,
2117 this does nothing and returns nil. */)
2118 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
2120 CHECK_SYMBOL (function
);
2121 CHECK_STRING (file
);
2123 /* If function is defined and not as an autoload, don't override. */
2124 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
2125 && !(CONSP (XSYMBOL (function
)->function
)
2126 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
2129 if (NILP (Vpurify_flag
))
2130 /* Only add entries after dumping, because the ones before are
2131 not useful and else we get loads of them from the loaddefs.el. */
2132 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
2134 /* We don't want the docstring in purespace (instead,
2135 Snarf-documentation should (hopefully) overwrite it).
2136 We used to use 0 here, but that leads to accidental sharing in
2137 purecopy's hash-consing, so we use a (hopefully) unique integer
2139 docstring
= make_number (XHASH (function
));
2140 return Ffset (function
,
2141 Fpurecopy (list5 (Qautoload
, file
, docstring
,
2142 interactive
, type
)));
2146 un_autoload (Lisp_Object oldqueue
)
2148 register Lisp_Object queue
, first
, second
;
2150 /* Queue to unwind is current value of Vautoload_queue.
2151 oldqueue is the shadowed value to leave in Vautoload_queue. */
2152 queue
= Vautoload_queue
;
2153 Vautoload_queue
= oldqueue
;
2154 while (CONSP (queue
))
2156 first
= XCAR (queue
);
2157 second
= Fcdr (first
);
2158 first
= Fcar (first
);
2159 if (EQ (first
, make_number (0)))
2162 Ffset (first
, second
);
2163 queue
= XCDR (queue
);
2168 /* Load an autoloaded function.
2169 FUNNAME is the symbol which is the function's name.
2170 FUNDEF is the autoload definition (a list). */
2173 do_autoload (Lisp_Object fundef
, Lisp_Object funname
)
2175 int count
= SPECPDL_INDEX ();
2177 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2179 /* This is to make sure that loadup.el gives a clear picture
2180 of what files are preloaded and when. */
2181 if (! NILP (Vpurify_flag
))
2182 error ("Attempt to autoload %s while preparing to dump",
2183 SDATA (SYMBOL_NAME (funname
)));
2186 CHECK_SYMBOL (funname
);
2187 GCPRO3 (fun
, funname
, fundef
);
2189 /* Preserve the match data. */
2190 record_unwind_save_match_data ();
2192 /* If autoloading gets an error (which includes the error of failing
2193 to define the function being called), we use Vautoload_queue
2194 to undo function definitions and `provide' calls made by
2195 the function. We do this in the specific case of autoloading
2196 because autoloading is not an explicit request "load this file",
2197 but rather a request to "call this function".
2199 The value saved here is to be restored into Vautoload_queue. */
2200 record_unwind_protect (un_autoload
, Vautoload_queue
);
2201 Vautoload_queue
= Qt
;
2202 Fload (Fcar (Fcdr (fundef
)), Qnil
, Qt
, Qnil
, Qt
);
2204 /* Once loading finishes, don't undo it. */
2205 Vautoload_queue
= Qt
;
2206 unbind_to (count
, Qnil
);
2208 fun
= Findirect_function (fun
, Qnil
);
2210 if (!NILP (Fequal (fun
, fundef
)))
2211 error ("Autoloading failed to define function %s",
2212 SDATA (SYMBOL_NAME (funname
)));
2217 DEFUE ("eval", Feval
, Seval
, 1, 2, 0,
2218 doc
: /* Evaluate FORM and return its value.
2219 If LEXICAL is t, evaluate using lexical scoping. */)
2220 (Lisp_Object form
, Lisp_Object lexical
)
2222 int count
= SPECPDL_INDEX ();
2223 specbind (Qinternal_interpreter_environment
,
2224 NILP (lexical
) ? Qnil
: Fcons (Qt
, Qnil
));
2225 return unbind_to (count
, eval_sub (form
));
2228 /* Eval a sub-expression of the current expression (i.e. in the same
2231 eval_sub (Lisp_Object form
)
2233 Lisp_Object fun
, val
, original_fun
, original_args
;
2235 struct backtrace backtrace
;
2236 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2238 if (handling_signal
)
2243 /* Look up its binding in the lexical environment.
2244 We do not pay attention to the declared_special flag here, since we
2245 already did that when let-binding the variable. */
2246 Lisp_Object lex_binding
2247 = !NILP (Vinternal_interpreter_environment
) /* Mere optimization! */
2248 ? Fassq (form
, Vinternal_interpreter_environment
)
2250 if (CONSP (lex_binding
))
2251 return XCDR (lex_binding
);
2253 return Fsymbol_value (form
);
2260 if ((consing_since_gc
> gc_cons_threshold
2261 && consing_since_gc
> gc_relative_threshold
)
2263 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2266 Fgarbage_collect ();
2270 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2272 if (max_lisp_eval_depth
< 100)
2273 max_lisp_eval_depth
= 100;
2274 if (lisp_eval_depth
> max_lisp_eval_depth
)
2275 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2278 original_fun
= Fcar (form
);
2279 original_args
= Fcdr (form
);
2281 backtrace
.next
= backtrace_list
;
2282 backtrace_list
= &backtrace
;
2283 backtrace
.function
= &original_fun
; /* This also protects them from gc. */
2284 backtrace
.args
= &original_args
;
2285 backtrace
.nargs
= UNEVALLED
;
2286 backtrace
.evalargs
= 1;
2287 backtrace
.debug_on_exit
= 0;
2289 if (debug_on_next_call
)
2290 do_debug_on_call (Qt
);
2292 /* At this point, only original_fun and original_args
2293 have values that will be used below. */
2296 /* Optimize for no indirection. */
2298 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2299 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2300 fun
= indirect_function (fun
);
2304 Lisp_Object numargs
;
2305 Lisp_Object argvals
[8];
2306 Lisp_Object args_left
;
2307 register int i
, maxargs
;
2309 args_left
= original_args
;
2310 numargs
= Flength (args_left
);
2314 if (XINT (numargs
) < XSUBR (fun
)->min_args
2315 || (XSUBR (fun
)->max_args
>= 0
2316 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2317 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2319 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
2321 backtrace
.evalargs
= 0;
2322 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2324 else if (XSUBR (fun
)->max_args
== MANY
)
2326 /* Pass a vector of evaluated arguments. */
2328 register size_t argnum
= 0;
2331 SAFE_ALLOCA_LISP (vals
, XINT (numargs
));
2333 GCPRO3 (args_left
, fun
, fun
);
2337 while (!NILP (args_left
))
2339 vals
[argnum
++] = eval_sub (Fcar (args_left
));
2340 args_left
= Fcdr (args_left
);
2341 gcpro3
.nvars
= argnum
;
2344 backtrace
.args
= vals
;
2345 backtrace
.nargs
= XINT (numargs
);
2347 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2353 GCPRO3 (args_left
, fun
, fun
);
2354 gcpro3
.var
= argvals
;
2357 maxargs
= XSUBR (fun
)->max_args
;
2358 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2360 argvals
[i
] = eval_sub (Fcar (args_left
));
2366 backtrace
.args
= argvals
;
2367 backtrace
.nargs
= XINT (numargs
);
2372 val
= (XSUBR (fun
)->function
.a0 ());
2375 val
= (XSUBR (fun
)->function
.a1 (argvals
[0]));
2378 val
= (XSUBR (fun
)->function
.a2 (argvals
[0], argvals
[1]));
2381 val
= (XSUBR (fun
)->function
.a3
2382 (argvals
[0], argvals
[1], argvals
[2]));
2385 val
= (XSUBR (fun
)->function
.a4
2386 (argvals
[0], argvals
[1], argvals
[2], argvals
[3]));
2389 val
= (XSUBR (fun
)->function
.a5
2390 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2394 val
= (XSUBR (fun
)->function
.a6
2395 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2396 argvals
[4], argvals
[5]));
2399 val
= (XSUBR (fun
)->function
.a7
2400 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2401 argvals
[4], argvals
[5], argvals
[6]));
2405 val
= (XSUBR (fun
)->function
.a8
2406 (argvals
[0], argvals
[1], argvals
[2], argvals
[3],
2407 argvals
[4], argvals
[5], argvals
[6], argvals
[7]));
2411 /* Someone has created a subr that takes more arguments than
2412 is supported by this code. We need to either rewrite the
2413 subr to use a different argument protocol, or add more
2414 cases to this switch. */
2419 else if (COMPILEDP (fun
))
2420 val
= apply_lambda (fun
, original_args
);
2423 if (EQ (fun
, Qunbound
))
2424 xsignal1 (Qvoid_function
, original_fun
);
2426 xsignal1 (Qinvalid_function
, original_fun
);
2427 funcar
= XCAR (fun
);
2428 if (!SYMBOLP (funcar
))
2429 xsignal1 (Qinvalid_function
, original_fun
);
2430 if (EQ (funcar
, Qautoload
))
2432 do_autoload (fun
, original_fun
);
2435 if (EQ (funcar
, Qmacro
))
2436 val
= eval_sub (apply1 (Fcdr (fun
), original_args
));
2437 else if (EQ (funcar
, Qlambda
)
2438 || EQ (funcar
, Qclosure
))
2439 val
= apply_lambda (fun
, original_args
);
2441 xsignal1 (Qinvalid_function
, original_fun
);
2446 if (backtrace
.debug_on_exit
)
2447 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2448 backtrace_list
= backtrace
.next
;
2453 DEFUE ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2454 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2455 Then return the value FUNCTION returns.
2456 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2457 usage: (apply FUNCTION &rest ARGUMENTS) */)
2458 (size_t nargs
, Lisp_Object
*args
)
2460 register size_t i
, numargs
;
2461 register Lisp_Object spread_arg
;
2462 register Lisp_Object
*funcall_args
;
2463 Lisp_Object fun
, retval
;
2464 struct gcpro gcpro1
;
2469 spread_arg
= args
[nargs
- 1];
2470 CHECK_LIST (spread_arg
);
2472 numargs
= XINT (Flength (spread_arg
));
2475 return Ffuncall (nargs
- 1, args
);
2476 else if (numargs
== 1)
2478 args
[nargs
- 1] = XCAR (spread_arg
);
2479 return Ffuncall (nargs
, args
);
2482 numargs
+= nargs
- 2;
2484 /* Optimize for no indirection. */
2485 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2486 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2487 fun
= indirect_function (fun
);
2488 if (EQ (fun
, Qunbound
))
2490 /* Let funcall get the error. */
2497 if (numargs
< XSUBR (fun
)->min_args
2498 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2499 goto funcall
; /* Let funcall get the error. */
2500 else if (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
> numargs
)
2502 /* Avoid making funcall cons up a yet another new vector of arguments
2503 by explicitly supplying nil's for optional values. */
2504 SAFE_ALLOCA_LISP (funcall_args
, 1 + XSUBR (fun
)->max_args
);
2505 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2506 funcall_args
[++i
] = Qnil
;
2507 GCPRO1 (*funcall_args
);
2508 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2512 /* We add 1 to numargs because funcall_args includes the
2513 function itself as well as its arguments. */
2516 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
2517 GCPRO1 (*funcall_args
);
2518 gcpro1
.nvars
= 1 + numargs
;
2521 memcpy (funcall_args
, args
, nargs
* sizeof (Lisp_Object
));
2522 /* Spread the last arg we got. Its first element goes in
2523 the slot that it used to occupy, hence this value of I. */
2525 while (!NILP (spread_arg
))
2527 funcall_args
[i
++] = XCAR (spread_arg
);
2528 spread_arg
= XCDR (spread_arg
);
2531 /* By convention, the caller needs to gcpro Ffuncall's args. */
2532 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
2539 /* Run hook variables in various ways. */
2542 funcall_nil (size_t nargs
, Lisp_Object
*args
)
2544 Ffuncall (nargs
, args
);
2548 DEFUE ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2549 doc
: /* Run each hook in HOOKS.
2550 Each argument should be a symbol, a hook variable.
2551 These symbols are processed in the order specified.
2552 If a hook symbol has a non-nil value, that value may be a function
2553 or a list of functions to be called to run the hook.
2554 If the value is a function, it is called with no arguments.
2555 If it is a list, the elements are called, in order, with no arguments.
2557 Major modes should not use this function directly to run their mode
2558 hook; they should use `run-mode-hooks' instead.
2560 Do not use `make-local-variable' to make a hook variable buffer-local.
2561 Instead, use `add-hook' and specify t for the LOCAL argument.
2562 usage: (run-hooks &rest HOOKS) */)
2563 (size_t nargs
, Lisp_Object
*args
)
2565 Lisp_Object hook
[1];
2568 for (i
= 0; i
< nargs
; i
++)
2571 run_hook_with_args (1, hook
, funcall_nil
);
2577 DEFUE ("run-hook-with-args", Frun_hook_with_args
,
2578 Srun_hook_with_args
, 1, MANY
, 0,
2579 doc
: /* Run HOOK with the specified arguments ARGS.
2580 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2581 value, that value may be a function or a list of functions to be
2582 called to run the hook. If the value is a function, it is called with
2583 the given arguments and its return value is returned. If it is a list
2584 of functions, those functions are called, in order,
2585 with the given arguments ARGS.
2586 It is best not to depend on the value returned by `run-hook-with-args',
2589 Do not use `make-local-variable' to make a hook variable buffer-local.
2590 Instead, use `add-hook' and specify t for the LOCAL argument.
2591 usage: (run-hook-with-args HOOK &rest ARGS) */)
2592 (size_t nargs
, Lisp_Object
*args
)
2594 return run_hook_with_args (nargs
, args
, funcall_nil
);
2597 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2598 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2599 doc
: /* Run HOOK with the specified arguments ARGS.
2600 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2601 value, that value may be a function or a list of functions to be
2602 called to run the hook. If the value is a function, it is called with
2603 the given arguments and its return value is returned.
2604 If it is a list of functions, those functions are called, in order,
2605 with the given arguments ARGS, until one of them
2606 returns a non-nil value. Then we return that value.
2607 However, if they all return nil, we return nil.
2609 Do not use `make-local-variable' to make a hook variable buffer-local.
2610 Instead, use `add-hook' and specify t for the LOCAL argument.
2611 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2612 (size_t nargs
, Lisp_Object
*args
)
2614 return run_hook_with_args (nargs
, args
, Ffuncall
);
2618 funcall_not (size_t nargs
, Lisp_Object
*args
)
2620 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
2623 DEFUE ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2624 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2625 doc
: /* Run HOOK with the specified arguments ARGS.
2626 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2627 value, that value may be a function or a list of functions to be
2628 called to run the hook. If the value is a function, it is called with
2629 the given arguments and its return value is returned.
2630 If it is a list of functions, those functions are called, in order,
2631 with the given arguments ARGS, until one of them returns nil.
2632 Then we return nil. However, if they all return non-nil, we return non-nil.
2634 Do not use `make-local-variable' to make a hook variable buffer-local.
2635 Instead, use `add-hook' and specify t for the LOCAL argument.
2636 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2637 (size_t nargs
, Lisp_Object
*args
)
2639 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
2643 run_hook_wrapped_funcall (size_t nargs
, Lisp_Object
*args
)
2645 Lisp_Object tmp
= args
[0], ret
;
2648 ret
= Ffuncall (nargs
, args
);
2654 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
2655 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
2656 I.e. instead of calling each function FUN directly with arguments ARGS,
2657 it calls WRAP-FUNCTION with arguments FUN and ARGS.
2658 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2659 aborts and returns that value.
2660 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2661 (size_t nargs
, Lisp_Object
*args
)
2663 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
2666 /* ARGS[0] should be a hook symbol.
2667 Call each of the functions in the hook value, passing each of them
2668 as arguments all the rest of ARGS (all NARGS - 1 elements).
2669 FUNCALL specifies how to call each function on the hook.
2670 The caller (or its caller, etc) must gcpro all of ARGS,
2671 except that it isn't necessary to gcpro ARGS[0]. */
2674 run_hook_with_args (size_t nargs
, Lisp_Object
*args
,
2675 Lisp_Object (*funcall
) (size_t nargs
, Lisp_Object
*args
))
2677 Lisp_Object sym
, val
, ret
= Qnil
;
2678 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2680 /* If we are dying or still initializing,
2681 don't do anything--it would probably crash if we tried. */
2682 if (NILP (Vrun_hooks
))
2686 val
= find_symbol_value (sym
);
2688 if (EQ (val
, Qunbound
) || NILP (val
))
2690 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2693 return funcall (nargs
, args
);
2697 Lisp_Object global_vals
= Qnil
;
2698 GCPRO3 (sym
, val
, global_vals
);
2701 CONSP (val
) && NILP (ret
);
2704 if (EQ (XCAR (val
), Qt
))
2706 /* t indicates this hook has a local binding;
2707 it means to run the global binding too. */
2708 global_vals
= Fdefault_value (sym
);
2709 if (NILP (global_vals
)) continue;
2711 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
2713 args
[0] = global_vals
;
2714 ret
= funcall (nargs
, args
);
2719 CONSP (global_vals
) && NILP (ret
);
2720 global_vals
= XCDR (global_vals
))
2722 args
[0] = XCAR (global_vals
);
2723 /* In a global value, t should not occur. If it does, we
2724 must ignore it to avoid an endless loop. */
2725 if (!EQ (args
[0], Qt
))
2726 ret
= funcall (nargs
, args
);
2732 args
[0] = XCAR (val
);
2733 ret
= funcall (nargs
, args
);
2742 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2745 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2747 Lisp_Object temp
[3];
2752 Frun_hook_with_args (3, temp
);
2755 /* Apply fn to arg. */
2757 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2759 struct gcpro gcpro1
;
2763 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2766 Lisp_Object args
[2];
2770 RETURN_UNGCPRO (Fapply (2, args
));
2774 /* Call function fn on no arguments. */
2776 call0 (Lisp_Object fn
)
2778 struct gcpro gcpro1
;
2781 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2784 /* Call function fn with 1 argument arg1. */
2787 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2789 struct gcpro gcpro1
;
2790 Lisp_Object args
[2];
2796 RETURN_UNGCPRO (Ffuncall (2, args
));
2799 /* Call function fn with 2 arguments arg1, arg2. */
2802 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2804 struct gcpro gcpro1
;
2805 Lisp_Object args
[3];
2811 RETURN_UNGCPRO (Ffuncall (3, args
));
2814 /* Call function fn with 3 arguments arg1, arg2, arg3. */
2817 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2819 struct gcpro gcpro1
;
2820 Lisp_Object args
[4];
2827 RETURN_UNGCPRO (Ffuncall (4, args
));
2830 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2833 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2836 struct gcpro gcpro1
;
2837 Lisp_Object args
[5];
2845 RETURN_UNGCPRO (Ffuncall (5, args
));
2848 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2851 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2852 Lisp_Object arg4
, Lisp_Object arg5
)
2854 struct gcpro gcpro1
;
2855 Lisp_Object args
[6];
2864 RETURN_UNGCPRO (Ffuncall (6, args
));
2867 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2870 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2871 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2873 struct gcpro gcpro1
;
2874 Lisp_Object args
[7];
2884 RETURN_UNGCPRO (Ffuncall (7, args
));
2887 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2890 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2891 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2893 struct gcpro gcpro1
;
2894 Lisp_Object args
[8];
2905 RETURN_UNGCPRO (Ffuncall (8, args
));
2908 /* The caller should GCPRO all the elements of ARGS. */
2910 DEFUE ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
2911 doc
: /* Non-nil if OBJECT is a function. */)
2912 (Lisp_Object object
)
2914 if (SYMBOLP (object
) && !NILP (Ffboundp (object
)))
2916 object
= Findirect_function (object
, Qt
);
2918 if (CONSP (object
) && EQ (XCAR (object
), Qautoload
))
2920 /* Autoloaded symbols are functions, except if they load
2921 macros or keymaps. */
2923 for (i
= 0; i
< 4 && CONSP (object
); i
++)
2924 object
= XCDR (object
);
2926 return (CONSP (object
) && !NILP (XCAR (object
))) ? Qnil
: Qt
;
2931 return (XSUBR (object
)->max_args
!= UNEVALLED
) ? Qt
: Qnil
;
2932 else if (COMPILEDP (object
))
2934 else if (CONSP (object
))
2936 Lisp_Object car
= XCAR (object
);
2937 return (EQ (car
, Qlambda
) || EQ (car
, Qclosure
)) ? Qt
: Qnil
;
2943 DEFUE ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2944 doc
: /* Call first argument as a function, passing remaining arguments to it.
2945 Return the value that function returns.
2946 Thus, (funcall 'cons 'x 'y) returns (x . y).
2947 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2948 (size_t nargs
, Lisp_Object
*args
)
2950 Lisp_Object fun
, original_fun
;
2952 size_t numargs
= nargs
- 1;
2953 Lisp_Object lisp_numargs
;
2955 struct backtrace backtrace
;
2956 register Lisp_Object
*internal_args
;
2960 if ((consing_since_gc
> gc_cons_threshold
2961 && consing_since_gc
> gc_relative_threshold
)
2963 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2964 Fgarbage_collect ();
2966 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2968 if (max_lisp_eval_depth
< 100)
2969 max_lisp_eval_depth
= 100;
2970 if (lisp_eval_depth
> max_lisp_eval_depth
)
2971 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2974 backtrace
.next
= backtrace_list
;
2975 backtrace_list
= &backtrace
;
2976 backtrace
.function
= &args
[0];
2977 backtrace
.args
= &args
[1];
2978 backtrace
.nargs
= nargs
- 1;
2979 backtrace
.evalargs
= 0;
2980 backtrace
.debug_on_exit
= 0;
2982 if (debug_on_next_call
)
2983 do_debug_on_call (Qlambda
);
2987 original_fun
= args
[0];
2991 /* Optimize for no indirection. */
2993 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2994 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2995 fun
= indirect_function (fun
);
2999 if (numargs
< XSUBR (fun
)->min_args
3000 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
3002 XSETFASTINT (lisp_numargs
, numargs
);
3003 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
3006 else if (XSUBR (fun
)->max_args
== UNEVALLED
)
3007 xsignal1 (Qinvalid_function
, original_fun
);
3009 else if (XSUBR (fun
)->max_args
== MANY
)
3010 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
3013 if (XSUBR (fun
)->max_args
> numargs
)
3015 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
3016 memcpy (internal_args
, args
+ 1, numargs
* sizeof (Lisp_Object
));
3017 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
3018 internal_args
[i
] = Qnil
;
3021 internal_args
= args
+ 1;
3022 switch (XSUBR (fun
)->max_args
)
3025 val
= (XSUBR (fun
)->function
.a0 ());
3028 val
= (XSUBR (fun
)->function
.a1 (internal_args
[0]));
3031 val
= (XSUBR (fun
)->function
.a2
3032 (internal_args
[0], internal_args
[1]));
3035 val
= (XSUBR (fun
)->function
.a3
3036 (internal_args
[0], internal_args
[1], internal_args
[2]));
3039 val
= (XSUBR (fun
)->function
.a4
3040 (internal_args
[0], internal_args
[1], internal_args
[2],
3044 val
= (XSUBR (fun
)->function
.a5
3045 (internal_args
[0], internal_args
[1], internal_args
[2],
3046 internal_args
[3], internal_args
[4]));
3049 val
= (XSUBR (fun
)->function
.a6
3050 (internal_args
[0], internal_args
[1], internal_args
[2],
3051 internal_args
[3], internal_args
[4], internal_args
[5]));
3054 val
= (XSUBR (fun
)->function
.a7
3055 (internal_args
[0], internal_args
[1], internal_args
[2],
3056 internal_args
[3], internal_args
[4], internal_args
[5],
3061 val
= (XSUBR (fun
)->function
.a8
3062 (internal_args
[0], internal_args
[1], internal_args
[2],
3063 internal_args
[3], internal_args
[4], internal_args
[5],
3064 internal_args
[6], internal_args
[7]));
3069 /* If a subr takes more than 8 arguments without using MANY
3070 or UNEVALLED, we need to extend this function to support it.
3071 Until this is done, there is no way to call the function. */
3076 else if (COMPILEDP (fun
))
3077 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3080 if (EQ (fun
, Qunbound
))
3081 xsignal1 (Qvoid_function
, original_fun
);
3083 xsignal1 (Qinvalid_function
, original_fun
);
3084 funcar
= XCAR (fun
);
3085 if (!SYMBOLP (funcar
))
3086 xsignal1 (Qinvalid_function
, original_fun
);
3087 if (EQ (funcar
, Qlambda
)
3088 || EQ (funcar
, Qclosure
))
3089 val
= funcall_lambda (fun
, numargs
, args
+ 1);
3090 else if (EQ (funcar
, Qautoload
))
3092 do_autoload (fun
, original_fun
);
3097 xsignal1 (Qinvalid_function
, original_fun
);
3101 if (backtrace
.debug_on_exit
)
3102 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
3103 backtrace_list
= backtrace
.next
;
3108 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
3110 Lisp_Object args_left
;
3112 register Lisp_Object
*arg_vector
;
3113 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3115 register Lisp_Object tem
;
3118 numargs
= XINT (Flength (args
));
3119 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
3122 GCPRO3 (*arg_vector
, args_left
, fun
);
3125 for (i
= 0; i
< numargs
; )
3127 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
3128 tem
= eval_sub (tem
);
3129 arg_vector
[i
++] = tem
;
3135 backtrace_list
->args
= arg_vector
;
3136 backtrace_list
->nargs
= i
;
3137 backtrace_list
->evalargs
= 0;
3138 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
3140 /* Do the debug-on-exit now, while arg_vector still exists. */
3141 if (backtrace_list
->debug_on_exit
)
3142 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
3143 /* Don't do it again when we return to eval. */
3144 backtrace_list
->debug_on_exit
= 0;
3149 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3150 and return the result of evaluation.
3151 FUN must be either a lambda-expression or a compiled-code object. */
3154 funcall_lambda (Lisp_Object fun
, size_t nargs
,
3155 register Lisp_Object
*arg_vector
)
3157 Lisp_Object val
, syms_left
, next
, lexenv
;
3158 int count
= SPECPDL_INDEX ();
3164 if (EQ (XCAR (fun
), Qclosure
))
3166 fun
= XCDR (fun
); /* Drop `closure'. */
3167 lexenv
= XCAR (fun
);
3168 CHECK_LIST_CONS (fun
, fun
);
3172 syms_left
= XCDR (fun
);
3173 if (CONSP (syms_left
))
3174 syms_left
= XCAR (syms_left
);
3176 xsignal1 (Qinvalid_function
, fun
);
3178 else if (COMPILEDP (fun
))
3180 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3181 if (INTEGERP (syms_left
))
3182 /* A byte-code object with a non-nil `push args' slot means we
3183 shouldn't bind any arguments, instead just call the byte-code
3184 interpreter directly; it will push arguments as necessary.
3186 Byte-code objects with either a non-existant, or a nil value for
3187 the `push args' slot (the default), have dynamically-bound
3188 arguments, and use the argument-binding code below instead (as do
3189 all interpreted functions, even lexically bound ones). */
3191 /* If we have not actually read the bytecode string
3192 and constants vector yet, fetch them from the file. */
3193 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3194 Ffetch_bytecode (fun
);
3195 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3196 AREF (fun
, COMPILED_CONSTANTS
),
3197 AREF (fun
, COMPILED_STACK_DEPTH
),
3206 i
= optional
= rest
= 0;
3207 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3211 next
= XCAR (syms_left
);
3212 if (!SYMBOLP (next
))
3213 xsignal1 (Qinvalid_function
, fun
);
3215 if (EQ (next
, Qand_rest
))
3217 else if (EQ (next
, Qand_optional
))
3224 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
3228 arg
= arg_vector
[i
++];
3230 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3234 /* Bind the argument. */
3235 if (!NILP (lexenv
) && SYMBOLP (next
))
3236 /* Lexically bind NEXT by adding it to the lexenv alist. */
3237 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
3239 /* Dynamically bind NEXT. */
3240 specbind (next
, arg
);
3244 if (!NILP (syms_left
))
3245 xsignal1 (Qinvalid_function
, fun
);
3247 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3249 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3250 /* Instantiate a new lexical environment. */
3251 specbind (Qinternal_interpreter_environment
, lexenv
);
3254 val
= Fprogn (XCDR (XCDR (fun
)));
3257 /* If we have not actually read the bytecode string
3258 and constants vector yet, fetch them from the file. */
3259 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3260 Ffetch_bytecode (fun
);
3261 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3262 AREF (fun
, COMPILED_CONSTANTS
),
3263 AREF (fun
, COMPILED_STACK_DEPTH
),
3267 return unbind_to (count
, val
);
3270 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3272 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3273 (Lisp_Object object
)
3277 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3279 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3282 tem
= AREF (object
, COMPILED_BYTECODE
);
3283 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3284 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3286 error ("Invalid byte code");
3288 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3289 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3297 register int count
= SPECPDL_INDEX ();
3298 if (specpdl_size
>= max_specpdl_size
)
3300 if (max_specpdl_size
< 400)
3301 max_specpdl_size
= 400;
3302 if (specpdl_size
>= max_specpdl_size
)
3303 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil
);
3306 if (specpdl_size
> max_specpdl_size
)
3307 specpdl_size
= max_specpdl_size
;
3308 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3309 specpdl_ptr
= specpdl
+ count
;
3312 /* `specpdl_ptr->symbol' is a field which describes which variable is
3313 let-bound, so it can be properly undone when we unbind_to.
3314 It can have the following two shapes:
3315 - SYMBOL : if it's a plain symbol, it means that we have let-bound
3316 a symbol that is not buffer-local (at least at the time
3317 the let binding started). Note also that it should not be
3318 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3320 - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
3321 variable SYMBOL which can be buffer-local. WHERE tells us
3322 which buffer is affected (or nil if the let-binding affects the
3323 global value of the variable) and BUFFER tells us which buffer was
3324 current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
3325 BUFFER did not yet have a buffer-local value). */
3328 specbind (Lisp_Object symbol
, Lisp_Object value
)
3330 struct Lisp_Symbol
*sym
;
3332 eassert (!handling_signal
);
3334 CHECK_SYMBOL (symbol
);
3335 sym
= XSYMBOL (symbol
);
3336 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3340 switch (sym
->redirect
)
3342 case SYMBOL_VARALIAS
:
3343 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3344 case SYMBOL_PLAINVAL
:
3345 /* The most common case is that of a non-constant symbol with a
3346 trivial value. Make that as fast as we can. */
3347 specpdl_ptr
->symbol
= symbol
;
3348 specpdl_ptr
->old_value
= SYMBOL_VAL (sym
);
3349 specpdl_ptr
->func
= NULL
;
3352 SET_SYMBOL_VAL (sym
, value
);
3354 set_internal (symbol
, value
, Qnil
, 1);
3356 case SYMBOL_LOCALIZED
:
3357 if (SYMBOL_BLV (sym
)->frame_local
)
3358 error ("Frame-local vars cannot be let-bound");
3359 case SYMBOL_FORWARDED
:
3361 Lisp_Object ovalue
= find_symbol_value (symbol
);
3362 specpdl_ptr
->func
= 0;
3363 specpdl_ptr
->old_value
= ovalue
;
3365 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3366 || (EQ (SYMBOL_BLV (sym
)->where
,
3367 SYMBOL_BLV (sym
)->frame_local
?
3368 Fselected_frame () : Fcurrent_buffer ())));
3370 if (sym
->redirect
== SYMBOL_LOCALIZED
3371 || BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3373 Lisp_Object where
, cur_buf
= Fcurrent_buffer ();
3375 /* For a local variable, record both the symbol and which
3376 buffer's or frame's value we are saving. */
3377 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3379 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3380 || (BLV_FOUND (SYMBOL_BLV (sym
))
3381 && EQ (cur_buf
, SYMBOL_BLV (sym
)->where
)));
3384 else if (sym
->redirect
== SYMBOL_LOCALIZED
3385 && BLV_FOUND (SYMBOL_BLV (sym
)))
3386 where
= SYMBOL_BLV (sym
)->where
;
3390 /* We're not using the `unused' slot in the specbinding
3391 structure because this would mean we have to do more
3392 work for simple variables. */
3393 /* FIXME: The third value `current_buffer' is only used in
3394 let_shadows_buffer_binding_p which is itself only used
3395 in set_internal for local_if_set. */
3396 eassert (NILP (where
) || EQ (where
, cur_buf
));
3397 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, cur_buf
));
3399 /* If SYMBOL is a per-buffer variable which doesn't have a
3400 buffer-local value here, make the `let' change the global
3401 value by changing the value of SYMBOL in all buffers not
3402 having their own value. This is consistent with what
3403 happens with other buffer-local variables. */
3405 && sym
->redirect
== SYMBOL_FORWARDED
)
3407 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)));
3409 Fset_default (symbol
, value
);
3414 specpdl_ptr
->symbol
= symbol
;
3417 set_internal (symbol
, value
, Qnil
, 1);
3425 record_unwind_protect (Lisp_Object (*function
) (Lisp_Object
), Lisp_Object arg
)
3427 eassert (!handling_signal
);
3429 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3431 specpdl_ptr
->func
= function
;
3432 specpdl_ptr
->symbol
= Qnil
;
3433 specpdl_ptr
->old_value
= arg
;
3438 unbind_to (int count
, Lisp_Object value
)
3440 Lisp_Object quitf
= Vquit_flag
;
3441 struct gcpro gcpro1
, gcpro2
;
3443 GCPRO2 (value
, quitf
);
3446 while (specpdl_ptr
!= specpdl
+ count
)
3448 /* Copy the binding, and decrement specpdl_ptr, before we do
3449 the work to unbind it. We decrement first
3450 so that an error in unbinding won't try to unbind
3451 the same entry again, and we copy the binding first
3452 in case more bindings are made during some of the code we run. */
3454 struct specbinding this_binding
;
3455 this_binding
= *--specpdl_ptr
;
3457 if (this_binding
.func
!= 0)
3458 (*this_binding
.func
) (this_binding
.old_value
);
3459 /* If the symbol is a list, it is really (SYMBOL WHERE
3460 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3461 frame. If WHERE is a buffer or frame, this indicates we
3462 bound a variable that had a buffer-local or frame-local
3463 binding. WHERE nil means that the variable had the default
3464 value when it was bound. CURRENT-BUFFER is the buffer that
3465 was current when the variable was bound. */
3466 else if (CONSP (this_binding
.symbol
))
3468 Lisp_Object symbol
, where
;
3470 symbol
= XCAR (this_binding
.symbol
);
3471 where
= XCAR (XCDR (this_binding
.symbol
));
3474 Fset_default (symbol
, this_binding
.old_value
);
3475 /* If `where' is non-nil, reset the value in the appropriate
3476 local binding, but only if that binding still exists. */
3477 else if (BUFFERP (where
)
3478 ? !NILP (Flocal_variable_p (symbol
, where
))
3479 : !NILP (Fassq (symbol
, XFRAME (where
)->param_alist
)))
3480 set_internal (symbol
, this_binding
.old_value
, where
, 1);
3482 /* If variable has a trivial value (no forwarding), we can
3483 just set it. No need to check for constant symbols here,
3484 since that was already done by specbind. */
3485 else if (XSYMBOL (this_binding
.symbol
)->redirect
== SYMBOL_PLAINVAL
)
3486 SET_SYMBOL_VAL (XSYMBOL (this_binding
.symbol
),
3487 this_binding
.old_value
);
3489 /* NOTE: we only ever come here if make_local_foo was used for
3490 the first time on this var within this let. */
3491 Fset_default (this_binding
.symbol
, this_binding
.old_value
);
3494 if (NILP (Vquit_flag
) && !NILP (quitf
))
3501 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3502 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3503 A special variable is one that will be bound dynamically, even in a
3504 context where binding is lexical by default. */)
3505 (Lisp_Object symbol
)
3507 CHECK_SYMBOL (symbol
);
3508 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3512 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3513 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3514 The debugger is entered when that frame exits, if the flag is non-nil. */)
3515 (Lisp_Object level
, Lisp_Object flag
)
3517 register struct backtrace
*backlist
= backtrace_list
;
3520 CHECK_NUMBER (level
);
3522 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3524 backlist
= backlist
->next
;
3528 backlist
->debug_on_exit
= !NILP (flag
);
3533 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3534 doc
: /* Print a trace of Lisp function calls currently active.
3535 Output stream used is value of `standard-output'. */)
3538 register struct backtrace
*backlist
= backtrace_list
;
3541 struct gcpro gcpro1
;
3542 Lisp_Object old_print_level
= Vprint_level
;
3544 if (NILP (Vprint_level
))
3545 XSETFASTINT (Vprint_level
, 8);
3552 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3553 if (backlist
->nargs
== UNEVALLED
)
3555 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3556 write_string ("\n", -1);
3560 tem
= *backlist
->function
;
3561 Fprin1 (tem
, Qnil
); /* This can QUIT. */
3562 write_string ("(", -1);
3563 if (backlist
->nargs
== MANY
)
3564 { /* FIXME: Can this happen? */
3566 for (tail
= *backlist
->args
, i
= 0;
3568 tail
= Fcdr (tail
), i
= 1)
3570 if (i
) write_string (" ", -1);
3571 Fprin1 (Fcar (tail
), Qnil
);
3577 for (i
= 0; i
< backlist
->nargs
; i
++)
3579 if (i
) write_string (" ", -1);
3580 Fprin1 (backlist
->args
[i
], Qnil
);
3583 write_string (")\n", -1);
3585 backlist
= backlist
->next
;
3588 Vprint_level
= old_print_level
;
3593 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3594 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3595 If that frame has not evaluated the arguments yet (or is a special form),
3596 the value is (nil FUNCTION ARG-FORMS...).
3597 If that frame has evaluated its arguments and called its function already,
3598 the value is (t FUNCTION ARG-VALUES...).
3599 A &rest arg is represented as the tail of the list ARG-VALUES.
3600 FUNCTION is whatever was supplied as car of evaluated list,
3601 or a lambda expression for macro calls.
3602 If NFRAMES is more than the number of frames, the value is nil. */)
3603 (Lisp_Object nframes
)
3605 register struct backtrace
*backlist
= backtrace_list
;
3606 register EMACS_INT i
;
3609 CHECK_NATNUM (nframes
);
3611 /* Find the frame requested. */
3612 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3613 backlist
= backlist
->next
;
3617 if (backlist
->nargs
== UNEVALLED
)
3618 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3621 if (backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3622 tem
= *backlist
->args
;
3624 tem
= Flist (backlist
->nargs
, backlist
->args
);
3626 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3632 mark_backtrace (void)
3634 register struct backtrace
*backlist
;
3637 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3639 mark_object (*backlist
->function
);
3641 if (backlist
->nargs
== UNEVALLED
3642 || backlist
->nargs
== MANY
) /* FIXME: Can this happen? */
3645 i
= backlist
->nargs
;
3647 mark_object (backlist
->args
[i
]);
3654 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
3655 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3656 If Lisp code tries to increase the total number past this amount,
3657 an error is signaled.
3658 You can safely use a value considerably larger than the default value,
3659 if that proves inconveniently small. However, if you increase it too far,
3660 Emacs could run out of memory trying to make the stack bigger. */);
3662 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
3663 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3665 This limit serves to catch infinite recursions for you before they cause
3666 actual stack overflow in C, which would be fatal for Emacs.
3667 You can safely make it considerably larger than its default value,
3668 if that proves inconveniently small. However, if you increase it too far,
3669 Emacs could overflow the real C stack, and crash. */);
3671 DEFVAR_LISP ("quit-flag", Vquit_flag
,
3672 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3673 If the value is t, that means do an ordinary quit.
3674 If the value equals `throw-on-input', that means quit by throwing
3675 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3676 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3677 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3680 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
3681 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3682 Note that `quit-flag' will still be set by typing C-g,
3683 so a quit will be signaled as soon as `inhibit-quit' is nil.
3684 To prevent this happening, set `quit-flag' to nil
3685 before making `inhibit-quit' nil. */);
3686 Vinhibit_quit
= Qnil
;
3688 Qinhibit_quit
= intern_c_string ("inhibit-quit");
3689 staticpro (&Qinhibit_quit
);
3691 Qautoload
= intern_c_string ("autoload");
3692 staticpro (&Qautoload
);
3694 Qdebug_on_error
= intern_c_string ("debug-on-error");
3695 staticpro (&Qdebug_on_error
);
3697 Qmacro
= intern_c_string ("macro");
3698 staticpro (&Qmacro
);
3700 Qdeclare
= intern_c_string ("declare");
3701 staticpro (&Qdeclare
);
3703 /* Note that the process handling also uses Qexit, but we don't want
3704 to staticpro it twice, so we just do it here. */
3705 Qexit
= intern_c_string ("exit");
3708 Qinteractive
= intern_c_string ("interactive");
3709 staticpro (&Qinteractive
);
3711 Qcommandp
= intern_c_string ("commandp");
3712 staticpro (&Qcommandp
);
3714 Qdefun
= intern_c_string ("defun");
3715 staticpro (&Qdefun
);
3717 Qand_rest
= intern_c_string ("&rest");
3718 staticpro (&Qand_rest
);
3720 Qand_optional
= intern_c_string ("&optional");
3721 staticpro (&Qand_optional
);
3723 Qclosure
= intern_c_string ("closure");
3724 staticpro (&Qclosure
);
3726 Qdebug
= intern_c_string ("debug");
3727 staticpro (&Qdebug
);
3729 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
3730 doc
: /* *Non-nil means enter debugger if an error is signaled.
3731 Does not apply to errors handled by `condition-case' or those
3732 matched by `debug-ignored-errors'.
3733 If the value is a list, an error only means to enter the debugger
3734 if one of its condition symbols appears in the list.
3735 When you evaluate an expression interactively, this variable
3736 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3737 The command `toggle-debug-on-error' toggles this.
3738 See also the variable `debug-on-quit'. */);
3739 Vdebug_on_error
= Qnil
;
3741 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
3742 doc
: /* *List of errors for which the debugger should not be called.
3743 Each element may be a condition-name or a regexp that matches error messages.
3744 If any element applies to a given error, that error skips the debugger
3745 and just returns to top level.
3746 This overrides the variable `debug-on-error'.
3747 It does not apply to errors handled by `condition-case'. */);
3748 Vdebug_ignored_errors
= Qnil
;
3750 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
3751 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3752 Does not apply if quit is handled by a `condition-case'. */);
3755 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
3756 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3758 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
3759 doc
: /* Non-nil means debugger may continue execution.
3760 This is nil when the debugger is called under circumstances where it
3761 might not be safe to continue. */);
3762 debugger_may_continue
= 1;
3764 DEFVAR_LISP ("debugger", Vdebugger
,
3765 doc
: /* Function to call to invoke debugger.
3766 If due to frame exit, args are `exit' and the value being returned;
3767 this function's value will be returned instead of that.
3768 If due to error, args are `error' and a list of the args to `signal'.
3769 If due to `apply' or `funcall' entry, one arg, `lambda'.
3770 If due to `eval' entry, one arg, t. */);
3773 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
3774 doc
: /* If non-nil, this is a function for `signal' to call.
3775 It receives the same arguments that `signal' was given.
3776 The Edebug package uses this to regain control. */);
3777 Vsignal_hook_function
= Qnil
;
3779 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
3780 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3781 Note that `debug-on-error', `debug-on-quit' and friends
3782 still determine whether to handle the particular condition. */);
3783 Vdebug_on_signal
= Qnil
;
3785 DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function
,
3786 doc
: /* Function to process declarations in a macro definition.
3787 The function will be called with two args MACRO and DECL.
3788 MACRO is the name of the macro being defined.
3789 DECL is a list `(declare ...)' containing the declarations.
3790 The value the function returns is not used. */);
3791 Vmacro_declaration_function
= Qnil
;
3793 /* When lexical binding is being used,
3794 vinternal_interpreter_environment is non-nil, and contains an alist
3795 of lexically-bound variable, or (t), indicating an empty
3796 environment. The lisp name of this variable would be
3797 `internal-interpreter-environment' if it weren't hidden.
3798 Every element of this list can be either a cons (VAR . VAL)
3799 specifying a lexical binding, or a single symbol VAR indicating
3800 that this variable should use dynamic scoping. */
3801 Qinternal_interpreter_environment
3802 = intern_c_string ("internal-interpreter-environment");
3803 staticpro (&Qinternal_interpreter_environment
);
3804 DEFVAR_LISP ("internal-interpreter-environment",
3805 Vinternal_interpreter_environment
,
3806 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3807 When lexical binding is not being used, this variable is nil.
3808 A value of `(t)' indicates an empty environment, otherwise it is an
3809 alist of active lexical bindings. */);
3810 Vinternal_interpreter_environment
= Qnil
;
3811 /* Don't export this variable to Elisp, so noone can mess with it
3812 (Just imagine if someone makes it buffer-local). */
3813 Funintern (Qinternal_interpreter_environment
, Qnil
);
3815 Vrun_hooks
= intern_c_string ("run-hooks");
3816 staticpro (&Vrun_hooks
);
3818 staticpro (&Vautoload_queue
);
3819 Vautoload_queue
= Qnil
;
3820 staticpro (&Vsignaling_function
);
3821 Vsignaling_function
= Qnil
;
3832 defsubr (&Sfunction
);
3834 defsubr (&Sdefmacro
);
3836 defsubr (&Sdefvaralias
);
3837 defsubr (&Sdefconst
);
3838 defsubr (&Suser_variable_p
);
3842 defsubr (&Smacroexpand
);
3845 defsubr (&Sunwind_protect
);
3846 defsubr (&Scondition_case
);
3848 defsubr (&Sinteractive_p
);
3849 defsubr (&Scalled_interactively_p
);
3850 defsubr (&Scommandp
);
3851 defsubr (&Sautoload
);
3854 defsubr (&Sfuncall
);
3855 defsubr (&Srun_hooks
);
3856 defsubr (&Srun_hook_with_args
);
3857 defsubr (&Srun_hook_with_args_until_success
);
3858 defsubr (&Srun_hook_with_args_until_failure
);
3859 defsubr (&Srun_hook_wrapped
);
3860 defsubr (&Sfetch_bytecode
);
3861 defsubr (&Sbacktrace_debug
);
3862 defsubr (&Sbacktrace
);
3863 defsubr (&Sbacktrace_frame
);
3864 defsubr (&Sspecial_variable_p
);
3865 defsubr (&Sfunctionp
);