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 /* This is less than the initial value of num_nonmacro_input_chars. */
167 when_entered_debugger
= -1;
174 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
175 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
176 if (specpdl_size
+ 40 > max_specpdl_size
)
177 max_specpdl_size
= specpdl_size
+ 40;
178 debug_on_next_call
= 0;
179 when_entered_debugger
= num_nonmacro_input_chars
;
180 return apply1 (Vdebugger
, arg
);
183 do_debug_on_call (code
)
186 debug_on_next_call
= 0;
187 backtrace_list
->debug_on_exit
= 1;
188 call_debugger (Fcons (code
, Qnil
));
191 /* NOTE!!! Every function that can call EVAL must protect its args
192 and temporaries from garbage collection while it needs them.
193 The definition of `For' shows what you have to do. */
195 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
196 "Eval args until one of them yields non-nil, then return that value.\n\
197 The remaining args are not evalled at all.\n\
198 If all args return nil, return nil.")
202 register Lisp_Object val
;
203 Lisp_Object args_left
;
214 val
= Feval (Fcar (args_left
));
217 args_left
= Fcdr (args_left
);
219 while (!NILP(args_left
));
225 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
226 "Eval args until one of them yields nil, then return nil.\n\
227 The remaining args are not evalled at all.\n\
228 If no arg yields nil, return the last arg's value.")
232 register Lisp_Object val
;
233 Lisp_Object args_left
;
244 val
= Feval (Fcar (args_left
));
247 args_left
= Fcdr (args_left
);
249 while (!NILP(args_left
));
255 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
256 "(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...\n\
257 Returns the value of THEN or the value of the last of the ELSE's.\n\
258 THEN must be one expression, but ELSE... can be zero or more expressions.\n\
259 If COND yields nil, and there are no ELSE's, the value is nil.")
263 register Lisp_Object cond
;
267 cond
= Feval (Fcar (args
));
271 return Feval (Fcar (Fcdr (args
)));
272 return Fprogn (Fcdr (Fcdr (args
)));
275 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
276 "(cond CLAUSES...): try each clause until one succeeds.\n\
277 Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\
278 and, if the value is non-nil, this clause succeeds:\n\
279 then the expressions in BODY are evaluated and the last one's\n\
280 value is the value of the cond-form.\n\
281 If no clause succeeds, cond returns nil.\n\
282 If a clause has one element, as in (CONDITION),\n\
283 CONDITION's value if non-nil is returned from the cond-form.")
287 register Lisp_Object clause
, val
;
294 clause
= Fcar (args
);
295 val
= Feval (Fcar (clause
));
298 if (!EQ (XCONS (clause
)->cdr
, Qnil
))
299 val
= Fprogn (XCONS (clause
)->cdr
);
302 args
= XCONS (args
)->cdr
;
309 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
310 "(progn BODY...): eval BODY forms sequentially and return value of last one.")
314 register Lisp_Object val
, tem
;
315 Lisp_Object args_left
;
318 /* In Mocklisp code, symbols at the front of the progn arglist
319 are to be bound to zero. */
320 if (!EQ (Vmocklisp_arguments
, Qt
))
322 val
= make_number (0);
323 while (!NILP (args
) && (tem
= Fcar (args
), XTYPE (tem
) == Lisp_Symbol
))
326 specbind (tem
, val
), args
= Fcdr (args
);
338 val
= Feval (Fcar (args_left
));
339 args_left
= Fcdr (args_left
);
341 while (!NILP(args_left
));
347 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
348 "(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.\n\
349 The value of FIRST is saved during the evaluation of the remaining args,\n\
350 whose values are discarded.")
355 register Lisp_Object args_left
;
356 struct gcpro gcpro1
, gcpro2
;
357 register int argnum
= 0;
369 val
= Feval (Fcar (args_left
));
371 Feval (Fcar (args_left
));
372 args_left
= Fcdr (args_left
);
374 while (!NILP(args_left
));
380 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
381 "(prog1 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
382 The value of Y is saved during the evaluation of the remaining args,\n\
383 whose values are discarded.")
388 register Lisp_Object args_left
;
389 struct gcpro gcpro1
, gcpro2
;
390 register int argnum
= -1;
404 val
= Feval (Fcar (args_left
));
406 Feval (Fcar (args_left
));
407 args_left
= Fcdr (args_left
);
409 while (!NILP (args_left
));
415 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
416 "(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
417 The symbols SYM are variables; they are literal (not evaluated).\n\
418 The values VAL are expressions; they are evaluated.\n\
419 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\
420 The second VAL is not computed until after the first SYM is set, and so on;\n\
421 each VAL can use the new value of variables set earlier in the `setq'.\n\
422 The return value of the `setq' form is the value of the last VAL.")
426 register Lisp_Object args_left
;
427 register Lisp_Object val
, sym
;
438 val
= Feval (Fcar (Fcdr (args_left
)));
439 sym
= Fcar (args_left
);
441 args_left
= Fcdr (Fcdr (args_left
));
443 while (!NILP(args_left
));
449 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
450 "Return the argument, without evaluating it. `(quote x)' yields `x'.")
457 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
458 "Like `quote', but preferred for objects which are functions.\n\
459 In byte compilation, `function' causes its argument to be compiled.\n\
460 `quote' cannot do that.")
467 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
468 "Return t if function in which this appears was called interactively.\n\
469 This means that the function was called with call-interactively (which\n\
470 includes being called as the binding of a key)\n\
471 and input is currently coming from the keyboard (not in keyboard macro).")
474 register struct backtrace
*btp
;
475 register Lisp_Object fun
;
480 btp
= backtrace_list
;
482 /* If this isn't a byte-compiled function, there may be a frame at
483 the top for Finteractive_p itself. If so, skip it. */
484 fun
= Findirect_function (*btp
->function
);
485 if (XTYPE (fun
) == Lisp_Subr
486 && (struct Lisp_Subr
*) XPNTR (fun
) == &Sinteractive_p
)
489 /* If we're running an Emacs 18-style byte-compiled function, there
490 may be a frame for Fbytecode. Now, given the strictest
491 definition, this function isn't really being called
492 interactively, but because that's the way Emacs 18 always builds
493 byte-compiled functions, we'll accept it for now. */
494 if (EQ (*btp
->function
, Qbytecode
))
497 /* If this isn't a byte-compiled function, then we may now be
498 looking at several frames for special forms. Skip past them. */
500 btp
->nargs
== UNEVALLED
)
503 /* btp now points at the frame of the innermost function that isn't
504 a special form, ignoring frames for Finteractive_p and/or
505 Fbytecode at the top. If this frame is for a built-in function
506 (such as load or eval-region) return nil. */
507 fun
= Findirect_function (*btp
->function
);
508 if (XTYPE (fun
) == Lisp_Subr
)
510 /* btp points to the frame of a Lisp function that called interactive-p.
511 Return t if that function was called interactively. */
512 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
517 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
518 "(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.\n\
519 The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
520 See also the function `interactive'.")
524 register Lisp_Object fn_name
;
525 register Lisp_Object defn
;
527 fn_name
= Fcar (args
);
528 defn
= Fcons (Qlambda
, Fcdr (args
));
529 if (!NILP (Vpurify_flag
))
530 defn
= Fpurecopy (defn
);
531 Ffset (fn_name
, defn
);
532 LOADHIST_ATTACH (fn_name
);
536 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
537 "(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.\n\
538 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
539 When the macro is called, as in (NAME ARGS...),\n\
540 the function (lambda ARGLIST BODY...) is applied to\n\
541 the list ARGS... as it appears in the expression,\n\
542 and the result should be a form to be evaluated instead of the original.")
546 register Lisp_Object fn_name
;
547 register Lisp_Object defn
;
549 fn_name
= Fcar (args
);
550 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
551 if (!NILP (Vpurify_flag
))
552 defn
= Fpurecopy (defn
);
553 Ffset (fn_name
, defn
);
554 LOADHIST_ATTACH (fn_name
);
558 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
559 "(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.\n\
560 You are not required to define a variable in order to use it,\n\
561 but the definition can supply documentation and an initial value\n\
562 in a way that tags can recognize.\n\n\
563 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
564 If SYMBOL is buffer-local, its default value is what is set;\n\
565 buffer-local values are not affected.\n\
566 INITVALUE and DOCSTRING are optional.\n\
567 If DOCSTRING starts with *, this variable is identified as a user option.\n\
568 This means that M-x set-variable and M-x edit-options recognize it.\n\
569 If INITVALUE is missing, SYMBOL's value is not set.")
573 register Lisp_Object sym
, tem
;
579 tem
= Fdefault_boundp (sym
);
581 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
583 tem
= Fcar (Fcdr (Fcdr (args
)));
586 if (!NILP (Vpurify_flag
))
587 tem
= Fpurecopy (tem
);
588 Fput (sym
, Qvariable_documentation
, tem
);
590 LOADHIST_ATTACH (sym
);
594 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
595 "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
596 The intent is that programs do not change this value, but users may.\n\
597 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
598 If SYMBOL is buffer-local, its default value is what is set;\n\
599 buffer-local values are not affected.\n\
600 DOCSTRING is optional.\n\
601 If DOCSTRING starts with *, this variable is identified as a user option.\n\
602 This means that M-x set-variable and M-x edit-options recognize it.\n\n\
603 Note: do not use `defconst' for user options in libraries that are not\n\
604 normally loaded, since it is useful for users to be able to specify\n\
605 their own values for such variables before loading the library.\n\
606 Since `defconst' unconditionally assigns the variable,\n\
607 it would override the user's choice.")
611 register Lisp_Object sym
, tem
;
614 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
615 tem
= Fcar (Fcdr (Fcdr (args
)));
618 if (!NILP (Vpurify_flag
))
619 tem
= Fpurecopy (tem
);
620 Fput (sym
, Qvariable_documentation
, tem
);
622 LOADHIST_ATTACH (sym
);
626 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
627 "Returns t if VARIABLE is intended to be set and modified by users.\n\
628 \(The alternative is a variable used internally in a Lisp program.)\n\
629 Determined by whether the first character of the documentation\n\
630 for the variable is \"*\"")
632 Lisp_Object variable
;
634 Lisp_Object documentation
;
636 documentation
= Fget (variable
, Qvariable_documentation
);
637 if (XTYPE (documentation
) == Lisp_Int
&& XINT (documentation
) < 0)
639 if ((XTYPE (documentation
) == Lisp_String
) &&
640 ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
645 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
646 "(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
647 The value of the last form in BODY is returned.\n\
648 Each element of VARLIST is a symbol (which is bound to nil)\n\
649 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
650 Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
654 Lisp_Object varlist
, val
, elt
;
655 int count
= specpdl_ptr
- specpdl
;
656 struct gcpro gcpro1
, gcpro2
, gcpro3
;
658 GCPRO3 (args
, elt
, varlist
);
660 varlist
= Fcar (args
);
661 while (!NILP (varlist
))
664 elt
= Fcar (varlist
);
665 if (XTYPE (elt
) == Lisp_Symbol
)
666 specbind (elt
, Qnil
);
667 else if (! NILP (Fcdr (Fcdr (elt
))))
669 Fcons (build_string ("`let' bindings can have only one value-form"),
673 val
= Feval (Fcar (Fcdr (elt
)));
674 specbind (Fcar (elt
), val
);
676 varlist
= Fcdr (varlist
);
679 val
= Fprogn (Fcdr (args
));
680 return unbind_to (count
, val
);
683 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
684 "(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
685 The value of the last form in BODY is returned.\n\
686 Each element of VARLIST is a symbol (which is bound to nil)\n\
687 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
688 All the VALUEFORMs are evalled before any symbols are bound.")
692 Lisp_Object
*temps
, tem
;
693 register Lisp_Object elt
, varlist
;
694 int count
= specpdl_ptr
- specpdl
;
696 struct gcpro gcpro1
, gcpro2
;
698 varlist
= Fcar (args
);
700 /* Make space to hold the values to give the bound variables */
701 elt
= Flength (varlist
);
702 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
704 /* Compute the values and store them in `temps' */
706 GCPRO2 (args
, *temps
);
709 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
712 elt
= Fcar (varlist
);
713 if (XTYPE (elt
) == Lisp_Symbol
)
714 temps
[argnum
++] = Qnil
;
715 else if (! NILP (Fcdr (Fcdr (elt
))))
717 Fcons (build_string ("`let' bindings can have only one value-form"),
720 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
721 gcpro2
.nvars
= argnum
;
725 varlist
= Fcar (args
);
726 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
728 elt
= Fcar (varlist
);
729 tem
= temps
[argnum
++];
730 if (XTYPE (elt
) == Lisp_Symbol
)
733 specbind (Fcar (elt
), tem
);
736 elt
= Fprogn (Fcdr (args
));
737 return unbind_to (count
, elt
);
740 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
741 "(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.\n\
742 The order of execution is thus TEST, BODY, TEST, BODY and so on\n\
743 until TEST returns nil.")
747 Lisp_Object test
, body
, tem
;
748 struct gcpro gcpro1
, gcpro2
;
754 while (tem
= Feval (test
),
755 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
765 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
766 "Return result of expanding macros at top level of FORM.\n\
767 If FORM is not a macro call, it is returned unchanged.\n\
768 Otherwise, the macro is expanded and the expansion is considered\n\
769 in place of FORM. When a non-macro-call results, it is returned.\n\n\
770 The second optional arg ENVIRONMENT species an environment of macro\n\
771 definitions to shadow the loaded ones for use in file byte-compilation.")
773 register Lisp_Object form
;
776 /* With cleanups from Hallvard Furuseth. */
777 register Lisp_Object expander
, sym
, def
, tem
;
781 /* Come back here each time we expand a macro call,
782 in case it expands into another macro call. */
783 if (XTYPE (form
) != Lisp_Cons
)
785 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
786 def
= sym
= XCONS (form
)->car
;
788 /* Trace symbols aliases to other symbols
789 until we get a symbol that is not an alias. */
790 while (XTYPE (def
) == Lisp_Symbol
)
794 tem
= Fassq (sym
, env
);
797 def
= XSYMBOL (sym
)->function
;
798 if (!EQ (def
, Qunbound
))
803 /* Right now TEM is the result from SYM in ENV,
804 and if TEM is nil then DEF is SYM's function definition. */
807 /* SYM is not mentioned in ENV.
808 Look at its function definition. */
809 if (EQ (def
, Qunbound
)
810 || XTYPE (def
) != Lisp_Cons
)
811 /* Not defined or definition not suitable */
813 if (EQ (XCONS (def
)->car
, Qautoload
))
815 /* Autoloading function: will it be a macro when loaded? */
816 tem
= Fnth (make_number (4), def
);
817 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
818 /* Yes, load it and try again. */
820 do_autoload (def
, sym
);
826 else if (!EQ (XCONS (def
)->car
, Qmacro
))
828 else expander
= XCONS (def
)->cdr
;
832 expander
= XCONS (tem
)->cdr
;
836 form
= apply1 (expander
, XCONS (form
)->cdr
);
841 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
842 "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
843 TAG is evalled to get the tag to use. Then the BODY is executed.\n\
844 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
845 If no throw happens, `catch' returns the value of the last BODY form.\n\
846 If a throw happens, it specifies the value to return from `catch'.")
850 register Lisp_Object tag
;
854 tag
= Feval (Fcar (args
));
856 return internal_catch (tag
, Fprogn
, Fcdr (args
));
859 /* Set up a catch, then call C function FUNC on argument ARG.
860 FUNC should return a Lisp_Object.
861 This is how catches are done from within C code. */
864 internal_catch (tag
, func
, arg
)
866 Lisp_Object (*func
) ();
869 /* This structure is made part of the chain `catchlist'. */
872 /* Fill in the components of c, and put it on the list. */
876 c
.backlist
= backtrace_list
;
877 c
.handlerlist
= handlerlist
;
878 c
.lisp_eval_depth
= lisp_eval_depth
;
879 c
.pdlcount
= specpdl_ptr
- specpdl
;
880 c
.poll_suppress_count
= poll_suppress_count
;
885 if (! _setjmp (c
.jmp
))
886 c
.val
= (*func
) (arg
);
888 /* Throw works by a longjmp that comes right here. */
893 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
894 jump to that CATCH, returning VALUE as the value of that catch.
896 This is the guts Fthrow and Fsignal; they differ only in the way
897 they choose the catch tag to throw to. A catch tag for a
898 condition-case form has a TAG of Qnil.
900 Before each catch is discarded, unbind all special bindings and
901 execute all unwind-protect clauses made above that catch. Unwind
902 the handler stack as we go, so that the proper handlers are in
903 effect for each unwind-protect clause we run. At the end, restore
904 some static info saved in CATCH, and longjmp to the location
907 This is used for correct unwinding in Fthrow and Fsignal. */
910 unwind_to_catch (catch, value
)
911 struct catchtag
*catch;
914 register int last_time
;
916 /* Save the value in the tag. */
919 /* Restore the polling-suppression count. */
920 set_poll_suppress_count (catch->poll_suppress_count
);
924 last_time
= catchlist
== catch;
926 /* Unwind the specpdl stack, and then restore the proper set of
928 unbind_to (catchlist
->pdlcount
, Qnil
);
929 handlerlist
= catchlist
->handlerlist
;
930 catchlist
= catchlist
->next
;
934 gcprolist
= catch->gcpro
;
935 backtrace_list
= catch->backlist
;
936 lisp_eval_depth
= catch->lisp_eval_depth
;
938 _longjmp (catch->jmp
, 1);
941 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
942 "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
943 Both TAG and VALUE are evalled.")
945 register Lisp_Object tag
, val
;
947 register struct catchtag
*c
;
952 for (c
= catchlist
; c
; c
= c
->next
)
954 if (EQ (c
->tag
, tag
))
955 unwind_to_catch (c
, val
);
957 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (val
, Qnil
)));
962 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
963 "Do BODYFORM, protecting with UNWINDFORMS.\n\
964 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\
965 If BODYFORM completes normally, its value is returned\n\
966 after executing the UNWINDFORMS.\n\
967 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
972 int count
= specpdl_ptr
- specpdl
;
974 record_unwind_protect (0, Fcdr (args
));
975 val
= Feval (Fcar (args
));
976 return unbind_to (count
, val
);
979 /* Chain of condition handlers currently in effect.
980 The elements of this chain are contained in the stack frames
981 of Fcondition_case and internal_condition_case.
982 When an error is signaled (by calling Fsignal, below),
983 this chain is searched for an element that applies. */
985 struct handler
*handlerlist
;
987 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
988 "Regain control when an error is signaled.\n\
989 Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\
990 executes BODYFORM and returns its value if no error happens.\n\
991 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
992 where the BODY is made of Lisp expressions.\n\n\
993 A handler is applicable to an error\n\
994 if CONDITION-NAME is one of the error's condition names.\n\
995 If an error happens, the first applicable handler is run.\n\
997 The car of a handler may be a list of condition names\n\
998 instead of a single condition name.\n\
1000 When a handler handles an error,\n\
1001 control returns to the condition-case and the handler BODY... is executed\n\
1002 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
1003 VAR may be nil; then you do not get access to the signal information.\n\
1005 The value of the last BODY form is returned from the condition-case.\n\
1006 See also the function `signal' for more info.")
1013 register Lisp_Object var
, bodyform
, handlers
;
1016 bodyform
= Fcar (Fcdr (args
));
1017 handlers
= Fcdr (Fcdr (args
));
1018 CHECK_SYMBOL (var
, 0);
1020 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1026 && (SYMBOLP (XCONS (tem
)->car
)
1027 || CONSP (XCONS (tem
)->car
)))))
1028 error ("Invalid condition handler", tem
);
1033 c
.backlist
= backtrace_list
;
1034 c
.handlerlist
= handlerlist
;
1035 c
.lisp_eval_depth
= lisp_eval_depth
;
1036 c
.pdlcount
= specpdl_ptr
- specpdl
;
1037 c
.poll_suppress_count
= poll_suppress_count
;
1038 c
.gcpro
= gcprolist
;
1039 if (_setjmp (c
.jmp
))
1042 specbind (h
.var
, c
.val
);
1043 val
= Fprogn (Fcdr (h
.chosen_clause
));
1045 /* Note that this just undoes the binding of h.var; whoever
1046 longjumped to us unwound the stack to c.pdlcount before
1048 unbind_to (c
.pdlcount
, Qnil
);
1055 h
.handler
= handlers
;
1056 h
.next
= handlerlist
;
1060 val
= Feval (bodyform
);
1062 handlerlist
= h
.next
;
1067 internal_condition_case (bfun
, handlers
, hfun
)
1068 Lisp_Object (*bfun
) ();
1069 Lisp_Object handlers
;
1070 Lisp_Object (*hfun
) ();
1078 c
.backlist
= backtrace_list
;
1079 c
.handlerlist
= handlerlist
;
1080 c
.lisp_eval_depth
= lisp_eval_depth
;
1081 c
.pdlcount
= specpdl_ptr
- specpdl
;
1082 c
.poll_suppress_count
= poll_suppress_count
;
1083 c
.gcpro
= gcprolist
;
1084 if (_setjmp (c
.jmp
))
1086 return (*hfun
) (c
.val
);
1090 h
.handler
= handlers
;
1092 h
.next
= handlerlist
;
1098 handlerlist
= h
.next
;
1103 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1104 Lisp_Object (*bfun
) ();
1106 Lisp_Object handlers
;
1107 Lisp_Object (*hfun
) ();
1115 c
.backlist
= backtrace_list
;
1116 c
.handlerlist
= handlerlist
;
1117 c
.lisp_eval_depth
= lisp_eval_depth
;
1118 c
.pdlcount
= specpdl_ptr
- specpdl
;
1119 c
.poll_suppress_count
= poll_suppress_count
;
1120 c
.gcpro
= gcprolist
;
1121 if (_setjmp (c
.jmp
))
1123 return (*hfun
) (c
.val
);
1127 h
.handler
= handlers
;
1129 h
.next
= handlerlist
;
1133 val
= (*bfun
) (arg
);
1135 handlerlist
= h
.next
;
1139 static Lisp_Object
find_handler_clause ();
1141 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1142 "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
1143 This function does not return.\n\n\
1144 An error symbol is a symbol with an `error-conditions' property\n\
1145 that is a list of condition names.\n\
1146 A handler for any of those names will get to handle this signal.\n\
1147 The symbol `error' should normally be one of them.\n\
1149 DATA should be a list. Its elements are printed as part of the error message.\n\
1150 If the signal is handled, DATA is made available to the handler.\n\
1151 See also the function `condition-case'.")
1152 (error_symbol
, data
)
1153 Lisp_Object error_symbol
, data
;
1155 register struct handler
*allhandlers
= handlerlist
;
1156 Lisp_Object conditions
;
1157 extern int gc_in_progress
;
1158 extern int waiting_for_input
;
1159 Lisp_Object debugger_value
;
1161 quit_error_check ();
1163 if (gc_in_progress
|| waiting_for_input
)
1166 #ifdef HAVE_X_WINDOWS
1167 TOTALLY_UNBLOCK_INPUT
;
1170 conditions
= Fget (error_symbol
, Qerror_conditions
);
1172 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1174 register Lisp_Object clause
;
1175 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1176 error_symbol
, data
, &debugger_value
);
1178 #if 0 /* Most callers are not prepared to handle gc if this returns.
1179 So, since this feature is not very useful, take it out. */
1180 /* If have called debugger and user wants to continue,
1182 if (EQ (clause
, Qlambda
))
1183 return debugger_value
;
1185 if (EQ (clause
, Qlambda
))
1187 /* We can't return values to code which signalled an error, but we
1188 can continue code which has signalled a quit. */
1189 if (EQ (error_symbol
, Qquit
))
1192 error ("Cannot return from the debugger in an error");
1198 Lisp_Object unwind_data
;
1199 struct handler
*h
= handlerlist
;
1201 handlerlist
= allhandlers
;
1202 if (data
== memory_signal_data
)
1203 unwind_data
= memory_signal_data
;
1205 unwind_data
= Fcons (error_symbol
, data
);
1206 h
->chosen_clause
= clause
;
1207 unwind_to_catch (h
->tag
, unwind_data
);
1211 handlerlist
= allhandlers
;
1212 /* If no handler is present now, try to run the debugger,
1213 and if that fails, throw to top level. */
1214 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1215 Fthrow (Qtop_level
, Qt
);
1218 /* Return nonzero iff LIST is a non-nil atom or
1219 a list containing one of CONDITIONS. */
1222 wants_debugger (list
, conditions
)
1223 Lisp_Object list
, conditions
;
1230 while (CONSP (conditions
))
1232 Lisp_Object
this, tail
;
1233 this = XCONS (conditions
)->car
;
1234 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1235 if (EQ (XCONS (tail
)->car
, this))
1237 conditions
= XCONS (conditions
)->cdr
;
1242 /* Value of Qlambda means we have called debugger and user has continued.
1243 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1246 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1247 Lisp_Object handlers
, conditions
, sig
, data
;
1248 Lisp_Object
*debugger_value_ptr
;
1250 register Lisp_Object h
;
1251 register Lisp_Object tem
;
1253 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1255 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1257 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1258 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1259 if ((EQ (sig
, Qquit
)
1261 : wants_debugger (Vdebug_on_error
, conditions
))
1262 && when_entered_debugger
< num_nonmacro_input_chars
)
1264 int count
= specpdl_ptr
- specpdl
;
1265 specbind (Qdebug_on_error
, Qnil
);
1266 *debugger_value_ptr
=
1267 call_debugger (Fcons (Qerror
,
1268 Fcons (Fcons (sig
, data
),
1270 return unbind_to (count
, Qlambda
);
1274 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1276 Lisp_Object handler
, condit
;
1279 if (!CONSP (handler
))
1281 condit
= Fcar (handler
);
1282 /* Handle a single condition name in handler HANDLER. */
1283 if (SYMBOLP (condit
))
1285 tem
= Fmemq (Fcar (handler
), conditions
);
1289 /* Handle a list of condition names in handler HANDLER. */
1290 else if (CONSP (condit
))
1292 while (CONSP (condit
))
1294 tem
= Fmemq (Fcar (condit
), conditions
);
1297 condit
= XCONS (condit
)->cdr
;
1304 /* dump an error message; called like printf */
1308 error (m
, a1
, a2
, a3
)
1328 int used
= doprnt (buf
, size
, m
, m
+ mlen
, 3, args
);
1333 buffer
= (char *) xrealloc (buffer
, size
);
1334 buffer
= (char *) xmalloc (size
);
1337 string
= build_string (buf
);
1341 Fsignal (Qerror
, Fcons (string
, Qnil
));
1344 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1345 "T if FUNCTION makes provisions for interactive calling.\n\
1346 This means it contains a description for how to read arguments to give it.\n\
1347 The value is nil for an invalid function or a symbol with no function\n\
1350 Interactively callable functions include strings and vectors (treated\n\
1351 as keyboard macros), lambda-expressions that contain a top-level call\n\
1352 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1353 fourth argument, and some of the built-in functions of Lisp.\n\
1355 Also, a symbol satisfies `commandp' if its function definition does so.")
1357 Lisp_Object function
;
1359 register Lisp_Object fun
;
1360 register Lisp_Object funcar
;
1361 register Lisp_Object tem
;
1366 fun
= indirect_function (fun
);
1367 if (EQ (fun
, Qunbound
))
1370 /* Emacs primitives are interactive if their DEFUN specifies an
1371 interactive spec. */
1372 if (XTYPE (fun
) == Lisp_Subr
)
1374 if (XSUBR (fun
)->prompt
)
1380 /* Bytecode objects are interactive if they are long enough to
1381 have an element whose index is COMPILED_INTERACTIVE, which is
1382 where the interactive spec is stored. */
1383 else if (XTYPE (fun
) == Lisp_Compiled
)
1384 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1387 /* Strings and vectors are keyboard macros. */
1388 if (XTYPE (fun
) == Lisp_String
1389 || XTYPE (fun
) == Lisp_Vector
)
1392 /* Lists may represent commands. */
1395 funcar
= Fcar (fun
);
1396 if (XTYPE (funcar
) != Lisp_Symbol
)
1397 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1398 if (EQ (funcar
, Qlambda
))
1399 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1400 if (EQ (funcar
, Qmocklisp
))
1401 return Qt
; /* All mocklisp functions can be called interactively */
1402 if (EQ (funcar
, Qautoload
))
1403 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1409 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1410 "Define FUNCTION to autoload from FILE.\n\
1411 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1412 Third arg DOCSTRING is documentation for the function.\n\
1413 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1414 Fifth arg TYPE indicates the type of the object:\n\
1415 nil or omitted says FUNCTION is a function,\n\
1416 `keymap' says FUNCTION is really a keymap, and\n\
1417 `macro' or t says FUNCTION is really a macro.\n\
1418 Third through fifth args give info about the real definition.\n\
1419 They default to nil.\n\
1420 If FUNCTION is already defined other than as an autoload,\n\
1421 this does nothing and returns nil.")
1422 (function
, file
, docstring
, interactive
, type
)
1423 Lisp_Object function
, file
, docstring
, interactive
, type
;
1426 Lisp_Object args
[4];
1429 CHECK_SYMBOL (function
, 0);
1430 CHECK_STRING (file
, 1);
1432 /* If function is defined and not as an autoload, don't override */
1433 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1434 && !(XTYPE (XSYMBOL (function
)->function
) == Lisp_Cons
1435 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1440 args
[1] = docstring
;
1441 args
[2] = interactive
;
1444 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1445 #else /* NO_ARG_ARRAY */
1446 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1447 #endif /* not NO_ARG_ARRAY */
1451 un_autoload (oldqueue
)
1452 Lisp_Object oldqueue
;
1454 register Lisp_Object queue
, first
, second
;
1456 /* Queue to unwind is current value of Vautoload_queue.
1457 oldqueue is the shadowed value to leave in Vautoload_queue. */
1458 queue
= Vautoload_queue
;
1459 Vautoload_queue
= oldqueue
;
1460 while (CONSP (queue
))
1462 first
= Fcar (queue
);
1463 second
= Fcdr (first
);
1464 first
= Fcar (first
);
1465 if (EQ (second
, Qnil
))
1468 Ffset (first
, second
);
1469 queue
= Fcdr (queue
);
1474 do_autoload (fundef
, funname
)
1475 Lisp_Object fundef
, funname
;
1477 int count
= specpdl_ptr
- specpdl
;
1478 Lisp_Object fun
, val
, queue
, first
, second
;
1481 CHECK_SYMBOL (funname
, 0);
1483 /* Value saved here is to be restored into Vautoload_queue */
1484 record_unwind_protect (un_autoload
, Vautoload_queue
);
1485 Vautoload_queue
= Qt
;
1486 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1488 /* Save the old autoloads, in case we ever do an unload. */
1489 queue
= Vautoload_queue
;
1490 while (CONSP (queue
))
1492 first
= Fcar (queue
);
1493 second
= Fcdr (first
);
1494 first
= Fcar (first
);
1496 /* Note: This test is subtle. The cdr of an autoload-queue entry
1497 may be an atom if the autoload entry was generated by a defalias
1500 Fput (first
, Qautoload
, (Fcdr (second
)));
1502 queue
= Fcdr (queue
);
1505 /* Once loading finishes, don't undo it. */
1506 Vautoload_queue
= Qt
;
1507 unbind_to (count
, Qnil
);
1509 fun
= Findirect_function (fun
);
1511 if (!NILP (Fequal (fun
, fundef
)))
1512 error ("Autoloading failed to define function %s",
1513 XSYMBOL (funname
)->name
->data
);
1516 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1517 "Evaluate FORM and return its value.")
1521 Lisp_Object fun
, val
, original_fun
, original_args
;
1523 struct backtrace backtrace
;
1524 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1526 if (XTYPE (form
) == Lisp_Symbol
)
1528 if (EQ (Vmocklisp_arguments
, Qt
))
1529 return Fsymbol_value (form
);
1530 val
= Fsymbol_value (form
);
1533 else if (EQ (val
, Qt
))
1541 if (consing_since_gc
> gc_cons_threshold
)
1544 Fgarbage_collect ();
1548 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1550 if (max_lisp_eval_depth
< 100)
1551 max_lisp_eval_depth
= 100;
1552 if (lisp_eval_depth
> max_lisp_eval_depth
)
1553 error ("Lisp nesting exceeds max-lisp-eval-depth");
1556 original_fun
= Fcar (form
);
1557 original_args
= Fcdr (form
);
1559 backtrace
.next
= backtrace_list
;
1560 backtrace_list
= &backtrace
;
1561 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1562 backtrace
.args
= &original_args
;
1563 backtrace
.nargs
= UNEVALLED
;
1564 backtrace
.evalargs
= 1;
1565 backtrace
.debug_on_exit
= 0;
1567 if (debug_on_next_call
)
1568 do_debug_on_call (Qt
);
1570 /* At this point, only original_fun and original_args
1571 have values that will be used below */
1573 fun
= Findirect_function (original_fun
);
1575 if (XTYPE (fun
) == Lisp_Subr
)
1577 Lisp_Object numargs
;
1578 Lisp_Object argvals
[7];
1579 Lisp_Object args_left
;
1580 register int i
, maxargs
;
1582 args_left
= original_args
;
1583 numargs
= Flength (args_left
);
1585 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1586 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1587 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1589 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1591 backtrace
.evalargs
= 0;
1592 val
= (*XSUBR (fun
)->function
) (args_left
);
1596 if (XSUBR (fun
)->max_args
== MANY
)
1598 /* Pass a vector of evaluated arguments */
1600 register int argnum
= 0;
1602 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1604 GCPRO3 (args_left
, fun
, fun
);
1608 while (!NILP (args_left
))
1610 vals
[argnum
++] = Feval (Fcar (args_left
));
1611 args_left
= Fcdr (args_left
);
1612 gcpro3
.nvars
= argnum
;
1615 backtrace
.args
= vals
;
1616 backtrace
.nargs
= XINT (numargs
);
1618 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1623 GCPRO3 (args_left
, fun
, fun
);
1624 gcpro3
.var
= argvals
;
1627 maxargs
= XSUBR (fun
)->max_args
;
1628 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1630 argvals
[i
] = Feval (Fcar (args_left
));
1636 backtrace
.args
= argvals
;
1637 backtrace
.nargs
= XINT (numargs
);
1642 val
= (*XSUBR (fun
)->function
) ();
1645 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1648 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1651 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1655 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1656 argvals
[2], argvals
[3]);
1659 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1660 argvals
[3], argvals
[4]);
1663 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1664 argvals
[3], argvals
[4], argvals
[5]);
1667 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1668 argvals
[3], argvals
[4], argvals
[5],
1673 /* Someone has created a subr that takes more arguments than
1674 is supported by this code. We need to either rewrite the
1675 subr to use a different argument protocol, or add more
1676 cases to this switch. */
1680 if (XTYPE (fun
) == Lisp_Compiled
)
1681 val
= apply_lambda (fun
, original_args
, 1);
1685 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1686 funcar
= Fcar (fun
);
1687 if (XTYPE (funcar
) != Lisp_Symbol
)
1688 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1689 if (EQ (funcar
, Qautoload
))
1691 do_autoload (fun
, original_fun
);
1694 if (EQ (funcar
, Qmacro
))
1695 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1696 else if (EQ (funcar
, Qlambda
))
1697 val
= apply_lambda (fun
, original_args
, 1);
1698 else if (EQ (funcar
, Qmocklisp
))
1699 val
= ml_apply (fun
, original_args
);
1701 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1704 if (!EQ (Vmocklisp_arguments
, Qt
))
1708 else if (EQ (val
, Qt
))
1712 if (backtrace
.debug_on_exit
)
1713 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1714 backtrace_list
= backtrace
.next
;
1718 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1719 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1720 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1725 register int i
, numargs
;
1726 register Lisp_Object spread_arg
;
1727 register Lisp_Object
*funcall_args
;
1729 struct gcpro gcpro1
;
1733 spread_arg
= args
[nargs
- 1];
1734 CHECK_LIST (spread_arg
, nargs
);
1736 numargs
= XINT (Flength (spread_arg
));
1739 return Ffuncall (nargs
- 1, args
);
1740 else if (numargs
== 1)
1742 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1743 return Ffuncall (nargs
, args
);
1746 numargs
+= nargs
- 2;
1748 fun
= indirect_function (fun
);
1749 if (EQ (fun
, Qunbound
))
1751 /* Let funcall get the error */
1756 if (XTYPE (fun
) == Lisp_Subr
)
1758 if (numargs
< XSUBR (fun
)->min_args
1759 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1760 goto funcall
; /* Let funcall get the error */
1761 else if (XSUBR (fun
)->max_args
> numargs
)
1763 /* Avoid making funcall cons up a yet another new vector of arguments
1764 by explicitly supplying nil's for optional values */
1765 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1766 * sizeof (Lisp_Object
));
1767 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1768 funcall_args
[++i
] = Qnil
;
1769 GCPRO1 (*funcall_args
);
1770 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1774 /* We add 1 to numargs because funcall_args includes the
1775 function itself as well as its arguments. */
1778 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1779 * sizeof (Lisp_Object
));
1780 GCPRO1 (*funcall_args
);
1781 gcpro1
.nvars
= 1 + numargs
;
1784 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1785 /* Spread the last arg we got. Its first element goes in
1786 the slot that it used to occupy, hence this value of I. */
1788 while (!NILP (spread_arg
))
1790 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1791 spread_arg
= XCONS (spread_arg
)->cdr
;
1794 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1797 /* Apply fn to arg */
1800 Lisp_Object fn
, arg
;
1802 struct gcpro gcpro1
;
1806 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1810 Lisp_Object args
[2];
1814 RETURN_UNGCPRO (Fapply (2, args
));
1816 #else /* not NO_ARG_ARRAY */
1817 RETURN_UNGCPRO (Fapply (2, &fn
));
1818 #endif /* not NO_ARG_ARRAY */
1821 /* Call function fn on no arguments */
1826 struct gcpro gcpro1
;
1829 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1832 /* Call function fn with 1 argument arg1 */
1836 Lisp_Object fn
, arg1
;
1838 struct gcpro gcpro1
;
1840 Lisp_Object args
[2];
1846 RETURN_UNGCPRO (Ffuncall (2, args
));
1847 #else /* not NO_ARG_ARRAY */
1850 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1851 #endif /* not NO_ARG_ARRAY */
1854 /* Call function fn with 2 arguments arg1, arg2 */
1857 call2 (fn
, arg1
, arg2
)
1858 Lisp_Object fn
, arg1
, arg2
;
1860 struct gcpro gcpro1
;
1862 Lisp_Object args
[3];
1868 RETURN_UNGCPRO (Ffuncall (3, args
));
1869 #else /* not NO_ARG_ARRAY */
1872 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1873 #endif /* not NO_ARG_ARRAY */
1876 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1879 call3 (fn
, arg1
, arg2
, arg3
)
1880 Lisp_Object fn
, arg1
, arg2
, arg3
;
1882 struct gcpro gcpro1
;
1884 Lisp_Object args
[4];
1891 RETURN_UNGCPRO (Ffuncall (4, args
));
1892 #else /* not NO_ARG_ARRAY */
1895 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1896 #endif /* not NO_ARG_ARRAY */
1899 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1902 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1903 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1905 struct gcpro gcpro1
;
1907 Lisp_Object args
[5];
1915 RETURN_UNGCPRO (Ffuncall (5, args
));
1916 #else /* not NO_ARG_ARRAY */
1919 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1920 #endif /* not NO_ARG_ARRAY */
1923 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1926 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1927 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1929 struct gcpro gcpro1
;
1931 Lisp_Object args
[6];
1940 RETURN_UNGCPRO (Ffuncall (6, args
));
1941 #else /* not NO_ARG_ARRAY */
1944 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1945 #endif /* not NO_ARG_ARRAY */
1948 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1951 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1952 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1954 struct gcpro gcpro1
;
1956 Lisp_Object args
[7];
1966 RETURN_UNGCPRO (Ffuncall (7, args
));
1967 #else /* not NO_ARG_ARRAY */
1970 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1971 #endif /* not NO_ARG_ARRAY */
1974 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1975 "Call first argument as a function, passing remaining arguments to it.\n\
1976 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1983 int numargs
= nargs
- 1;
1984 Lisp_Object lisp_numargs
;
1986 struct backtrace backtrace
;
1987 register Lisp_Object
*internal_args
;
1991 if (consing_since_gc
> gc_cons_threshold
)
1992 Fgarbage_collect ();
1994 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1996 if (max_lisp_eval_depth
< 100)
1997 max_lisp_eval_depth
= 100;
1998 if (lisp_eval_depth
> max_lisp_eval_depth
)
1999 error ("Lisp nesting exceeds max-lisp-eval-depth");
2002 backtrace
.next
= backtrace_list
;
2003 backtrace_list
= &backtrace
;
2004 backtrace
.function
= &args
[0];
2005 backtrace
.args
= &args
[1];
2006 backtrace
.nargs
= nargs
- 1;
2007 backtrace
.evalargs
= 0;
2008 backtrace
.debug_on_exit
= 0;
2010 if (debug_on_next_call
)
2011 do_debug_on_call (Qlambda
);
2017 fun
= Findirect_function (fun
);
2019 if (XTYPE (fun
) == Lisp_Subr
)
2021 if (numargs
< XSUBR (fun
)->min_args
2022 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2024 XFASTINT (lisp_numargs
) = numargs
;
2025 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2028 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2029 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2031 if (XSUBR (fun
)->max_args
== MANY
)
2033 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2037 if (XSUBR (fun
)->max_args
> numargs
)
2039 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2040 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2041 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2042 internal_args
[i
] = Qnil
;
2045 internal_args
= args
+ 1;
2046 switch (XSUBR (fun
)->max_args
)
2049 val
= (*XSUBR (fun
)->function
) ();
2052 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2055 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2059 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2063 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2068 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2069 internal_args
[2], internal_args
[3],
2073 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2074 internal_args
[2], internal_args
[3],
2075 internal_args
[4], internal_args
[5]);
2078 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2079 internal_args
[2], internal_args
[3],
2080 internal_args
[4], internal_args
[5],
2086 /* If a subr takes more than 6 arguments without using MANY
2087 or UNEVALLED, we need to extend this function to support it.
2088 Until this is done, there is no way to call the function. */
2092 if (XTYPE (fun
) == Lisp_Compiled
)
2093 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2097 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2098 funcar
= Fcar (fun
);
2099 if (XTYPE (funcar
) != Lisp_Symbol
)
2100 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2101 if (EQ (funcar
, Qlambda
))
2102 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2103 else if (EQ (funcar
, Qmocklisp
))
2104 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2105 else if (EQ (funcar
, Qautoload
))
2107 do_autoload (fun
, args
[0]);
2111 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2115 if (backtrace
.debug_on_exit
)
2116 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2117 backtrace_list
= backtrace
.next
;
2122 apply_lambda (fun
, args
, eval_flag
)
2123 Lisp_Object fun
, args
;
2126 Lisp_Object args_left
;
2127 Lisp_Object numargs
;
2128 register Lisp_Object
*arg_vector
;
2129 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2131 register Lisp_Object tem
;
2133 numargs
= Flength (args
);
2134 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2137 GCPRO3 (*arg_vector
, args_left
, fun
);
2140 for (i
= 0; i
< XINT (numargs
);)
2142 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2143 if (eval_flag
) tem
= Feval (tem
);
2144 arg_vector
[i
++] = tem
;
2152 backtrace_list
->args
= arg_vector
;
2153 backtrace_list
->nargs
= i
;
2155 backtrace_list
->evalargs
= 0;
2156 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2158 /* Do the debug-on-exit now, while arg_vector still exists. */
2159 if (backtrace_list
->debug_on_exit
)
2160 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2161 /* Don't do it again when we return to eval. */
2162 backtrace_list
->debug_on_exit
= 0;
2166 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2167 and return the result of evaluation.
2168 FUN must be either a lambda-expression or a compiled-code object. */
2171 funcall_lambda (fun
, nargs
, arg_vector
)
2174 register Lisp_Object
*arg_vector
;
2176 Lisp_Object val
, tem
;
2177 register Lisp_Object syms_left
;
2178 Lisp_Object numargs
;
2179 register Lisp_Object next
;
2180 int count
= specpdl_ptr
- specpdl
;
2182 int optional
= 0, rest
= 0;
2184 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2186 XFASTINT (numargs
) = nargs
;
2188 if (XTYPE (fun
) == Lisp_Cons
)
2189 syms_left
= Fcar (Fcdr (fun
));
2190 else if (XTYPE (fun
) == Lisp_Compiled
)
2191 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2195 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2198 next
= Fcar (syms_left
);
2199 while (XTYPE (next
) != Lisp_Symbol
)
2200 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2201 if (EQ (next
, Qand_rest
))
2203 else if (EQ (next
, Qand_optional
))
2207 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2212 tem
= arg_vector
[i
++];
2213 specbind (next
, tem
);
2216 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2218 specbind (next
, Qnil
);
2222 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2224 if (XTYPE (fun
) == Lisp_Cons
)
2225 val
= Fprogn (Fcdr (Fcdr (fun
)));
2227 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2228 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2229 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2230 return unbind_to (count
, val
);
2236 register int count
= specpdl_ptr
- specpdl
;
2237 if (specpdl_size
>= max_specpdl_size
)
2239 if (max_specpdl_size
< 400)
2240 max_specpdl_size
= 400;
2241 if (specpdl_size
>= max_specpdl_size
)
2243 if (!NILP (Vdebug_on_error
))
2244 /* Leave room for some specpdl in the debugger. */
2245 max_specpdl_size
= specpdl_size
+ 100;
2247 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2251 if (specpdl_size
> max_specpdl_size
)
2252 specpdl_size
= max_specpdl_size
;
2253 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2254 specpdl_ptr
= specpdl
+ count
;
2258 specbind (symbol
, value
)
2259 Lisp_Object symbol
, value
;
2261 extern void store_symval_forwarding (); /* in eval.c */
2264 CHECK_SYMBOL (symbol
, 0);
2266 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2268 specpdl_ptr
->symbol
= symbol
;
2269 specpdl_ptr
->func
= 0;
2270 specpdl_ptr
->old_value
= ovalue
= find_symbol_value (symbol
);
2272 if (XTYPE (ovalue
) == Lisp_Buffer_Objfwd
)
2273 store_symval_forwarding (symbol
, ovalue
, value
);
2275 Fset (symbol
, value
);
2279 record_unwind_protect (function
, arg
)
2280 Lisp_Object (*function
)();
2283 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2285 specpdl_ptr
->func
= function
;
2286 specpdl_ptr
->symbol
= Qnil
;
2287 specpdl_ptr
->old_value
= arg
;
2292 unbind_to (count
, value
)
2296 int quitf
= !NILP (Vquit_flag
);
2297 struct gcpro gcpro1
;
2303 while (specpdl_ptr
!= specpdl
+ count
)
2306 if (specpdl_ptr
->func
!= 0)
2307 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2308 /* Note that a "binding" of nil is really an unwind protect,
2309 so in that case the "old value" is a list of forms to evaluate. */
2310 else if (NILP (specpdl_ptr
->symbol
))
2311 Fprogn (specpdl_ptr
->old_value
);
2313 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2315 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2324 /* Get the value of symbol's global binding, even if that binding
2325 is not now dynamically visible. */
2328 top_level_value (symbol
)
2331 register struct specbinding
*ptr
= specpdl
;
2333 CHECK_SYMBOL (symbol
, 0);
2334 for (; ptr
!= specpdl_ptr
; ptr
++)
2336 if (EQ (ptr
->symbol
, symbol
))
2337 return ptr
->old_value
;
2339 return Fsymbol_value (symbol
);
2343 top_level_set (symbol
, newval
)
2344 Lisp_Object symbol
, newval
;
2346 register struct specbinding
*ptr
= specpdl
;
2348 CHECK_SYMBOL (symbol
, 0);
2349 for (; ptr
!= specpdl_ptr
; ptr
++)
2351 if (EQ (ptr
->symbol
, symbol
))
2353 ptr
->old_value
= newval
;
2357 return Fset (symbol
, newval
);
2362 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2363 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2364 The debugger is entered when that frame exits, if the flag is non-nil.")
2366 Lisp_Object level
, flag
;
2368 register struct backtrace
*backlist
= backtrace_list
;
2371 CHECK_NUMBER (level
, 0);
2373 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2375 backlist
= backlist
->next
;
2379 backlist
->debug_on_exit
= !NILP (flag
);
2384 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2385 "Print a trace of Lisp function calls currently active.\n\
2386 Output stream used is value of `standard-output'.")
2389 register struct backtrace
*backlist
= backtrace_list
;
2393 extern Lisp_Object Vprint_level
;
2394 struct gcpro gcpro1
;
2396 XFASTINT (Vprint_level
) = 3;
2403 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2404 if (backlist
->nargs
== UNEVALLED
)
2406 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2410 tem
= *backlist
->function
;
2411 Fprin1 (tem
, Qnil
); /* This can QUIT */
2412 write_string ("(", -1);
2413 if (backlist
->nargs
== MANY
)
2415 for (tail
= *backlist
->args
, i
= 0;
2417 tail
= Fcdr (tail
), i
++)
2419 if (i
) write_string (" ", -1);
2420 Fprin1 (Fcar (tail
), Qnil
);
2425 for (i
= 0; i
< backlist
->nargs
; i
++)
2427 if (i
) write_string (" ", -1);
2428 Fprin1 (backlist
->args
[i
], Qnil
);
2432 write_string (")\n", -1);
2433 backlist
= backlist
->next
;
2436 Vprint_level
= Qnil
;
2441 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2442 "Return the function and arguments N frames up from current execution point.\n\
2443 If that frame has not evaluated the arguments yet (or is a special form),\n\
2444 the value is (nil FUNCTION ARG-FORMS...).\n\
2445 If that frame has evaluated its arguments and called its function already,\n\
2446 the value is (t FUNCTION ARG-VALUES...).\n\
2447 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2448 FUNCTION is whatever was supplied as car of evaluated list,\n\
2449 or a lambda expression for macro calls.\n\
2450 If N is more than the number of frames, the value is nil.")
2452 Lisp_Object nframes
;
2454 register struct backtrace
*backlist
= backtrace_list
;
2458 CHECK_NATNUM (nframes
, 0);
2460 /* Find the frame requested. */
2461 for (i
= 0; i
< XFASTINT (nframes
); i
++)
2462 backlist
= backlist
->next
;
2466 if (backlist
->nargs
== UNEVALLED
)
2467 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2470 if (backlist
->nargs
== MANY
)
2471 tem
= *backlist
->args
;
2473 tem
= Flist (backlist
->nargs
, backlist
->args
);
2475 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2481 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2482 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2484 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2485 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2486 This limit is to catch infinite recursions for you before they cause\n\
2487 actual stack overflow in C, which would be fatal for Emacs.\n\
2488 You can safely make it considerably larger than its default value,\n\
2489 if that proves inconveniently small.");
2491 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2492 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2493 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2496 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2497 "Non-nil inhibits C-g quitting from happening immediately.\n\
2498 Note that `quit-flag' will still be set by typing C-g,\n\
2499 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2500 To prevent this happening, set `quit-flag' to nil\n\
2501 before making `inhibit-quit' nil.");
2502 Vinhibit_quit
= Qnil
;
2504 Qinhibit_quit
= intern ("inhibit-quit");
2505 staticpro (&Qinhibit_quit
);
2507 Qautoload
= intern ("autoload");
2508 staticpro (&Qautoload
);
2510 Qdebug_on_error
= intern ("debug-on-error");
2511 staticpro (&Qdebug_on_error
);
2513 Qmacro
= intern ("macro");
2514 staticpro (&Qmacro
);
2516 /* Note that the process handling also uses Qexit, but we don't want
2517 to staticpro it twice, so we just do it here. */
2518 Qexit
= intern ("exit");
2521 Qinteractive
= intern ("interactive");
2522 staticpro (&Qinteractive
);
2524 Qcommandp
= intern ("commandp");
2525 staticpro (&Qcommandp
);
2527 Qdefun
= intern ("defun");
2528 staticpro (&Qdefun
);
2530 Qand_rest
= intern ("&rest");
2531 staticpro (&Qand_rest
);
2533 Qand_optional
= intern ("&optional");
2534 staticpro (&Qand_optional
);
2536 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2537 "*Non-nil means automatically display a backtrace buffer\n\
2538 after any error that is handled by the editor command loop.\n\
2539 If the value is a list, an error only means to display a backtrace\n\
2540 if one of its condition symbols appears in the list.");
2541 Vstack_trace_on_error
= Qnil
;
2543 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2544 "*Non-nil means enter debugger if an error is signaled.\n\
2545 Does not apply to errors handled by `condition-case'.\n\
2546 If the value is a list, an error only means to enter the debugger\n\
2547 if one of its condition symbols appears in the list.\n\
2548 See also variable `debug-on-quit'.");
2549 Vdebug_on_error
= Qnil
;
2551 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2552 "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
2553 Does not apply if quit is handled by a `condition-case'.");
2556 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2557 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2559 DEFVAR_LISP ("debugger", &Vdebugger
,
2560 "Function to call to invoke debugger.\n\
2561 If due to frame exit, args are `exit' and the value being returned;\n\
2562 this function's value will be returned instead of that.\n\
2563 If due to error, args are `error' and a list of the args to `signal'.\n\
2564 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2565 If due to `eval' entry, one arg, t.");
2568 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2569 staticpro (&Qmocklisp_arguments
);
2570 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2571 "While in a mocklisp function, the list of its unevaluated args.");
2572 Vmocklisp_arguments
= Qt
;
2574 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2575 "Set to the function `run-hooks', if that function has been defined.\n\
2576 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2579 staticpro (&Vautoload_queue
);
2580 Vautoload_queue
= Qnil
;
2591 defsubr (&Sfunction
);
2593 defsubr (&Sdefmacro
);
2595 defsubr (&Sdefconst
);
2596 defsubr (&Suser_variable_p
);
2600 defsubr (&Smacroexpand
);
2603 defsubr (&Sunwind_protect
);
2604 defsubr (&Scondition_case
);
2606 defsubr (&Sinteractive_p
);
2607 defsubr (&Scommandp
);
2608 defsubr (&Sautoload
);
2611 defsubr (&Sfuncall
);
2612 defsubr (&Sbacktrace_debug
);
2613 defsubr (&Sbacktrace
);
2614 defsubr (&Sbacktrace_frame
);