1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include "blockinput.h"
28 #include "dispextern.h"
31 /* This definition is duplicated in alloc.c and keyboard.c */
32 /* Putting it in lisp.h makes cc bomb out! */
36 struct backtrace
*next
;
37 Lisp_Object
*function
;
38 Lisp_Object
*args
; /* Points to vector of args. */
39 int nargs
; /* Length of vector.
40 If nargs is UNEVALLED, args points to slot holding
41 list of unevalled args */
43 /* Nonzero means call value of debugger when done with this operation. */
47 struct backtrace
*backtrace_list
;
49 /* This structure helps implement the `catch' and `throw' control
50 structure. A struct catchtag contains all the information needed
51 to restore the state of the interpreter after a non-local jump.
53 Handlers for error conditions (represented by `struct handler'
54 structures) just point to a catch tag to do the cleanup required
57 catchtag structures are chained together in the C calling stack;
58 the `next' member points to the next outer catchtag.
60 A call like (throw TAG VAL) searches for a catchtag whose `tag'
61 member is TAG, and then unbinds to it. The `val' member is used to
62 hold VAL while the stack is unwound; `val' is returned as the value
65 All the other members are concerned with restoring the interpreter
72 struct catchtag
*next
;
75 struct backtrace
*backlist
;
76 struct handler
*handlerlist
;
79 int poll_suppress_count
;
80 struct byte_stack
*byte_stack
;
83 struct catchtag
*catchlist
;
86 /* Count levels of GCPRO to detect failure to UNGCPRO. */
90 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
91 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
92 Lisp_Object Qmocklisp_arguments
, Vmocklisp_arguments
, Qmocklisp
;
93 Lisp_Object Qand_rest
, Qand_optional
;
94 Lisp_Object Qdebug_on_error
;
96 /* This holds either the symbol `run-hooks' or nil.
97 It is nil at an early stage of startup, and when Emacs
100 Lisp_Object Vrun_hooks
;
102 /* Non-nil means record all fset's and provide's, to be undone
103 if the file being autoloaded is not fully loaded.
104 They are recorded by being consed onto the front of Vautoload_queue:
105 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
107 Lisp_Object Vautoload_queue
;
109 /* Current number of specbindings allocated in specpdl. */
113 /* Pointer to beginning of specpdl. */
115 struct specbinding
*specpdl
;
117 /* Pointer to first unused element in specpdl. */
119 struct specbinding
*specpdl_ptr
;
121 /* Maximum size allowed for specpdl allocation */
123 int max_specpdl_size
;
125 /* Depth in Lisp evaluations and function calls. */
129 /* Maximum allowed depth in Lisp evaluations and function calls. */
131 int max_lisp_eval_depth
;
133 /* Nonzero means enter debugger before next function call */
135 int debug_on_next_call
;
137 /* Non-zero means debuffer may continue. This is zero when the
138 debugger is called during redisplay, where it might not be safe to
139 continue the interrupted redisplay. */
141 int debugger_may_continue
;
143 /* List of conditions (non-nil atom means all) which cause a backtrace
144 if an error is handled by the command loop's error handler. */
146 Lisp_Object Vstack_trace_on_error
;
148 /* List of conditions (non-nil atom means all) which enter the debugger
149 if an error is handled by the command loop's error handler. */
151 Lisp_Object Vdebug_on_error
;
153 /* List of conditions and regexps specifying error messages which
154 do not enter the debugger even if Vdebug_on_errors says they should. */
156 Lisp_Object Vdebug_ignored_errors
;
158 /* Non-nil means call the debugger even if the error will be handled. */
160 Lisp_Object Vdebug_on_signal
;
162 /* Hook for edebug to use. */
164 Lisp_Object Vsignal_hook_function
;
166 /* Nonzero means enter debugger if a quit signal
167 is handled by the command loop's error handler. */
171 /* The value of num_nonmacro_input_events as of the last time we
172 started to enter the debugger. If we decide to enter the debugger
173 again when this is still equal to num_nonmacro_input_events, then we
174 know that the debugger itself has an error, and we should just
175 signal the error instead of entering an infinite loop of debugger
178 int when_entered_debugger
;
180 Lisp_Object Vdebugger
;
182 /* The function from which the last `signal' was called. Set in
185 Lisp_Object Vsignaling_function
;
187 /* Set to non-zero while processing X events. Checked in Feval to
188 make sure the Lisp interpreter isn't called from a signal handler,
189 which is unsafe because the interpreter isn't reentrant. */
193 void specbind (), record_unwind_protect ();
195 Lisp_Object
run_hook_with_args ();
197 Lisp_Object
funcall_lambda ();
198 extern Lisp_Object
ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
204 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
205 specpdl_ptr
= specpdl
;
206 max_specpdl_size
= 600;
207 max_lisp_eval_depth
= 300;
215 specpdl_ptr
= specpdl
;
220 debug_on_next_call
= 0;
225 /* This is less than the initial value of num_nonmacro_input_events. */
226 when_entered_debugger
= -1;
233 int debug_while_redisplaying
;
234 int count
= specpdl_ptr
- specpdl
;
237 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
238 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
240 if (specpdl_size
+ 40 > max_specpdl_size
)
241 max_specpdl_size
= specpdl_size
+ 40;
243 #ifdef HAVE_X_WINDOWS
244 if (display_hourglass_p
)
248 debug_on_next_call
= 0;
249 when_entered_debugger
= num_nonmacro_input_events
;
251 /* Resetting redisplaying_p to 0 makes sure that debug output is
252 displayed if the debugger is invoked during redisplay. */
253 debug_while_redisplaying
= redisplaying_p
;
255 specbind (intern ("debugger-may-continue"),
256 debug_while_redisplaying
? Qnil
: Qt
);
257 specbind (Qinhibit_redisplay
, Qnil
);
259 #if 0 /* Binding this prevents execution of Lisp code during
260 redisplay, which necessarily leads to display problems. */
261 specbind (Qinhibit_eval_during_redisplay
, Qt
);
264 val
= apply1 (Vdebugger
, arg
);
266 /* Interrupting redisplay and resuming it later is not safe under
267 all circumstances. So, when the debugger returns, abort the
268 interupted redisplay by going back to the top-level. */
269 if (debug_while_redisplaying
)
272 return unbind_to (count
, val
);
276 do_debug_on_call (code
)
279 debug_on_next_call
= 0;
280 backtrace_list
->debug_on_exit
= 1;
281 call_debugger (Fcons (code
, Qnil
));
284 /* NOTE!!! Every function that can call EVAL must protect its args
285 and temporaries from garbage collection while it needs them.
286 The definition of `For' shows what you have to do. */
288 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
289 "Eval args until one of them yields non-nil, then return that value.\n\
290 The remaining args are not evalled at all.\n\
291 If all args return nil, return nil.")
295 register Lisp_Object val
;
296 Lisp_Object args_left
;
307 val
= Feval (Fcar (args_left
));
310 args_left
= Fcdr (args_left
);
312 while (!NILP(args_left
));
318 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
319 "Eval args until one of them yields nil, then return nil.\n\
320 The remaining args are not evalled at all.\n\
321 If no arg yields nil, return the last arg's value.")
325 register Lisp_Object val
;
326 Lisp_Object args_left
;
337 val
= Feval (Fcar (args_left
));
340 args_left
= Fcdr (args_left
);
342 while (!NILP(args_left
));
348 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
349 "If COND yields non-nil, do THEN, else do ELSE...\n\
350 Returns the value of THEN or the value of the last of the ELSE's.\n\
351 THEN must be one expression, but ELSE... can be zero or more expressions.\n\
352 If COND yields nil, and there are no ELSE's, the value is nil.")
356 register Lisp_Object cond
;
360 cond
= Feval (Fcar (args
));
364 return Feval (Fcar (Fcdr (args
)));
365 return Fprogn (Fcdr (Fcdr (args
)));
368 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
369 "Try each clause until one succeeds.\n\
370 Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\
371 and, if the value is non-nil, this clause succeeds:\n\
372 then the expressions in BODY are evaluated and the last one's\n\
373 value is the value of the cond-form.\n\
374 If no clause succeeds, cond returns nil.\n\
375 If a clause has one element, as in (CONDITION),\n\
376 CONDITION's value if non-nil is returned from the cond-form.")
380 register Lisp_Object clause
, val
;
387 clause
= Fcar (args
);
388 val
= Feval (Fcar (clause
));
391 if (!EQ (XCDR (clause
), Qnil
))
392 val
= Fprogn (XCDR (clause
));
402 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
403 "Eval BODY forms sequentially and return value of last one.")
407 register Lisp_Object val
, tem
;
408 Lisp_Object args_left
;
411 /* In Mocklisp code, symbols at the front of the progn arglist
412 are to be bound to zero. */
413 if (!EQ (Vmocklisp_arguments
, Qt
))
415 val
= make_number (0);
416 while (!NILP (args
) && (tem
= Fcar (args
), SYMBOLP (tem
)))
419 specbind (tem
, val
), args
= Fcdr (args
);
431 val
= Feval (Fcar (args_left
));
432 args_left
= Fcdr (args_left
);
434 while (!NILP(args_left
));
440 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
441 "Eval FIRST and BODY sequentially; value from FIRST.\n\
442 The value of FIRST is saved during the evaluation of the remaining args,\n\
443 whose values are discarded.")
448 register Lisp_Object args_left
;
449 struct gcpro gcpro1
, gcpro2
;
450 register int argnum
= 0;
462 val
= Feval (Fcar (args_left
));
464 Feval (Fcar (args_left
));
465 args_left
= Fcdr (args_left
);
467 while (!NILP(args_left
));
473 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
474 "Eval X, Y and BODY sequentially; value from Y.\n\
475 The value of Y is saved during the evaluation of the remaining args,\n\
476 whose values are discarded.")
481 register Lisp_Object args_left
;
482 struct gcpro gcpro1
, gcpro2
;
483 register int argnum
= -1;
497 val
= Feval (Fcar (args_left
));
499 Feval (Fcar (args_left
));
500 args_left
= Fcdr (args_left
);
502 while (!NILP (args_left
));
508 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
509 "Set each SYM to the value of its VAL.\n\
510 The symbols SYM are variables; they are literal (not evaluated).\n\
511 The values VAL are expressions; they are evaluated.\n\
512 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\
513 The second VAL is not computed until after the first SYM is set, and so on;\n\
514 each VAL can use the new value of variables set earlier in the `setq'.\n\
515 The return value of the `setq' form is the value of the last VAL.")
519 register Lisp_Object args_left
;
520 register Lisp_Object val
, sym
;
531 val
= Feval (Fcar (Fcdr (args_left
)));
532 sym
= Fcar (args_left
);
534 args_left
= Fcdr (Fcdr (args_left
));
536 while (!NILP(args_left
));
542 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
543 "Return the argument, without evaluating it. `(quote x)' yields `x'.")
550 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
551 "Like `quote', but preferred for objects which are functions.\n\
552 In byte compilation, `function' causes its argument to be compiled.\n\
553 `quote' cannot do that.")
561 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
562 "Return t if function in which this appears was called interactively.\n\
563 This means that the function was called with call-interactively (which\n\
564 includes being called as the binding of a key)\n\
565 and input is currently coming from the keyboard (not in keyboard macro).")
568 return interactive_p (1) ? Qt
: Qnil
;
572 /* Return 1 if function in which this appears was called
573 interactively. This means that the function was called with
574 call-interactively (which includes being called as the binding of
575 a key) and input is currently coming from the keyboard (not in
578 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
579 called is a built-in. */
582 interactive_p (exclude_subrs_p
)
585 struct backtrace
*btp
;
591 btp
= backtrace_list
;
593 /* If this isn't a byte-compiled function, there may be a frame at
594 the top for Finteractive_p. If so, skip it. */
595 fun
= Findirect_function (*btp
->function
);
596 if (SUBRP (fun
) && XSUBR (fun
) == &Sinteractive_p
)
599 /* If we're running an Emacs 18-style byte-compiled function, there
600 may be a frame for Fbytecode. Now, given the strictest
601 definition, this function isn't really being called
602 interactively, but because that's the way Emacs 18 always builds
603 byte-compiled functions, we'll accept it for now. */
604 if (EQ (*btp
->function
, Qbytecode
))
607 /* If this isn't a byte-compiled function, then we may now be
608 looking at several frames for special forms. Skip past them. */
610 btp
->nargs
== UNEVALLED
)
613 /* btp now points at the frame of the innermost function that isn't
614 a special form, ignoring frames for Finteractive_p and/or
615 Fbytecode at the top. If this frame is for a built-in function
616 (such as load or eval-region) return nil. */
617 fun
= Findirect_function (*btp
->function
);
618 if (exclude_subrs_p
&& SUBRP (fun
))
621 /* btp points to the frame of a Lisp function that called interactive-p.
622 Return t if that function was called interactively. */
623 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
629 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
630 "Define NAME as a function.\n\
631 The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
632 See also the function `interactive'.")
636 register Lisp_Object fn_name
;
637 register Lisp_Object defn
;
639 fn_name
= Fcar (args
);
640 defn
= Fcons (Qlambda
, Fcdr (args
));
641 if (!NILP (Vpurify_flag
))
642 defn
= Fpurecopy (defn
);
643 Ffset (fn_name
, defn
);
644 LOADHIST_ATTACH (fn_name
);
648 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
649 "Define NAME as a macro.\n\
650 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
651 When the macro is called, as in (NAME ARGS...),\n\
652 the function (lambda ARGLIST BODY...) is applied to\n\
653 the list ARGS... as it appears in the expression,\n\
654 and the result should be a form to be evaluated instead of the original.")
658 register Lisp_Object fn_name
;
659 register Lisp_Object defn
;
661 fn_name
= Fcar (args
);
662 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
663 if (!NILP (Vpurify_flag
))
664 defn
= Fpurecopy (defn
);
665 Ffset (fn_name
, defn
);
666 LOADHIST_ATTACH (fn_name
);
671 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 2, 0,
672 "Make SYMBOL a variable alias for symbol ALIASED.\n\
673 Setting the value of SYMBOL will subsequently set the value of ALIASED,\n\
674 and getting the value of SYMBOL will return the value ALIASED has.\n\
675 ALIASED nil means remove the alias; SYMBOL is unbound after that.")
677 Lisp_Object symbol
, aliased
;
679 struct Lisp_Symbol
*sym
;
681 CHECK_SYMBOL (symbol
, 0);
682 CHECK_SYMBOL (aliased
, 1);
684 if (SYMBOL_CONSTANT_P (symbol
))
685 error ("Cannot make a constant an alias");
687 sym
= XSYMBOL (symbol
);
688 sym
->indirect_variable
= 1;
689 sym
->value
= aliased
;
690 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
691 LOADHIST_ATTACH (symbol
);
697 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
698 "Define SYMBOL as a variable.\n\
699 You are not required to define a variable in order to use it,\n\
700 but the definition can supply documentation and an initial value\n\
701 in a way that tags can recognize.\n\n\
702 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
703 If SYMBOL is buffer-local, its default value is what is set;\n\
704 buffer-local values are not affected.\n\
705 INITVALUE and DOCSTRING are optional.\n\
706 If DOCSTRING starts with *, this variable is identified as a user option.\n\
707 This means that M-x set-variable recognizes it.\n\
708 See also `user-variable-p'.\n\
709 If INITVALUE is missing, SYMBOL's value is not set.")
713 register Lisp_Object sym
, tem
, tail
;
717 if (!NILP (Fcdr (Fcdr (tail
))))
718 error ("too many arguments");
720 tem
= Fdefault_boundp (sym
);
724 Fset_default (sym
, Feval (Fcar (tail
)));
726 if (!NILP (Fcar (tail
)))
729 if (!NILP (Vpurify_flag
))
730 tem
= Fpurecopy (tem
);
731 Fput (sym
, Qvariable_documentation
, tem
);
733 LOADHIST_ATTACH (sym
);
736 /* A (defvar <var>) should not take precedence in the load-history over
737 an earlier (defvar <var> <val>), so only add to history if the default
738 value is still unbound. */
740 LOADHIST_ATTACH (sym
);
745 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
746 "Define SYMBOL as a constant variable.\n\
747 The intent is that neither programs nor users should ever change this value.\n\
748 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
749 If SYMBOL is buffer-local, its default value is what is set;\n\
750 buffer-local values are not affected.\n\
751 DOCSTRING is optional.")
755 register Lisp_Object sym
, tem
;
758 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
759 error ("too many arguments");
761 tem
= Feval (Fcar (Fcdr (args
)));
762 if (!NILP (Vpurify_flag
))
763 tem
= Fpurecopy (tem
);
764 Fset_default (sym
, tem
);
765 tem
= Fcar (Fcdr (Fcdr (args
)));
768 if (!NILP (Vpurify_flag
))
769 tem
= Fpurecopy (tem
);
770 Fput (sym
, Qvariable_documentation
, tem
);
772 LOADHIST_ATTACH (sym
);
776 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
777 "Returns t if VARIABLE is intended to be set and modified by users.\n\
778 \(The alternative is a variable used internally in a Lisp program.)\n\
779 Determined by whether the first character of the documentation\n\
780 for the variable is `*' or if the variable is customizable (has a non-nil\n\
781 value of any of `custom-type', `custom-loads' or `standard-value'\n\
782 on its property list).")
784 Lisp_Object variable
;
786 Lisp_Object documentation
;
788 if (!SYMBOLP (variable
))
791 documentation
= Fget (variable
, Qvariable_documentation
);
792 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
794 if (STRINGP (documentation
)
795 && ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
797 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
798 if (CONSP (documentation
)
799 && STRINGP (XCAR (documentation
))
800 && INTEGERP (XCDR (documentation
))
801 && XINT (XCDR (documentation
)) < 0)
804 if ((!NILP (Fget (variable
, intern ("custom-type"))))
805 || (!NILP (Fget (variable
, intern ("custom-loads"))))
806 || (!NILP (Fget (variable
, intern ("standard-value")))))
811 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
812 "Bind variables according to VARLIST then eval BODY.\n\
813 The value of the last form in BODY is returned.\n\
814 Each element of VARLIST is a symbol (which is bound to nil)\n\
815 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
816 Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
820 Lisp_Object varlist
, val
, elt
;
821 int count
= specpdl_ptr
- specpdl
;
822 struct gcpro gcpro1
, gcpro2
, gcpro3
;
824 GCPRO3 (args
, elt
, varlist
);
826 varlist
= Fcar (args
);
827 while (!NILP (varlist
))
830 elt
= Fcar (varlist
);
832 specbind (elt
, Qnil
);
833 else if (! NILP (Fcdr (Fcdr (elt
))))
835 Fcons (build_string ("`let' bindings can have only one value-form"),
839 val
= Feval (Fcar (Fcdr (elt
)));
840 specbind (Fcar (elt
), val
);
842 varlist
= Fcdr (varlist
);
845 val
= Fprogn (Fcdr (args
));
846 return unbind_to (count
, val
);
849 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
850 "Bind variables according to VARLIST then eval BODY.\n\
851 The value of the last form in BODY is returned.\n\
852 Each element of VARLIST is a symbol (which is bound to nil)\n\
853 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
854 All the VALUEFORMs are evalled before any symbols are bound.")
858 Lisp_Object
*temps
, tem
;
859 register Lisp_Object elt
, varlist
;
860 int count
= specpdl_ptr
- specpdl
;
862 struct gcpro gcpro1
, gcpro2
;
864 varlist
= Fcar (args
);
866 /* Make space to hold the values to give the bound variables */
867 elt
= Flength (varlist
);
868 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
870 /* Compute the values and store them in `temps' */
872 GCPRO2 (args
, *temps
);
875 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
878 elt
= Fcar (varlist
);
880 temps
[argnum
++] = Qnil
;
881 else if (! NILP (Fcdr (Fcdr (elt
))))
883 Fcons (build_string ("`let' bindings can have only one value-form"),
886 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
887 gcpro2
.nvars
= argnum
;
891 varlist
= Fcar (args
);
892 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
894 elt
= Fcar (varlist
);
895 tem
= temps
[argnum
++];
899 specbind (Fcar (elt
), tem
);
902 elt
= Fprogn (Fcdr (args
));
903 return unbind_to (count
, elt
);
906 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
907 "If TEST yields non-nil, eval BODY... and repeat.\n\
908 The order of execution is thus TEST, BODY, TEST, BODY and so on\n\
909 until TEST returns nil.")
913 Lisp_Object test
, body
, tem
;
914 struct gcpro gcpro1
, gcpro2
;
920 while (tem
= Feval (test
),
921 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
931 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
932 "Return result of expanding macros at top level of FORM.\n\
933 If FORM is not a macro call, it is returned unchanged.\n\
934 Otherwise, the macro is expanded and the expansion is considered\n\
935 in place of FORM. When a non-macro-call results, it is returned.\n\n\
936 The second optional arg ENVIRONMENT specifies an environment of macro\n\
937 definitions to shadow the loaded ones for use in file byte-compilation.")
940 Lisp_Object environment
;
942 /* With cleanups from Hallvard Furuseth. */
943 register Lisp_Object expander
, sym
, def
, tem
;
947 /* Come back here each time we expand a macro call,
948 in case it expands into another macro call. */
951 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
952 def
= sym
= XCAR (form
);
954 /* Trace symbols aliases to other symbols
955 until we get a symbol that is not an alias. */
956 while (SYMBOLP (def
))
960 tem
= Fassq (sym
, environment
);
963 def
= XSYMBOL (sym
)->function
;
964 if (!EQ (def
, Qunbound
))
969 /* Right now TEM is the result from SYM in ENVIRONMENT,
970 and if TEM is nil then DEF is SYM's function definition. */
973 /* SYM is not mentioned in ENVIRONMENT.
974 Look at its function definition. */
975 if (EQ (def
, Qunbound
) || !CONSP (def
))
976 /* Not defined or definition not suitable */
978 if (EQ (XCAR (def
), Qautoload
))
980 /* Autoloading function: will it be a macro when loaded? */
981 tem
= Fnth (make_number (4), def
);
982 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
983 /* Yes, load it and try again. */
987 do_autoload (def
, sym
);
994 else if (!EQ (XCAR (def
), Qmacro
))
996 else expander
= XCDR (def
);
1000 expander
= XCDR (tem
);
1001 if (NILP (expander
))
1004 form
= apply1 (expander
, XCDR (form
));
1009 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1010 "Eval BODY allowing nonlocal exits using `throw'.\n\
1011 TAG is evalled to get the tag to use; it must not be nil.\n\
1013 Then the BODY is executed.\n\
1014 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
1015 If no throw happens, `catch' returns the value of the last BODY form.\n\
1016 If a throw happens, it specifies the value to return from `catch'.")
1020 register Lisp_Object tag
;
1021 struct gcpro gcpro1
;
1024 tag
= Feval (Fcar (args
));
1026 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1029 /* Set up a catch, then call C function FUNC on argument ARG.
1030 FUNC should return a Lisp_Object.
1031 This is how catches are done from within C code. */
1034 internal_catch (tag
, func
, arg
)
1036 Lisp_Object (*func
) ();
1039 /* This structure is made part of the chain `catchlist'. */
1042 /* Fill in the components of c, and put it on the list. */
1046 c
.backlist
= backtrace_list
;
1047 c
.handlerlist
= handlerlist
;
1048 c
.lisp_eval_depth
= lisp_eval_depth
;
1049 c
.pdlcount
= specpdl_ptr
- specpdl
;
1050 c
.poll_suppress_count
= poll_suppress_count
;
1051 c
.gcpro
= gcprolist
;
1052 c
.byte_stack
= byte_stack_list
;
1056 if (! _setjmp (c
.jmp
))
1057 c
.val
= (*func
) (arg
);
1059 /* Throw works by a longjmp that comes right here. */
1064 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1065 jump to that CATCH, returning VALUE as the value of that catch.
1067 This is the guts Fthrow and Fsignal; they differ only in the way
1068 they choose the catch tag to throw to. A catch tag for a
1069 condition-case form has a TAG of Qnil.
1071 Before each catch is discarded, unbind all special bindings and
1072 execute all unwind-protect clauses made above that catch. Unwind
1073 the handler stack as we go, so that the proper handlers are in
1074 effect for each unwind-protect clause we run. At the end, restore
1075 some static info saved in CATCH, and longjmp to the location
1078 This is used for correct unwinding in Fthrow and Fsignal. */
1081 unwind_to_catch (catch, value
)
1082 struct catchtag
*catch;
1085 register int last_time
;
1087 /* Save the value in the tag. */
1090 /* Restore the polling-suppression count. */
1091 set_poll_suppress_count (catch->poll_suppress_count
);
1095 last_time
= catchlist
== catch;
1097 /* Unwind the specpdl stack, and then restore the proper set of
1099 unbind_to (catchlist
->pdlcount
, Qnil
);
1100 handlerlist
= catchlist
->handlerlist
;
1101 catchlist
= catchlist
->next
;
1103 while (! last_time
);
1105 byte_stack_list
= catch->byte_stack
;
1106 gcprolist
= catch->gcpro
;
1109 gcpro_level
= gcprolist
->level
+ 1;
1113 backtrace_list
= catch->backlist
;
1114 lisp_eval_depth
= catch->lisp_eval_depth
;
1116 _longjmp (catch->jmp
, 1);
1119 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1120 "Throw to the catch for TAG and return VALUE from it.\n\
1121 Both TAG and VALUE are evalled.")
1123 register Lisp_Object tag
, value
;
1125 register struct catchtag
*c
;
1130 for (c
= catchlist
; c
; c
= c
->next
)
1132 if (EQ (c
->tag
, tag
))
1133 unwind_to_catch (c
, value
);
1135 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1140 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1141 "Do BODYFORM, protecting with UNWINDFORMS.\n\
1142 If BODYFORM completes normally, its value is returned\n\
1143 after executing the UNWINDFORMS.\n\
1144 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
1149 int count
= specpdl_ptr
- specpdl
;
1151 record_unwind_protect (0, Fcdr (args
));
1152 val
= Feval (Fcar (args
));
1153 return unbind_to (count
, val
);
1156 /* Chain of condition handlers currently in effect.
1157 The elements of this chain are contained in the stack frames
1158 of Fcondition_case and internal_condition_case.
1159 When an error is signaled (by calling Fsignal, below),
1160 this chain is searched for an element that applies. */
1162 struct handler
*handlerlist
;
1164 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1165 "Regain control when an error is signaled.\n\
1166 executes BODYFORM and returns its value if no error happens.\n\
1167 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
1168 where the BODY is made of Lisp expressions.\n\n\
1169 A handler is applicable to an error\n\
1170 if CONDITION-NAME is one of the error's condition names.\n\
1171 If an error happens, the first applicable handler is run.\n\
1173 The car of a handler may be a list of condition names\n\
1174 instead of a single condition name.\n\
1176 When a handler handles an error,\n\
1177 control returns to the condition-case and the handler BODY... is executed\n\
1178 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
1179 VAR may be nil; then you do not get access to the signal information.\n\
1181 The value of the last BODY form is returned from the condition-case.\n\
1182 See also the function `signal' for more info.")
1189 register Lisp_Object bodyform
, handlers
;
1190 volatile Lisp_Object var
;
1193 bodyform
= Fcar (Fcdr (args
));
1194 handlers
= Fcdr (Fcdr (args
));
1195 CHECK_SYMBOL (var
, 0);
1197 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1203 && (SYMBOLP (XCAR (tem
))
1204 || CONSP (XCAR (tem
))))))
1205 error ("Invalid condition handler", tem
);
1210 c
.backlist
= backtrace_list
;
1211 c
.handlerlist
= handlerlist
;
1212 c
.lisp_eval_depth
= lisp_eval_depth
;
1213 c
.pdlcount
= specpdl_ptr
- specpdl
;
1214 c
.poll_suppress_count
= poll_suppress_count
;
1215 c
.gcpro
= gcprolist
;
1216 c
.byte_stack
= byte_stack_list
;
1217 if (_setjmp (c
.jmp
))
1220 specbind (h
.var
, c
.val
);
1221 val
= Fprogn (Fcdr (h
.chosen_clause
));
1223 /* Note that this just undoes the binding of h.var; whoever
1224 longjumped to us unwound the stack to c.pdlcount before
1226 unbind_to (c
.pdlcount
, Qnil
);
1233 h
.handler
= handlers
;
1234 h
.next
= handlerlist
;
1238 val
= Feval (bodyform
);
1240 handlerlist
= h
.next
;
1244 /* Call the function BFUN with no arguments, catching errors within it
1245 according to HANDLERS. If there is an error, call HFUN with
1246 one argument which is the data that describes the error:
1249 HANDLERS can be a list of conditions to catch.
1250 If HANDLERS is Qt, catch all errors.
1251 If HANDLERS is Qerror, catch all errors
1252 but allow the debugger to run if that is enabled. */
1255 internal_condition_case (bfun
, handlers
, hfun
)
1256 Lisp_Object (*bfun
) ();
1257 Lisp_Object handlers
;
1258 Lisp_Object (*hfun
) ();
1264 #if 0 /* Can't do this check anymore because realize_basic_faces has
1265 to BLOCK_INPUT, and can call Lisp. What's really needed is a
1266 flag indicating that we're currently handling a signal. */
1267 /* Since Fsignal resets this to 0, it had better be 0 now
1268 or else we have a potential bug. */
1269 if (interrupt_input_blocked
!= 0)
1275 c
.backlist
= backtrace_list
;
1276 c
.handlerlist
= handlerlist
;
1277 c
.lisp_eval_depth
= lisp_eval_depth
;
1278 c
.pdlcount
= specpdl_ptr
- specpdl
;
1279 c
.poll_suppress_count
= poll_suppress_count
;
1280 c
.gcpro
= gcprolist
;
1281 c
.byte_stack
= byte_stack_list
;
1282 if (_setjmp (c
.jmp
))
1284 return (*hfun
) (c
.val
);
1288 h
.handler
= handlers
;
1290 h
.next
= handlerlist
;
1296 handlerlist
= h
.next
;
1300 /* Like internal_condition_case but call HFUN with ARG as its argument. */
1303 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1304 Lisp_Object (*bfun
) ();
1306 Lisp_Object handlers
;
1307 Lisp_Object (*hfun
) ();
1315 c
.backlist
= backtrace_list
;
1316 c
.handlerlist
= handlerlist
;
1317 c
.lisp_eval_depth
= lisp_eval_depth
;
1318 c
.pdlcount
= specpdl_ptr
- specpdl
;
1319 c
.poll_suppress_count
= poll_suppress_count
;
1320 c
.gcpro
= gcprolist
;
1321 c
.byte_stack
= byte_stack_list
;
1322 if (_setjmp (c
.jmp
))
1324 return (*hfun
) (c
.val
);
1328 h
.handler
= handlers
;
1330 h
.next
= handlerlist
;
1334 val
= (*bfun
) (arg
);
1336 handlerlist
= h
.next
;
1341 /* Like internal_condition_case but call HFUN with NARGS as first,
1342 and ARGS as second argument. */
1345 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1346 Lisp_Object (*bfun
) ();
1349 Lisp_Object handlers
;
1350 Lisp_Object (*hfun
) ();
1358 c
.backlist
= backtrace_list
;
1359 c
.handlerlist
= handlerlist
;
1360 c
.lisp_eval_depth
= lisp_eval_depth
;
1361 c
.pdlcount
= specpdl_ptr
- specpdl
;
1362 c
.poll_suppress_count
= poll_suppress_count
;
1363 c
.gcpro
= gcprolist
;
1364 c
.byte_stack
= byte_stack_list
;
1365 if (_setjmp (c
.jmp
))
1367 return (*hfun
) (c
.val
);
1371 h
.handler
= handlers
;
1373 h
.next
= handlerlist
;
1377 val
= (*bfun
) (nargs
, args
);
1379 handlerlist
= h
.next
;
1384 static Lisp_Object
find_handler_clause ();
1386 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1387 "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
1388 This function does not return.\n\n\
1389 An error symbol is a symbol with an `error-conditions' property\n\
1390 that is a list of condition names.\n\
1391 A handler for any of those names will get to handle this signal.\n\
1392 The symbol `error' should normally be one of them.\n\
1394 DATA should be a list. Its elements are printed as part of the error message.\n\
1395 If the signal is handled, DATA is made available to the handler.\n\
1396 See also the function `condition-case'.")
1397 (error_symbol
, data
)
1398 Lisp_Object error_symbol
, data
;
1400 /* When memory is full, ERROR-SYMBOL is nil,
1401 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). */
1402 register struct handler
*allhandlers
= handlerlist
;
1403 Lisp_Object conditions
;
1404 extern int gc_in_progress
;
1405 extern int waiting_for_input
;
1406 Lisp_Object debugger_value
;
1408 Lisp_Object real_error_symbol
;
1409 extern int display_hourglass_p
;
1410 struct backtrace
*bp
;
1412 immediate_quit
= handling_signal
= 0;
1413 if (gc_in_progress
|| waiting_for_input
)
1416 TOTALLY_UNBLOCK_INPUT
;
1418 if (NILP (error_symbol
))
1419 real_error_symbol
= Fcar (data
);
1421 real_error_symbol
= error_symbol
;
1423 #ifdef HAVE_X_WINDOWS
1424 if (display_hourglass_p
)
1425 cancel_hourglass ();
1428 /* This hook is used by edebug. */
1429 if (! NILP (Vsignal_hook_function
))
1430 call2 (Vsignal_hook_function
, error_symbol
, data
);
1432 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1434 /* Remember from where signal was called. Skip over the frame for
1435 `signal' itself. If a frame for `error' follows, skip that,
1437 Vsignaling_function
= Qnil
;
1440 bp
= backtrace_list
->next
;
1441 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1443 if (bp
&& bp
->function
)
1444 Vsignaling_function
= *bp
->function
;
1447 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1449 register Lisp_Object clause
;
1451 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1452 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1454 if (specpdl_size
+ 40 > max_specpdl_size
)
1455 max_specpdl_size
= specpdl_size
+ 40;
1457 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1458 error_symbol
, data
, &debugger_value
);
1460 #if 0 /* Most callers are not prepared to handle gc if this returns.
1461 So, since this feature is not very useful, take it out. */
1462 /* If have called debugger and user wants to continue,
1464 if (EQ (clause
, Qlambda
))
1465 return debugger_value
;
1467 if (EQ (clause
, Qlambda
))
1469 /* We can't return values to code which signaled an error, but we
1470 can continue code which has signaled a quit. */
1471 if (EQ (real_error_symbol
, Qquit
))
1474 error ("Cannot return from the debugger in an error");
1480 Lisp_Object unwind_data
;
1481 struct handler
*h
= handlerlist
;
1483 handlerlist
= allhandlers
;
1485 if (NILP (error_symbol
))
1488 unwind_data
= Fcons (error_symbol
, data
);
1489 h
->chosen_clause
= clause
;
1490 unwind_to_catch (h
->tag
, unwind_data
);
1494 handlerlist
= allhandlers
;
1495 /* If no handler is present now, try to run the debugger,
1496 and if that fails, throw to top level. */
1497 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1499 Fthrow (Qtop_level
, Qt
);
1501 if (! NILP (error_symbol
))
1502 data
= Fcons (error_symbol
, data
);
1504 string
= Ferror_message_string (data
);
1505 fatal ("%s", XSTRING (string
)->data
, 0);
1508 /* Return nonzero iff LIST is a non-nil atom or
1509 a list containing one of CONDITIONS. */
1512 wants_debugger (list
, conditions
)
1513 Lisp_Object list
, conditions
;
1520 while (CONSP (conditions
))
1522 Lisp_Object
this, tail
;
1523 this = XCAR (conditions
);
1524 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1525 if (EQ (XCAR (tail
), this))
1527 conditions
= XCDR (conditions
);
1532 /* Return 1 if an error with condition-symbols CONDITIONS,
1533 and described by SIGNAL-DATA, should skip the debugger
1534 according to debugger-ignore-errors. */
1537 skip_debugger (conditions
, data
)
1538 Lisp_Object conditions
, data
;
1541 int first_string
= 1;
1542 Lisp_Object error_message
;
1544 error_message
= Qnil
;
1545 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1547 if (STRINGP (XCAR (tail
)))
1551 error_message
= Ferror_message_string (data
);
1555 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1560 Lisp_Object contail
;
1562 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1563 if (EQ (XCAR (tail
), XCAR (contail
)))
1571 /* Value of Qlambda means we have called debugger and user has continued.
1572 There are two ways to pass SIG and DATA:
1573 = SIG is the error symbol, and DATA is the rest of the data.
1574 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1575 This is for memory-full errors only.
1577 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1580 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1581 Lisp_Object handlers
, conditions
, sig
, data
;
1582 Lisp_Object
*debugger_value_ptr
;
1584 register Lisp_Object h
;
1585 register Lisp_Object tem
;
1587 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1589 /* error is used similarly, but means print an error message
1590 and run the debugger if that is enabled. */
1591 if (EQ (handlers
, Qerror
)
1592 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1593 there is a handler. */
1595 int count
= specpdl_ptr
- specpdl
;
1596 int debugger_called
= 0;
1597 Lisp_Object sig_symbol
, combined_data
;
1598 /* This is set to 1 if we are handling a memory-full error,
1599 because these must not run the debugger.
1600 (There is no room in memory to do that!) */
1601 int no_debugger
= 0;
1605 combined_data
= data
;
1606 sig_symbol
= Fcar (data
);
1611 combined_data
= Fcons (sig
, data
);
1615 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1618 internal_with_output_to_temp_buffer ("*Backtrace*",
1619 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1622 internal_with_output_to_temp_buffer ("*Backtrace*",
1627 && (EQ (sig_symbol
, Qquit
)
1629 : wants_debugger (Vdebug_on_error
, conditions
))
1630 && ! skip_debugger (conditions
, combined_data
)
1631 && when_entered_debugger
< num_nonmacro_input_events
)
1633 specbind (Qdebug_on_error
, Qnil
);
1635 = call_debugger (Fcons (Qerror
,
1636 Fcons (combined_data
, Qnil
)));
1637 debugger_called
= 1;
1639 /* If there is no handler, return saying whether we ran the debugger. */
1640 if (EQ (handlers
, Qerror
))
1642 if (debugger_called
)
1643 return unbind_to (count
, Qlambda
);
1647 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1649 Lisp_Object handler
, condit
;
1652 if (!CONSP (handler
))
1654 condit
= Fcar (handler
);
1655 /* Handle a single condition name in handler HANDLER. */
1656 if (SYMBOLP (condit
))
1658 tem
= Fmemq (Fcar (handler
), conditions
);
1662 /* Handle a list of condition names in handler HANDLER. */
1663 else if (CONSP (condit
))
1665 while (CONSP (condit
))
1667 tem
= Fmemq (Fcar (condit
), conditions
);
1670 condit
= XCDR (condit
);
1677 /* dump an error message; called like printf */
1681 error (m
, a1
, a2
, a3
)
1701 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1706 buffer
= (char *) xrealloc (buffer
, size
);
1709 buffer
= (char *) xmalloc (size
);
1714 string
= build_string (buffer
);
1718 Fsignal (Qerror
, Fcons (string
, Qnil
));
1722 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1723 "T if FUNCTION makes provisions for interactive calling.\n\
1724 This means it contains a description for how to read arguments to give it.\n\
1725 The value is nil for an invalid function or a symbol with no function\n\
1728 Interactively callable functions include strings and vectors (treated\n\
1729 as keyboard macros), lambda-expressions that contain a top-level call\n\
1730 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1731 fourth argument, and some of the built-in functions of Lisp.\n\
1733 Also, a symbol satisfies `commandp' if its function definition does so.")
1735 Lisp_Object function
;
1737 register Lisp_Object fun
;
1738 register Lisp_Object funcar
;
1742 fun
= indirect_function (fun
);
1743 if (EQ (fun
, Qunbound
))
1746 /* Emacs primitives are interactive if their DEFUN specifies an
1747 interactive spec. */
1750 if (XSUBR (fun
)->prompt
)
1756 /* Bytecode objects are interactive if they are long enough to
1757 have an element whose index is COMPILED_INTERACTIVE, which is
1758 where the interactive spec is stored. */
1759 else if (COMPILEDP (fun
))
1760 return ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1763 /* Strings and vectors are keyboard macros. */
1764 if (STRINGP (fun
) || VECTORP (fun
))
1767 /* Lists may represent commands. */
1770 funcar
= Fcar (fun
);
1771 if (!SYMBOLP (funcar
))
1772 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1773 if (EQ (funcar
, Qlambda
))
1774 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1775 if (EQ (funcar
, Qmocklisp
))
1776 return Qt
; /* All mocklisp functions can be called interactively */
1777 if (EQ (funcar
, Qautoload
))
1778 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1784 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1785 "Define FUNCTION to autoload from FILE.\n\
1786 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1787 Third arg DOCSTRING is documentation for the function.\n\
1788 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1789 Fifth arg TYPE indicates the type of the object:\n\
1790 nil or omitted says FUNCTION is a function,\n\
1791 `keymap' says FUNCTION is really a keymap, and\n\
1792 `macro' or t says FUNCTION is really a macro.\n\
1793 Third through fifth args give info about the real definition.\n\
1794 They default to nil.\n\
1795 If FUNCTION is already defined other than as an autoload,\n\
1796 this does nothing and returns nil.")
1797 (function
, file
, docstring
, interactive
, type
)
1798 Lisp_Object function
, file
, docstring
, interactive
, type
;
1801 Lisp_Object args
[4];
1804 CHECK_SYMBOL (function
, 0);
1805 CHECK_STRING (file
, 1);
1807 /* If function is defined and not as an autoload, don't override */
1808 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1809 && !(CONSP (XSYMBOL (function
)->function
)
1810 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1813 if (NILP (Vpurify_flag
))
1814 /* Only add entries after dumping, because the ones before are
1815 not useful and else we get loads of them from the loaddefs.el. */
1816 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1820 args
[1] = docstring
;
1821 args
[2] = interactive
;
1824 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1825 #else /* NO_ARG_ARRAY */
1826 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1827 #endif /* not NO_ARG_ARRAY */
1831 un_autoload (oldqueue
)
1832 Lisp_Object oldqueue
;
1834 register Lisp_Object queue
, first
, second
;
1836 /* Queue to unwind is current value of Vautoload_queue.
1837 oldqueue is the shadowed value to leave in Vautoload_queue. */
1838 queue
= Vautoload_queue
;
1839 Vautoload_queue
= oldqueue
;
1840 while (CONSP (queue
))
1842 first
= Fcar (queue
);
1843 second
= Fcdr (first
);
1844 first
= Fcar (first
);
1845 if (EQ (second
, Qnil
))
1848 Ffset (first
, second
);
1849 queue
= Fcdr (queue
);
1854 /* Load an autoloaded function.
1855 FUNNAME is the symbol which is the function's name.
1856 FUNDEF is the autoload definition (a list). */
1859 do_autoload (fundef
, funname
)
1860 Lisp_Object fundef
, funname
;
1862 int count
= specpdl_ptr
- specpdl
;
1863 Lisp_Object fun
, queue
, first
, second
;
1864 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1867 CHECK_SYMBOL (funname
, 0);
1868 GCPRO3 (fun
, funname
, fundef
);
1870 /* Preserve the match data. */
1871 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1873 /* Value saved here is to be restored into Vautoload_queue. */
1874 record_unwind_protect (un_autoload
, Vautoload_queue
);
1875 Vautoload_queue
= Qt
;
1876 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1878 /* Save the old autoloads, in case we ever do an unload. */
1879 queue
= Vautoload_queue
;
1880 while (CONSP (queue
))
1882 first
= Fcar (queue
);
1883 second
= Fcdr (first
);
1884 first
= Fcar (first
);
1886 /* Note: This test is subtle. The cdr of an autoload-queue entry
1887 may be an atom if the autoload entry was generated by a defalias
1890 Fput (first
, Qautoload
, (Fcdr (second
)));
1892 queue
= Fcdr (queue
);
1895 /* Once loading finishes, don't undo it. */
1896 Vautoload_queue
= Qt
;
1897 unbind_to (count
, Qnil
);
1899 fun
= Findirect_function (fun
);
1901 if (!NILP (Fequal (fun
, fundef
)))
1902 error ("Autoloading failed to define function %s",
1903 XSYMBOL (funname
)->name
->data
);
1908 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1909 "Evaluate FORM and return its value.")
1913 Lisp_Object fun
, val
, original_fun
, original_args
;
1915 struct backtrace backtrace
;
1916 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1918 if (handling_signal
)
1923 if (EQ (Vmocklisp_arguments
, Qt
))
1924 return Fsymbol_value (form
);
1925 val
= Fsymbol_value (form
);
1927 XSETFASTINT (val
, 0);
1928 else if (EQ (val
, Qt
))
1929 XSETFASTINT (val
, 1);
1936 if (consing_since_gc
> gc_cons_threshold
)
1939 Fgarbage_collect ();
1943 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1945 if (max_lisp_eval_depth
< 100)
1946 max_lisp_eval_depth
= 100;
1947 if (lisp_eval_depth
> max_lisp_eval_depth
)
1948 error ("Lisp nesting exceeds max-lisp-eval-depth");
1951 original_fun
= Fcar (form
);
1952 original_args
= Fcdr (form
);
1954 backtrace
.next
= backtrace_list
;
1955 backtrace_list
= &backtrace
;
1956 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1957 backtrace
.args
= &original_args
;
1958 backtrace
.nargs
= UNEVALLED
;
1959 backtrace
.evalargs
= 1;
1960 backtrace
.debug_on_exit
= 0;
1962 if (debug_on_next_call
)
1963 do_debug_on_call (Qt
);
1965 /* At this point, only original_fun and original_args
1966 have values that will be used below */
1968 fun
= Findirect_function (original_fun
);
1972 Lisp_Object numargs
;
1973 Lisp_Object argvals
[8];
1974 Lisp_Object args_left
;
1975 register int i
, maxargs
;
1977 args_left
= original_args
;
1978 numargs
= Flength (args_left
);
1980 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1981 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1982 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1984 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1986 backtrace
.evalargs
= 0;
1987 val
= (*XSUBR (fun
)->function
) (args_left
);
1991 if (XSUBR (fun
)->max_args
== MANY
)
1993 /* Pass a vector of evaluated arguments */
1995 register int argnum
= 0;
1997 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1999 GCPRO3 (args_left
, fun
, fun
);
2003 while (!NILP (args_left
))
2005 vals
[argnum
++] = Feval (Fcar (args_left
));
2006 args_left
= Fcdr (args_left
);
2007 gcpro3
.nvars
= argnum
;
2010 backtrace
.args
= vals
;
2011 backtrace
.nargs
= XINT (numargs
);
2013 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2018 GCPRO3 (args_left
, fun
, fun
);
2019 gcpro3
.var
= argvals
;
2022 maxargs
= XSUBR (fun
)->max_args
;
2023 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2025 argvals
[i
] = Feval (Fcar (args_left
));
2031 backtrace
.args
= argvals
;
2032 backtrace
.nargs
= XINT (numargs
);
2037 val
= (*XSUBR (fun
)->function
) ();
2040 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2043 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2046 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2050 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2051 argvals
[2], argvals
[3]);
2054 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2055 argvals
[3], argvals
[4]);
2058 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2059 argvals
[3], argvals
[4], argvals
[5]);
2062 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2063 argvals
[3], argvals
[4], argvals
[5],
2068 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2069 argvals
[3], argvals
[4], argvals
[5],
2070 argvals
[6], argvals
[7]);
2074 /* Someone has created a subr that takes more arguments than
2075 is supported by this code. We need to either rewrite the
2076 subr to use a different argument protocol, or add more
2077 cases to this switch. */
2081 if (COMPILEDP (fun
))
2082 val
= apply_lambda (fun
, original_args
, 1);
2086 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2087 funcar
= Fcar (fun
);
2088 if (!SYMBOLP (funcar
))
2089 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2090 if (EQ (funcar
, Qautoload
))
2092 do_autoload (fun
, original_fun
);
2095 if (EQ (funcar
, Qmacro
))
2096 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2097 else if (EQ (funcar
, Qlambda
))
2098 val
= apply_lambda (fun
, original_args
, 1);
2099 else if (EQ (funcar
, Qmocklisp
))
2100 val
= ml_apply (fun
, original_args
);
2102 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2105 if (!EQ (Vmocklisp_arguments
, Qt
))
2108 XSETFASTINT (val
, 0);
2109 else if (EQ (val
, Qt
))
2110 XSETFASTINT (val
, 1);
2113 if (backtrace
.debug_on_exit
)
2114 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2115 backtrace_list
= backtrace
.next
;
2119 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2120 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
2121 Then return the value FUNCTION returns.\n\
2122 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
2127 register int i
, numargs
;
2128 register Lisp_Object spread_arg
;
2129 register Lisp_Object
*funcall_args
;
2131 struct gcpro gcpro1
;
2135 spread_arg
= args
[nargs
- 1];
2136 CHECK_LIST (spread_arg
, nargs
);
2138 numargs
= XINT (Flength (spread_arg
));
2141 return Ffuncall (nargs
- 1, args
);
2142 else if (numargs
== 1)
2144 args
[nargs
- 1] = XCAR (spread_arg
);
2145 return Ffuncall (nargs
, args
);
2148 numargs
+= nargs
- 2;
2150 fun
= indirect_function (fun
);
2151 if (EQ (fun
, Qunbound
))
2153 /* Let funcall get the error */
2160 if (numargs
< XSUBR (fun
)->min_args
2161 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2162 goto funcall
; /* Let funcall get the error */
2163 else if (XSUBR (fun
)->max_args
> numargs
)
2165 /* Avoid making funcall cons up a yet another new vector of arguments
2166 by explicitly supplying nil's for optional values */
2167 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2168 * sizeof (Lisp_Object
));
2169 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2170 funcall_args
[++i
] = Qnil
;
2171 GCPRO1 (*funcall_args
);
2172 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2176 /* We add 1 to numargs because funcall_args includes the
2177 function itself as well as its arguments. */
2180 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2181 * sizeof (Lisp_Object
));
2182 GCPRO1 (*funcall_args
);
2183 gcpro1
.nvars
= 1 + numargs
;
2186 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2187 /* Spread the last arg we got. Its first element goes in
2188 the slot that it used to occupy, hence this value of I. */
2190 while (!NILP (spread_arg
))
2192 funcall_args
[i
++] = XCAR (spread_arg
);
2193 spread_arg
= XCDR (spread_arg
);
2196 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2199 /* Run hook variables in various ways. */
2201 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2203 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2204 "Run each hook in HOOKS. Major mode functions use this.\n\
2205 Each argument should be a symbol, a hook variable.\n\
2206 These symbols are processed in the order specified.\n\
2207 If a hook symbol has a non-nil value, that value may be a function\n\
2208 or a list of functions to be called to run the hook.\n\
2209 If the value is a function, it is called with no arguments.\n\
2210 If it is a list, the elements are called, in order, with no arguments.\n\
2212 To make a hook variable buffer-local, use `make-local-hook',\n\
2213 not `make-local-variable'.")
2218 Lisp_Object hook
[1];
2221 for (i
= 0; i
< nargs
; i
++)
2224 run_hook_with_args (1, hook
, to_completion
);
2230 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2231 Srun_hook_with_args
, 1, MANY
, 0,
2232 "Run HOOK with the specified arguments ARGS.\n\
2233 HOOK should be a symbol, a hook variable. If HOOK has a non-nil\n\
2234 value, that value may be a function or a list of functions to be\n\
2235 called to run the hook. If the value is a function, it is called with\n\
2236 the given arguments and its return value is returned. If it is a list\n\
2237 of functions, those functions are called, in order,\n\
2238 with the given arguments ARGS.\n\
2239 It is best not to depend on the value return by `run-hook-with-args',\n\
2240 as that may change.\n\
2242 To make a hook variable buffer-local, use `make-local-hook',\n\
2243 not `make-local-variable'.")
2248 return run_hook_with_args (nargs
, args
, to_completion
);
2251 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2252 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2253 "Run HOOK with the specified arguments ARGS.\n\
2254 HOOK should be a symbol, a hook variable. Its value should\n\
2255 be a list of functions. We call those functions, one by one,\n\
2256 passing arguments ARGS to each of them, until one of them\n\
2257 returns a non-nil value. Then we return that value.\n\
2258 If all the functions return nil, we return nil.\n\
2260 To make a hook variable buffer-local, use `make-local-hook',\n\
2261 not `make-local-variable'.")
2266 return run_hook_with_args (nargs
, args
, until_success
);
2269 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2270 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2271 "Run HOOK with the specified arguments ARGS.\n\
2272 HOOK should be a symbol, a hook variable. Its value should\n\
2273 be a list of functions. We call those functions, one by one,\n\
2274 passing arguments ARGS to each of them, until one of them\n\
2275 returns nil. Then we return nil.\n\
2276 If all the functions return non-nil, we return non-nil.\n\
2278 To make a hook variable buffer-local, use `make-local-hook',\n\
2279 not `make-local-variable'.")
2284 return run_hook_with_args (nargs
, args
, until_failure
);
2287 /* ARGS[0] should be a hook symbol.
2288 Call each of the functions in the hook value, passing each of them
2289 as arguments all the rest of ARGS (all NARGS - 1 elements).
2290 COND specifies a condition to test after each call
2291 to decide whether to stop.
2292 The caller (or its caller, etc) must gcpro all of ARGS,
2293 except that it isn't necessary to gcpro ARGS[0]. */
2296 run_hook_with_args (nargs
, args
, cond
)
2299 enum run_hooks_condition cond
;
2301 Lisp_Object sym
, val
, ret
;
2302 Lisp_Object globals
;
2303 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2305 /* If we are dying or still initializing,
2306 don't do anything--it would probably crash if we tried. */
2307 if (NILP (Vrun_hooks
))
2311 val
= find_symbol_value (sym
);
2312 ret
= (cond
== until_failure
? Qt
: Qnil
);
2314 if (EQ (val
, Qunbound
) || NILP (val
))
2316 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2319 return Ffuncall (nargs
, args
);
2324 GCPRO3 (sym
, val
, globals
);
2327 CONSP (val
) && ((cond
== to_completion
)
2328 || (cond
== until_success
? NILP (ret
)
2332 if (EQ (XCAR (val
), Qt
))
2334 /* t indicates this hook has a local binding;
2335 it means to run the global binding too. */
2337 for (globals
= Fdefault_value (sym
);
2338 CONSP (globals
) && ((cond
== to_completion
)
2339 || (cond
== until_success
? NILP (ret
)
2341 globals
= XCDR (globals
))
2343 args
[0] = XCAR (globals
);
2344 /* In a global value, t should not occur. If it does, we
2345 must ignore it to avoid an endless loop. */
2346 if (!EQ (args
[0], Qt
))
2347 ret
= Ffuncall (nargs
, args
);
2352 args
[0] = XCAR (val
);
2353 ret
= Ffuncall (nargs
, args
);
2362 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2363 present value of that symbol.
2364 Call each element of FUNLIST,
2365 passing each of them the rest of ARGS.
2366 The caller (or its caller, etc) must gcpro all of ARGS,
2367 except that it isn't necessary to gcpro ARGS[0]. */
2370 run_hook_list_with_args (funlist
, nargs
, args
)
2371 Lisp_Object funlist
;
2377 Lisp_Object globals
;
2378 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2382 GCPRO3 (sym
, val
, globals
);
2384 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2386 if (EQ (XCAR (val
), Qt
))
2388 /* t indicates this hook has a local binding;
2389 it means to run the global binding too. */
2391 for (globals
= Fdefault_value (sym
);
2393 globals
= XCDR (globals
))
2395 args
[0] = XCAR (globals
);
2396 /* In a global value, t should not occur. If it does, we
2397 must ignore it to avoid an endless loop. */
2398 if (!EQ (args
[0], Qt
))
2399 Ffuncall (nargs
, args
);
2404 args
[0] = XCAR (val
);
2405 Ffuncall (nargs
, args
);
2412 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2415 run_hook_with_args_2 (hook
, arg1
, arg2
)
2416 Lisp_Object hook
, arg1
, arg2
;
2418 Lisp_Object temp
[3];
2423 Frun_hook_with_args (3, temp
);
2426 /* Apply fn to arg */
2429 Lisp_Object fn
, arg
;
2431 struct gcpro gcpro1
;
2435 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2439 Lisp_Object args
[2];
2443 RETURN_UNGCPRO (Fapply (2, args
));
2445 #else /* not NO_ARG_ARRAY */
2446 RETURN_UNGCPRO (Fapply (2, &fn
));
2447 #endif /* not NO_ARG_ARRAY */
2450 /* Call function fn on no arguments */
2455 struct gcpro gcpro1
;
2458 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2461 /* Call function fn with 1 argument arg1 */
2465 Lisp_Object fn
, arg1
;
2467 struct gcpro gcpro1
;
2469 Lisp_Object args
[2];
2475 RETURN_UNGCPRO (Ffuncall (2, args
));
2476 #else /* not NO_ARG_ARRAY */
2479 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2480 #endif /* not NO_ARG_ARRAY */
2483 /* Call function fn with 2 arguments arg1, arg2 */
2486 call2 (fn
, arg1
, arg2
)
2487 Lisp_Object fn
, arg1
, arg2
;
2489 struct gcpro gcpro1
;
2491 Lisp_Object args
[3];
2497 RETURN_UNGCPRO (Ffuncall (3, args
));
2498 #else /* not NO_ARG_ARRAY */
2501 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2502 #endif /* not NO_ARG_ARRAY */
2505 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2508 call3 (fn
, arg1
, arg2
, arg3
)
2509 Lisp_Object fn
, arg1
, arg2
, arg3
;
2511 struct gcpro gcpro1
;
2513 Lisp_Object args
[4];
2520 RETURN_UNGCPRO (Ffuncall (4, args
));
2521 #else /* not NO_ARG_ARRAY */
2524 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2525 #endif /* not NO_ARG_ARRAY */
2528 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2531 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2532 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2534 struct gcpro gcpro1
;
2536 Lisp_Object args
[5];
2544 RETURN_UNGCPRO (Ffuncall (5, args
));
2545 #else /* not NO_ARG_ARRAY */
2548 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2549 #endif /* not NO_ARG_ARRAY */
2552 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2555 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2556 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2558 struct gcpro gcpro1
;
2560 Lisp_Object args
[6];
2569 RETURN_UNGCPRO (Ffuncall (6, args
));
2570 #else /* not NO_ARG_ARRAY */
2573 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2574 #endif /* not NO_ARG_ARRAY */
2577 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2580 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2581 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2583 struct gcpro gcpro1
;
2585 Lisp_Object args
[7];
2595 RETURN_UNGCPRO (Ffuncall (7, args
));
2596 #else /* not NO_ARG_ARRAY */
2599 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2600 #endif /* not NO_ARG_ARRAY */
2603 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2604 "Call first argument as a function, passing remaining arguments to it.\n\
2605 Return the value that function returns.\n\
2606 Thus, (funcall 'cons 'x 'y) returns (x . y).")
2613 int numargs
= nargs
- 1;
2614 Lisp_Object lisp_numargs
;
2616 struct backtrace backtrace
;
2617 register Lisp_Object
*internal_args
;
2621 if (consing_since_gc
> gc_cons_threshold
)
2622 Fgarbage_collect ();
2624 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2626 if (max_lisp_eval_depth
< 100)
2627 max_lisp_eval_depth
= 100;
2628 if (lisp_eval_depth
> max_lisp_eval_depth
)
2629 error ("Lisp nesting exceeds max-lisp-eval-depth");
2632 backtrace
.next
= backtrace_list
;
2633 backtrace_list
= &backtrace
;
2634 backtrace
.function
= &args
[0];
2635 backtrace
.args
= &args
[1];
2636 backtrace
.nargs
= nargs
- 1;
2637 backtrace
.evalargs
= 0;
2638 backtrace
.debug_on_exit
= 0;
2640 if (debug_on_next_call
)
2641 do_debug_on_call (Qlambda
);
2647 fun
= Findirect_function (fun
);
2651 if (numargs
< XSUBR (fun
)->min_args
2652 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2654 XSETFASTINT (lisp_numargs
, numargs
);
2655 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2658 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2659 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2661 if (XSUBR (fun
)->max_args
== MANY
)
2663 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2667 if (XSUBR (fun
)->max_args
> numargs
)
2669 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2670 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2671 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2672 internal_args
[i
] = Qnil
;
2675 internal_args
= args
+ 1;
2676 switch (XSUBR (fun
)->max_args
)
2679 val
= (*XSUBR (fun
)->function
) ();
2682 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2685 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2689 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2693 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2698 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2699 internal_args
[2], internal_args
[3],
2703 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2704 internal_args
[2], internal_args
[3],
2705 internal_args
[4], internal_args
[5]);
2708 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2709 internal_args
[2], internal_args
[3],
2710 internal_args
[4], internal_args
[5],
2715 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2716 internal_args
[2], internal_args
[3],
2717 internal_args
[4], internal_args
[5],
2718 internal_args
[6], internal_args
[7]);
2723 /* If a subr takes more than 8 arguments without using MANY
2724 or UNEVALLED, we need to extend this function to support it.
2725 Until this is done, there is no way to call the function. */
2729 if (COMPILEDP (fun
))
2730 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2734 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2735 funcar
= Fcar (fun
);
2736 if (!SYMBOLP (funcar
))
2737 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2738 if (EQ (funcar
, Qlambda
))
2739 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2740 else if (EQ (funcar
, Qmocklisp
))
2741 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2742 else if (EQ (funcar
, Qautoload
))
2744 do_autoload (fun
, args
[0]);
2748 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2752 if (backtrace
.debug_on_exit
)
2753 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2754 backtrace_list
= backtrace
.next
;
2759 apply_lambda (fun
, args
, eval_flag
)
2760 Lisp_Object fun
, args
;
2763 Lisp_Object args_left
;
2764 Lisp_Object numargs
;
2765 register Lisp_Object
*arg_vector
;
2766 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2768 register Lisp_Object tem
;
2770 numargs
= Flength (args
);
2771 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2774 GCPRO3 (*arg_vector
, args_left
, fun
);
2777 for (i
= 0; i
< XINT (numargs
);)
2779 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2780 if (eval_flag
) tem
= Feval (tem
);
2781 arg_vector
[i
++] = tem
;
2789 backtrace_list
->args
= arg_vector
;
2790 backtrace_list
->nargs
= i
;
2792 backtrace_list
->evalargs
= 0;
2793 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2795 /* Do the debug-on-exit now, while arg_vector still exists. */
2796 if (backtrace_list
->debug_on_exit
)
2797 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2798 /* Don't do it again when we return to eval. */
2799 backtrace_list
->debug_on_exit
= 0;
2803 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2804 and return the result of evaluation.
2805 FUN must be either a lambda-expression or a compiled-code object. */
2808 funcall_lambda (fun
, nargs
, arg_vector
)
2811 register Lisp_Object
*arg_vector
;
2813 Lisp_Object val
, syms_left
, next
;
2814 int count
= specpdl_ptr
- specpdl
;
2815 int i
, optional
, rest
;
2817 if (NILP (Vmocklisp_arguments
))
2818 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2822 syms_left
= XCDR (fun
);
2823 if (CONSP (syms_left
))
2824 syms_left
= XCAR (syms_left
);
2826 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2828 else if (COMPILEDP (fun
))
2829 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2833 i
= optional
= rest
= 0;
2834 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2838 next
= XCAR (syms_left
);
2839 while (!SYMBOLP (next
))
2840 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2842 if (EQ (next
, Qand_rest
))
2844 else if (EQ (next
, Qand_optional
))
2848 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2852 specbind (next
, arg_vector
[i
++]);
2854 return Fsignal (Qwrong_number_of_arguments
,
2855 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2857 specbind (next
, Qnil
);
2860 if (!NILP (syms_left
))
2861 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2863 return Fsignal (Qwrong_number_of_arguments
,
2864 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2867 val
= Fprogn (XCDR (XCDR (fun
)));
2870 /* If we have not actually read the bytecode string
2871 and constants vector yet, fetch them from the file. */
2872 if (CONSP (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
]))
2873 Ffetch_bytecode (fun
);
2874 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2875 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2876 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2879 return unbind_to (count
, val
);
2882 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2884 "If byte-compiled OBJECT is lazy-loaded, fetch it now.")
2890 if (COMPILEDP (object
)
2891 && CONSP (XVECTOR (object
)->contents
[COMPILED_BYTECODE
]))
2893 tem
= read_doc_string (XVECTOR (object
)->contents
[COMPILED_BYTECODE
]);
2895 error ("invalid byte code");
2896 XVECTOR (object
)->contents
[COMPILED_BYTECODE
] = XCAR (tem
);
2897 XVECTOR (object
)->contents
[COMPILED_CONSTANTS
] = XCDR (tem
);
2905 register int count
= specpdl_ptr
- specpdl
;
2906 if (specpdl_size
>= max_specpdl_size
)
2908 if (max_specpdl_size
< 400)
2909 max_specpdl_size
= 400;
2910 if (specpdl_size
>= max_specpdl_size
)
2912 if (!NILP (Vdebug_on_error
))
2913 /* Leave room for some specpdl in the debugger. */
2914 max_specpdl_size
= specpdl_size
+ 100;
2916 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2920 if (specpdl_size
> max_specpdl_size
)
2921 specpdl_size
= max_specpdl_size
;
2922 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2923 specpdl_ptr
= specpdl
+ count
;
2927 specbind (symbol
, value
)
2928 Lisp_Object symbol
, value
;
2931 Lisp_Object valcontents
;
2933 CHECK_SYMBOL (symbol
, 0);
2934 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2937 /* The most common case is that of a non-constant symbol with a
2938 trivial value. Make that as fast as we can. */
2939 valcontents
= SYMBOL_VALUE (symbol
);
2940 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
2942 specpdl_ptr
->symbol
= symbol
;
2943 specpdl_ptr
->old_value
= valcontents
;
2944 specpdl_ptr
->func
= NULL
;
2946 SET_SYMBOL_VALUE (symbol
, value
);
2950 Lisp_Object valcontents
;
2952 ovalue
= find_symbol_value (symbol
);
2953 specpdl_ptr
->func
= 0;
2954 specpdl_ptr
->old_value
= ovalue
;
2956 valcontents
= XSYMBOL (symbol
)->value
;
2958 if (BUFFER_LOCAL_VALUEP (valcontents
)
2959 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
2960 || BUFFER_OBJFWDP (valcontents
))
2962 Lisp_Object where
, current_buffer
;
2964 current_buffer
= Fcurrent_buffer ();
2966 /* For a local variable, record both the symbol and which
2967 buffer's or frame's value we are saving. */
2968 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
2969 where
= current_buffer
;
2970 else if (!BUFFER_OBJFWDP (valcontents
)
2971 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
2972 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
2976 /* We're not using the `unused' slot in the specbinding
2977 structure because this would mean we have to do more
2978 work for simple variables. */
2979 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
2981 /* If SYMBOL is a per-buffer variable which doesn't have a
2982 buffer-local value here, make the `let' change the global
2983 value by changing the value of SYMBOL in all buffers not
2984 having their own value. This is consistent with what
2985 happens with other buffer-local variables. */
2987 && BUFFER_OBJFWDP (valcontents
))
2990 Fset_default (symbol
, value
);
2995 specpdl_ptr
->symbol
= symbol
;
2998 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
2999 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3001 set_internal (symbol
, value
, 0, 1);
3006 record_unwind_protect (function
, arg
)
3007 Lisp_Object (*function
) P_ ((Lisp_Object
));
3010 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3012 specpdl_ptr
->func
= function
;
3013 specpdl_ptr
->symbol
= Qnil
;
3014 specpdl_ptr
->old_value
= arg
;
3019 unbind_to (count
, value
)
3023 int quitf
= !NILP (Vquit_flag
);
3024 struct gcpro gcpro1
;
3029 while (specpdl_ptr
!= specpdl
+ count
)
3033 if (specpdl_ptr
->func
!= 0)
3034 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
3035 /* Note that a "binding" of nil is really an unwind protect,
3036 so in that case the "old value" is a list of forms to evaluate. */
3037 else if (NILP (specpdl_ptr
->symbol
))
3038 Fprogn (specpdl_ptr
->old_value
);
3039 /* If the symbol is a list, it is really (SYMBOL WHERE
3040 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3041 frame. If WHERE is a buffer or frame, this indicates we
3042 bound a variable that had a buffer-local or frmae-local
3043 binding.. WHERE nil means that the variable had the default
3044 value when it was bound. CURRENT-BUFFER is the buffer that
3045 was current when the variable was bound. */
3046 else if (CONSP (specpdl_ptr
->symbol
))
3048 Lisp_Object symbol
, where
;
3050 symbol
= XCAR (specpdl_ptr
->symbol
);
3051 where
= XCAR (XCDR (specpdl_ptr
->symbol
));
3054 Fset_default (symbol
, specpdl_ptr
->old_value
);
3055 else if (BUFFERP (where
))
3056 set_internal (symbol
, specpdl_ptr
->old_value
, XBUFFER (where
), 1);
3058 set_internal (symbol
, specpdl_ptr
->old_value
, NULL
, 1);
3062 /* If variable has a trivial value (no forwarding), we can
3063 just set it. No need to check for constant symbols here,
3064 since that was already done by specbind. */
3065 if (!MISCP (SYMBOL_VALUE (specpdl_ptr
->symbol
)))
3066 SET_SYMBOL_VALUE (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
3068 set_internal (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
, 0, 1);
3072 if (NILP (Vquit_flag
) && quitf
)
3081 /* Get the value of symbol's global binding, even if that binding
3082 is not now dynamically visible. */
3085 top_level_value (symbol
)
3088 register struct specbinding
*ptr
= specpdl
;
3090 CHECK_SYMBOL (symbol
, 0);
3091 for (; ptr
!= specpdl_ptr
; ptr
++)
3093 if (EQ (ptr
->symbol
, symbol
))
3094 return ptr
->old_value
;
3096 return Fsymbol_value (symbol
);
3100 top_level_set (symbol
, newval
)
3101 Lisp_Object symbol
, newval
;
3103 register struct specbinding
*ptr
= specpdl
;
3105 CHECK_SYMBOL (symbol
, 0);
3106 for (; ptr
!= specpdl_ptr
; ptr
++)
3108 if (EQ (ptr
->symbol
, symbol
))
3110 ptr
->old_value
= newval
;
3114 return Fset (symbol
, newval
);
3119 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3120 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
3121 The debugger is entered when that frame exits, if the flag is non-nil.")
3123 Lisp_Object level
, flag
;
3125 register struct backtrace
*backlist
= backtrace_list
;
3128 CHECK_NUMBER (level
, 0);
3130 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3132 backlist
= backlist
->next
;
3136 backlist
->debug_on_exit
= !NILP (flag
);
3141 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3142 "Print a trace of Lisp function calls currently active.\n\
3143 Output stream used is value of `standard-output'.")
3146 register struct backtrace
*backlist
= backtrace_list
;
3150 extern Lisp_Object Vprint_level
;
3151 struct gcpro gcpro1
;
3153 XSETFASTINT (Vprint_level
, 3);
3160 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3161 if (backlist
->nargs
== UNEVALLED
)
3163 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3164 write_string ("\n", -1);
3168 tem
= *backlist
->function
;
3169 Fprin1 (tem
, Qnil
); /* This can QUIT */
3170 write_string ("(", -1);
3171 if (backlist
->nargs
== MANY
)
3173 for (tail
= *backlist
->args
, i
= 0;
3175 tail
= Fcdr (tail
), i
++)
3177 if (i
) write_string (" ", -1);
3178 Fprin1 (Fcar (tail
), Qnil
);
3183 for (i
= 0; i
< backlist
->nargs
; i
++)
3185 if (i
) write_string (" ", -1);
3186 Fprin1 (backlist
->args
[i
], Qnil
);
3189 write_string (")\n", -1);
3191 backlist
= backlist
->next
;
3194 Vprint_level
= Qnil
;
3199 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3200 "Return the function and arguments NFRAMES up from current execution point.\n\
3201 If that frame has not evaluated the arguments yet (or is a special form),\n\
3202 the value is (nil FUNCTION ARG-FORMS...).\n\
3203 If that frame has evaluated its arguments and called its function already,\n\
3204 the value is (t FUNCTION ARG-VALUES...).\n\
3205 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
3206 FUNCTION is whatever was supplied as car of evaluated list,\n\
3207 or a lambda expression for macro calls.\n\
3208 If NFRAMES is more than the number of frames, the value is nil.")
3210 Lisp_Object nframes
;
3212 register struct backtrace
*backlist
= backtrace_list
;
3216 CHECK_NATNUM (nframes
, 0);
3218 /* Find the frame requested. */
3219 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3220 backlist
= backlist
->next
;
3224 if (backlist
->nargs
== UNEVALLED
)
3225 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3228 if (backlist
->nargs
== MANY
)
3229 tem
= *backlist
->args
;
3231 tem
= Flist (backlist
->nargs
, backlist
->args
);
3233 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3241 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3242 "*Limit on number of Lisp variable bindings & unwind-protects.\n\
3243 If Lisp code tries to make more than this many at once,\n\
3244 an error is signaled.");
3246 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3247 "*Limit on depth in `eval', `apply' and `funcall' before error.\n\
3248 This limit is to catch infinite recursions for you before they cause\n\
3249 actual stack overflow in C, which would be fatal for Emacs.\n\
3250 You can safely make it considerably larger than its default value,\n\
3251 if that proves inconveniently small.");
3253 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3254 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
3255 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
3258 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3259 "Non-nil inhibits C-g quitting from happening immediately.\n\
3260 Note that `quit-flag' will still be set by typing C-g,\n\
3261 so a quit will be signaled as soon as `inhibit-quit' is nil.\n\
3262 To prevent this happening, set `quit-flag' to nil\n\
3263 before making `inhibit-quit' nil.");
3264 Vinhibit_quit
= Qnil
;
3266 Qinhibit_quit
= intern ("inhibit-quit");
3267 staticpro (&Qinhibit_quit
);
3269 Qautoload
= intern ("autoload");
3270 staticpro (&Qautoload
);
3272 Qdebug_on_error
= intern ("debug-on-error");
3273 staticpro (&Qdebug_on_error
);
3275 Qmacro
= intern ("macro");
3276 staticpro (&Qmacro
);
3278 /* Note that the process handling also uses Qexit, but we don't want
3279 to staticpro it twice, so we just do it here. */
3280 Qexit
= intern ("exit");
3283 Qinteractive
= intern ("interactive");
3284 staticpro (&Qinteractive
);
3286 Qcommandp
= intern ("commandp");
3287 staticpro (&Qcommandp
);
3289 Qdefun
= intern ("defun");
3290 staticpro (&Qdefun
);
3292 Qand_rest
= intern ("&rest");
3293 staticpro (&Qand_rest
);
3295 Qand_optional
= intern ("&optional");
3296 staticpro (&Qand_optional
);
3298 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3299 "*Non-nil means automatically display a backtrace buffer\n\
3300 after any error that is handled by the editor command loop.\n\
3301 If the value is a list, an error only means to display a backtrace\n\
3302 if one of its condition symbols appears in the list.");
3303 Vstack_trace_on_error
= Qnil
;
3305 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3306 "*Non-nil means enter debugger if an error is signaled.\n\
3307 Does not apply to errors handled by `condition-case' or those\n\
3308 matched by `debug-ignored-errors'.\n\
3309 If the value is a list, an error only means to enter the debugger\n\
3310 if one of its condition symbols appears in the list.\n\
3311 See also variable `debug-on-quit'.");
3312 Vdebug_on_error
= Qnil
;
3314 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3315 "*List of errors for which the debugger should not be called.\n\
3316 Each element may be a condition-name or a regexp that matches error messages.\n\
3317 If any element applies to a given error, that error skips the debugger\n\
3318 and just returns to top level.\n\
3319 This overrides the variable `debug-on-error'.\n\
3320 It does not apply to errors handled by `condition-case'.");
3321 Vdebug_ignored_errors
= Qnil
;
3323 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3324 "*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\
3325 Does not apply if quit is handled by a `condition-case'.");
3328 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3329 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
3331 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3332 "Non-nil means debugger may continue execution.\n\
3333 This is nil when the debugger is called under circumstances where it\n\
3334 might not be safe to continue.");
3335 debugger_may_continue
= 1;
3337 DEFVAR_LISP ("debugger", &Vdebugger
,
3338 "Function to call to invoke debugger.\n\
3339 If due to frame exit, args are `exit' and the value being returned;\n\
3340 this function's value will be returned instead of that.\n\
3341 If due to error, args are `error' and a list of the args to `signal'.\n\
3342 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
3343 If due to `eval' entry, one arg, t.");
3346 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3347 "If non-nil, this is a function for `signal' to call.\n\
3348 It receives the same arguments that `signal' was given.\n\
3349 The Edebug package uses this to regain control.");
3350 Vsignal_hook_function
= Qnil
;
3352 Qmocklisp_arguments
= intern ("mocklisp-arguments");
3353 staticpro (&Qmocklisp_arguments
);
3354 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
3355 "While in a mocklisp function, the list of its unevaluated args.");
3356 Vmocklisp_arguments
= Qt
;
3358 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3359 "*Non-nil means call the debugger regardless of condition handlers.\n\
3360 Note that `debug-on-error', `debug-on-quit' and friends\n\
3361 still determine whether to handle the particular condition.");
3362 Vdebug_on_signal
= Qnil
;
3364 Vrun_hooks
= intern ("run-hooks");
3365 staticpro (&Vrun_hooks
);
3367 staticpro (&Vautoload_queue
);
3368 Vautoload_queue
= Qnil
;
3369 staticpro (&Vsignaling_function
);
3370 Vsignaling_function
= Qnil
;
3381 defsubr (&Sfunction
);
3383 defsubr (&Sdefmacro
);
3385 defsubr (&Sdefvaralias
);
3386 defsubr (&Sdefconst
);
3387 defsubr (&Suser_variable_p
);
3391 defsubr (&Smacroexpand
);
3394 defsubr (&Sunwind_protect
);
3395 defsubr (&Scondition_case
);
3397 defsubr (&Sinteractive_p
);
3398 defsubr (&Scommandp
);
3399 defsubr (&Sautoload
);
3402 defsubr (&Sfuncall
);
3403 defsubr (&Srun_hooks
);
3404 defsubr (&Srun_hook_with_args
);
3405 defsubr (&Srun_hook_with_args_until_success
);
3406 defsubr (&Srun_hook_with_args_until_failure
);
3407 defsubr (&Sfetch_bytecode
);
3408 defsubr (&Sbacktrace_debug
);
3409 defsubr (&Sbacktrace
);
3410 defsubr (&Sbacktrace_frame
);