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 (tem
, Qt
) || EQ (tem
, Qmacro
))
813 /* Yes, load it and try again. */
815 do_autoload (def
, sym
);
821 else if (!EQ (XCONS (def
)->car
, Qmacro
))
823 else expander
= XCONS (def
)->cdr
;
827 expander
= XCONS (tem
)->cdr
;
831 form
= apply1 (expander
, XCONS (form
)->cdr
);
836 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
837 "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
838 TAG is evalled to get the tag to use. Then the BODY is executed.\n\
839 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
840 If no throw happens, `catch' returns the value of the last BODY form.\n\
841 If a throw happens, it specifies the value to return from `catch'.")
845 register Lisp_Object tag
;
849 tag
= Feval (Fcar (args
));
851 return internal_catch (tag
, Fprogn
, Fcdr (args
));
854 /* Set up a catch, then call C function FUNC on argument ARG.
855 FUNC should return a Lisp_Object.
856 This is how catches are done from within C code. */
859 internal_catch (tag
, func
, arg
)
861 Lisp_Object (*func
) ();
864 /* This structure is made part of the chain `catchlist'. */
867 /* Fill in the components of c, and put it on the list. */
871 c
.backlist
= backtrace_list
;
872 c
.handlerlist
= handlerlist
;
873 c
.lisp_eval_depth
= lisp_eval_depth
;
874 c
.pdlcount
= specpdl_ptr
- specpdl
;
875 c
.poll_suppress_count
= poll_suppress_count
;
880 if (! _setjmp (c
.jmp
))
881 c
.val
= (*func
) (arg
);
883 /* Throw works by a longjmp that comes right here. */
888 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
889 jump to that CATCH, returning VALUE as the value of that catch.
891 This is the guts Fthrow and Fsignal; they differ only in the way
892 they choose the catch tag to throw to. A catch tag for a
893 condition-case form has a TAG of Qnil.
895 Before each catch is discarded, unbind all special bindings and
896 execute all unwind-protect clauses made above that catch. Unwind
897 the handler stack as we go, so that the proper handlers are in
898 effect for each unwind-protect clause we run. At the end, restore
899 some static info saved in CATCH, and longjmp to the location
902 This is used for correct unwinding in Fthrow and Fsignal. */
905 unwind_to_catch (catch, value
)
906 struct catchtag
*catch;
909 register int last_time
;
911 /* Save the value in the tag. */
914 /* Restore the polling-suppression count. */
915 set_poll_suppress_count (catch->poll_suppress_count
);
919 last_time
= catchlist
== catch;
921 /* Unwind the specpdl stack, and then restore the proper set of
923 unbind_to (catchlist
->pdlcount
, Qnil
);
924 handlerlist
= catchlist
->handlerlist
;
925 catchlist
= catchlist
->next
;
929 gcprolist
= catch->gcpro
;
930 backtrace_list
= catch->backlist
;
931 lisp_eval_depth
= catch->lisp_eval_depth
;
933 _longjmp (catch->jmp
, 1);
936 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
937 "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
938 Both TAG and VALUE are evalled.")
940 register Lisp_Object tag
, val
;
942 register struct catchtag
*c
;
947 for (c
= catchlist
; c
; c
= c
->next
)
949 if (EQ (c
->tag
, tag
))
950 unwind_to_catch (c
, val
);
952 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (val
, Qnil
)));
957 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
958 "Do BODYFORM, protecting with UNWINDFORMS.\n\
959 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\
960 If BODYFORM completes normally, its value is returned\n\
961 after executing the UNWINDFORMS.\n\
962 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
967 int count
= specpdl_ptr
- specpdl
;
969 record_unwind_protect (0, Fcdr (args
));
970 val
= Feval (Fcar (args
));
971 return unbind_to (count
, val
);
974 /* Chain of condition handlers currently in effect.
975 The elements of this chain are contained in the stack frames
976 of Fcondition_case and internal_condition_case.
977 When an error is signaled (by calling Fsignal, below),
978 this chain is searched for an element that applies. */
980 struct handler
*handlerlist
;
982 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
983 "Regain control when an error is signaled.\n\
984 Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\
985 executes BODYFORM and returns its value if no error happens.\n\
986 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
987 where the BODY is made of Lisp expressions.\n\n\
988 A handler is applicable to an error\n\
989 if CONDITION-NAME is one of the error's condition names.\n\
990 If an error happens, the first applicable handler is run.\n\
992 When a handler handles an error,\n\
993 control returns to the condition-case and the handler BODY... is executed\n\
994 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
995 VAR may be nil; then you do not get access to the signal information.\n\
997 The value of the last BODY form is returned from the condition-case.\n\
998 See also the function `signal' for more info.")
1005 register Lisp_Object var
, bodyform
, handlers
;
1008 bodyform
= Fcar (Fcdr (args
));
1009 handlers
= Fcdr (Fcdr (args
));
1010 CHECK_SYMBOL (var
, 0);
1012 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1018 && (SYMBOLP (XCONS (tem
)->car
)
1019 || CONSP (XCONS (tem
)->car
)))))
1020 error ("Invalid condition handler", tem
);
1025 c
.backlist
= backtrace_list
;
1026 c
.handlerlist
= handlerlist
;
1027 c
.lisp_eval_depth
= lisp_eval_depth
;
1028 c
.pdlcount
= specpdl_ptr
- specpdl
;
1029 c
.poll_suppress_count
= poll_suppress_count
;
1030 c
.gcpro
= gcprolist
;
1031 if (_setjmp (c
.jmp
))
1034 specbind (h
.var
, Fcdr (c
.val
));
1035 val
= Fprogn (Fcdr (Fcar (c
.val
)));
1037 /* Note that this just undoes the binding of h.var; whoever
1038 longjumped to us unwound the stack to c.pdlcount before
1040 unbind_to (c
.pdlcount
, Qnil
);
1047 h
.handler
= handlers
;
1048 h
.next
= handlerlist
;
1052 val
= Feval (bodyform
);
1054 handlerlist
= h
.next
;
1059 internal_condition_case (bfun
, handlers
, hfun
)
1060 Lisp_Object (*bfun
) ();
1061 Lisp_Object handlers
;
1062 Lisp_Object (*hfun
) ();
1070 c
.backlist
= backtrace_list
;
1071 c
.handlerlist
= handlerlist
;
1072 c
.lisp_eval_depth
= lisp_eval_depth
;
1073 c
.pdlcount
= specpdl_ptr
- specpdl
;
1074 c
.poll_suppress_count
= poll_suppress_count
;
1075 c
.gcpro
= gcprolist
;
1076 if (_setjmp (c
.jmp
))
1078 return (*hfun
) (Fcdr (c
.val
));
1082 h
.handler
= handlers
;
1084 h
.next
= handlerlist
;
1090 handlerlist
= h
.next
;
1094 static Lisp_Object
find_handler_clause ();
1096 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1097 "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
1098 This function does not return.\n\n\
1099 An error symbol is a symbol with an `error-conditions' property\n\
1100 that is a list of condition names.\n\
1101 A handler for any of those names will get to handle this signal.\n\
1102 The symbol `error' should normally be one of them.\n\
1104 DATA should be a list. Its elements are printed as part of the error message.\n\
1105 If the signal is handled, DATA is made available to the handler.\n\
1106 See also the function `condition-case'.")
1107 (error_symbol
, data
)
1108 Lisp_Object error_symbol
, data
;
1110 register struct handler
*allhandlers
= handlerlist
;
1111 Lisp_Object conditions
;
1112 extern int gc_in_progress
;
1113 extern int waiting_for_input
;
1114 Lisp_Object debugger_value
;
1116 quit_error_check ();
1118 if (gc_in_progress
|| waiting_for_input
)
1121 #ifdef HAVE_X_WINDOWS
1122 TOTALLY_UNBLOCK_INPUT
;
1125 conditions
= Fget (error_symbol
, Qerror_conditions
);
1127 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1129 register Lisp_Object clause
;
1130 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1131 error_symbol
, data
, &debugger_value
);
1133 #if 0 /* Most callers are not prepared to handle gc if this returns.
1134 So, since this feature is not very useful, take it out. */
1135 /* If have called debugger and user wants to continue,
1137 if (EQ (clause
, Qlambda
))
1138 return debugger_value
;
1140 if (EQ (clause
, Qlambda
))
1142 /* We can't return values to code which signalled an error, but we
1143 can continue code which has signalled a quit. */
1144 if (EQ (error_symbol
, Qquit
))
1147 error ("Cannot return from the debugger in an error");
1153 struct handler
*h
= handlerlist
;
1154 handlerlist
= allhandlers
;
1155 unwind_to_catch (h
->tag
, Fcons (clause
, Fcons (error_symbol
, data
)));
1159 handlerlist
= allhandlers
;
1160 /* If no handler is present now, try to run the debugger,
1161 and if that fails, throw to top level. */
1162 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1163 Fthrow (Qtop_level
, Qt
);
1166 /* Return nonzero iff LIST is a non-nil atom or
1167 a list containing one of CONDITIONS. */
1170 wants_debugger (list
, conditions
)
1171 Lisp_Object list
, conditions
;
1178 while (CONSP (conditions
))
1180 Lisp_Object
this, tail
;
1181 this = XCONS (conditions
)->car
;
1182 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1183 if (EQ (XCONS (tail
)->car
, this))
1185 conditions
= XCONS (conditions
)->cdr
;
1190 /* Value of Qlambda means we have called debugger and user has continued.
1191 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1194 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1195 Lisp_Object handlers
, conditions
, sig
, data
;
1196 Lisp_Object
*debugger_value_ptr
;
1198 register Lisp_Object h
;
1199 register Lisp_Object tem
;
1201 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1203 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1205 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1206 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1207 if ((EQ (sig
, Qquit
)
1209 : wants_debugger (Vdebug_on_error
, conditions
))
1210 && when_entered_debugger
< num_nonmacro_input_chars
)
1212 int count
= specpdl_ptr
- specpdl
;
1213 specbind (Qdebug_on_error
, Qnil
);
1214 *debugger_value_ptr
=
1215 call_debugger (Fcons (Qerror
,
1216 Fcons (Fcons (sig
, data
),
1218 return unbind_to (count
, Qlambda
);
1222 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1224 Lisp_Object handler
, condit
;
1227 if (!CONSP (handler
))
1229 condit
= Fcar (handler
);
1230 /* Handle a single condition name in handler HANDLER. */
1231 if (SYMBOLP (condit
))
1233 tem
= Fmemq (Fcar (handler
), conditions
);
1237 /* Handle a list of condition names in handler HANDLER. */
1238 else if (CONSP (condit
))
1240 while (CONSP (condit
))
1242 tem
= Fmemq (Fcar (condit
), conditions
);
1245 condit
= XCONS (condit
)->cdr
;
1252 /* dump an error message; called like printf */
1256 error (m
, a1
, a2
, a3
)
1260 sprintf (buf
, m
, a1
, a2
, a3
);
1263 Fsignal (Qerror
, Fcons (build_string (buf
), Qnil
));
1266 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1267 "T if FUNCTION makes provisions for interactive calling.\n\
1268 This means it contains a description for how to read arguments to give it.\n\
1269 The value is nil for an invalid function or a symbol with no function\n\
1272 Interactively callable functions include strings and vectors (treated\n\
1273 as keyboard macros), lambda-expressions that contain a top-level call\n\
1274 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1275 fourth argument, and some of the built-in functions of Lisp.\n\
1277 Also, a symbol satisfies `commandp' if its function definition does so.")
1279 Lisp_Object function
;
1281 register Lisp_Object fun
;
1282 register Lisp_Object funcar
;
1283 register Lisp_Object tem
;
1288 fun
= indirect_function (fun
);
1289 if (EQ (fun
, Qunbound
))
1292 /* Emacs primitives are interactive if their DEFUN specifies an
1293 interactive spec. */
1294 if (XTYPE (fun
) == Lisp_Subr
)
1296 if (XSUBR (fun
)->prompt
)
1302 /* Bytecode objects are interactive if they are long enough to
1303 have an element whose index is COMPILED_INTERACTIVE, which is
1304 where the interactive spec is stored. */
1305 else if (XTYPE (fun
) == Lisp_Compiled
)
1306 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1309 /* Strings and vectors are keyboard macros. */
1310 if (XTYPE (fun
) == Lisp_String
1311 || XTYPE (fun
) == Lisp_Vector
)
1314 /* Lists may represent commands. */
1317 funcar
= Fcar (fun
);
1318 if (XTYPE (funcar
) != Lisp_Symbol
)
1319 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1320 if (EQ (funcar
, Qlambda
))
1321 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1322 if (EQ (funcar
, Qmocklisp
))
1323 return Qt
; /* All mocklisp functions can be called interactively */
1324 if (EQ (funcar
, Qautoload
))
1325 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1331 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1332 "Define FUNCTION to autoload from FILE.\n\
1333 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1334 Third arg DOCSTRING is documentation for the function.\n\
1335 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1336 Fifth arg TYPE indicates the type of the object:\n\
1337 nil or omitted says FUNCTION is a function,\n\
1338 `keymap' says FUNCTION is really a keymap, and\n\
1339 `macro' or t says FUNCTION is really a macro.\n\
1340 Third through fifth args give info about the real definition.\n\
1341 They default to nil.\n\
1342 If FUNCTION is already defined other than as an autoload,\n\
1343 this does nothing and returns nil.")
1344 (function
, file
, docstring
, interactive
, type
)
1345 Lisp_Object function
, file
, docstring
, interactive
, type
;
1348 Lisp_Object args
[4];
1351 CHECK_SYMBOL (function
, 0);
1352 CHECK_STRING (file
, 1);
1354 /* If function is defined and not as an autoload, don't override */
1355 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1356 && !(XTYPE (XSYMBOL (function
)->function
) == Lisp_Cons
1357 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1362 args
[1] = docstring
;
1363 args
[2] = interactive
;
1366 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1367 #else /* NO_ARG_ARRAY */
1368 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1369 #endif /* not NO_ARG_ARRAY */
1373 un_autoload (oldqueue
)
1374 Lisp_Object oldqueue
;
1376 register Lisp_Object queue
, first
, second
;
1378 /* Queue to unwind is current value of Vautoload_queue.
1379 oldqueue is the shadowed value to leave in Vautoload_queue. */
1380 queue
= Vautoload_queue
;
1381 Vautoload_queue
= oldqueue
;
1382 while (CONSP (queue
))
1384 first
= Fcar (queue
);
1385 second
= Fcdr (first
);
1386 first
= Fcar (first
);
1387 if (EQ (second
, Qnil
))
1390 Ffset (first
, second
);
1391 queue
= Fcdr (queue
);
1396 do_autoload (fundef
, funname
)
1397 Lisp_Object fundef
, funname
;
1399 int count
= specpdl_ptr
- specpdl
;
1400 Lisp_Object fun
, val
, queue
, first
, second
;
1403 CHECK_SYMBOL (funname
, 0);
1405 /* Value saved here is to be restored into Vautoload_queue */
1406 record_unwind_protect (un_autoload
, Vautoload_queue
);
1407 Vautoload_queue
= Qt
;
1408 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1410 /* Save the old autoloads, in case we ever do an unload. */
1411 queue
= Vautoload_queue
;
1412 while (CONSP (queue
))
1414 first
= Fcar (queue
);
1415 second
= Fcdr (first
);
1416 first
= Fcar (first
);
1418 /* Note: This test is subtle. The cdr of an autoload-queue entry
1419 may be an atom if the autoload entry was generated by a defalias
1422 Fput (first
, Qautoload
, (Fcdr (second
)));
1424 queue
= Fcdr (queue
);
1427 /* Once loading finishes, don't undo it. */
1428 Vautoload_queue
= Qt
;
1429 unbind_to (count
, Qnil
);
1431 fun
= Findirect_function (fun
);
1433 if (!NILP (Fequal (fun
, fundef
)))
1434 error ("Autoloading failed to define function %s",
1435 XSYMBOL (funname
)->name
->data
);
1438 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1439 "Evaluate FORM and return its value.")
1443 Lisp_Object fun
, val
, original_fun
, original_args
;
1445 struct backtrace backtrace
;
1446 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1448 if (XTYPE (form
) == Lisp_Symbol
)
1450 if (EQ (Vmocklisp_arguments
, Qt
))
1451 return Fsymbol_value (form
);
1452 val
= Fsymbol_value (form
);
1455 else if (EQ (val
, Qt
))
1463 if (consing_since_gc
> gc_cons_threshold
)
1466 Fgarbage_collect ();
1470 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1472 if (max_lisp_eval_depth
< 100)
1473 max_lisp_eval_depth
= 100;
1474 if (lisp_eval_depth
> max_lisp_eval_depth
)
1475 error ("Lisp nesting exceeds max-lisp-eval-depth");
1478 original_fun
= Fcar (form
);
1479 original_args
= Fcdr (form
);
1481 backtrace
.next
= backtrace_list
;
1482 backtrace_list
= &backtrace
;
1483 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1484 backtrace
.args
= &original_args
;
1485 backtrace
.nargs
= UNEVALLED
;
1486 backtrace
.evalargs
= 1;
1487 backtrace
.debug_on_exit
= 0;
1489 if (debug_on_next_call
)
1490 do_debug_on_call (Qt
);
1492 /* At this point, only original_fun and original_args
1493 have values that will be used below */
1495 fun
= Findirect_function (original_fun
);
1497 if (XTYPE (fun
) == Lisp_Subr
)
1499 Lisp_Object numargs
;
1500 Lisp_Object argvals
[7];
1501 Lisp_Object args_left
;
1502 register int i
, maxargs
;
1504 args_left
= original_args
;
1505 numargs
= Flength (args_left
);
1507 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1508 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1509 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1511 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1513 backtrace
.evalargs
= 0;
1514 val
= (*XSUBR (fun
)->function
) (args_left
);
1518 if (XSUBR (fun
)->max_args
== MANY
)
1520 /* Pass a vector of evaluated arguments */
1522 register int argnum
= 0;
1524 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1526 GCPRO3 (args_left
, fun
, fun
);
1530 while (!NILP (args_left
))
1532 vals
[argnum
++] = Feval (Fcar (args_left
));
1533 args_left
= Fcdr (args_left
);
1534 gcpro3
.nvars
= argnum
;
1537 backtrace
.args
= vals
;
1538 backtrace
.nargs
= XINT (numargs
);
1540 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1545 GCPRO3 (args_left
, fun
, fun
);
1546 gcpro3
.var
= argvals
;
1549 maxargs
= XSUBR (fun
)->max_args
;
1550 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1552 argvals
[i
] = Feval (Fcar (args_left
));
1558 backtrace
.args
= argvals
;
1559 backtrace
.nargs
= XINT (numargs
);
1564 val
= (*XSUBR (fun
)->function
) ();
1567 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1570 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1573 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1577 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1578 argvals
[2], argvals
[3]);
1581 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1582 argvals
[3], argvals
[4]);
1585 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1586 argvals
[3], argvals
[4], argvals
[5]);
1589 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1590 argvals
[3], argvals
[4], argvals
[5],
1595 /* Someone has created a subr that takes more arguments than
1596 is supported by this code. We need to either rewrite the
1597 subr to use a different argument protocol, or add more
1598 cases to this switch. */
1602 if (XTYPE (fun
) == Lisp_Compiled
)
1603 val
= apply_lambda (fun
, original_args
, 1);
1607 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1608 funcar
= Fcar (fun
);
1609 if (XTYPE (funcar
) != Lisp_Symbol
)
1610 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1611 if (EQ (funcar
, Qautoload
))
1613 do_autoload (fun
, original_fun
);
1616 if (EQ (funcar
, Qmacro
))
1617 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1618 else if (EQ (funcar
, Qlambda
))
1619 val
= apply_lambda (fun
, original_args
, 1);
1620 else if (EQ (funcar
, Qmocklisp
))
1621 val
= ml_apply (fun
, original_args
);
1623 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1626 if (!EQ (Vmocklisp_arguments
, Qt
))
1630 else if (EQ (val
, Qt
))
1634 if (backtrace
.debug_on_exit
)
1635 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1636 backtrace_list
= backtrace
.next
;
1640 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1641 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1642 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1647 register int i
, numargs
;
1648 register Lisp_Object spread_arg
;
1649 register Lisp_Object
*funcall_args
;
1651 struct gcpro gcpro1
;
1655 spread_arg
= args
[nargs
- 1];
1656 CHECK_LIST (spread_arg
, nargs
);
1658 numargs
= XINT (Flength (spread_arg
));
1661 return Ffuncall (nargs
- 1, args
);
1662 else if (numargs
== 1)
1664 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1665 return Ffuncall (nargs
, args
);
1668 numargs
+= nargs
- 2;
1670 fun
= indirect_function (fun
);
1671 if (EQ (fun
, Qunbound
))
1673 /* Let funcall get the error */
1678 if (XTYPE (fun
) == Lisp_Subr
)
1680 if (numargs
< XSUBR (fun
)->min_args
1681 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1682 goto funcall
; /* Let funcall get the error */
1683 else if (XSUBR (fun
)->max_args
> numargs
)
1685 /* Avoid making funcall cons up a yet another new vector of arguments
1686 by explicitly supplying nil's for optional values */
1687 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1688 * sizeof (Lisp_Object
));
1689 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1690 funcall_args
[++i
] = Qnil
;
1691 GCPRO1 (*funcall_args
);
1692 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1696 /* We add 1 to numargs because funcall_args includes the
1697 function itself as well as its arguments. */
1700 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1701 * sizeof (Lisp_Object
));
1702 GCPRO1 (*funcall_args
);
1703 gcpro1
.nvars
= 1 + numargs
;
1706 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1707 /* Spread the last arg we got. Its first element goes in
1708 the slot that it used to occupy, hence this value of I. */
1710 while (!NILP (spread_arg
))
1712 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1713 spread_arg
= XCONS (spread_arg
)->cdr
;
1716 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1719 /* Apply fn to arg */
1722 Lisp_Object fn
, arg
;
1724 struct gcpro gcpro1
;
1728 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1732 Lisp_Object args
[2];
1736 RETURN_UNGCPRO (Fapply (2, args
));
1738 #else /* not NO_ARG_ARRAY */
1739 RETURN_UNGCPRO (Fapply (2, &fn
));
1740 #endif /* not NO_ARG_ARRAY */
1743 /* Call function fn on no arguments */
1748 struct gcpro gcpro1
;
1751 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1754 /* Call function fn with 1 argument arg1 */
1758 Lisp_Object fn
, arg1
;
1760 struct gcpro gcpro1
;
1762 Lisp_Object args
[2];
1768 RETURN_UNGCPRO (Ffuncall (2, args
));
1769 #else /* not NO_ARG_ARRAY */
1772 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1773 #endif /* not NO_ARG_ARRAY */
1776 /* Call function fn with 2 arguments arg1, arg2 */
1779 call2 (fn
, arg1
, arg2
)
1780 Lisp_Object fn
, arg1
, arg2
;
1782 struct gcpro gcpro1
;
1784 Lisp_Object args
[3];
1790 RETURN_UNGCPRO (Ffuncall (3, args
));
1791 #else /* not NO_ARG_ARRAY */
1794 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1795 #endif /* not NO_ARG_ARRAY */
1798 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1801 call3 (fn
, arg1
, arg2
, arg3
)
1802 Lisp_Object fn
, arg1
, arg2
, arg3
;
1804 struct gcpro gcpro1
;
1806 Lisp_Object args
[4];
1813 RETURN_UNGCPRO (Ffuncall (4, args
));
1814 #else /* not NO_ARG_ARRAY */
1817 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1818 #endif /* not NO_ARG_ARRAY */
1821 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1824 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1825 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1827 struct gcpro gcpro1
;
1829 Lisp_Object args
[5];
1837 RETURN_UNGCPRO (Ffuncall (5, args
));
1838 #else /* not NO_ARG_ARRAY */
1841 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1842 #endif /* not NO_ARG_ARRAY */
1845 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1848 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1849 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1851 struct gcpro gcpro1
;
1853 Lisp_Object args
[6];
1862 RETURN_UNGCPRO (Ffuncall (6, args
));
1863 #else /* not NO_ARG_ARRAY */
1866 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1867 #endif /* not NO_ARG_ARRAY */
1870 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1873 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1874 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1876 struct gcpro gcpro1
;
1878 Lisp_Object args
[7];
1888 RETURN_UNGCPRO (Ffuncall (7, args
));
1889 #else /* not NO_ARG_ARRAY */
1892 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1893 #endif /* not NO_ARG_ARRAY */
1896 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1897 "Call first argument as a function, passing remaining arguments to it.\n\
1898 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1905 int numargs
= nargs
- 1;
1906 Lisp_Object lisp_numargs
;
1908 struct backtrace backtrace
;
1909 register Lisp_Object
*internal_args
;
1913 if (consing_since_gc
> gc_cons_threshold
)
1914 Fgarbage_collect ();
1916 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1918 if (max_lisp_eval_depth
< 100)
1919 max_lisp_eval_depth
= 100;
1920 if (lisp_eval_depth
> max_lisp_eval_depth
)
1921 error ("Lisp nesting exceeds max-lisp-eval-depth");
1924 backtrace
.next
= backtrace_list
;
1925 backtrace_list
= &backtrace
;
1926 backtrace
.function
= &args
[0];
1927 backtrace
.args
= &args
[1];
1928 backtrace
.nargs
= nargs
- 1;
1929 backtrace
.evalargs
= 0;
1930 backtrace
.debug_on_exit
= 0;
1932 if (debug_on_next_call
)
1933 do_debug_on_call (Qlambda
);
1939 fun
= Findirect_function (fun
);
1941 if (XTYPE (fun
) == Lisp_Subr
)
1943 if (numargs
< XSUBR (fun
)->min_args
1944 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1946 XFASTINT (lisp_numargs
) = numargs
;
1947 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
1950 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1951 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1953 if (XSUBR (fun
)->max_args
== MANY
)
1955 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
1959 if (XSUBR (fun
)->max_args
> numargs
)
1961 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
1962 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
1963 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
1964 internal_args
[i
] = Qnil
;
1967 internal_args
= args
+ 1;
1968 switch (XSUBR (fun
)->max_args
)
1971 val
= (*XSUBR (fun
)->function
) ();
1974 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
1977 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
1981 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1985 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1990 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1991 internal_args
[2], internal_args
[3],
1995 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1996 internal_args
[2], internal_args
[3],
1997 internal_args
[4], internal_args
[5]);
2000 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2001 internal_args
[2], internal_args
[3],
2002 internal_args
[4], internal_args
[5],
2008 /* If a subr takes more than 6 arguments without using MANY
2009 or UNEVALLED, we need to extend this function to support it.
2010 Until this is done, there is no way to call the function. */
2014 if (XTYPE (fun
) == Lisp_Compiled
)
2015 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2019 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2020 funcar
= Fcar (fun
);
2021 if (XTYPE (funcar
) != Lisp_Symbol
)
2022 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2023 if (EQ (funcar
, Qlambda
))
2024 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2025 else if (EQ (funcar
, Qmocklisp
))
2026 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2027 else if (EQ (funcar
, Qautoload
))
2029 do_autoload (fun
, args
[0]);
2033 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2037 if (backtrace
.debug_on_exit
)
2038 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2039 backtrace_list
= backtrace
.next
;
2044 apply_lambda (fun
, args
, eval_flag
)
2045 Lisp_Object fun
, args
;
2048 Lisp_Object args_left
;
2049 Lisp_Object numargs
;
2050 register Lisp_Object
*arg_vector
;
2051 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2053 register Lisp_Object tem
;
2055 numargs
= Flength (args
);
2056 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2059 GCPRO3 (*arg_vector
, args_left
, fun
);
2062 for (i
= 0; i
< XINT (numargs
);)
2064 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2065 if (eval_flag
) tem
= Feval (tem
);
2066 arg_vector
[i
++] = tem
;
2074 backtrace_list
->args
= arg_vector
;
2075 backtrace_list
->nargs
= i
;
2077 backtrace_list
->evalargs
= 0;
2078 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2080 /* Do the debug-on-exit now, while arg_vector still exists. */
2081 if (backtrace_list
->debug_on_exit
)
2082 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2083 /* Don't do it again when we return to eval. */
2084 backtrace_list
->debug_on_exit
= 0;
2088 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2089 and return the result of evaluation.
2090 FUN must be either a lambda-expression or a compiled-code object. */
2093 funcall_lambda (fun
, nargs
, arg_vector
)
2096 register Lisp_Object
*arg_vector
;
2098 Lisp_Object val
, tem
;
2099 register Lisp_Object syms_left
;
2100 Lisp_Object numargs
;
2101 register Lisp_Object next
;
2102 int count
= specpdl_ptr
- specpdl
;
2104 int optional
= 0, rest
= 0;
2106 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2108 XFASTINT (numargs
) = nargs
;
2110 if (XTYPE (fun
) == Lisp_Cons
)
2111 syms_left
= Fcar (Fcdr (fun
));
2112 else if (XTYPE (fun
) == Lisp_Compiled
)
2113 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2117 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2120 next
= Fcar (syms_left
);
2121 while (XTYPE (next
) != Lisp_Symbol
)
2122 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2123 if (EQ (next
, Qand_rest
))
2125 else if (EQ (next
, Qand_optional
))
2129 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2134 tem
= arg_vector
[i
++];
2135 specbind (next
, tem
);
2138 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2140 specbind (next
, Qnil
);
2144 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2146 if (XTYPE (fun
) == Lisp_Cons
)
2147 val
= Fprogn (Fcdr (Fcdr (fun
)));
2149 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2150 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2151 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2152 return unbind_to (count
, val
);
2158 register int count
= specpdl_ptr
- specpdl
;
2159 if (specpdl_size
>= max_specpdl_size
)
2161 if (max_specpdl_size
< 400)
2162 max_specpdl_size
= 400;
2163 if (specpdl_size
>= max_specpdl_size
)
2165 if (!NILP (Vdebug_on_error
))
2166 /* Leave room for some specpdl in the debugger. */
2167 max_specpdl_size
= specpdl_size
+ 100;
2169 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2173 if (specpdl_size
> max_specpdl_size
)
2174 specpdl_size
= max_specpdl_size
;
2175 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2176 specpdl_ptr
= specpdl
+ count
;
2180 specbind (symbol
, value
)
2181 Lisp_Object symbol
, value
;
2183 extern void store_symval_forwarding (); /* in eval.c */
2186 CHECK_SYMBOL (symbol
, 0);
2188 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2190 specpdl_ptr
->symbol
= symbol
;
2191 specpdl_ptr
->func
= 0;
2192 ovalue
= XSYMBOL (symbol
)->value
;
2193 specpdl_ptr
->old_value
= EQ (ovalue
, Qunbound
) ? Qunbound
: Fsymbol_value (symbol
);
2195 if (XTYPE (ovalue
) == Lisp_Buffer_Objfwd
)
2196 store_symval_forwarding (symbol
, ovalue
, value
);
2198 Fset (symbol
, value
);
2202 record_unwind_protect (function
, arg
)
2203 Lisp_Object (*function
)();
2206 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2208 specpdl_ptr
->func
= function
;
2209 specpdl_ptr
->symbol
= Qnil
;
2210 specpdl_ptr
->old_value
= arg
;
2215 unbind_to (count
, value
)
2219 int quitf
= !NILP (Vquit_flag
);
2220 struct gcpro gcpro1
;
2226 while (specpdl_ptr
!= specpdl
+ count
)
2229 if (specpdl_ptr
->func
!= 0)
2230 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2231 /* Note that a "binding" of nil is really an unwind protect,
2232 so in that case the "old value" is a list of forms to evaluate. */
2233 else if (NILP (specpdl_ptr
->symbol
))
2234 Fprogn (specpdl_ptr
->old_value
);
2236 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2238 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2247 /* Get the value of symbol's global binding, even if that binding
2248 is not now dynamically visible. */
2251 top_level_value (symbol
)
2254 register struct specbinding
*ptr
= specpdl
;
2256 CHECK_SYMBOL (symbol
, 0);
2257 for (; ptr
!= specpdl_ptr
; ptr
++)
2259 if (EQ (ptr
->symbol
, symbol
))
2260 return ptr
->old_value
;
2262 return Fsymbol_value (symbol
);
2266 top_level_set (symbol
, newval
)
2267 Lisp_Object symbol
, newval
;
2269 register struct specbinding
*ptr
= specpdl
;
2271 CHECK_SYMBOL (symbol
, 0);
2272 for (; ptr
!= specpdl_ptr
; ptr
++)
2274 if (EQ (ptr
->symbol
, symbol
))
2276 ptr
->old_value
= newval
;
2280 return Fset (symbol
, newval
);
2285 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2286 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2287 The debugger is entered when that frame exits, if the flag is non-nil.")
2289 Lisp_Object level
, flag
;
2291 register struct backtrace
*backlist
= backtrace_list
;
2294 CHECK_NUMBER (level
, 0);
2296 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2298 backlist
= backlist
->next
;
2302 backlist
->debug_on_exit
= !NILP (flag
);
2307 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2308 "Print a trace of Lisp function calls currently active.\n\
2309 Output stream used is value of `standard-output'.")
2312 register struct backtrace
*backlist
= backtrace_list
;
2316 extern Lisp_Object Vprint_level
;
2317 struct gcpro gcpro1
;
2319 XFASTINT (Vprint_level
) = 3;
2326 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2327 if (backlist
->nargs
== UNEVALLED
)
2329 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2333 tem
= *backlist
->function
;
2334 Fprin1 (tem
, Qnil
); /* This can QUIT */
2335 write_string ("(", -1);
2336 if (backlist
->nargs
== MANY
)
2338 for (tail
= *backlist
->args
, i
= 0;
2340 tail
= Fcdr (tail
), i
++)
2342 if (i
) write_string (" ", -1);
2343 Fprin1 (Fcar (tail
), Qnil
);
2348 for (i
= 0; i
< backlist
->nargs
; i
++)
2350 if (i
) write_string (" ", -1);
2351 Fprin1 (backlist
->args
[i
], Qnil
);
2355 write_string (")\n", -1);
2356 backlist
= backlist
->next
;
2359 Vprint_level
= Qnil
;
2364 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2365 "Return the function and arguments N frames up from current execution point.\n\
2366 If that frame has not evaluated the arguments yet (or is a special form),\n\
2367 the value is (nil FUNCTION ARG-FORMS...).\n\
2368 If that frame has evaluated its arguments and called its function already,\n\
2369 the value is (t FUNCTION ARG-VALUES...).\n\
2370 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2371 FUNCTION is whatever was supplied as car of evaluated list,\n\
2372 or a lambda expression for macro calls.\n\
2373 If N is more than the number of frames, the value is nil.")
2375 Lisp_Object nframes
;
2377 register struct backtrace
*backlist
= backtrace_list
;
2381 CHECK_NATNUM (nframes
, 0);
2383 /* Find the frame requested. */
2384 for (i
= 0; i
< XFASTINT (nframes
); i
++)
2385 backlist
= backlist
->next
;
2389 if (backlist
->nargs
== UNEVALLED
)
2390 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2393 if (backlist
->nargs
== MANY
)
2394 tem
= *backlist
->args
;
2396 tem
= Flist (backlist
->nargs
, backlist
->args
);
2398 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2404 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2405 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2407 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2408 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2409 This limit is to catch infinite recursions for you before they cause\n\
2410 actual stack overflow in C, which would be fatal for Emacs.\n\
2411 You can safely make it considerably larger than its default value,\n\
2412 if that proves inconveniently small.");
2414 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2415 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2416 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2419 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2420 "Non-nil inhibits C-g quitting from happening immediately.\n\
2421 Note that `quit-flag' will still be set by typing C-g,\n\
2422 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2423 To prevent this happening, set `quit-flag' to nil\n\
2424 before making `inhibit-quit' nil.");
2425 Vinhibit_quit
= Qnil
;
2427 Qinhibit_quit
= intern ("inhibit-quit");
2428 staticpro (&Qinhibit_quit
);
2430 Qautoload
= intern ("autoload");
2431 staticpro (&Qautoload
);
2433 Qdebug_on_error
= intern ("debug-on-error");
2434 staticpro (&Qdebug_on_error
);
2436 Qmacro
= intern ("macro");
2437 staticpro (&Qmacro
);
2439 /* Note that the process handling also uses Qexit, but we don't want
2440 to staticpro it twice, so we just do it here. */
2441 Qexit
= intern ("exit");
2444 Qinteractive
= intern ("interactive");
2445 staticpro (&Qinteractive
);
2447 Qcommandp
= intern ("commandp");
2448 staticpro (&Qcommandp
);
2450 Qdefun
= intern ("defun");
2451 staticpro (&Qdefun
);
2453 Qand_rest
= intern ("&rest");
2454 staticpro (&Qand_rest
);
2456 Qand_optional
= intern ("&optional");
2457 staticpro (&Qand_optional
);
2459 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2460 "*Non-nil means automatically display a backtrace buffer\n\
2461 after any error that is handled by the editor command loop.\n\
2462 If the value is a list, an error only means to display a backtrace\n\
2463 if one of its condition symbols appears in the list.");
2464 Vstack_trace_on_error
= Qnil
;
2466 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2467 "*Non-nil means enter debugger if an error is signaled.\n\
2468 Does not apply to errors handled by `condition-case'.\n\
2469 If the value is a list, an error only means to enter the debugger\n\
2470 if one of its condition symbols appears in the list.\n\
2471 See also variable `debug-on-quit'.");
2472 Vdebug_on_error
= Qnil
;
2474 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2475 "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
2476 Does not apply if quit is handled by a `condition-case'.");
2479 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2480 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2482 DEFVAR_LISP ("debugger", &Vdebugger
,
2483 "Function to call to invoke debugger.\n\
2484 If due to frame exit, args are `exit' and the value being returned;\n\
2485 this function's value will be returned instead of that.\n\
2486 If due to error, args are `error' and a list of the args to `signal'.\n\
2487 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2488 If due to `eval' entry, one arg, t.");
2491 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2492 staticpro (&Qmocklisp_arguments
);
2493 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2494 "While in a mocklisp function, the list of its unevaluated args.");
2495 Vmocklisp_arguments
= Qt
;
2497 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2498 "Set to the function `run-hooks', if that function has been defined.\n\
2499 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2502 staticpro (&Vautoload_queue
);
2503 Vautoload_queue
= Qnil
;
2514 defsubr (&Sfunction
);
2516 defsubr (&Sdefmacro
);
2518 defsubr (&Sdefconst
);
2519 defsubr (&Suser_variable_p
);
2523 defsubr (&Smacroexpand
);
2526 defsubr (&Sunwind_protect
);
2527 defsubr (&Scondition_case
);
2529 defsubr (&Sinteractive_p
);
2530 defsubr (&Scommandp
);
2531 defsubr (&Sautoload
);
2534 defsubr (&Sfuncall
);
2535 defsubr (&Sbacktrace_debug
);
2536 defsubr (&Sbacktrace
);
2537 defsubr (&Sbacktrace_frame
);