1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include "blockinput.h"
34 /* This definition is duplicated in alloc.c and keyboard.c */
35 /* Putting it in lisp.h makes cc bomb out! */
39 struct backtrace
*next
;
40 Lisp_Object
*function
;
41 Lisp_Object
*args
; /* Points to vector of args. */
42 int nargs
; /* Length of vector.
43 If nargs is UNEVALLED, args points to slot holding
44 list of unevalled args */
46 /* Nonzero means call value of debugger when done with this operation. */
50 struct backtrace
*backtrace_list
;
52 /* This structure helps implement the `catch' and `throw' control
53 structure. A struct catchtag contains all the information needed
54 to restore the state of the interpreter after a non-local jump.
56 Handlers for error conditions (represented by `struct handler'
57 structures) just point to a catch tag to do the cleanup required
60 catchtag structures are chained together in the C calling stack;
61 the `next' member points to the next outer catchtag.
63 A call like (throw TAG VAL) searches for a catchtag whose `tag'
64 member is TAG, and then unbinds to it. The `val' member is used to
65 hold VAL while the stack is unwound; `val' is returned as the value
68 All the other members are concerned with restoring the interpreter
74 struct catchtag
*next
;
77 struct backtrace
*backlist
;
78 struct handler
*handlerlist
;
81 int poll_suppress_count
;
84 struct catchtag
*catchlist
;
86 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
87 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
88 Lisp_Object Qmocklisp_arguments
, Vmocklisp_arguments
, Qmocklisp
;
89 Lisp_Object Qand_rest
, Qand_optional
;
90 Lisp_Object Qdebug_on_error
;
92 Lisp_Object Vrun_hooks
;
94 /* Non-nil means record all fset's and provide's, to be undone
95 if the file being autoloaded is not fully loaded.
96 They are recorded by being consed onto the front of Vautoload_queue:
97 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
99 Lisp_Object Vautoload_queue
;
101 /* Current number of specbindings allocated in specpdl. */
104 /* Pointer to beginning of specpdl. */
105 struct specbinding
*specpdl
;
107 /* Pointer to first unused element in specpdl. */
108 struct specbinding
*specpdl_ptr
;
110 /* Maximum size allowed for specpdl allocation */
111 int max_specpdl_size
;
113 /* Depth in Lisp evaluations and function calls. */
116 /* Maximum allowed depth in Lisp evaluations and function calls. */
117 int max_lisp_eval_depth
;
119 /* Nonzero means enter debugger before next function call */
120 int debug_on_next_call
;
122 /* List of conditions (non-nil atom means all) which cause a backtrace
123 if an error is handled by the command loop's error handler. */
124 Lisp_Object Vstack_trace_on_error
;
126 /* List of conditions (non-nil atom means all) which enter the debugger
127 if an error is handled by the command loop's error handler. */
128 Lisp_Object Vdebug_on_error
;
130 /* Nonzero means enter debugger if a quit signal
131 is handled by the command loop's error handler. */
134 /* The value of num_nonmacro_input_chars as of the last time we
135 started to enter the debugger. If we decide to enter the debugger
136 again when this is still equal to num_nonmacro_input_chars, then we
137 know that the debugger itself has an error, and we should just
138 signal the error instead of entering an infinite loop of debugger
140 int when_entered_debugger
;
142 Lisp_Object Vdebugger
;
144 void specbind (), record_unwind_protect ();
146 Lisp_Object
funcall_lambda ();
147 extern Lisp_Object
ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
152 specpdl
= (struct specbinding
*) malloc (specpdl_size
* sizeof (struct specbinding
));
153 max_specpdl_size
= 600;
154 max_lisp_eval_depth
= 200;
159 specpdl_ptr
= specpdl
;
164 debug_on_next_call
= 0;
166 when_entered_debugger
= 0;
173 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
174 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
175 if (specpdl_size
+ 40 > max_specpdl_size
)
176 max_specpdl_size
= specpdl_size
+ 40;
177 debug_on_next_call
= 0;
178 when_entered_debugger
= num_nonmacro_input_chars
;
179 return apply1 (Vdebugger
, arg
);
182 do_debug_on_call (code
)
185 debug_on_next_call
= 0;
186 backtrace_list
->debug_on_exit
= 1;
187 call_debugger (Fcons (code
, Qnil
));
190 /* NOTE!!! Every function that can call EVAL must protect its args
191 and temporaries from garbage collection while it needs them.
192 The definition of `For' shows what you have to do. */
194 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
195 "Eval args until one of them yields non-nil, then return that value.\n\
196 The remaining args are not evalled at all.\n\
197 If all args return nil, return nil.")
201 register Lisp_Object val
;
202 Lisp_Object args_left
;
213 val
= Feval (Fcar (args_left
));
216 args_left
= Fcdr (args_left
);
218 while (!NILP(args_left
));
224 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
225 "Eval args until one of them yields nil, then return nil.\n\
226 The remaining args are not evalled at all.\n\
227 If no arg yields nil, return the last arg's value.")
231 register Lisp_Object val
;
232 Lisp_Object args_left
;
243 val
= Feval (Fcar (args_left
));
246 args_left
= Fcdr (args_left
);
248 while (!NILP(args_left
));
254 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
255 "(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...\n\
256 Returns the value of THEN or the value of the last of the ELSE's.\n\
257 THEN must be one expression, but ELSE... can be zero or more expressions.\n\
258 If COND yields nil, and there are no ELSE's, the value is nil.")
262 register Lisp_Object cond
;
266 cond
= Feval (Fcar (args
));
270 return Feval (Fcar (Fcdr (args
)));
271 return Fprogn (Fcdr (Fcdr (args
)));
274 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
275 "(cond CLAUSES...): try each clause until one succeeds.\n\
276 Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\
277 and, if the value is non-nil, this clause succeeds:\n\
278 then the expressions in BODY are evaluated and the last one's\n\
279 value is the value of the cond-form.\n\
280 If no clause succeeds, cond returns nil.\n\
281 If a clause has one element, as in (CONDITION),\n\
282 CONDITION's value if non-nil is returned from the cond-form.")
286 register Lisp_Object clause
, val
;
293 clause
= Fcar (args
);
294 val
= Feval (Fcar (clause
));
297 if (!EQ (XCONS (clause
)->cdr
, Qnil
))
298 val
= Fprogn (XCONS (clause
)->cdr
);
301 args
= XCONS (args
)->cdr
;
308 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
309 "(progn BODY...): eval BODY forms sequentially and return value of last one.")
313 register Lisp_Object val
, tem
;
314 Lisp_Object args_left
;
317 /* In Mocklisp code, symbols at the front of the progn arglist
318 are to be bound to zero. */
319 if (!EQ (Vmocklisp_arguments
, Qt
))
321 val
= make_number (0);
322 while (!NILP (args
) && (tem
= Fcar (args
), XTYPE (tem
) == Lisp_Symbol
))
325 specbind (tem
, val
), args
= Fcdr (args
);
337 val
= Feval (Fcar (args_left
));
338 args_left
= Fcdr (args_left
);
340 while (!NILP(args_left
));
346 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
347 "(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.\n\
348 The value of FIRST is saved during the evaluation of the remaining args,\n\
349 whose values are discarded.")
354 register Lisp_Object args_left
;
355 struct gcpro gcpro1
, gcpro2
;
356 register int argnum
= 0;
368 val
= Feval (Fcar (args_left
));
370 Feval (Fcar (args_left
));
371 args_left
= Fcdr (args_left
);
373 while (!NILP(args_left
));
379 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
380 "(prog1 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
381 The value of Y is saved during the evaluation of the remaining args,\n\
382 whose values are discarded.")
387 register Lisp_Object args_left
;
388 struct gcpro gcpro1
, gcpro2
;
389 register int argnum
= -1;
403 val
= Feval (Fcar (args_left
));
405 Feval (Fcar (args_left
));
406 args_left
= Fcdr (args_left
);
408 while (!NILP(args_left
));
414 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
415 "(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
416 The SYMs are not evaluated. Thus (setq x y) sets x to the value of y.\n\
417 Each SYM is set before the next VAL is computed.")
421 register Lisp_Object args_left
;
422 register Lisp_Object val
, sym
;
433 val
= Feval (Fcar (Fcdr (args_left
)));
434 sym
= Fcar (args_left
);
436 args_left
= Fcdr (Fcdr (args_left
));
438 while (!NILP(args_left
));
444 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
445 "Return the argument, without evaluating it. `(quote x)' yields `x'.")
452 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
453 "Like `quote', but preferred for objects which are functions.\n\
454 In byte compilation, `function' causes its argument to be compiled.\n\
455 `quote' cannot do that.")
462 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
463 "Return t if function in which this appears was called interactively.\n\
464 This means that the function was called with call-interactively (which\n\
465 includes being called as the binding of a key)\n\
466 and input is currently coming from the keyboard (not in keyboard macro).")
469 register struct backtrace
*btp
;
470 register Lisp_Object fun
;
475 btp
= backtrace_list
;
477 /* If this isn't a byte-compiled function, there may be a frame at
478 the top for Finteractive_p itself. If so, skip it. */
479 fun
= Findirect_function (*btp
->function
);
480 if (XTYPE (fun
) == Lisp_Subr
481 && (struct Lisp_Subr
*) XPNTR (fun
) == &Sinteractive_p
)
484 /* If we're running an Emacs 18-style byte-compiled function, there
485 may be a frame for Fbytecode. Now, given the strictest
486 definition, this function isn't really being called
487 interactively, but because that's the way Emacs 18 always builds
488 byte-compiled functions, we'll accept it for now. */
489 if (EQ (*btp
->function
, Qbytecode
))
492 /* If this isn't a byte-compiled function, then we may now be
493 looking at several frames for special forms. Skip past them. */
495 btp
->nargs
== UNEVALLED
)
498 /* btp now points at the frame of the innermost function that isn't
499 a special form, ignoring frames for Finteractive_p and/or
500 Fbytecode at the top. If this frame is for a built-in function
501 (such as load or eval-region) return nil. */
502 fun
= Findirect_function (*btp
->function
);
503 if (XTYPE (fun
) == Lisp_Subr
)
505 /* btp points to the frame of a Lisp function that called interactive-p.
506 Return t if that function was called interactively. */
507 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
512 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
513 "(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.\n\
514 The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
515 See also the function `interactive'.")
519 register Lisp_Object fn_name
;
520 register Lisp_Object defn
;
522 fn_name
= Fcar (args
);
523 defn
= Fcons (Qlambda
, Fcdr (args
));
524 if (!NILP (Vpurify_flag
))
525 defn
= Fpurecopy (defn
);
526 Ffset (fn_name
, defn
);
527 LOADHIST_ATTACH (fn_name
);
531 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
532 "(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.\n\
533 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
534 When the macro is called, as in (NAME ARGS...),\n\
535 the function (lambda ARGLIST BODY...) is applied to\n\
536 the list ARGS... as it appears in the expression,\n\
537 and the result should be a form to be evaluated instead of the original.")
541 register Lisp_Object fn_name
;
542 register Lisp_Object defn
;
544 fn_name
= Fcar (args
);
545 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
546 if (!NILP (Vpurify_flag
))
547 defn
= Fpurecopy (defn
);
548 Ffset (fn_name
, defn
);
549 LOADHIST_ATTACH (fn_name
);
553 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
554 "(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.\n\
555 You are not required to define a variable in order to use it,\n\
556 but the definition can supply documentation and an initial value\n\
557 in a way that tags can recognize.\n\n\
558 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
559 If SYMBOL is buffer-local, its default value is what is set;\n\
560 buffer-local values are not affected.\n\
561 INITVALUE and DOCSTRING are optional.\n\
562 If DOCSTRING starts with *, this variable is identified as a user option.\n\
563 This means that M-x set-variable and M-x edit-options recognize it.\n\
564 If INITVALUE is missing, SYMBOL's value is not set.")
568 register Lisp_Object sym
, tem
;
574 tem
= Fdefault_boundp (sym
);
576 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
578 tem
= Fcar (Fcdr (Fcdr (args
)));
581 if (!NILP (Vpurify_flag
))
582 tem
= Fpurecopy (tem
);
583 Fput (sym
, Qvariable_documentation
, tem
);
585 LOADHIST_ATTACH (sym
);
589 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
590 "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
591 The intent is that programs do not change this value, but users may.\n\
592 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
593 If SYMBOL is buffer-local, its default value is what is set;\n\
594 buffer-local values are not affected.\n\
595 DOCSTRING is optional.\n\
596 If DOCSTRING starts with *, this variable is identified as a user option.\n\
597 This means that M-x set-variable and M-x edit-options recognize it.\n\n\
598 Note: do not use `defconst' for user options in libraries that are not\n\
599 normally loaded, since it is useful for users to be able to specify\n\
600 their own values for such variables before loading the library.\n\
601 Since `defconst' unconditionally assigns the variable,\n\
602 it would override the user's choice.")
606 register Lisp_Object sym
, tem
;
609 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
610 tem
= Fcar (Fcdr (Fcdr (args
)));
613 if (!NILP (Vpurify_flag
))
614 tem
= Fpurecopy (tem
);
615 Fput (sym
, Qvariable_documentation
, tem
);
617 LOADHIST_ATTACH (sym
);
621 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
622 "Returns t if VARIABLE is intended to be set and modified by users.\n\
623 \(The alternative is a variable used internally in a Lisp program.)\n\
624 Determined by whether the first character of the documentation\n\
625 for the variable is \"*\"")
627 Lisp_Object variable
;
629 Lisp_Object documentation
;
631 documentation
= Fget (variable
, Qvariable_documentation
);
632 if (XTYPE (documentation
) == Lisp_Int
&& XINT (documentation
) < 0)
634 if ((XTYPE (documentation
) == Lisp_String
) &&
635 ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
640 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
641 "(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
642 The value of the last form in BODY is returned.\n\
643 Each element of VARLIST is a symbol (which is bound to nil)\n\
644 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
645 Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
649 Lisp_Object varlist
, val
, elt
;
650 int count
= specpdl_ptr
- specpdl
;
651 struct gcpro gcpro1
, gcpro2
, gcpro3
;
653 GCPRO3 (args
, elt
, varlist
);
655 varlist
= Fcar (args
);
656 while (!NILP (varlist
))
659 elt
= Fcar (varlist
);
660 if (XTYPE (elt
) == Lisp_Symbol
)
661 specbind (elt
, Qnil
);
662 else if (! NILP (Fcdr (Fcdr (elt
))))
664 Fcons (build_string ("`let' bindings can have only one value-form"),
668 val
= Feval (Fcar (Fcdr (elt
)));
669 specbind (Fcar (elt
), val
);
671 varlist
= Fcdr (varlist
);
674 val
= Fprogn (Fcdr (args
));
675 return unbind_to (count
, val
);
678 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
679 "(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
680 The value of the last form in BODY is returned.\n\
681 Each element of VARLIST is a symbol (which is bound to nil)\n\
682 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
683 All the VALUEFORMs are evalled before any symbols are bound.")
687 Lisp_Object
*temps
, tem
;
688 register Lisp_Object elt
, varlist
;
689 int count
= specpdl_ptr
- specpdl
;
691 struct gcpro gcpro1
, gcpro2
;
693 varlist
= Fcar (args
);
695 /* Make space to hold the values to give the bound variables */
696 elt
= Flength (varlist
);
697 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
699 /* Compute the values and store them in `temps' */
701 GCPRO2 (args
, *temps
);
704 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
707 elt
= Fcar (varlist
);
708 if (XTYPE (elt
) == Lisp_Symbol
)
709 temps
[argnum
++] = Qnil
;
710 else if (! NILP (Fcdr (Fcdr (elt
))))
712 Fcons (build_string ("`let' bindings can have only one value-form"),
715 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
716 gcpro2
.nvars
= argnum
;
720 varlist
= Fcar (args
);
721 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
723 elt
= Fcar (varlist
);
724 tem
= temps
[argnum
++];
725 if (XTYPE (elt
) == Lisp_Symbol
)
728 specbind (Fcar (elt
), tem
);
731 elt
= Fprogn (Fcdr (args
));
732 return unbind_to (count
, elt
);
735 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
736 "(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.\n\
737 The order of execution is thus TEST, BODY, TEST, BODY and so on\n\
738 until TEST returns nil.")
742 Lisp_Object test
, body
, tem
;
743 struct gcpro gcpro1
, gcpro2
;
749 while (tem
= Feval (test
),
750 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
760 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
761 "Return result of expanding macros at top level of FORM.\n\
762 If FORM is not a macro call, it is returned unchanged.\n\
763 Otherwise, the macro is expanded and the expansion is considered\n\
764 in place of FORM. When a non-macro-call results, it is returned.\n\n\
765 The second optional arg ENVIRONMENT species an environment of macro\n\
766 definitions to shadow the loaded ones for use in file byte-compilation.")
768 register Lisp_Object form
;
771 /* With cleanups from Hallvard Furuseth. */
772 register Lisp_Object expander
, sym
, def
, tem
;
776 /* Come back here each time we expand a macro call,
777 in case it expands into another macro call. */
778 if (XTYPE (form
) != Lisp_Cons
)
780 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
781 def
= sym
= XCONS (form
)->car
;
783 /* Trace symbols aliases to other symbols
784 until we get a symbol that is not an alias. */
785 while (XTYPE (def
) == Lisp_Symbol
)
789 tem
= Fassq (sym
, env
);
792 def
= XSYMBOL (sym
)->function
;
793 if (!EQ (def
, Qunbound
))
798 /* Right now TEM is the result from SYM in ENV,
799 and if TEM is nil then DEF is SYM's function definition. */
802 /* SYM is not mentioned in ENV.
803 Look at its function definition. */
804 if (EQ (def
, Qunbound
)
805 || XTYPE (def
) != Lisp_Cons
)
806 /* Not defined or definition not suitable */
808 if (EQ (XCONS (def
)->car
, Qautoload
))
810 /* Autoloading function: will it be a macro when loaded? */
811 tem
= Fnth (make_number (4), def
);
812 if (EQ (XCONS (tem
)->car
, Qt
)
813 || EQ (XCONS (tem
)->car
, Qmacro
))
814 /* Yes, load it and try again. */
816 do_autoload (def
, sym
);
822 else if (!EQ (XCONS (def
)->car
, Qmacro
))
824 else expander
= XCONS (def
)->cdr
;
828 expander
= XCONS (tem
)->cdr
;
832 form
= apply1 (expander
, XCONS (form
)->cdr
);
837 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
838 "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
839 TAG is evalled to get the tag to use. Then the BODY is executed.\n\
840 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
841 If no throw happens, `catch' returns the value of the last BODY form.\n\
842 If a throw happens, it specifies the value to return from `catch'.")
846 register Lisp_Object tag
;
850 tag
= Feval (Fcar (args
));
852 return internal_catch (tag
, Fprogn
, Fcdr (args
));
855 /* Set up a catch, then call C function FUNC on argument ARG.
856 FUNC should return a Lisp_Object.
857 This is how catches are done from within C code. */
860 internal_catch (tag
, func
, arg
)
862 Lisp_Object (*func
) ();
865 /* This structure is made part of the chain `catchlist'. */
868 /* Fill in the components of c, and put it on the list. */
872 c
.backlist
= backtrace_list
;
873 c
.handlerlist
= handlerlist
;
874 c
.lisp_eval_depth
= lisp_eval_depth
;
875 c
.pdlcount
= specpdl_ptr
- specpdl
;
876 c
.poll_suppress_count
= poll_suppress_count
;
881 if (! _setjmp (c
.jmp
))
882 c
.val
= (*func
) (arg
);
884 /* Throw works by a longjmp that comes right here. */
889 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
890 jump to that CATCH, returning VALUE as the value of that catch.
892 This is the guts Fthrow and Fsignal; they differ only in the way
893 they choose the catch tag to throw to. A catch tag for a
894 condition-case form has a TAG of Qnil.
896 Before each catch is discarded, unbind all special bindings and
897 execute all unwind-protect clauses made above that catch. Unwind
898 the handler stack as we go, so that the proper handlers are in
899 effect for each unwind-protect clause we run. At the end, restore
900 some static info saved in CATCH, and longjmp to the location
903 This is used for correct unwinding in Fthrow and Fsignal. */
906 unwind_to_catch (catch, value
)
907 struct catchtag
*catch;
910 register int last_time
;
912 /* Save the value in the tag. */
915 /* Restore the polling-suppression count. */
916 if (catch->poll_suppress_count
> poll_suppress_count
)
918 while (catch->poll_suppress_count
< poll_suppress_count
)
923 last_time
= catchlist
== catch;
925 /* Unwind the specpdl stack, and then restore the proper set of
927 unbind_to (catchlist
->pdlcount
, Qnil
);
928 handlerlist
= catchlist
->handlerlist
;
929 catchlist
= catchlist
->next
;
933 gcprolist
= catch->gcpro
;
934 backtrace_list
= catch->backlist
;
935 lisp_eval_depth
= catch->lisp_eval_depth
;
937 _longjmp (catch->jmp
, 1);
940 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
941 "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
942 Both TAG and VALUE are evalled.")
944 register Lisp_Object tag
, val
;
946 register struct catchtag
*c
;
951 for (c
= catchlist
; c
; c
= c
->next
)
953 if (EQ (c
->tag
, tag
))
954 unwind_to_catch (c
, val
);
956 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (val
, Qnil
)));
961 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
962 "Do BODYFORM, protecting with UNWINDFORMS.\n\
963 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\
964 If BODYFORM completes normally, its value is returned\n\
965 after executing the UNWINDFORMS.\n\
966 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
971 int count
= specpdl_ptr
- specpdl
;
973 record_unwind_protect (0, Fcdr (args
));
974 val
= Feval (Fcar (args
));
975 return unbind_to (count
, val
);
978 /* Chain of condition handlers currently in effect.
979 The elements of this chain are contained in the stack frames
980 of Fcondition_case and internal_condition_case.
981 When an error is signaled (by calling Fsignal, below),
982 this chain is searched for an element that applies. */
984 struct handler
*handlerlist
;
986 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
987 "Regain control when an error is signaled.\n\
988 Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\
989 executes BODYFORM and returns its value if no error happens.\n\
990 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
991 where the BODY is made of Lisp expressions.\n\n\
992 A handler is applicable to an error\n\
993 if CONDITION-NAME is one of the error's condition names.\n\
994 If an error happens, the first applicable handler is run.\n\
996 When a handler handles an error,\n\
997 control returns to the condition-case and the handler BODY... is executed\n\
998 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
999 VAR may be nil; then you do not get access to the signal information.\n\
1001 The value of the last BODY form is returned from the condition-case.\n\
1002 See also the function `signal' for more info.")
1009 register Lisp_Object var
, bodyform
, handlers
;
1012 bodyform
= Fcar (Fcdr (args
));
1013 handlers
= Fcdr (Fcdr (args
));
1014 CHECK_SYMBOL (var
, 0);
1016 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1020 if ((!NILP (tem
)) &&
1021 (!CONSP (tem
) || (XTYPE (XCONS (tem
)->car
) != Lisp_Symbol
)))
1022 error ("Invalid condition handler", tem
);
1027 c
.backlist
= backtrace_list
;
1028 c
.handlerlist
= handlerlist
;
1029 c
.lisp_eval_depth
= lisp_eval_depth
;
1030 c
.pdlcount
= specpdl_ptr
- specpdl
;
1031 c
.poll_suppress_count
= poll_suppress_count
;
1032 c
.gcpro
= gcprolist
;
1033 if (_setjmp (c
.jmp
))
1036 specbind (h
.var
, Fcdr (c
.val
));
1037 val
= Fprogn (Fcdr (Fcar (c
.val
)));
1039 /* Note that this just undoes the binding of h.var; whoever
1040 longjumped to us unwound the stack to c.pdlcount before
1042 unbind_to (c
.pdlcount
, Qnil
);
1049 h
.handler
= handlers
;
1050 h
.next
= handlerlist
;
1054 val
= Feval (bodyform
);
1056 handlerlist
= h
.next
;
1061 internal_condition_case (bfun
, handlers
, hfun
)
1062 Lisp_Object (*bfun
) ();
1063 Lisp_Object handlers
;
1064 Lisp_Object (*hfun
) ();
1072 c
.backlist
= backtrace_list
;
1073 c
.handlerlist
= handlerlist
;
1074 c
.lisp_eval_depth
= lisp_eval_depth
;
1075 c
.pdlcount
= specpdl_ptr
- specpdl
;
1076 c
.poll_suppress_count
= poll_suppress_count
;
1077 c
.gcpro
= gcprolist
;
1078 if (_setjmp (c
.jmp
))
1080 return (*hfun
) (Fcdr (c
.val
));
1084 h
.handler
= handlers
;
1086 h
.next
= handlerlist
;
1092 handlerlist
= h
.next
;
1096 static Lisp_Object
find_handler_clause ();
1098 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1099 "Signal an error. Args are SIGNAL-NAME, and associated DATA.\n\
1100 This function does not return.\n\n\
1101 A signal name is a symbol with an `error-conditions' property\n\
1102 that is a list of condition names.\n\
1103 A handler for any of those names will get to handle this signal.\n\
1104 The symbol `error' should normally be one of them.\n\
1106 DATA should be a list. Its elements are printed as part of the error message.\n\
1107 If the signal is handled, DATA is made available to the handler.\n\
1108 See also the function `condition-case'.")
1110 Lisp_Object sig
, data
;
1112 register struct handler
*allhandlers
= handlerlist
;
1113 Lisp_Object conditions
;
1114 extern int gc_in_progress
;
1115 extern int waiting_for_input
;
1116 Lisp_Object debugger_value
;
1118 quit_error_check ();
1120 if (gc_in_progress
|| waiting_for_input
)
1123 #ifdef HAVE_X_WINDOWS
1124 TOTALLY_UNBLOCK_INPUT
;
1127 conditions
= Fget (sig
, Qerror_conditions
);
1129 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1131 register Lisp_Object clause
;
1132 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1133 sig
, data
, &debugger_value
);
1135 #if 0 /* Most callers are not prepared to handle gc if this returns.
1136 So, since this feature is not very useful, take it out. */
1137 /* If have called debugger and user wants to continue,
1139 if (EQ (clause
, Qlambda
))
1140 return debugger_value
;
1142 if (EQ (clause
, Qlambda
))
1144 /* We can't return values to code which signalled an error, but we
1145 can continue code which has signalled a quit. */
1146 if (EQ (sig
, Qquit
))
1149 error ("Cannot return from the debugger in an error");
1155 struct handler
*h
= handlerlist
;
1156 handlerlist
= allhandlers
;
1157 unwind_to_catch (h
->tag
, Fcons (clause
, Fcons (sig
, data
)));
1161 handlerlist
= allhandlers
;
1162 /* If no handler is present now, try to run the debugger,
1163 and if that fails, throw to top level. */
1164 find_handler_clause (Qerror
, conditions
, sig
, data
, &debugger_value
);
1165 Fthrow (Qtop_level
, Qt
);
1168 /* Return nonzero iff LIST is a non-nil atom or
1169 a list containing one of CONDITIONS. */
1172 wants_debugger (list
, conditions
)
1173 Lisp_Object list
, conditions
;
1180 while (CONSP (conditions
))
1182 Lisp_Object
this, tail
;
1183 this = XCONS (conditions
)->car
;
1184 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1185 if (EQ (XCONS (tail
)->car
, this))
1187 conditions
= XCONS (conditions
)->cdr
;
1192 /* Value of Qlambda means we have called debugger and user has continued.
1193 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1196 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1197 Lisp_Object handlers
, conditions
, sig
, data
;
1198 Lisp_Object
*debugger_value_ptr
;
1200 register Lisp_Object h
;
1201 register Lisp_Object tem
;
1202 register Lisp_Object tem1
;
1204 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1206 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1208 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1209 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1210 if ((EQ (sig
, Qquit
)
1212 : wants_debugger (Vdebug_on_error
, conditions
))
1213 && when_entered_debugger
< num_nonmacro_input_chars
)
1215 int count
= specpdl_ptr
- specpdl
;
1216 specbind (Qdebug_on_error
, Qnil
);
1217 *debugger_value_ptr
=
1218 call_debugger (Fcons (Qerror
,
1219 Fcons (Fcons (sig
, data
),
1221 return unbind_to (count
, Qlambda
);
1225 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1230 tem
= Fmemq (Fcar (tem1
), conditions
);
1237 /* dump an error message; called like printf */
1241 error (m
, a1
, a2
, a3
)
1245 sprintf (buf
, m
, a1
, a2
, a3
);
1248 Fsignal (Qerror
, Fcons (build_string (buf
), Qnil
));
1251 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1252 "T if FUNCTION makes provisions for interactive calling.\n\
1253 This means it contains a description for how to read arguments to give it.\n\
1254 The value is nil for an invalid function or a symbol with no function\n\
1257 Interactively callable functions include strings and vectors (treated\n\
1258 as keyboard macros), lambda-expressions that contain a top-level call\n\
1259 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1260 fourth argument, and some of the built-in functions of Lisp.\n\
1262 Also, a symbol satisfies `commandp' if its function definition does so.")
1264 Lisp_Object function
;
1266 register Lisp_Object fun
;
1267 register Lisp_Object funcar
;
1268 register Lisp_Object tem
;
1273 fun
= indirect_function (fun
);
1274 if (EQ (fun
, Qunbound
))
1277 /* Emacs primitives are interactive if their DEFUN specifies an
1278 interactive spec. */
1279 if (XTYPE (fun
) == Lisp_Subr
)
1281 if (XSUBR (fun
)->prompt
)
1287 /* Bytecode objects are interactive if they are long enough to
1288 have an element whose index is COMPILED_INTERACTIVE, which is
1289 where the interactive spec is stored. */
1290 else if (XTYPE (fun
) == Lisp_Compiled
)
1291 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1294 /* Strings and vectors are keyboard macros. */
1295 if (XTYPE (fun
) == Lisp_String
1296 || XTYPE (fun
) == Lisp_Vector
)
1299 /* Lists may represent commands. */
1302 funcar
= Fcar (fun
);
1303 if (XTYPE (funcar
) != Lisp_Symbol
)
1304 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1305 if (EQ (funcar
, Qlambda
))
1306 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1307 if (EQ (funcar
, Qmocklisp
))
1308 return Qt
; /* All mocklisp functions can be called interactively */
1309 if (EQ (funcar
, Qautoload
))
1310 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1316 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1317 "Define FUNCTION to autoload from FILE.\n\
1318 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1319 Third arg DOCSTRING is documentation for the function.\n\
1320 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1321 Fifth arg TYPE indicates the type of the object:\n\
1322 nil or omitted says FUNCTION is a function,\n\
1323 `keymap' says FUNCTION is really a keymap, and\n\
1324 `macro' or t says FUNCTION is really a macro.\n\
1325 Third through fifth args give info about the real definition.\n\
1326 They default to nil.\n\
1327 If FUNCTION is already defined other than as an autoload,\n\
1328 this does nothing and returns nil.")
1329 (function
, file
, docstring
, interactive
, type
)
1330 Lisp_Object function
, file
, docstring
, interactive
, type
;
1333 Lisp_Object args
[4];
1336 CHECK_SYMBOL (function
, 0);
1337 CHECK_STRING (file
, 1);
1339 /* If function is defined and not as an autoload, don't override */
1340 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1341 && !(XTYPE (XSYMBOL (function
)->function
) == Lisp_Cons
1342 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1347 args
[1] = docstring
;
1348 args
[2] = interactive
;
1351 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1352 #else /* NO_ARG_ARRAY */
1353 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1354 #endif /* not NO_ARG_ARRAY */
1358 un_autoload (oldqueue
)
1359 Lisp_Object oldqueue
;
1361 register Lisp_Object queue
, first
, second
;
1363 /* Queue to unwind is current value of Vautoload_queue.
1364 oldqueue is the shadowed value to leave in Vautoload_queue. */
1365 queue
= Vautoload_queue
;
1366 Vautoload_queue
= oldqueue
;
1367 while (CONSP (queue
))
1369 first
= Fcar (queue
);
1370 second
= Fcdr (first
);
1371 first
= Fcar (first
);
1372 if (EQ (second
, Qnil
))
1375 Ffset (first
, second
);
1376 queue
= Fcdr (queue
);
1381 do_autoload (fundef
, funname
)
1382 Lisp_Object fundef
, funname
;
1384 int count
= specpdl_ptr
- specpdl
;
1385 Lisp_Object fun
, val
, queue
, first
, second
;
1388 CHECK_SYMBOL (funname
, 0);
1390 /* Value saved here is to be restored into Vautoload_queue */
1391 record_unwind_protect (un_autoload
, Vautoload_queue
);
1392 Vautoload_queue
= Qt
;
1393 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1395 /* Save the old autoloads, in case we ever do an unload. */
1396 queue
= Vautoload_queue
;
1397 while (CONSP (queue
))
1399 first
= Fcar (queue
);
1400 second
= Fcdr (first
);
1401 first
= Fcar (first
);
1403 /* Note: This test is subtle. The cdr of an autoload-queue entry
1404 may be an atom if the autoload entry was generated by a defalias
1407 Fput(first
, Qautoload
, (Fcdr (second
)));
1409 queue
= Fcdr (queue
);
1412 /* Once loading finishes, don't undo it. */
1413 Vautoload_queue
= Qt
;
1414 unbind_to (count
, Qnil
);
1416 fun
= Findirect_function (fun
);
1418 if (XTYPE (fun
) == Lisp_Cons
1419 && EQ (XCONS (fun
)->car
, Qautoload
))
1420 error ("Autoloading failed to define function %s",
1421 XSYMBOL (funname
)->name
->data
);
1424 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1425 "Evaluate FORM and return its value.")
1429 Lisp_Object fun
, val
, original_fun
, original_args
;
1431 struct backtrace backtrace
;
1432 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1434 if (XTYPE (form
) == Lisp_Symbol
)
1436 if (EQ (Vmocklisp_arguments
, Qt
))
1437 return Fsymbol_value (form
);
1438 val
= Fsymbol_value (form
);
1441 else if (EQ (val
, Qt
))
1449 if (consing_since_gc
> gc_cons_threshold
)
1452 Fgarbage_collect ();
1456 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1458 if (max_lisp_eval_depth
< 100)
1459 max_lisp_eval_depth
= 100;
1460 if (lisp_eval_depth
> max_lisp_eval_depth
)
1461 error ("Lisp nesting exceeds max-lisp-eval-depth");
1464 original_fun
= Fcar (form
);
1465 original_args
= Fcdr (form
);
1467 backtrace
.next
= backtrace_list
;
1468 backtrace_list
= &backtrace
;
1469 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1470 backtrace
.args
= &original_args
;
1471 backtrace
.nargs
= UNEVALLED
;
1472 backtrace
.evalargs
= 1;
1473 backtrace
.debug_on_exit
= 0;
1475 if (debug_on_next_call
)
1476 do_debug_on_call (Qt
);
1478 /* At this point, only original_fun and original_args
1479 have values that will be used below */
1481 fun
= Findirect_function (original_fun
);
1483 if (XTYPE (fun
) == Lisp_Subr
)
1485 Lisp_Object numargs
;
1486 Lisp_Object argvals
[7];
1487 Lisp_Object args_left
;
1488 register int i
, maxargs
;
1490 args_left
= original_args
;
1491 numargs
= Flength (args_left
);
1493 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1494 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1495 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1497 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1499 backtrace
.evalargs
= 0;
1500 val
= (*XSUBR (fun
)->function
) (args_left
);
1504 if (XSUBR (fun
)->max_args
== MANY
)
1506 /* Pass a vector of evaluated arguments */
1508 register int argnum
= 0;
1510 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1512 GCPRO3 (args_left
, fun
, fun
);
1516 while (!NILP (args_left
))
1518 vals
[argnum
++] = Feval (Fcar (args_left
));
1519 args_left
= Fcdr (args_left
);
1520 gcpro3
.nvars
= argnum
;
1523 backtrace
.args
= vals
;
1524 backtrace
.nargs
= XINT (numargs
);
1526 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1531 GCPRO3 (args_left
, fun
, fun
);
1532 gcpro3
.var
= argvals
;
1535 maxargs
= XSUBR (fun
)->max_args
;
1536 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1538 argvals
[i
] = Feval (Fcar (args_left
));
1544 backtrace
.args
= argvals
;
1545 backtrace
.nargs
= XINT (numargs
);
1550 val
= (*XSUBR (fun
)->function
) ();
1553 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1556 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1559 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1563 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1564 argvals
[2], argvals
[3]);
1567 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1568 argvals
[3], argvals
[4]);
1571 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1572 argvals
[3], argvals
[4], argvals
[5]);
1575 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1576 argvals
[3], argvals
[4], argvals
[5],
1581 /* Someone has created a subr that takes more arguments than
1582 is supported by this code. We need to either rewrite the
1583 subr to use a different argument protocol, or add more
1584 cases to this switch. */
1588 if (XTYPE (fun
) == Lisp_Compiled
)
1589 val
= apply_lambda (fun
, original_args
, 1);
1593 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1594 funcar
= Fcar (fun
);
1595 if (XTYPE (funcar
) != Lisp_Symbol
)
1596 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1597 if (EQ (funcar
, Qautoload
))
1599 do_autoload (fun
, original_fun
);
1602 if (EQ (funcar
, Qmacro
))
1603 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1604 else if (EQ (funcar
, Qlambda
))
1605 val
= apply_lambda (fun
, original_args
, 1);
1606 else if (EQ (funcar
, Qmocklisp
))
1607 val
= ml_apply (fun
, original_args
);
1609 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1612 if (!EQ (Vmocklisp_arguments
, Qt
))
1616 else if (EQ (val
, Qt
))
1620 if (backtrace
.debug_on_exit
)
1621 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1622 backtrace_list
= backtrace
.next
;
1626 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1627 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1628 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1633 register int i
, numargs
;
1634 register Lisp_Object spread_arg
;
1635 register Lisp_Object
*funcall_args
;
1637 struct gcpro gcpro1
;
1641 spread_arg
= args
[nargs
- 1];
1642 CHECK_LIST (spread_arg
, nargs
);
1644 numargs
= XINT (Flength (spread_arg
));
1647 return Ffuncall (nargs
- 1, args
);
1648 else if (numargs
== 1)
1650 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1651 return Ffuncall (nargs
, args
);
1654 numargs
+= nargs
- 2;
1656 fun
= indirect_function (fun
);
1657 if (EQ (fun
, Qunbound
))
1659 /* Let funcall get the error */
1664 if (XTYPE (fun
) == Lisp_Subr
)
1666 if (numargs
< XSUBR (fun
)->min_args
1667 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1668 goto funcall
; /* Let funcall get the error */
1669 else if (XSUBR (fun
)->max_args
> numargs
)
1671 /* Avoid making funcall cons up a yet another new vector of arguments
1672 by explicitly supplying nil's for optional values */
1673 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1674 * sizeof (Lisp_Object
));
1675 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1676 funcall_args
[++i
] = Qnil
;
1677 GCPRO1 (*funcall_args
);
1678 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1682 /* We add 1 to numargs because funcall_args includes the
1683 function itself as well as its arguments. */
1686 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1687 * sizeof (Lisp_Object
));
1688 GCPRO1 (*funcall_args
);
1689 gcpro1
.nvars
= 1 + numargs
;
1692 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1693 /* Spread the last arg we got. Its first element goes in
1694 the slot that it used to occupy, hence this value of I. */
1696 while (!NILP (spread_arg
))
1698 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1699 spread_arg
= XCONS (spread_arg
)->cdr
;
1702 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1705 /* Apply fn to arg */
1708 Lisp_Object fn
, arg
;
1710 struct gcpro gcpro1
;
1714 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1718 Lisp_Object args
[2];
1722 RETURN_UNGCPRO (Fapply (2, args
));
1724 #else /* not NO_ARG_ARRAY */
1725 RETURN_UNGCPRO (Fapply (2, &fn
));
1726 #endif /* not NO_ARG_ARRAY */
1729 /* Call function fn on no arguments */
1734 struct gcpro gcpro1
;
1737 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1740 /* Call function fn with 1 argument arg1 */
1744 Lisp_Object fn
, arg1
;
1746 struct gcpro gcpro1
;
1748 Lisp_Object args
[2];
1754 RETURN_UNGCPRO (Ffuncall (2, args
));
1755 #else /* not NO_ARG_ARRAY */
1758 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1759 #endif /* not NO_ARG_ARRAY */
1762 /* Call function fn with 2 arguments arg1, arg2 */
1765 call2 (fn
, arg1
, arg2
)
1766 Lisp_Object fn
, arg1
, arg2
;
1768 struct gcpro gcpro1
;
1770 Lisp_Object args
[3];
1776 RETURN_UNGCPRO (Ffuncall (3, args
));
1777 #else /* not NO_ARG_ARRAY */
1780 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1781 #endif /* not NO_ARG_ARRAY */
1784 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1787 call3 (fn
, arg1
, arg2
, arg3
)
1788 Lisp_Object fn
, arg1
, arg2
, arg3
;
1790 struct gcpro gcpro1
;
1792 Lisp_Object args
[4];
1799 RETURN_UNGCPRO (Ffuncall (4, args
));
1800 #else /* not NO_ARG_ARRAY */
1803 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1804 #endif /* not NO_ARG_ARRAY */
1807 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1810 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1811 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1813 struct gcpro gcpro1
;
1815 Lisp_Object args
[5];
1823 RETURN_UNGCPRO (Ffuncall (5, args
));
1824 #else /* not NO_ARG_ARRAY */
1827 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1828 #endif /* not NO_ARG_ARRAY */
1831 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1834 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1835 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1837 struct gcpro gcpro1
;
1839 Lisp_Object args
[6];
1848 RETURN_UNGCPRO (Ffuncall (6, args
));
1849 #else /* not NO_ARG_ARRAY */
1852 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1853 #endif /* not NO_ARG_ARRAY */
1856 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1859 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1860 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1862 struct gcpro gcpro1
;
1864 Lisp_Object args
[7];
1874 RETURN_UNGCPRO (Ffuncall (7, args
));
1875 #else /* not NO_ARG_ARRAY */
1878 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1879 #endif /* not NO_ARG_ARRAY */
1882 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1883 "Call first argument as a function, passing remaining arguments to it.\n\
1884 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1891 int numargs
= nargs
- 1;
1892 Lisp_Object lisp_numargs
;
1894 struct backtrace backtrace
;
1895 register Lisp_Object
*internal_args
;
1899 if (consing_since_gc
> gc_cons_threshold
)
1900 Fgarbage_collect ();
1902 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1904 if (max_lisp_eval_depth
< 100)
1905 max_lisp_eval_depth
= 100;
1906 if (lisp_eval_depth
> max_lisp_eval_depth
)
1907 error ("Lisp nesting exceeds max-lisp-eval-depth");
1910 backtrace
.next
= backtrace_list
;
1911 backtrace_list
= &backtrace
;
1912 backtrace
.function
= &args
[0];
1913 backtrace
.args
= &args
[1];
1914 backtrace
.nargs
= nargs
- 1;
1915 backtrace
.evalargs
= 0;
1916 backtrace
.debug_on_exit
= 0;
1918 if (debug_on_next_call
)
1919 do_debug_on_call (Qlambda
);
1925 fun
= Findirect_function (fun
);
1927 if (XTYPE (fun
) == Lisp_Subr
)
1929 if (numargs
< XSUBR (fun
)->min_args
1930 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1932 XFASTINT (lisp_numargs
) = numargs
;
1933 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
1936 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1937 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1939 if (XSUBR (fun
)->max_args
== MANY
)
1941 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
1945 if (XSUBR (fun
)->max_args
> numargs
)
1947 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
1948 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
1949 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
1950 internal_args
[i
] = Qnil
;
1953 internal_args
= args
+ 1;
1954 switch (XSUBR (fun
)->max_args
)
1957 val
= (*XSUBR (fun
)->function
) ();
1960 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
1963 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
1967 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1971 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1976 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1977 internal_args
[2], internal_args
[3],
1981 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1982 internal_args
[2], internal_args
[3],
1983 internal_args
[4], internal_args
[5]);
1986 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1987 internal_args
[2], internal_args
[3],
1988 internal_args
[4], internal_args
[5],
1994 /* If a subr takes more than 6 arguments without using MANY
1995 or UNEVALLED, we need to extend this function to support it.
1996 Until this is done, there is no way to call the function. */
2000 if (XTYPE (fun
) == Lisp_Compiled
)
2001 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2005 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2006 funcar
= Fcar (fun
);
2007 if (XTYPE (funcar
) != Lisp_Symbol
)
2008 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2009 if (EQ (funcar
, Qlambda
))
2010 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2011 else if (EQ (funcar
, Qmocklisp
))
2012 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2013 else if (EQ (funcar
, Qautoload
))
2015 do_autoload (fun
, args
[0]);
2019 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2023 if (backtrace
.debug_on_exit
)
2024 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2025 backtrace_list
= backtrace
.next
;
2030 apply_lambda (fun
, args
, eval_flag
)
2031 Lisp_Object fun
, args
;
2034 Lisp_Object args_left
;
2035 Lisp_Object numargs
;
2036 register Lisp_Object
*arg_vector
;
2037 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2039 register Lisp_Object tem
;
2041 numargs
= Flength (args
);
2042 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2045 GCPRO3 (*arg_vector
, args_left
, fun
);
2048 for (i
= 0; i
< XINT (numargs
);)
2050 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2051 if (eval_flag
) tem
= Feval (tem
);
2052 arg_vector
[i
++] = tem
;
2060 backtrace_list
->args
= arg_vector
;
2061 backtrace_list
->nargs
= i
;
2063 backtrace_list
->evalargs
= 0;
2064 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2066 /* Do the debug-on-exit now, while arg_vector still exists. */
2067 if (backtrace_list
->debug_on_exit
)
2068 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2069 /* Don't do it again when we return to eval. */
2070 backtrace_list
->debug_on_exit
= 0;
2074 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2075 and return the result of evaluation.
2076 FUN must be either a lambda-expression or a compiled-code object. */
2079 funcall_lambda (fun
, nargs
, arg_vector
)
2082 register Lisp_Object
*arg_vector
;
2084 Lisp_Object val
, tem
;
2085 register Lisp_Object syms_left
;
2086 Lisp_Object numargs
;
2087 register Lisp_Object next
;
2088 int count
= specpdl_ptr
- specpdl
;
2090 int optional
= 0, rest
= 0;
2092 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2094 XFASTINT (numargs
) = nargs
;
2096 if (XTYPE (fun
) == Lisp_Cons
)
2097 syms_left
= Fcar (Fcdr (fun
));
2098 else if (XTYPE (fun
) == Lisp_Compiled
)
2099 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2103 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2106 next
= Fcar (syms_left
);
2107 while (XTYPE (next
) != Lisp_Symbol
)
2108 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2109 if (EQ (next
, Qand_rest
))
2111 else if (EQ (next
, Qand_optional
))
2115 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2120 tem
= arg_vector
[i
++];
2121 specbind (next
, tem
);
2124 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2126 specbind (next
, Qnil
);
2130 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2132 if (XTYPE (fun
) == Lisp_Cons
)
2133 val
= Fprogn (Fcdr (Fcdr (fun
)));
2135 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2136 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2137 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2138 return unbind_to (count
, val
);
2144 register int count
= specpdl_ptr
- specpdl
;
2145 if (specpdl_size
>= max_specpdl_size
)
2147 if (max_specpdl_size
< 400)
2148 max_specpdl_size
= 400;
2149 if (specpdl_size
>= max_specpdl_size
)
2151 if (!NILP (Vdebug_on_error
))
2152 /* Leave room for some specpdl in the debugger. */
2153 max_specpdl_size
= specpdl_size
+ 100;
2155 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2159 if (specpdl_size
> max_specpdl_size
)
2160 specpdl_size
= max_specpdl_size
;
2161 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2162 specpdl_ptr
= specpdl
+ count
;
2166 specbind (symbol
, value
)
2167 Lisp_Object symbol
, value
;
2169 extern void store_symval_forwarding (); /* in eval.c */
2172 CHECK_SYMBOL (symbol
, 0);
2174 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2176 specpdl_ptr
->symbol
= symbol
;
2177 specpdl_ptr
->func
= 0;
2178 ovalue
= XSYMBOL (symbol
)->value
;
2179 specpdl_ptr
->old_value
= EQ (ovalue
, Qunbound
) ? Qunbound
: Fsymbol_value (symbol
);
2181 if (XTYPE (ovalue
) == Lisp_Buffer_Objfwd
)
2182 store_symval_forwarding (symbol
, ovalue
, value
);
2184 Fset (symbol
, value
);
2188 record_unwind_protect (function
, arg
)
2189 Lisp_Object (*function
)();
2192 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2194 specpdl_ptr
->func
= function
;
2195 specpdl_ptr
->symbol
= Qnil
;
2196 specpdl_ptr
->old_value
= arg
;
2201 unbind_to (count
, value
)
2205 int quitf
= !NILP (Vquit_flag
);
2206 struct gcpro gcpro1
;
2212 while (specpdl_ptr
!= specpdl
+ count
)
2215 if (specpdl_ptr
->func
!= 0)
2216 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2217 /* Note that a "binding" of nil is really an unwind protect,
2218 so in that case the "old value" is a list of forms to evaluate. */
2219 else if (NILP (specpdl_ptr
->symbol
))
2220 Fprogn (specpdl_ptr
->old_value
);
2222 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2224 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2233 /* Get the value of symbol's global binding, even if that binding
2234 is not now dynamically visible. */
2237 top_level_value (symbol
)
2240 register struct specbinding
*ptr
= specpdl
;
2242 CHECK_SYMBOL (symbol
, 0);
2243 for (; ptr
!= specpdl_ptr
; ptr
++)
2245 if (EQ (ptr
->symbol
, symbol
))
2246 return ptr
->old_value
;
2248 return Fsymbol_value (symbol
);
2252 top_level_set (symbol
, newval
)
2253 Lisp_Object symbol
, newval
;
2255 register struct specbinding
*ptr
= specpdl
;
2257 CHECK_SYMBOL (symbol
, 0);
2258 for (; ptr
!= specpdl_ptr
; ptr
++)
2260 if (EQ (ptr
->symbol
, symbol
))
2262 ptr
->old_value
= newval
;
2266 return Fset (symbol
, newval
);
2271 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2272 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2273 The debugger is entered when that frame exits, if the flag is non-nil.")
2275 Lisp_Object level
, flag
;
2277 register struct backtrace
*backlist
= backtrace_list
;
2280 CHECK_NUMBER (level
, 0);
2282 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2284 backlist
= backlist
->next
;
2288 backlist
->debug_on_exit
= !NILP (flag
);
2293 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2294 "Print a trace of Lisp function calls currently active.\n\
2295 Output stream used is value of `standard-output'.")
2298 register struct backtrace
*backlist
= backtrace_list
;
2302 extern Lisp_Object Vprint_level
;
2303 struct gcpro gcpro1
;
2305 XFASTINT (Vprint_level
) = 3;
2312 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2313 if (backlist
->nargs
== UNEVALLED
)
2315 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2319 tem
= *backlist
->function
;
2320 Fprin1 (tem
, Qnil
); /* This can QUIT */
2321 write_string ("(", -1);
2322 if (backlist
->nargs
== MANY
)
2324 for (tail
= *backlist
->args
, i
= 0;
2326 tail
= Fcdr (tail
), i
++)
2328 if (i
) write_string (" ", -1);
2329 Fprin1 (Fcar (tail
), Qnil
);
2334 for (i
= 0; i
< backlist
->nargs
; i
++)
2336 if (i
) write_string (" ", -1);
2337 Fprin1 (backlist
->args
[i
], Qnil
);
2341 write_string (")\n", -1);
2342 backlist
= backlist
->next
;
2345 Vprint_level
= Qnil
;
2350 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2351 "Return the function and arguments N frames up from current execution point.\n\
2352 If that frame has not evaluated the arguments yet (or is a special form),\n\
2353 the value is (nil FUNCTION ARG-FORMS...).\n\
2354 If that frame has evaluated its arguments and called its function already,\n\
2355 the value is (t FUNCTION ARG-VALUES...).\n\
2356 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2357 FUNCTION is whatever was supplied as car of evaluated list,\n\
2358 or a lambda expression for macro calls.\n\
2359 If N is more than the number of frames, the value is nil.")
2361 Lisp_Object nframes
;
2363 register struct backtrace
*backlist
= backtrace_list
;
2367 CHECK_NATNUM (nframes
, 0);
2369 /* Find the frame requested. */
2370 for (i
= 0; i
< XFASTINT (nframes
); i
++)
2371 backlist
= backlist
->next
;
2375 if (backlist
->nargs
== UNEVALLED
)
2376 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2379 if (backlist
->nargs
== MANY
)
2380 tem
= *backlist
->args
;
2382 tem
= Flist (backlist
->nargs
, backlist
->args
);
2384 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2390 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2391 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2393 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2394 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2395 This limit is to catch infinite recursions for you before they cause\n\
2396 actual stack overflow in C, which would be fatal for Emacs.\n\
2397 You can safely make it considerably larger than its default value,\n\
2398 if that proves inconveniently small.");
2400 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2401 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2402 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2405 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2406 "Non-nil inhibits C-g quitting from happening immediately.\n\
2407 Note that `quit-flag' will still be set by typing C-g,\n\
2408 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2409 To prevent this happening, set `quit-flag' to nil\n\
2410 before making `inhibit-quit' nil.");
2411 Vinhibit_quit
= Qnil
;
2413 Qinhibit_quit
= intern ("inhibit-quit");
2414 staticpro (&Qinhibit_quit
);
2416 Qautoload
= intern ("autoload");
2417 staticpro (&Qautoload
);
2419 Qdebug_on_error
= intern ("debug-on-error");
2420 staticpro (&Qdebug_on_error
);
2422 Qmacro
= intern ("macro");
2423 staticpro (&Qmacro
);
2425 /* Note that the process handling also uses Qexit, but we don't want
2426 to staticpro it twice, so we just do it here. */
2427 Qexit
= intern ("exit");
2430 Qinteractive
= intern ("interactive");
2431 staticpro (&Qinteractive
);
2433 Qcommandp
= intern ("commandp");
2434 staticpro (&Qcommandp
);
2436 Qdefun
= intern ("defun");
2437 staticpro (&Qdefun
);
2439 Qand_rest
= intern ("&rest");
2440 staticpro (&Qand_rest
);
2442 Qand_optional
= intern ("&optional");
2443 staticpro (&Qand_optional
);
2445 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2446 "*Non-nil means automatically display a backtrace buffer\n\
2447 after any error that is handled by the editor command loop.\n\
2448 If the value is a list, an error only means to display a backtrace\n\
2449 if one of its condition symbols appears in the list.");
2450 Vstack_trace_on_error
= Qnil
;
2452 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2453 "*Non-nil means enter debugger if an error is signaled.\n\
2454 Does not apply to errors handled by `condition-case'.\n\
2455 If the value is a list, an error only means to enter the debugger\n\
2456 if one of its condition symbols appears in the list.\n\
2457 See also variable `debug-on-quit'.");
2458 Vdebug_on_error
= Qnil
;
2460 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2461 "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
2462 Does not apply if quit is handled by a `condition-case'.");
2465 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2466 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2468 DEFVAR_LISP ("debugger", &Vdebugger
,
2469 "Function to call to invoke debugger.\n\
2470 If due to frame exit, args are `exit' and the value being returned;\n\
2471 this function's value will be returned instead of that.\n\
2472 If due to error, args are `error' and a list of the args to `signal'.\n\
2473 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2474 If due to `eval' entry, one arg, t.");
2477 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2478 staticpro (&Qmocklisp_arguments
);
2479 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2480 "While in a mocklisp function, the list of its unevaluated args.");
2481 Vmocklisp_arguments
= Qt
;
2483 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2484 "Set to the function `run-hooks', if that function has been defined.\n\
2485 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2488 staticpro (&Vautoload_queue
);
2489 Vautoload_queue
= Qnil
;
2500 defsubr (&Sfunction
);
2502 defsubr (&Sdefmacro
);
2504 defsubr (&Sdefconst
);
2505 defsubr (&Suser_variable_p
);
2509 defsubr (&Smacroexpand
);
2512 defsubr (&Sunwind_protect
);
2513 defsubr (&Scondition_case
);
2515 defsubr (&Sinteractive_p
);
2516 defsubr (&Scommandp
);
2517 defsubr (&Sautoload
);
2520 defsubr (&Sfuncall
);
2521 defsubr (&Sbacktrace_debug
);
2522 defsubr (&Sbacktrace
);
2523 defsubr (&Sbacktrace_frame
);