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 EMACS_INT max_specpdl_size
;
125 /* Depth in Lisp evaluations and function calls. */
129 /* Maximum allowed depth in Lisp evaluations and function calls. */
131 EMACS_INT max_lisp_eval_depth
;
133 /* Nonzero means enter debugger before next function call */
135 int debug_on_next_call
;
137 /* Non-zero means debugger 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_error 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 static Lisp_Object funcall_lambda
P_ ((Lisp_Object
, int, Lisp_Object
*));
194 /* Apply a mocklisp function to unevaluated argument list. */
195 extern Lisp_Object ml_apply
P_ ((Lisp_Object
, Lisp_Object
));
201 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
202 specpdl_ptr
= specpdl
;
203 max_specpdl_size
= 600;
204 max_lisp_eval_depth
= 300;
212 specpdl_ptr
= specpdl
;
217 debug_on_next_call
= 0;
222 /* This is less than the initial value of num_nonmacro_input_events. */
223 when_entered_debugger
= -1;
230 int debug_while_redisplaying
;
231 int count
= specpdl_ptr
- specpdl
;
234 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
235 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
237 if (specpdl_size
+ 40 > max_specpdl_size
)
238 max_specpdl_size
= specpdl_size
+ 40;
240 #ifdef HAVE_X_WINDOWS
241 if (display_hourglass_p
)
245 debug_on_next_call
= 0;
246 when_entered_debugger
= num_nonmacro_input_events
;
248 /* Resetting redisplaying_p to 0 makes sure that debug output is
249 displayed if the debugger is invoked during redisplay. */
250 debug_while_redisplaying
= redisplaying_p
;
252 specbind (intern ("debugger-may-continue"),
253 debug_while_redisplaying
? Qnil
: Qt
);
254 specbind (Qinhibit_redisplay
, Qnil
);
256 #if 0 /* Binding this prevents execution of Lisp code during
257 redisplay, which necessarily leads to display problems. */
258 specbind (Qinhibit_eval_during_redisplay
, Qt
);
261 val
= apply1 (Vdebugger
, arg
);
263 /* Interrupting redisplay and resuming it later is not safe under
264 all circumstances. So, when the debugger returns, abort the
265 interrupted redisplay by going back to the top-level. */
266 if (debug_while_redisplaying
)
269 return unbind_to (count
, val
);
273 do_debug_on_call (code
)
276 debug_on_next_call
= 0;
277 backtrace_list
->debug_on_exit
= 1;
278 call_debugger (Fcons (code
, Qnil
));
281 /* NOTE!!! Every function that can call EVAL must protect its args
282 and temporaries from garbage collection while it needs them.
283 The definition of `For' shows what you have to do. */
285 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
286 doc
: /* Eval args until one of them yields non-nil, then return that value.
287 The remaining args are not evalled at all.
288 If all args return nil, return nil.
289 usage: (or CONDITIONS ...) */)
293 register Lisp_Object val
;
294 Lisp_Object args_left
;
305 val
= Feval (Fcar (args_left
));
308 args_left
= Fcdr (args_left
);
310 while (!NILP(args_left
));
316 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
317 doc
: /* Eval args until one of them yields nil, then return nil.
318 The remaining args are not evalled at all.
319 If no arg yields nil, return the last arg's value.
320 usage: (and CONDITIONS ...) */)
324 register Lisp_Object val
;
325 Lisp_Object args_left
;
336 val
= Feval (Fcar (args_left
));
339 args_left
= Fcdr (args_left
);
341 while (!NILP(args_left
));
347 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
348 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
349 Returns the value of THEN or the value of the last of the ELSE's.
350 THEN must be one expression, but ELSE... can be zero or more expressions.
351 If COND yields nil, and there are no ELSE's, the value is nil.
352 usage: (if COND THEN ELSE...) */)
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 doc
: /* Try each clause until one succeeds.
370 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
371 and, if the value is non-nil, this clause succeeds:
372 then the expressions in BODY are evaluated and the last one's
373 value is the value of the cond-form.
374 If no clause succeeds, cond returns nil.
375 If a clause has one element, as in (CONDITION),
376 CONDITION's value if non-nil is returned from the cond-form.
377 usage: (cond CLAUSES...) */)
381 register Lisp_Object clause
, val
;
388 clause
= Fcar (args
);
389 val
= Feval (Fcar (clause
));
392 if (!EQ (XCDR (clause
), Qnil
))
393 val
= Fprogn (XCDR (clause
));
403 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
404 doc
: /* Eval BODY forms sequentially and return value of last one.
405 usage: (progn BODY ...) */)
409 register Lisp_Object val
, tem
;
410 Lisp_Object args_left
;
413 /* In Mocklisp code, symbols at the front of the progn arglist
414 are to be bound to zero. */
415 if (!EQ (Vmocklisp_arguments
, Qt
))
417 val
= make_number (0);
418 while (!NILP (args
) && (tem
= Fcar (args
), SYMBOLP (tem
)))
421 specbind (tem
, val
), args
= Fcdr (args
);
433 val
= Feval (Fcar (args_left
));
434 args_left
= Fcdr (args_left
);
436 while (!NILP(args_left
));
442 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
443 doc
: /* Eval FIRST and BODY sequentially; value from FIRST.
444 The value of FIRST is saved during the evaluation of the remaining args,
445 whose values are discarded.
446 usage: (prog1 FIRST BODY...) */)
451 register Lisp_Object args_left
;
452 struct gcpro gcpro1
, gcpro2
;
453 register int argnum
= 0;
465 val
= Feval (Fcar (args_left
));
467 Feval (Fcar (args_left
));
468 args_left
= Fcdr (args_left
);
470 while (!NILP(args_left
));
476 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
477 doc
: /* Eval X, Y and BODY sequentially; value from Y.
478 The value of Y is saved during the evaluation of the remaining args,
479 whose values are discarded.
480 usage: (prog2 X Y BODY...) */)
485 register Lisp_Object args_left
;
486 struct gcpro gcpro1
, gcpro2
;
487 register int argnum
= -1;
501 val
= Feval (Fcar (args_left
));
503 Feval (Fcar (args_left
));
504 args_left
= Fcdr (args_left
);
506 while (!NILP (args_left
));
512 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
513 doc
: /* Set each SYM to the value of its VAL.
514 The symbols SYM are variables; they are literal (not evaluated).
515 The values VAL are expressions; they are evaluated.
516 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
517 The second VAL is not computed until after the first SYM is set, and so on;
518 each VAL can use the new value of variables set earlier in the `setq'.
519 The return value of the `setq' form is the value of the last VAL.
520 usage: (setq SYM VAL SYM VAL ...) */)
524 register Lisp_Object args_left
;
525 register Lisp_Object val
, sym
;
536 val
= Feval (Fcar (Fcdr (args_left
)));
537 sym
= Fcar (args_left
);
539 args_left
= Fcdr (Fcdr (args_left
));
541 while (!NILP(args_left
));
547 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
548 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
549 usage: (quote ARG) */)
556 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
557 doc
: /* Like `quote', but preferred for objects which are functions.
558 In byte compilation, `function' causes its argument to be compiled.
559 `quote' cannot do that.
560 usage: (function ARG) */)
568 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
569 doc
: /* Return t if function in which this appears was called interactively.
570 This means that the function was called with call-interactively (which
571 includes being called as the binding of a key)
572 and input is currently coming from the keyboard (not in keyboard macro). */)
575 return interactive_p (1) ? Qt
: Qnil
;
579 /* Return 1 if function in which this appears was called
580 interactively. This means that the function was called with
581 call-interactively (which includes being called as the binding of
582 a key) and input is currently coming from the keyboard (not in
585 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
586 called is a built-in. */
589 interactive_p (exclude_subrs_p
)
592 struct backtrace
*btp
;
598 btp
= backtrace_list
;
600 /* If this isn't a byte-compiled function, there may be a frame at
601 the top for Finteractive_p. If so, skip it. */
602 fun
= Findirect_function (*btp
->function
);
603 if (SUBRP (fun
) && XSUBR (fun
) == &Sinteractive_p
)
606 /* If we're running an Emacs 18-style byte-compiled function, there
607 may be a frame for Fbytecode. Now, given the strictest
608 definition, this function isn't really being called
609 interactively, but because that's the way Emacs 18 always builds
610 byte-compiled functions, we'll accept it for now. */
611 if (EQ (*btp
->function
, Qbytecode
))
614 /* If this isn't a byte-compiled function, then we may now be
615 looking at several frames for special forms. Skip past them. */
617 btp
->nargs
== UNEVALLED
)
620 /* btp now points at the frame of the innermost function that isn't
621 a special form, ignoring frames for Finteractive_p and/or
622 Fbytecode at the top. If this frame is for a built-in function
623 (such as load or eval-region) return nil. */
624 fun
= Findirect_function (*btp
->function
);
625 if (exclude_subrs_p
&& SUBRP (fun
))
628 /* btp points to the frame of a Lisp function that called interactive-p.
629 Return t if that function was called interactively. */
630 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
636 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
637 doc
: /* Define NAME as a function.
638 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
639 See also the function `interactive'.
640 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
644 register Lisp_Object fn_name
;
645 register Lisp_Object defn
;
647 fn_name
= Fcar (args
);
648 defn
= Fcons (Qlambda
, Fcdr (args
));
649 if (!NILP (Vpurify_flag
))
650 defn
= Fpurecopy (defn
);
651 Ffset (fn_name
, defn
);
652 LOADHIST_ATTACH (fn_name
);
656 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
657 doc
: /* Define NAME as a macro.
658 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
659 When the macro is called, as in (NAME ARGS...),
660 the function (lambda ARGLIST BODY...) is applied to
661 the list ARGS... as it appears in the expression,
662 and the result should be a form to be evaluated instead of the original.
663 usage: (defmacro NAME ARGLIST [DOCSTRING] BODY...) */)
667 register Lisp_Object fn_name
;
668 register Lisp_Object defn
;
670 fn_name
= Fcar (args
);
671 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
672 if (!NILP (Vpurify_flag
))
673 defn
= Fpurecopy (defn
);
674 Ffset (fn_name
, defn
);
675 LOADHIST_ATTACH (fn_name
);
680 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 2, 0,
681 doc
: /* Make SYMBOL a variable alias for symbol ALIASED.
682 Setting the value of SYMBOL will subsequently set the value of ALIASED,
683 and getting the value of SYMBOL will return the value ALIASED has.
684 ALIASED nil means remove the alias; SYMBOL is unbound after that. */)
686 Lisp_Object symbol
, aliased
;
688 struct Lisp_Symbol
*sym
;
690 CHECK_SYMBOL (symbol
);
691 CHECK_SYMBOL (aliased
);
693 if (SYMBOL_CONSTANT_P (symbol
))
694 error ("Cannot make a constant an alias");
696 sym
= XSYMBOL (symbol
);
697 sym
->indirect_variable
= 1;
698 sym
->value
= aliased
;
699 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
700 LOADHIST_ATTACH (symbol
);
706 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
707 doc
: /* Define SYMBOL as a variable.
708 You are not required to define a variable in order to use it,
709 but the definition can supply documentation and an initial value
710 in a way that tags can recognize.
712 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
713 If SYMBOL is buffer-local, its default value is what is set;
714 buffer-local values are not affected.
715 INITVALUE and DOCSTRING are optional.
716 If DOCSTRING starts with *, this variable is identified as a user option.
717 This means that M-x set-variable recognizes it.
718 See also `user-variable-p'.
719 If INITVALUE is missing, SYMBOL's value is not set.
720 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
724 register Lisp_Object sym
, tem
, tail
;
728 if (!NILP (Fcdr (Fcdr (tail
))))
729 error ("too many arguments");
731 tem
= Fdefault_boundp (sym
);
735 Fset_default (sym
, Feval (Fcar (tail
)));
737 if (!NILP (Fcar (tail
)))
740 if (!NILP (Vpurify_flag
))
741 tem
= Fpurecopy (tem
);
742 Fput (sym
, Qvariable_documentation
, tem
);
744 LOADHIST_ATTACH (sym
);
747 /* A (defvar <var>) should not take precedence in the load-history over
748 an earlier (defvar <var> <val>), so only add to history if the default
749 value is still unbound. */
751 LOADHIST_ATTACH (sym
);
756 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
757 doc
: /* Define SYMBOL as a constant variable.
758 The intent is that neither programs nor users should ever change this value.
759 Always sets the value of SYMBOL to the result of evalling INITVALUE.
760 If SYMBOL is buffer-local, its default value is what is set;
761 buffer-local values are not affected.
762 DOCSTRING is optional.
763 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
767 register Lisp_Object sym
, tem
;
770 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
771 error ("too many arguments");
773 tem
= Feval (Fcar (Fcdr (args
)));
774 if (!NILP (Vpurify_flag
))
775 tem
= Fpurecopy (tem
);
776 Fset_default (sym
, tem
);
777 tem
= Fcar (Fcdr (Fcdr (args
)));
780 if (!NILP (Vpurify_flag
))
781 tem
= Fpurecopy (tem
);
782 Fput (sym
, Qvariable_documentation
, tem
);
784 LOADHIST_ATTACH (sym
);
788 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
789 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
790 \(The alternative is a variable used internally in a Lisp program.)
791 Determined by whether the first character of the documentation
792 for the variable is `*' or if the variable is customizable (has a non-nil
793 value of any of `custom-type', `custom-loads' or `standard-value'
794 on its property list). */)
796 Lisp_Object variable
;
798 Lisp_Object documentation
;
800 if (!SYMBOLP (variable
))
803 documentation
= Fget (variable
, Qvariable_documentation
);
804 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
806 if (STRINGP (documentation
)
807 && ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
809 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
810 if (CONSP (documentation
)
811 && STRINGP (XCAR (documentation
))
812 && INTEGERP (XCDR (documentation
))
813 && XINT (XCDR (documentation
)) < 0)
816 if ((!NILP (Fget (variable
, intern ("custom-type"))))
817 || (!NILP (Fget (variable
, intern ("custom-loads"))))
818 || (!NILP (Fget (variable
, intern ("standard-value")))))
823 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
824 doc
: /* Bind variables according to VARLIST then eval BODY.
825 The value of the last form in BODY is returned.
826 Each element of VARLIST is a symbol (which is bound to nil)
827 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
828 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
829 usage: (let* VARLIST BODY...) */)
833 Lisp_Object varlist
, val
, elt
;
834 int count
= specpdl_ptr
- specpdl
;
835 struct gcpro gcpro1
, gcpro2
, gcpro3
;
837 GCPRO3 (args
, elt
, varlist
);
839 varlist
= Fcar (args
);
840 while (!NILP (varlist
))
843 elt
= Fcar (varlist
);
845 specbind (elt
, Qnil
);
846 else if (! NILP (Fcdr (Fcdr (elt
))))
848 Fcons (build_string ("`let' bindings can have only one value-form"),
852 val
= Feval (Fcar (Fcdr (elt
)));
853 specbind (Fcar (elt
), val
);
855 varlist
= Fcdr (varlist
);
858 val
= Fprogn (Fcdr (args
));
859 return unbind_to (count
, val
);
862 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
863 doc
: /* Bind variables according to VARLIST then eval BODY.
864 The value of the last form in BODY is returned.
865 Each element of VARLIST is a symbol (which is bound to nil)
866 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
867 All the VALUEFORMs are evalled before any symbols are bound.
868 usage: (let VARLIST BODY...) */)
872 Lisp_Object
*temps
, tem
;
873 register Lisp_Object elt
, varlist
;
874 int count
= specpdl_ptr
- specpdl
;
876 struct gcpro gcpro1
, gcpro2
;
878 varlist
= Fcar (args
);
880 /* Make space to hold the values to give the bound variables */
881 elt
= Flength (varlist
);
882 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
884 /* Compute the values and store them in `temps' */
886 GCPRO2 (args
, *temps
);
889 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
892 elt
= Fcar (varlist
);
894 temps
[argnum
++] = Qnil
;
895 else if (! NILP (Fcdr (Fcdr (elt
))))
897 Fcons (build_string ("`let' bindings can have only one value-form"),
900 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
901 gcpro2
.nvars
= argnum
;
905 varlist
= Fcar (args
);
906 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
908 elt
= Fcar (varlist
);
909 tem
= temps
[argnum
++];
913 specbind (Fcar (elt
), tem
);
916 elt
= Fprogn (Fcdr (args
));
917 return unbind_to (count
, elt
);
920 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
921 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
922 The order of execution is thus TEST, BODY, TEST, BODY and so on
923 until TEST returns nil.
924 usage: (while TEST BODY...) */)
928 Lisp_Object test
, body
, tem
;
929 struct gcpro gcpro1
, gcpro2
;
935 while (tem
= Feval (test
),
936 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
946 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
947 doc
: /* Return result of expanding macros at top level of FORM.
948 If FORM is not a macro call, it is returned unchanged.
949 Otherwise, the macro is expanded and the expansion is considered
950 in place of FORM. When a non-macro-call results, it is returned.
952 The second optional arg ENVIRONMENT specifies an environment of macro
953 definitions to shadow the loaded ones for use in file byte-compilation. */)
956 Lisp_Object environment
;
958 /* With cleanups from Hallvard Furuseth. */
959 register Lisp_Object expander
, sym
, def
, tem
;
963 /* Come back here each time we expand a macro call,
964 in case it expands into another macro call. */
967 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
968 def
= sym
= XCAR (form
);
970 /* Trace symbols aliases to other symbols
971 until we get a symbol that is not an alias. */
972 while (SYMBOLP (def
))
976 tem
= Fassq (sym
, environment
);
979 def
= XSYMBOL (sym
)->function
;
980 if (!EQ (def
, Qunbound
))
985 /* Right now TEM is the result from SYM in ENVIRONMENT,
986 and if TEM is nil then DEF is SYM's function definition. */
989 /* SYM is not mentioned in ENVIRONMENT.
990 Look at its function definition. */
991 if (EQ (def
, Qunbound
) || !CONSP (def
))
992 /* Not defined or definition not suitable */
994 if (EQ (XCAR (def
), Qautoload
))
996 /* Autoloading function: will it be a macro when loaded? */
997 tem
= Fnth (make_number (4), def
);
998 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
999 /* Yes, load it and try again. */
1001 struct gcpro gcpro1
;
1003 do_autoload (def
, sym
);
1010 else if (!EQ (XCAR (def
), Qmacro
))
1012 else expander
= XCDR (def
);
1016 expander
= XCDR (tem
);
1017 if (NILP (expander
))
1020 form
= apply1 (expander
, XCDR (form
));
1025 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1026 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1027 TAG is evalled to get the tag to use; it must not be nil.
1029 Then the BODY is executed.
1030 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1031 If no throw happens, `catch' returns the value of the last BODY form.
1032 If a throw happens, it specifies the value to return from `catch'.
1033 usage: (catch TAG BODY...) */)
1037 register Lisp_Object tag
;
1038 struct gcpro gcpro1
;
1041 tag
= Feval (Fcar (args
));
1043 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1046 /* Set up a catch, then call C function FUNC on argument ARG.
1047 FUNC should return a Lisp_Object.
1048 This is how catches are done from within C code. */
1051 internal_catch (tag
, func
, arg
)
1053 Lisp_Object (*func
) ();
1056 /* This structure is made part of the chain `catchlist'. */
1059 /* Fill in the components of c, and put it on the list. */
1063 c
.backlist
= backtrace_list
;
1064 c
.handlerlist
= handlerlist
;
1065 c
.lisp_eval_depth
= lisp_eval_depth
;
1066 c
.pdlcount
= specpdl_ptr
- specpdl
;
1067 c
.poll_suppress_count
= poll_suppress_count
;
1068 c
.gcpro
= gcprolist
;
1069 c
.byte_stack
= byte_stack_list
;
1073 if (! _setjmp (c
.jmp
))
1074 c
.val
= (*func
) (arg
);
1076 /* Throw works by a longjmp that comes right here. */
1081 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1082 jump to that CATCH, returning VALUE as the value of that catch.
1084 This is the guts Fthrow and Fsignal; they differ only in the way
1085 they choose the catch tag to throw to. A catch tag for a
1086 condition-case form has a TAG of Qnil.
1088 Before each catch is discarded, unbind all special bindings and
1089 execute all unwind-protect clauses made above that catch. Unwind
1090 the handler stack as we go, so that the proper handlers are in
1091 effect for each unwind-protect clause we run. At the end, restore
1092 some static info saved in CATCH, and longjmp to the location
1095 This is used for correct unwinding in Fthrow and Fsignal. */
1098 unwind_to_catch (catch, value
)
1099 struct catchtag
*catch;
1102 register int last_time
;
1104 /* Save the value in the tag. */
1107 /* Restore the polling-suppression count. */
1108 set_poll_suppress_count (catch->poll_suppress_count
);
1112 last_time
= catchlist
== catch;
1114 /* Unwind the specpdl stack, and then restore the proper set of
1116 unbind_to (catchlist
->pdlcount
, Qnil
);
1117 handlerlist
= catchlist
->handlerlist
;
1118 catchlist
= catchlist
->next
;
1120 while (! last_time
);
1122 byte_stack_list
= catch->byte_stack
;
1123 gcprolist
= catch->gcpro
;
1126 gcpro_level
= gcprolist
->level
+ 1;
1130 backtrace_list
= catch->backlist
;
1131 lisp_eval_depth
= catch->lisp_eval_depth
;
1133 _longjmp (catch->jmp
, 1);
1136 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1137 doc
: /* Throw to the catch for TAG and return VALUE from it.
1138 Both TAG and VALUE are evalled. */)
1140 register Lisp_Object tag
, value
;
1142 register struct catchtag
*c
;
1147 for (c
= catchlist
; c
; c
= c
->next
)
1149 if (EQ (c
->tag
, tag
))
1150 unwind_to_catch (c
, value
);
1152 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1157 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1158 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1159 If BODYFORM completes normally, its value is returned
1160 after executing the UNWINDFORMS.
1161 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1162 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1167 int count
= specpdl_ptr
- specpdl
;
1169 record_unwind_protect (0, Fcdr (args
));
1170 val
= Feval (Fcar (args
));
1171 return unbind_to (count
, val
);
1174 /* Chain of condition handlers currently in effect.
1175 The elements of this chain are contained in the stack frames
1176 of Fcondition_case and internal_condition_case.
1177 When an error is signaled (by calling Fsignal, below),
1178 this chain is searched for an element that applies. */
1180 struct handler
*handlerlist
;
1182 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1183 doc
: /* Regain control when an error is signaled.
1184 Executes BODYFORM and returns its value if no error happens.
1185 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1186 where the BODY is made of Lisp expressions.
1188 A handler is applicable to an error
1189 if CONDITION-NAME is one of the error's condition names.
1190 If an error happens, the first applicable handler is run.
1192 The car of a handler may be a list of condition names
1193 instead of a single condition name.
1195 When a handler handles an error,
1196 control returns to the condition-case and the handler BODY... is executed
1197 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1198 VAR may be nil; then you do not get access to the signal information.
1200 The value of the last BODY form is returned from the condition-case.
1201 See also the function `signal' for more info.
1202 usage: (condition-case VAR BODYFORM HANDLERS...) */)
1209 register Lisp_Object bodyform
, handlers
;
1210 volatile Lisp_Object var
;
1213 bodyform
= Fcar (Fcdr (args
));
1214 handlers
= Fcdr (Fcdr (args
));
1217 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1223 && (SYMBOLP (XCAR (tem
))
1224 || CONSP (XCAR (tem
))))))
1225 error ("Invalid condition handler", tem
);
1230 c
.backlist
= backtrace_list
;
1231 c
.handlerlist
= handlerlist
;
1232 c
.lisp_eval_depth
= lisp_eval_depth
;
1233 c
.pdlcount
= specpdl_ptr
- specpdl
;
1234 c
.poll_suppress_count
= poll_suppress_count
;
1235 c
.gcpro
= gcprolist
;
1236 c
.byte_stack
= byte_stack_list
;
1237 if (_setjmp (c
.jmp
))
1240 specbind (h
.var
, c
.val
);
1241 val
= Fprogn (Fcdr (h
.chosen_clause
));
1243 /* Note that this just undoes the binding of h.var; whoever
1244 longjumped to us unwound the stack to c.pdlcount before
1246 unbind_to (c
.pdlcount
, Qnil
);
1253 h
.handler
= handlers
;
1254 h
.next
= handlerlist
;
1258 val
= Feval (bodyform
);
1260 handlerlist
= h
.next
;
1264 /* Call the function BFUN with no arguments, catching errors within it
1265 according to HANDLERS. If there is an error, call HFUN with
1266 one argument which is the data that describes the error:
1269 HANDLERS can be a list of conditions to catch.
1270 If HANDLERS is Qt, catch all errors.
1271 If HANDLERS is Qerror, catch all errors
1272 but allow the debugger to run if that is enabled. */
1275 internal_condition_case (bfun
, handlers
, hfun
)
1276 Lisp_Object (*bfun
) ();
1277 Lisp_Object handlers
;
1278 Lisp_Object (*hfun
) ();
1284 #if 0 /* Can't do this check anymore because realize_basic_faces has
1285 to BLOCK_INPUT, and can call Lisp. What's really needed is a
1286 flag indicating that we're currently handling a signal. */
1287 /* Since Fsignal resets this to 0, it had better be 0 now
1288 or else we have a potential bug. */
1289 if (interrupt_input_blocked
!= 0)
1295 c
.backlist
= backtrace_list
;
1296 c
.handlerlist
= handlerlist
;
1297 c
.lisp_eval_depth
= lisp_eval_depth
;
1298 c
.pdlcount
= specpdl_ptr
- specpdl
;
1299 c
.poll_suppress_count
= poll_suppress_count
;
1300 c
.gcpro
= gcprolist
;
1301 c
.byte_stack
= byte_stack_list
;
1302 if (_setjmp (c
.jmp
))
1304 return (*hfun
) (c
.val
);
1308 h
.handler
= handlers
;
1310 h
.next
= handlerlist
;
1316 handlerlist
= h
.next
;
1320 /* Like internal_condition_case but call HFUN with ARG as its argument. */
1323 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1324 Lisp_Object (*bfun
) ();
1326 Lisp_Object handlers
;
1327 Lisp_Object (*hfun
) ();
1335 c
.backlist
= backtrace_list
;
1336 c
.handlerlist
= handlerlist
;
1337 c
.lisp_eval_depth
= lisp_eval_depth
;
1338 c
.pdlcount
= specpdl_ptr
- specpdl
;
1339 c
.poll_suppress_count
= poll_suppress_count
;
1340 c
.gcpro
= gcprolist
;
1341 c
.byte_stack
= byte_stack_list
;
1342 if (_setjmp (c
.jmp
))
1344 return (*hfun
) (c
.val
);
1348 h
.handler
= handlers
;
1350 h
.next
= handlerlist
;
1354 val
= (*bfun
) (arg
);
1356 handlerlist
= h
.next
;
1361 /* Like internal_condition_case but call HFUN with NARGS as first,
1362 and ARGS as second argument. */
1365 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1366 Lisp_Object (*bfun
) ();
1369 Lisp_Object handlers
;
1370 Lisp_Object (*hfun
) ();
1378 c
.backlist
= backtrace_list
;
1379 c
.handlerlist
= handlerlist
;
1380 c
.lisp_eval_depth
= lisp_eval_depth
;
1381 c
.pdlcount
= specpdl_ptr
- specpdl
;
1382 c
.poll_suppress_count
= poll_suppress_count
;
1383 c
.gcpro
= gcprolist
;
1384 c
.byte_stack
= byte_stack_list
;
1385 if (_setjmp (c
.jmp
))
1387 return (*hfun
) (c
.val
);
1391 h
.handler
= handlers
;
1393 h
.next
= handlerlist
;
1397 val
= (*bfun
) (nargs
, args
);
1399 handlerlist
= h
.next
;
1404 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1405 Lisp_Object
, Lisp_Object
,
1408 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1409 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1410 This function does not return.
1412 An error symbol is a symbol with an `error-conditions' property
1413 that is a list of condition names.
1414 A handler for any of those names will get to handle this signal.
1415 The symbol `error' should normally be one of them.
1417 DATA should be a list. Its elements are printed as part of the error message.
1418 If the signal is handled, DATA is made available to the handler.
1419 See also the function `condition-case'. */)
1420 (error_symbol
, data
)
1421 Lisp_Object error_symbol
, data
;
1423 /* When memory is full, ERROR-SYMBOL is nil,
1424 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). */
1425 register struct handler
*allhandlers
= handlerlist
;
1426 Lisp_Object conditions
;
1427 extern int gc_in_progress
;
1428 extern int waiting_for_input
;
1429 Lisp_Object debugger_value
;
1431 Lisp_Object real_error_symbol
;
1432 extern int display_hourglass_p
;
1433 struct backtrace
*bp
;
1435 immediate_quit
= handling_signal
= 0;
1436 if (gc_in_progress
|| waiting_for_input
)
1439 TOTALLY_UNBLOCK_INPUT
;
1441 if (NILP (error_symbol
))
1442 real_error_symbol
= Fcar (data
);
1444 real_error_symbol
= error_symbol
;
1446 #ifdef HAVE_X_WINDOWS
1447 if (display_hourglass_p
)
1448 cancel_hourglass ();
1451 /* This hook is used by edebug. */
1452 if (! NILP (Vsignal_hook_function
))
1453 call2 (Vsignal_hook_function
, error_symbol
, data
);
1455 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1457 /* Remember from where signal was called. Skip over the frame for
1458 `signal' itself. If a frame for `error' follows, skip that,
1460 Vsignaling_function
= Qnil
;
1463 bp
= backtrace_list
->next
;
1464 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1466 if (bp
&& bp
->function
)
1467 Vsignaling_function
= *bp
->function
;
1470 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1472 register Lisp_Object clause
;
1474 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1475 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1477 if (specpdl_size
+ 40 > max_specpdl_size
)
1478 max_specpdl_size
= specpdl_size
+ 40;
1480 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1481 error_symbol
, data
, &debugger_value
);
1483 #if 0 /* Most callers are not prepared to handle gc if this returns.
1484 So, since this feature is not very useful, take it out. */
1485 /* If have called debugger and user wants to continue,
1487 if (EQ (clause
, Qlambda
))
1488 return debugger_value
;
1490 if (EQ (clause
, Qlambda
))
1492 /* We can't return values to code which signaled an error, but we
1493 can continue code which has signaled a quit. */
1494 if (EQ (real_error_symbol
, Qquit
))
1497 error ("Cannot return from the debugger in an error");
1503 Lisp_Object unwind_data
;
1504 struct handler
*h
= handlerlist
;
1506 handlerlist
= allhandlers
;
1508 if (NILP (error_symbol
))
1511 unwind_data
= Fcons (error_symbol
, data
);
1512 h
->chosen_clause
= clause
;
1513 unwind_to_catch (h
->tag
, unwind_data
);
1517 handlerlist
= allhandlers
;
1518 /* If no handler is present now, try to run the debugger,
1519 and if that fails, throw to top level. */
1520 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1522 Fthrow (Qtop_level
, Qt
);
1524 if (! NILP (error_symbol
))
1525 data
= Fcons (error_symbol
, data
);
1527 string
= Ferror_message_string (data
);
1528 fatal ("%s", XSTRING (string
)->data
, 0);
1531 /* Return nonzero iff LIST is a non-nil atom or
1532 a list containing one of CONDITIONS. */
1535 wants_debugger (list
, conditions
)
1536 Lisp_Object list
, conditions
;
1543 while (CONSP (conditions
))
1545 Lisp_Object
this, tail
;
1546 this = XCAR (conditions
);
1547 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1548 if (EQ (XCAR (tail
), this))
1550 conditions
= XCDR (conditions
);
1555 /* Return 1 if an error with condition-symbols CONDITIONS,
1556 and described by SIGNAL-DATA, should skip the debugger
1557 according to debugger-ignored-errors. */
1560 skip_debugger (conditions
, data
)
1561 Lisp_Object conditions
, data
;
1564 int first_string
= 1;
1565 Lisp_Object error_message
;
1567 error_message
= Qnil
;
1568 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1570 if (STRINGP (XCAR (tail
)))
1574 error_message
= Ferror_message_string (data
);
1578 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1583 Lisp_Object contail
;
1585 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1586 if (EQ (XCAR (tail
), XCAR (contail
)))
1594 /* Value of Qlambda means we have called debugger and user has continued.
1595 There are two ways to pass SIG and DATA:
1596 = SIG is the error symbol, and DATA is the rest of the data.
1597 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1598 This is for memory-full errors only.
1600 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1603 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1604 Lisp_Object handlers
, conditions
, sig
, data
;
1605 Lisp_Object
*debugger_value_ptr
;
1607 register Lisp_Object h
;
1608 register Lisp_Object tem
;
1610 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1612 /* error is used similarly, but means print an error message
1613 and run the debugger if that is enabled. */
1614 if (EQ (handlers
, Qerror
)
1615 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1616 there is a handler. */
1618 int count
= specpdl_ptr
- specpdl
;
1619 int debugger_called
= 0;
1620 Lisp_Object sig_symbol
, combined_data
;
1621 /* This is set to 1 if we are handling a memory-full error,
1622 because these must not run the debugger.
1623 (There is no room in memory to do that!) */
1624 int no_debugger
= 0;
1628 combined_data
= data
;
1629 sig_symbol
= Fcar (data
);
1634 combined_data
= Fcons (sig
, data
);
1638 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1641 internal_with_output_to_temp_buffer ("*Backtrace*",
1642 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1645 internal_with_output_to_temp_buffer ("*Backtrace*",
1650 && (EQ (sig_symbol
, Qquit
)
1652 : wants_debugger (Vdebug_on_error
, conditions
))
1653 && ! skip_debugger (conditions
, combined_data
)
1654 && when_entered_debugger
< num_nonmacro_input_events
)
1656 specbind (Qdebug_on_error
, Qnil
);
1658 = call_debugger (Fcons (Qerror
,
1659 Fcons (combined_data
, Qnil
)));
1660 debugger_called
= 1;
1662 /* If there is no handler, return saying whether we ran the debugger. */
1663 if (EQ (handlers
, Qerror
))
1665 if (debugger_called
)
1666 return unbind_to (count
, Qlambda
);
1670 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1672 Lisp_Object handler
, condit
;
1675 if (!CONSP (handler
))
1677 condit
= Fcar (handler
);
1678 /* Handle a single condition name in handler HANDLER. */
1679 if (SYMBOLP (condit
))
1681 tem
= Fmemq (Fcar (handler
), conditions
);
1685 /* Handle a list of condition names in handler HANDLER. */
1686 else if (CONSP (condit
))
1688 while (CONSP (condit
))
1690 tem
= Fmemq (Fcar (condit
), conditions
);
1693 condit
= XCDR (condit
);
1700 /* dump an error message; called like printf */
1704 error (m
, a1
, a2
, a3
)
1724 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1729 buffer
= (char *) xrealloc (buffer
, size
);
1732 buffer
= (char *) xmalloc (size
);
1737 string
= build_string (buffer
);
1741 Fsignal (Qerror
, Fcons (string
, Qnil
));
1745 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1746 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1747 This means it contains a description for how to read arguments to give it.
1748 The value is nil for an invalid function or a symbol with no function
1751 Interactively callable functions include strings and vectors (treated
1752 as keyboard macros), lambda-expressions that contain a top-level call
1753 to `interactive', autoload definitions made by `autoload' with non-nil
1754 fourth argument, and some of the built-in functions of Lisp.
1756 Also, a symbol satisfies `commandp' if its function definition does so. */)
1758 Lisp_Object function
;
1760 register Lisp_Object fun
;
1761 register Lisp_Object funcar
;
1765 fun
= indirect_function (fun
);
1766 if (EQ (fun
, Qunbound
))
1769 /* Emacs primitives are interactive if their DEFUN specifies an
1770 interactive spec. */
1773 if (XSUBR (fun
)->prompt
)
1779 /* Bytecode objects are interactive if they are long enough to
1780 have an element whose index is COMPILED_INTERACTIVE, which is
1781 where the interactive spec is stored. */
1782 else if (COMPILEDP (fun
))
1783 return ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1786 /* Strings and vectors are keyboard macros. */
1787 if (STRINGP (fun
) || VECTORP (fun
))
1790 /* Lists may represent commands. */
1793 funcar
= Fcar (fun
);
1794 if (!SYMBOLP (funcar
))
1795 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1796 if (EQ (funcar
, Qlambda
))
1797 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1798 if (EQ (funcar
, Qmocklisp
))
1799 return Qt
; /* All mocklisp functions can be called interactively */
1800 if (EQ (funcar
, Qautoload
))
1801 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1807 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1808 doc
: /* Define FUNCTION to autoload from FILE.
1809 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1810 Third arg DOCSTRING is documentation for the function.
1811 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1812 Fifth arg TYPE indicates the type of the object:
1813 nil or omitted says FUNCTION is a function,
1814 `keymap' says FUNCTION is really a keymap, and
1815 `macro' or t says FUNCTION is really a macro.
1816 Third through fifth args give info about the real definition.
1817 They default to nil.
1818 If FUNCTION is already defined other than as an autoload,
1819 this does nothing and returns nil. */)
1820 (function
, file
, docstring
, interactive
, type
)
1821 Lisp_Object function
, file
, docstring
, interactive
, type
;
1824 Lisp_Object args
[4];
1827 CHECK_SYMBOL (function
);
1828 CHECK_STRING (file
);
1830 /* If function is defined and not as an autoload, don't override */
1831 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1832 && !(CONSP (XSYMBOL (function
)->function
)
1833 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1836 if (NILP (Vpurify_flag
))
1837 /* Only add entries after dumping, because the ones before are
1838 not useful and else we get loads of them from the loaddefs.el. */
1839 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1843 args
[1] = docstring
;
1844 args
[2] = interactive
;
1847 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1848 #else /* NO_ARG_ARRAY */
1849 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1850 #endif /* not NO_ARG_ARRAY */
1854 un_autoload (oldqueue
)
1855 Lisp_Object oldqueue
;
1857 register Lisp_Object queue
, first
, second
;
1859 /* Queue to unwind is current value of Vautoload_queue.
1860 oldqueue is the shadowed value to leave in Vautoload_queue. */
1861 queue
= Vautoload_queue
;
1862 Vautoload_queue
= oldqueue
;
1863 while (CONSP (queue
))
1865 first
= Fcar (queue
);
1866 second
= Fcdr (first
);
1867 first
= Fcar (first
);
1868 if (EQ (second
, Qnil
))
1871 Ffset (first
, second
);
1872 queue
= Fcdr (queue
);
1877 /* Load an autoloaded function.
1878 FUNNAME is the symbol which is the function's name.
1879 FUNDEF is the autoload definition (a list). */
1882 do_autoload (fundef
, funname
)
1883 Lisp_Object fundef
, funname
;
1885 int count
= specpdl_ptr
- specpdl
;
1886 Lisp_Object fun
, queue
, first
, second
;
1887 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1890 CHECK_SYMBOL (funname
);
1891 GCPRO3 (fun
, funname
, fundef
);
1893 /* Preserve the match data. */
1894 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1896 /* Value saved here is to be restored into Vautoload_queue. */
1897 record_unwind_protect (un_autoload
, Vautoload_queue
);
1898 Vautoload_queue
= Qt
;
1899 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1901 /* Save the old autoloads, in case we ever do an unload. */
1902 queue
= Vautoload_queue
;
1903 while (CONSP (queue
))
1905 first
= Fcar (queue
);
1906 second
= Fcdr (first
);
1907 first
= Fcar (first
);
1909 /* Note: This test is subtle. The cdr of an autoload-queue entry
1910 may be an atom if the autoload entry was generated by a defalias
1913 Fput (first
, Qautoload
, (Fcdr (second
)));
1915 queue
= Fcdr (queue
);
1918 /* Once loading finishes, don't undo it. */
1919 Vautoload_queue
= Qt
;
1920 unbind_to (count
, Qnil
);
1922 fun
= Findirect_function (fun
);
1924 if (!NILP (Fequal (fun
, fundef
)))
1925 error ("Autoloading failed to define function %s",
1926 XSYMBOL (funname
)->name
->data
);
1931 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1932 doc
: /* Evaluate FORM and return its value. */)
1936 Lisp_Object fun
, val
, original_fun
, original_args
;
1938 struct backtrace backtrace
;
1939 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1941 if (handling_signal
)
1946 if (EQ (Vmocklisp_arguments
, Qt
))
1947 return Fsymbol_value (form
);
1948 val
= Fsymbol_value (form
);
1950 XSETFASTINT (val
, 0);
1951 else if (EQ (val
, Qt
))
1952 XSETFASTINT (val
, 1);
1959 if (consing_since_gc
> gc_cons_threshold
)
1962 Fgarbage_collect ();
1966 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1968 if (max_lisp_eval_depth
< 100)
1969 max_lisp_eval_depth
= 100;
1970 if (lisp_eval_depth
> max_lisp_eval_depth
)
1971 error ("Lisp nesting exceeds max-lisp-eval-depth");
1974 original_fun
= Fcar (form
);
1975 original_args
= Fcdr (form
);
1977 backtrace
.next
= backtrace_list
;
1978 backtrace_list
= &backtrace
;
1979 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1980 backtrace
.args
= &original_args
;
1981 backtrace
.nargs
= UNEVALLED
;
1982 backtrace
.evalargs
= 1;
1983 backtrace
.debug_on_exit
= 0;
1985 if (debug_on_next_call
)
1986 do_debug_on_call (Qt
);
1988 /* At this point, only original_fun and original_args
1989 have values that will be used below */
1991 fun
= Findirect_function (original_fun
);
1995 Lisp_Object numargs
;
1996 Lisp_Object argvals
[8];
1997 Lisp_Object args_left
;
1998 register int i
, maxargs
;
2000 args_left
= original_args
;
2001 numargs
= Flength (args_left
);
2003 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2004 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2005 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2007 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2009 backtrace
.evalargs
= 0;
2010 val
= (*XSUBR (fun
)->function
) (args_left
);
2014 if (XSUBR (fun
)->max_args
== MANY
)
2016 /* Pass a vector of evaluated arguments */
2018 register int argnum
= 0;
2020 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2022 GCPRO3 (args_left
, fun
, fun
);
2026 while (!NILP (args_left
))
2028 vals
[argnum
++] = Feval (Fcar (args_left
));
2029 args_left
= Fcdr (args_left
);
2030 gcpro3
.nvars
= argnum
;
2033 backtrace
.args
= vals
;
2034 backtrace
.nargs
= XINT (numargs
);
2036 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2041 GCPRO3 (args_left
, fun
, fun
);
2042 gcpro3
.var
= argvals
;
2045 maxargs
= XSUBR (fun
)->max_args
;
2046 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2048 argvals
[i
] = Feval (Fcar (args_left
));
2054 backtrace
.args
= argvals
;
2055 backtrace
.nargs
= XINT (numargs
);
2060 val
= (*XSUBR (fun
)->function
) ();
2063 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2066 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2069 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2073 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2074 argvals
[2], argvals
[3]);
2077 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2078 argvals
[3], argvals
[4]);
2081 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2082 argvals
[3], argvals
[4], argvals
[5]);
2085 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2086 argvals
[3], argvals
[4], argvals
[5],
2091 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2092 argvals
[3], argvals
[4], argvals
[5],
2093 argvals
[6], argvals
[7]);
2097 /* Someone has created a subr that takes more arguments than
2098 is supported by this code. We need to either rewrite the
2099 subr to use a different argument protocol, or add more
2100 cases to this switch. */
2104 if (COMPILEDP (fun
))
2105 val
= apply_lambda (fun
, original_args
, 1);
2109 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2110 funcar
= Fcar (fun
);
2111 if (!SYMBOLP (funcar
))
2112 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2113 if (EQ (funcar
, Qautoload
))
2115 do_autoload (fun
, original_fun
);
2118 if (EQ (funcar
, Qmacro
))
2119 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2120 else if (EQ (funcar
, Qlambda
))
2121 val
= apply_lambda (fun
, original_args
, 1);
2122 else if (EQ (funcar
, Qmocklisp
))
2123 val
= ml_apply (fun
, original_args
);
2125 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2128 if (!EQ (Vmocklisp_arguments
, Qt
))
2131 XSETFASTINT (val
, 0);
2132 else if (EQ (val
, Qt
))
2133 XSETFASTINT (val
, 1);
2136 if (backtrace
.debug_on_exit
)
2137 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2138 backtrace_list
= backtrace
.next
;
2142 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2143 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2144 Then return the value FUNCTION returns.
2145 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2146 usage: (apply FUNCTION &rest ARGUMENTS) */)
2151 register int i
, numargs
;
2152 register Lisp_Object spread_arg
;
2153 register Lisp_Object
*funcall_args
;
2155 struct gcpro gcpro1
;
2159 spread_arg
= args
[nargs
- 1];
2160 CHECK_LIST (spread_arg
);
2162 numargs
= XINT (Flength (spread_arg
));
2165 return Ffuncall (nargs
- 1, args
);
2166 else if (numargs
== 1)
2168 args
[nargs
- 1] = XCAR (spread_arg
);
2169 return Ffuncall (nargs
, args
);
2172 numargs
+= nargs
- 2;
2174 fun
= indirect_function (fun
);
2175 if (EQ (fun
, Qunbound
))
2177 /* Let funcall get the error */
2184 if (numargs
< XSUBR (fun
)->min_args
2185 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2186 goto funcall
; /* Let funcall get the error */
2187 else if (XSUBR (fun
)->max_args
> numargs
)
2189 /* Avoid making funcall cons up a yet another new vector of arguments
2190 by explicitly supplying nil's for optional values */
2191 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2192 * sizeof (Lisp_Object
));
2193 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2194 funcall_args
[++i
] = Qnil
;
2195 GCPRO1 (*funcall_args
);
2196 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2200 /* We add 1 to numargs because funcall_args includes the
2201 function itself as well as its arguments. */
2204 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2205 * sizeof (Lisp_Object
));
2206 GCPRO1 (*funcall_args
);
2207 gcpro1
.nvars
= 1 + numargs
;
2210 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2211 /* Spread the last arg we got. Its first element goes in
2212 the slot that it used to occupy, hence this value of I. */
2214 while (!NILP (spread_arg
))
2216 funcall_args
[i
++] = XCAR (spread_arg
);
2217 spread_arg
= XCDR (spread_arg
);
2220 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2223 /* Run hook variables in various ways. */
2225 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2226 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2227 enum run_hooks_condition
));
2229 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2230 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2231 Each argument should be a symbol, a hook variable.
2232 These symbols are processed in the order specified.
2233 If a hook symbol has a non-nil value, that value may be a function
2234 or a list of functions to be called to run the hook.
2235 If the value is a function, it is called with no arguments.
2236 If it is a list, the elements are called, in order, with no arguments.
2238 Do not use `make-local-variable' to make a hook variable buffer-local.
2239 Instead, use `add-hook' and specify t for the LOCAL argument.
2240 usage: (run-hooks &rest HOOKS) */)
2245 Lisp_Object hook
[1];
2248 for (i
= 0; i
< nargs
; i
++)
2251 run_hook_with_args (1, hook
, to_completion
);
2257 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2258 Srun_hook_with_args
, 1, MANY
, 0,
2259 doc
: /* Run HOOK with the specified arguments ARGS.
2260 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2261 value, that value may be a function or a list of functions to be
2262 called to run the hook. If the value is a function, it is called with
2263 the given arguments and its return value is returned. If it is a list
2264 of functions, those functions are called, in order,
2265 with the given arguments ARGS.
2266 It is best not to depend on the value return by `run-hook-with-args',
2269 Do not use `make-local-variable' to make a hook variable buffer-local.
2270 Instead, use `add-hook' and specify t for the LOCAL argument.
2271 usage: (run-hook-with-args HOOK &rest ARGS) */)
2276 return run_hook_with_args (nargs
, args
, to_completion
);
2279 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2280 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2281 doc
: /* Run HOOK with the specified arguments ARGS.
2282 HOOK should be a symbol, a hook variable. Its value should
2283 be a list of functions. We call those functions, one by one,
2284 passing arguments ARGS to each of them, until one of them
2285 returns a non-nil value. Then we return that value.
2286 If all the functions return nil, we return nil.
2288 Do not use `make-local-variable' to make a hook variable buffer-local.
2289 Instead, use `add-hook' and specify t for the LOCAL argument.
2290 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2295 return run_hook_with_args (nargs
, args
, until_success
);
2298 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2299 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2300 doc
: /* Run HOOK with the specified arguments ARGS.
2301 HOOK should be a symbol, a hook variable. Its value should
2302 be a list of functions. We call those functions, one by one,
2303 passing arguments ARGS to each of them, until one of them
2304 returns nil. Then we return nil.
2305 If all the functions return non-nil, we return non-nil.
2307 Do not use `make-local-variable' to make a hook variable buffer-local.
2308 Instead, use `add-hook' and specify t for the LOCAL argument.
2309 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2314 return run_hook_with_args (nargs
, args
, until_failure
);
2317 /* ARGS[0] should be a hook symbol.
2318 Call each of the functions in the hook value, passing each of them
2319 as arguments all the rest of ARGS (all NARGS - 1 elements).
2320 COND specifies a condition to test after each call
2321 to decide whether to stop.
2322 The caller (or its caller, etc) must gcpro all of ARGS,
2323 except that it isn't necessary to gcpro ARGS[0]. */
2326 run_hook_with_args (nargs
, args
, cond
)
2329 enum run_hooks_condition cond
;
2331 Lisp_Object sym
, val
, ret
;
2332 Lisp_Object globals
;
2333 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2335 /* If we are dying or still initializing,
2336 don't do anything--it would probably crash if we tried. */
2337 if (NILP (Vrun_hooks
))
2341 val
= find_symbol_value (sym
);
2342 ret
= (cond
== until_failure
? Qt
: Qnil
);
2344 if (EQ (val
, Qunbound
) || NILP (val
))
2346 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2349 return Ffuncall (nargs
, args
);
2354 GCPRO3 (sym
, val
, globals
);
2357 CONSP (val
) && ((cond
== to_completion
)
2358 || (cond
== until_success
? NILP (ret
)
2362 if (EQ (XCAR (val
), Qt
))
2364 /* t indicates this hook has a local binding;
2365 it means to run the global binding too. */
2367 for (globals
= Fdefault_value (sym
);
2368 CONSP (globals
) && ((cond
== to_completion
)
2369 || (cond
== until_success
? NILP (ret
)
2371 globals
= XCDR (globals
))
2373 args
[0] = XCAR (globals
);
2374 /* In a global value, t should not occur. If it does, we
2375 must ignore it to avoid an endless loop. */
2376 if (!EQ (args
[0], Qt
))
2377 ret
= Ffuncall (nargs
, args
);
2382 args
[0] = XCAR (val
);
2383 ret
= Ffuncall (nargs
, args
);
2392 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2393 present value of that symbol.
2394 Call each element of FUNLIST,
2395 passing each of them the rest of ARGS.
2396 The caller (or its caller, etc) must gcpro all of ARGS,
2397 except that it isn't necessary to gcpro ARGS[0]. */
2400 run_hook_list_with_args (funlist
, nargs
, args
)
2401 Lisp_Object funlist
;
2407 Lisp_Object globals
;
2408 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2412 GCPRO3 (sym
, val
, globals
);
2414 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2416 if (EQ (XCAR (val
), Qt
))
2418 /* t indicates this hook has a local binding;
2419 it means to run the global binding too. */
2421 for (globals
= Fdefault_value (sym
);
2423 globals
= XCDR (globals
))
2425 args
[0] = XCAR (globals
);
2426 /* In a global value, t should not occur. If it does, we
2427 must ignore it to avoid an endless loop. */
2428 if (!EQ (args
[0], Qt
))
2429 Ffuncall (nargs
, args
);
2434 args
[0] = XCAR (val
);
2435 Ffuncall (nargs
, args
);
2442 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2445 run_hook_with_args_2 (hook
, arg1
, arg2
)
2446 Lisp_Object hook
, arg1
, arg2
;
2448 Lisp_Object temp
[3];
2453 Frun_hook_with_args (3, temp
);
2456 /* Apply fn to arg */
2459 Lisp_Object fn
, arg
;
2461 struct gcpro gcpro1
;
2465 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2469 Lisp_Object args
[2];
2473 RETURN_UNGCPRO (Fapply (2, args
));
2475 #else /* not NO_ARG_ARRAY */
2476 RETURN_UNGCPRO (Fapply (2, &fn
));
2477 #endif /* not NO_ARG_ARRAY */
2480 /* Call function fn on no arguments */
2485 struct gcpro gcpro1
;
2488 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2491 /* Call function fn with 1 argument arg1 */
2495 Lisp_Object fn
, arg1
;
2497 struct gcpro gcpro1
;
2499 Lisp_Object args
[2];
2505 RETURN_UNGCPRO (Ffuncall (2, args
));
2506 #else /* not NO_ARG_ARRAY */
2509 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2510 #endif /* not NO_ARG_ARRAY */
2513 /* Call function fn with 2 arguments arg1, arg2 */
2516 call2 (fn
, arg1
, arg2
)
2517 Lisp_Object fn
, arg1
, arg2
;
2519 struct gcpro gcpro1
;
2521 Lisp_Object args
[3];
2527 RETURN_UNGCPRO (Ffuncall (3, args
));
2528 #else /* not NO_ARG_ARRAY */
2531 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2532 #endif /* not NO_ARG_ARRAY */
2535 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2538 call3 (fn
, arg1
, arg2
, arg3
)
2539 Lisp_Object fn
, arg1
, arg2
, arg3
;
2541 struct gcpro gcpro1
;
2543 Lisp_Object args
[4];
2550 RETURN_UNGCPRO (Ffuncall (4, args
));
2551 #else /* not NO_ARG_ARRAY */
2554 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2555 #endif /* not NO_ARG_ARRAY */
2558 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2561 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2562 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2564 struct gcpro gcpro1
;
2566 Lisp_Object args
[5];
2574 RETURN_UNGCPRO (Ffuncall (5, args
));
2575 #else /* not NO_ARG_ARRAY */
2578 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2579 #endif /* not NO_ARG_ARRAY */
2582 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2585 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2586 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2588 struct gcpro gcpro1
;
2590 Lisp_Object args
[6];
2599 RETURN_UNGCPRO (Ffuncall (6, args
));
2600 #else /* not NO_ARG_ARRAY */
2603 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2604 #endif /* not NO_ARG_ARRAY */
2607 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2610 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2611 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2613 struct gcpro gcpro1
;
2615 Lisp_Object args
[7];
2625 RETURN_UNGCPRO (Ffuncall (7, args
));
2626 #else /* not NO_ARG_ARRAY */
2629 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2630 #endif /* not NO_ARG_ARRAY */
2633 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2634 doc
: /* Call first argument as a function, passing remaining arguments to it.
2635 Return the value that function returns.
2636 Thus, (funcall 'cons 'x 'y) returns (x . y).
2637 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2644 int numargs
= nargs
- 1;
2645 Lisp_Object lisp_numargs
;
2647 struct backtrace backtrace
;
2648 register Lisp_Object
*internal_args
;
2652 if (consing_since_gc
> gc_cons_threshold
)
2653 Fgarbage_collect ();
2655 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2657 if (max_lisp_eval_depth
< 100)
2658 max_lisp_eval_depth
= 100;
2659 if (lisp_eval_depth
> max_lisp_eval_depth
)
2660 error ("Lisp nesting exceeds max-lisp-eval-depth");
2663 backtrace
.next
= backtrace_list
;
2664 backtrace_list
= &backtrace
;
2665 backtrace
.function
= &args
[0];
2666 backtrace
.args
= &args
[1];
2667 backtrace
.nargs
= nargs
- 1;
2668 backtrace
.evalargs
= 0;
2669 backtrace
.debug_on_exit
= 0;
2671 if (debug_on_next_call
)
2672 do_debug_on_call (Qlambda
);
2678 fun
= Findirect_function (fun
);
2682 if (numargs
< XSUBR (fun
)->min_args
2683 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2685 XSETFASTINT (lisp_numargs
, numargs
);
2686 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2689 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2690 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2692 if (XSUBR (fun
)->max_args
== MANY
)
2694 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2698 if (XSUBR (fun
)->max_args
> numargs
)
2700 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2701 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2702 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2703 internal_args
[i
] = Qnil
;
2706 internal_args
= args
+ 1;
2707 switch (XSUBR (fun
)->max_args
)
2710 val
= (*XSUBR (fun
)->function
) ();
2713 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2716 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2720 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2724 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2729 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2730 internal_args
[2], internal_args
[3],
2734 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2735 internal_args
[2], internal_args
[3],
2736 internal_args
[4], internal_args
[5]);
2739 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2740 internal_args
[2], internal_args
[3],
2741 internal_args
[4], internal_args
[5],
2746 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2747 internal_args
[2], internal_args
[3],
2748 internal_args
[4], internal_args
[5],
2749 internal_args
[6], internal_args
[7]);
2754 /* If a subr takes more than 8 arguments without using MANY
2755 or UNEVALLED, we need to extend this function to support it.
2756 Until this is done, there is no way to call the function. */
2760 if (COMPILEDP (fun
))
2761 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2765 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2766 funcar
= Fcar (fun
);
2767 if (!SYMBOLP (funcar
))
2768 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2769 if (EQ (funcar
, Qlambda
))
2770 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2771 else if (EQ (funcar
, Qmocklisp
))
2772 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2773 else if (EQ (funcar
, Qautoload
))
2775 do_autoload (fun
, args
[0]);
2779 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2783 if (backtrace
.debug_on_exit
)
2784 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2785 backtrace_list
= backtrace
.next
;
2790 apply_lambda (fun
, args
, eval_flag
)
2791 Lisp_Object fun
, args
;
2794 Lisp_Object args_left
;
2795 Lisp_Object numargs
;
2796 register Lisp_Object
*arg_vector
;
2797 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2799 register Lisp_Object tem
;
2801 numargs
= Flength (args
);
2802 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2805 GCPRO3 (*arg_vector
, args_left
, fun
);
2808 for (i
= 0; i
< XINT (numargs
);)
2810 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2811 if (eval_flag
) tem
= Feval (tem
);
2812 arg_vector
[i
++] = tem
;
2820 backtrace_list
->args
= arg_vector
;
2821 backtrace_list
->nargs
= i
;
2823 backtrace_list
->evalargs
= 0;
2824 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2826 /* Do the debug-on-exit now, while arg_vector still exists. */
2827 if (backtrace_list
->debug_on_exit
)
2828 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2829 /* Don't do it again when we return to eval. */
2830 backtrace_list
->debug_on_exit
= 0;
2834 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2835 and return the result of evaluation.
2836 FUN must be either a lambda-expression or a compiled-code object. */
2839 funcall_lambda (fun
, nargs
, arg_vector
)
2842 register Lisp_Object
*arg_vector
;
2844 Lisp_Object val
, syms_left
, next
;
2845 int count
= specpdl_ptr
- specpdl
;
2846 int i
, optional
, rest
;
2848 if (NILP (Vmocklisp_arguments
))
2849 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2853 syms_left
= XCDR (fun
);
2854 if (CONSP (syms_left
))
2855 syms_left
= XCAR (syms_left
);
2857 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2859 else if (COMPILEDP (fun
))
2860 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2864 i
= optional
= rest
= 0;
2865 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2869 next
= XCAR (syms_left
);
2870 while (!SYMBOLP (next
))
2871 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2873 if (EQ (next
, Qand_rest
))
2875 else if (EQ (next
, Qand_optional
))
2879 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2883 specbind (next
, arg_vector
[i
++]);
2885 return Fsignal (Qwrong_number_of_arguments
,
2886 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2888 specbind (next
, Qnil
);
2891 if (!NILP (syms_left
))
2892 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2894 return Fsignal (Qwrong_number_of_arguments
,
2895 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2898 val
= Fprogn (XCDR (XCDR (fun
)));
2901 /* If we have not actually read the bytecode string
2902 and constants vector yet, fetch them from the file. */
2903 if (CONSP (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
]))
2904 Ffetch_bytecode (fun
);
2905 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2906 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2907 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2910 return unbind_to (count
, val
);
2913 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2915 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2921 if (COMPILEDP (object
)
2922 && CONSP (XVECTOR (object
)->contents
[COMPILED_BYTECODE
]))
2924 tem
= read_doc_string (XVECTOR (object
)->contents
[COMPILED_BYTECODE
]);
2926 error ("invalid byte code");
2927 XVECTOR (object
)->contents
[COMPILED_BYTECODE
] = XCAR (tem
);
2928 XVECTOR (object
)->contents
[COMPILED_CONSTANTS
] = XCDR (tem
);
2936 register int count
= specpdl_ptr
- specpdl
;
2937 if (specpdl_size
>= max_specpdl_size
)
2939 if (max_specpdl_size
< 400)
2940 max_specpdl_size
= 400;
2941 if (specpdl_size
>= max_specpdl_size
)
2943 if (!NILP (Vdebug_on_error
))
2944 /* Leave room for some specpdl in the debugger. */
2945 max_specpdl_size
= specpdl_size
+ 100;
2947 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2951 if (specpdl_size
> max_specpdl_size
)
2952 specpdl_size
= max_specpdl_size
;
2953 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2954 specpdl_ptr
= specpdl
+ count
;
2958 specbind (symbol
, value
)
2959 Lisp_Object symbol
, value
;
2962 Lisp_Object valcontents
;
2964 CHECK_SYMBOL (symbol
);
2965 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2968 /* The most common case is that of a non-constant symbol with a
2969 trivial value. Make that as fast as we can. */
2970 valcontents
= SYMBOL_VALUE (symbol
);
2971 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
2973 specpdl_ptr
->symbol
= symbol
;
2974 specpdl_ptr
->old_value
= valcontents
;
2975 specpdl_ptr
->func
= NULL
;
2977 SET_SYMBOL_VALUE (symbol
, value
);
2981 Lisp_Object valcontents
;
2983 ovalue
= find_symbol_value (symbol
);
2984 specpdl_ptr
->func
= 0;
2985 specpdl_ptr
->old_value
= ovalue
;
2987 valcontents
= XSYMBOL (symbol
)->value
;
2989 if (BUFFER_LOCAL_VALUEP (valcontents
)
2990 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
2991 || BUFFER_OBJFWDP (valcontents
))
2993 Lisp_Object where
, current_buffer
;
2995 current_buffer
= Fcurrent_buffer ();
2997 /* For a local variable, record both the symbol and which
2998 buffer's or frame's value we are saving. */
2999 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3000 where
= current_buffer
;
3001 else if (!BUFFER_OBJFWDP (valcontents
)
3002 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3003 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3007 /* We're not using the `unused' slot in the specbinding
3008 structure because this would mean we have to do more
3009 work for simple variables. */
3010 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3012 /* If SYMBOL is a per-buffer variable which doesn't have a
3013 buffer-local value here, make the `let' change the global
3014 value by changing the value of SYMBOL in all buffers not
3015 having their own value. This is consistent with what
3016 happens with other buffer-local variables. */
3018 && BUFFER_OBJFWDP (valcontents
))
3021 Fset_default (symbol
, value
);
3026 specpdl_ptr
->symbol
= symbol
;
3029 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3030 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3032 set_internal (symbol
, value
, 0, 1);
3037 record_unwind_protect (function
, arg
)
3038 Lisp_Object (*function
) P_ ((Lisp_Object
));
3041 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3043 specpdl_ptr
->func
= function
;
3044 specpdl_ptr
->symbol
= Qnil
;
3045 specpdl_ptr
->old_value
= arg
;
3050 unbind_to (count
, value
)
3054 int quitf
= !NILP (Vquit_flag
);
3055 struct gcpro gcpro1
;
3060 while (specpdl_ptr
!= specpdl
+ count
)
3064 if (specpdl_ptr
->func
!= 0)
3065 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
3066 /* Note that a "binding" of nil is really an unwind protect,
3067 so in that case the "old value" is a list of forms to evaluate. */
3068 else if (NILP (specpdl_ptr
->symbol
))
3069 Fprogn (specpdl_ptr
->old_value
);
3070 /* If the symbol is a list, it is really (SYMBOL WHERE
3071 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3072 frame. If WHERE is a buffer or frame, this indicates we
3073 bound a variable that had a buffer-local or frame-local
3074 binding. WHERE nil means that the variable had the default
3075 value when it was bound. CURRENT-BUFFER is the buffer that
3076 was current when the variable was bound. */
3077 else if (CONSP (specpdl_ptr
->symbol
))
3079 Lisp_Object symbol
, where
;
3081 symbol
= XCAR (specpdl_ptr
->symbol
);
3082 where
= XCAR (XCDR (specpdl_ptr
->symbol
));
3085 Fset_default (symbol
, specpdl_ptr
->old_value
);
3086 else if (BUFFERP (where
))
3087 set_internal (symbol
, specpdl_ptr
->old_value
, XBUFFER (where
), 1);
3089 set_internal (symbol
, specpdl_ptr
->old_value
, NULL
, 1);
3093 /* If variable has a trivial value (no forwarding), we can
3094 just set it. No need to check for constant symbols here,
3095 since that was already done by specbind. */
3096 if (!MISCP (SYMBOL_VALUE (specpdl_ptr
->symbol
)))
3097 SET_SYMBOL_VALUE (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
3099 set_internal (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
, 0, 1);
3103 if (NILP (Vquit_flag
) && quitf
)
3110 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3111 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3112 The debugger is entered when that frame exits, if the flag is non-nil. */)
3114 Lisp_Object level
, flag
;
3116 register struct backtrace
*backlist
= backtrace_list
;
3119 CHECK_NUMBER (level
);
3121 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3123 backlist
= backlist
->next
;
3127 backlist
->debug_on_exit
= !NILP (flag
);
3132 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3133 doc
: /* Print a trace of Lisp function calls currently active.
3134 Output stream used is value of `standard-output'. */)
3137 register struct backtrace
*backlist
= backtrace_list
;
3141 extern Lisp_Object Vprint_level
;
3142 struct gcpro gcpro1
;
3144 XSETFASTINT (Vprint_level
, 3);
3151 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3152 if (backlist
->nargs
== UNEVALLED
)
3154 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3155 write_string ("\n", -1);
3159 tem
= *backlist
->function
;
3160 Fprin1 (tem
, Qnil
); /* This can QUIT */
3161 write_string ("(", -1);
3162 if (backlist
->nargs
== MANY
)
3164 for (tail
= *backlist
->args
, i
= 0;
3166 tail
= Fcdr (tail
), i
++)
3168 if (i
) write_string (" ", -1);
3169 Fprin1 (Fcar (tail
), Qnil
);
3174 for (i
= 0; i
< backlist
->nargs
; i
++)
3176 if (i
) write_string (" ", -1);
3177 Fprin1 (backlist
->args
[i
], Qnil
);
3180 write_string (")\n", -1);
3182 backlist
= backlist
->next
;
3185 Vprint_level
= Qnil
;
3190 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3191 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3192 If that frame has not evaluated the arguments yet (or is a special form),
3193 the value is (nil FUNCTION ARG-FORMS...).
3194 If that frame has evaluated its arguments and called its function already,
3195 the value is (t FUNCTION ARG-VALUES...).
3196 A &rest arg is represented as the tail of the list ARG-VALUES.
3197 FUNCTION is whatever was supplied as car of evaluated list,
3198 or a lambda expression for macro calls.
3199 If NFRAMES is more than the number of frames, the value is nil. */)
3201 Lisp_Object nframes
;
3203 register struct backtrace
*backlist
= backtrace_list
;
3207 CHECK_NATNUM (nframes
);
3209 /* Find the frame requested. */
3210 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3211 backlist
= backlist
->next
;
3215 if (backlist
->nargs
== UNEVALLED
)
3216 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3219 if (backlist
->nargs
== MANY
)
3220 tem
= *backlist
->args
;
3222 tem
= Flist (backlist
->nargs
, backlist
->args
);
3224 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3232 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3233 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3234 If Lisp code tries to make more than this many at once,
3235 an error is signaled. */);
3237 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3238 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3239 This limit is to catch infinite recursions for you before they cause
3240 actual stack overflow in C, which would be fatal for Emacs.
3241 You can safely make it considerably larger than its default value,
3242 if that proves inconveniently small. */);
3244 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3245 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3246 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
3249 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3250 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3251 Note that `quit-flag' will still be set by typing C-g,
3252 so a quit will be signaled as soon as `inhibit-quit' is nil.
3253 To prevent this happening, set `quit-flag' to nil
3254 before making `inhibit-quit' nil. */);
3255 Vinhibit_quit
= Qnil
;
3257 Qinhibit_quit
= intern ("inhibit-quit");
3258 staticpro (&Qinhibit_quit
);
3260 Qautoload
= intern ("autoload");
3261 staticpro (&Qautoload
);
3263 Qdebug_on_error
= intern ("debug-on-error");
3264 staticpro (&Qdebug_on_error
);
3266 Qmacro
= intern ("macro");
3267 staticpro (&Qmacro
);
3269 /* Note that the process handling also uses Qexit, but we don't want
3270 to staticpro it twice, so we just do it here. */
3271 Qexit
= intern ("exit");
3274 Qinteractive
= intern ("interactive");
3275 staticpro (&Qinteractive
);
3277 Qcommandp
= intern ("commandp");
3278 staticpro (&Qcommandp
);
3280 Qdefun
= intern ("defun");
3281 staticpro (&Qdefun
);
3283 Qand_rest
= intern ("&rest");
3284 staticpro (&Qand_rest
);
3286 Qand_optional
= intern ("&optional");
3287 staticpro (&Qand_optional
);
3289 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3290 doc
: /* *Non-nil means errors display a backtrace buffer.
3291 More precisely, this happens for any error that is handled
3292 by the editor command loop.
3293 If the value is a list, an error only means to display a backtrace
3294 if one of its condition symbols appears in the list. */);
3295 Vstack_trace_on_error
= Qnil
;
3297 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3298 doc
: /* *Non-nil means enter debugger if an error is signaled.
3299 Does not apply to errors handled by `condition-case' or those
3300 matched by `debug-ignored-errors'.
3301 If the value is a list, an error only means to enter the debugger
3302 if one of its condition symbols appears in the list.
3303 When you evaluate an expression interactively, this variable
3304 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3305 See also variable `debug-on-quit'. */);
3306 Vdebug_on_error
= Qnil
;
3308 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3309 doc
: /* *List of errors for which the debugger should not be called.
3310 Each element may be a condition-name or a regexp that matches error messages.
3311 If any element applies to a given error, that error skips the debugger
3312 and just returns to top level.
3313 This overrides the variable `debug-on-error'.
3314 It does not apply to errors handled by `condition-case'. */);
3315 Vdebug_ignored_errors
= Qnil
;
3317 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3318 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3319 Does not apply if quit is handled by a `condition-case'.
3320 When you evaluate an expression interactively, this variable
3321 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3324 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3325 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3327 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3328 doc
: /* Non-nil means debugger may continue execution.
3329 This is nil when the debugger is called under circumstances where it
3330 might not be safe to continue. */);
3331 debugger_may_continue
= 1;
3333 DEFVAR_LISP ("debugger", &Vdebugger
,
3334 doc
: /* Function to call to invoke debugger.
3335 If due to frame exit, args are `exit' and the value being returned;
3336 this function's value will be returned instead of that.
3337 If due to error, args are `error' and a list of the args to `signal'.
3338 If due to `apply' or `funcall' entry, one arg, `lambda'.
3339 If due to `eval' entry, one arg, t. */);
3342 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3343 doc
: /* If non-nil, this is a function for `signal' to call.
3344 It receives the same arguments that `signal' was given.
3345 The Edebug package uses this to regain control. */);
3346 Vsignal_hook_function
= Qnil
;
3348 Qmocklisp_arguments
= intern ("mocklisp-arguments");
3349 staticpro (&Qmocklisp_arguments
);
3350 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
3351 doc
: /* While in a mocklisp function, the list of its unevaluated args. */);
3352 Vmocklisp_arguments
= Qt
;
3354 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3355 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3356 Note that `debug-on-error', `debug-on-quit' and friends
3357 still determine whether to handle the particular condition. */);
3358 Vdebug_on_signal
= Qnil
;
3360 Vrun_hooks
= intern ("run-hooks");
3361 staticpro (&Vrun_hooks
);
3363 staticpro (&Vautoload_queue
);
3364 Vautoload_queue
= Qnil
;
3365 staticpro (&Vsignaling_function
);
3366 Vsignaling_function
= Qnil
;
3377 defsubr (&Sfunction
);
3379 defsubr (&Sdefmacro
);
3381 defsubr (&Sdefvaralias
);
3382 defsubr (&Sdefconst
);
3383 defsubr (&Suser_variable_p
);
3387 defsubr (&Smacroexpand
);
3390 defsubr (&Sunwind_protect
);
3391 defsubr (&Scondition_case
);
3393 defsubr (&Sinteractive_p
);
3394 defsubr (&Scommandp
);
3395 defsubr (&Sautoload
);
3398 defsubr (&Sfuncall
);
3399 defsubr (&Srun_hooks
);
3400 defsubr (&Srun_hook_with_args
);
3401 defsubr (&Srun_hook_with_args_until_success
);
3402 defsubr (&Srun_hook_with_args_until_failure
);
3403 defsubr (&Sfetch_bytecode
);
3404 defsubr (&Sbacktrace_debug
);
3405 defsubr (&Sbacktrace
);
3406 defsubr (&Sbacktrace_frame
);