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 The car of a handler may be a list of condition names\n\
993 instead of a single condition name.\n\
995 When a handler handles an error,\n\
996 control returns to the condition-case and the handler BODY... is executed\n\
997 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
998 VAR may be nil; then you do not get access to the signal information.\n\
1000 The value of the last BODY form is returned from the condition-case.\n\
1001 See also the function `signal' for more info.")
1008 register Lisp_Object var
, bodyform
, handlers
;
1011 bodyform
= Fcar (Fcdr (args
));
1012 handlers
= Fcdr (Fcdr (args
));
1013 CHECK_SYMBOL (var
, 0);
1015 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1021 && (SYMBOLP (XCONS (tem
)->car
)
1022 || CONSP (XCONS (tem
)->car
)))))
1023 error ("Invalid condition handler", tem
);
1028 c
.backlist
= backtrace_list
;
1029 c
.handlerlist
= handlerlist
;
1030 c
.lisp_eval_depth
= lisp_eval_depth
;
1031 c
.pdlcount
= specpdl_ptr
- specpdl
;
1032 c
.poll_suppress_count
= poll_suppress_count
;
1033 c
.gcpro
= gcprolist
;
1034 if (_setjmp (c
.jmp
))
1037 specbind (h
.var
, c
.val
);
1038 val
= Fprogn (Fcdr (h
.chosen_clause
));
1040 /* Note that this just undoes the binding of h.var; whoever
1041 longjumped to us unwound the stack to c.pdlcount before
1043 unbind_to (c
.pdlcount
, Qnil
);
1050 h
.handler
= handlers
;
1051 h
.next
= handlerlist
;
1055 val
= Feval (bodyform
);
1057 handlerlist
= h
.next
;
1062 internal_condition_case (bfun
, handlers
, hfun
)
1063 Lisp_Object (*bfun
) ();
1064 Lisp_Object handlers
;
1065 Lisp_Object (*hfun
) ();
1073 c
.backlist
= backtrace_list
;
1074 c
.handlerlist
= handlerlist
;
1075 c
.lisp_eval_depth
= lisp_eval_depth
;
1076 c
.pdlcount
= specpdl_ptr
- specpdl
;
1077 c
.poll_suppress_count
= poll_suppress_count
;
1078 c
.gcpro
= gcprolist
;
1079 if (_setjmp (c
.jmp
))
1081 return (*hfun
) (c
.val
);
1085 h
.handler
= handlers
;
1087 h
.next
= handlerlist
;
1093 handlerlist
= h
.next
;
1098 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1099 Lisp_Object (*bfun
) ();
1101 Lisp_Object handlers
;
1102 Lisp_Object (*hfun
) ();
1110 c
.backlist
= backtrace_list
;
1111 c
.handlerlist
= handlerlist
;
1112 c
.lisp_eval_depth
= lisp_eval_depth
;
1113 c
.pdlcount
= specpdl_ptr
- specpdl
;
1114 c
.poll_suppress_count
= poll_suppress_count
;
1115 c
.gcpro
= gcprolist
;
1116 if (_setjmp (c
.jmp
))
1118 return (*hfun
) (c
.val
);
1122 h
.handler
= handlers
;
1124 h
.next
= handlerlist
;
1128 val
= (*bfun
) (arg
);
1130 handlerlist
= h
.next
;
1134 static Lisp_Object
find_handler_clause ();
1136 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1137 "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
1138 This function does not return.\n\n\
1139 An error symbol is a symbol with an `error-conditions' property\n\
1140 that is a list of condition names.\n\
1141 A handler for any of those names will get to handle this signal.\n\
1142 The symbol `error' should normally be one of them.\n\
1144 DATA should be a list. Its elements are printed as part of the error message.\n\
1145 If the signal is handled, DATA is made available to the handler.\n\
1146 See also the function `condition-case'.")
1147 (error_symbol
, data
)
1148 Lisp_Object error_symbol
, data
;
1150 register struct handler
*allhandlers
= handlerlist
;
1151 Lisp_Object conditions
;
1152 extern int gc_in_progress
;
1153 extern int waiting_for_input
;
1154 Lisp_Object debugger_value
;
1156 quit_error_check ();
1158 if (gc_in_progress
|| waiting_for_input
)
1161 #ifdef HAVE_X_WINDOWS
1162 TOTALLY_UNBLOCK_INPUT
;
1165 conditions
= Fget (error_symbol
, Qerror_conditions
);
1167 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1169 register Lisp_Object clause
;
1170 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1171 error_symbol
, data
, &debugger_value
);
1173 #if 0 /* Most callers are not prepared to handle gc if this returns.
1174 So, since this feature is not very useful, take it out. */
1175 /* If have called debugger and user wants to continue,
1177 if (EQ (clause
, Qlambda
))
1178 return debugger_value
;
1180 if (EQ (clause
, Qlambda
))
1182 /* We can't return values to code which signalled an error, but we
1183 can continue code which has signalled a quit. */
1184 if (EQ (error_symbol
, Qquit
))
1187 error ("Cannot return from the debugger in an error");
1193 Lisp_Object unwind_data
;
1194 struct handler
*h
= handlerlist
;
1196 handlerlist
= allhandlers
;
1197 if (data
== memory_signal_data
)
1198 unwind_data
= memory_signal_data
;
1200 unwind_data
= Fcons (error_symbol
, data
);
1201 h
->chosen_clause
= clause
;
1202 unwind_to_catch (h
->tag
, unwind_data
);
1206 handlerlist
= allhandlers
;
1207 /* If no handler is present now, try to run the debugger,
1208 and if that fails, throw to top level. */
1209 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1210 Fthrow (Qtop_level
, Qt
);
1213 /* Return nonzero iff LIST is a non-nil atom or
1214 a list containing one of CONDITIONS. */
1217 wants_debugger (list
, conditions
)
1218 Lisp_Object list
, conditions
;
1225 while (CONSP (conditions
))
1227 Lisp_Object
this, tail
;
1228 this = XCONS (conditions
)->car
;
1229 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1230 if (EQ (XCONS (tail
)->car
, this))
1232 conditions
= XCONS (conditions
)->cdr
;
1237 /* Value of Qlambda means we have called debugger and user has continued.
1238 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1241 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1242 Lisp_Object handlers
, conditions
, sig
, data
;
1243 Lisp_Object
*debugger_value_ptr
;
1245 register Lisp_Object h
;
1246 register Lisp_Object tem
;
1248 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1250 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1252 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1253 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1254 if ((EQ (sig
, Qquit
)
1256 : wants_debugger (Vdebug_on_error
, conditions
))
1257 && when_entered_debugger
< num_nonmacro_input_chars
)
1259 int count
= specpdl_ptr
- specpdl
;
1260 specbind (Qdebug_on_error
, Qnil
);
1261 *debugger_value_ptr
=
1262 call_debugger (Fcons (Qerror
,
1263 Fcons (Fcons (sig
, data
),
1265 return unbind_to (count
, Qlambda
);
1269 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1271 Lisp_Object handler
, condit
;
1274 if (!CONSP (handler
))
1276 condit
= Fcar (handler
);
1277 /* Handle a single condition name in handler HANDLER. */
1278 if (SYMBOLP (condit
))
1280 tem
= Fmemq (Fcar (handler
), conditions
);
1284 /* Handle a list of condition names in handler HANDLER. */
1285 else if (CONSP (condit
))
1287 while (CONSP (condit
))
1289 tem
= Fmemq (Fcar (condit
), conditions
);
1292 condit
= XCONS (condit
)->cdr
;
1299 /* dump an error message; called like printf */
1303 error (m
, a1
, a2
, a3
)
1323 int used
= doprnt (buf
, size
, m
, m
+ mlen
, 3, args
);
1328 buffer
= (char *) xrealloc (buffer
, size
);
1329 buffer
= (char *) xmalloc (size
);
1332 string
= build_string (buf
);
1336 Fsignal (Qerror
, Fcons (string
, Qnil
));
1339 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1340 "T if FUNCTION makes provisions for interactive calling.\n\
1341 This means it contains a description for how to read arguments to give it.\n\
1342 The value is nil for an invalid function or a symbol with no function\n\
1345 Interactively callable functions include strings and vectors (treated\n\
1346 as keyboard macros), lambda-expressions that contain a top-level call\n\
1347 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1348 fourth argument, and some of the built-in functions of Lisp.\n\
1350 Also, a symbol satisfies `commandp' if its function definition does so.")
1352 Lisp_Object function
;
1354 register Lisp_Object fun
;
1355 register Lisp_Object funcar
;
1356 register Lisp_Object tem
;
1361 fun
= indirect_function (fun
);
1362 if (EQ (fun
, Qunbound
))
1365 /* Emacs primitives are interactive if their DEFUN specifies an
1366 interactive spec. */
1367 if (XTYPE (fun
) == Lisp_Subr
)
1369 if (XSUBR (fun
)->prompt
)
1375 /* Bytecode objects are interactive if they are long enough to
1376 have an element whose index is COMPILED_INTERACTIVE, which is
1377 where the interactive spec is stored. */
1378 else if (XTYPE (fun
) == Lisp_Compiled
)
1379 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1382 /* Strings and vectors are keyboard macros. */
1383 if (XTYPE (fun
) == Lisp_String
1384 || XTYPE (fun
) == Lisp_Vector
)
1387 /* Lists may represent commands. */
1390 funcar
= Fcar (fun
);
1391 if (XTYPE (funcar
) != Lisp_Symbol
)
1392 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1393 if (EQ (funcar
, Qlambda
))
1394 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1395 if (EQ (funcar
, Qmocklisp
))
1396 return Qt
; /* All mocklisp functions can be called interactively */
1397 if (EQ (funcar
, Qautoload
))
1398 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1404 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1405 "Define FUNCTION to autoload from FILE.\n\
1406 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1407 Third arg DOCSTRING is documentation for the function.\n\
1408 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1409 Fifth arg TYPE indicates the type of the object:\n\
1410 nil or omitted says FUNCTION is a function,\n\
1411 `keymap' says FUNCTION is really a keymap, and\n\
1412 `macro' or t says FUNCTION is really a macro.\n\
1413 Third through fifth args give info about the real definition.\n\
1414 They default to nil.\n\
1415 If FUNCTION is already defined other than as an autoload,\n\
1416 this does nothing and returns nil.")
1417 (function
, file
, docstring
, interactive
, type
)
1418 Lisp_Object function
, file
, docstring
, interactive
, type
;
1421 Lisp_Object args
[4];
1424 CHECK_SYMBOL (function
, 0);
1425 CHECK_STRING (file
, 1);
1427 /* If function is defined and not as an autoload, don't override */
1428 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1429 && !(XTYPE (XSYMBOL (function
)->function
) == Lisp_Cons
1430 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1435 args
[1] = docstring
;
1436 args
[2] = interactive
;
1439 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1440 #else /* NO_ARG_ARRAY */
1441 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1442 #endif /* not NO_ARG_ARRAY */
1446 un_autoload (oldqueue
)
1447 Lisp_Object oldqueue
;
1449 register Lisp_Object queue
, first
, second
;
1451 /* Queue to unwind is current value of Vautoload_queue.
1452 oldqueue is the shadowed value to leave in Vautoload_queue. */
1453 queue
= Vautoload_queue
;
1454 Vautoload_queue
= oldqueue
;
1455 while (CONSP (queue
))
1457 first
= Fcar (queue
);
1458 second
= Fcdr (first
);
1459 first
= Fcar (first
);
1460 if (EQ (second
, Qnil
))
1463 Ffset (first
, second
);
1464 queue
= Fcdr (queue
);
1469 do_autoload (fundef
, funname
)
1470 Lisp_Object fundef
, funname
;
1472 int count
= specpdl_ptr
- specpdl
;
1473 Lisp_Object fun
, val
, queue
, first
, second
;
1476 CHECK_SYMBOL (funname
, 0);
1478 /* Value saved here is to be restored into Vautoload_queue */
1479 record_unwind_protect (un_autoload
, Vautoload_queue
);
1480 Vautoload_queue
= Qt
;
1481 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1483 /* Save the old autoloads, in case we ever do an unload. */
1484 queue
= Vautoload_queue
;
1485 while (CONSP (queue
))
1487 first
= Fcar (queue
);
1488 second
= Fcdr (first
);
1489 first
= Fcar (first
);
1491 /* Note: This test is subtle. The cdr of an autoload-queue entry
1492 may be an atom if the autoload entry was generated by a defalias
1495 Fput (first
, Qautoload
, (Fcdr (second
)));
1497 queue
= Fcdr (queue
);
1500 /* Once loading finishes, don't undo it. */
1501 Vautoload_queue
= Qt
;
1502 unbind_to (count
, Qnil
);
1504 fun
= Findirect_function (fun
);
1506 if (!NILP (Fequal (fun
, fundef
)))
1507 error ("Autoloading failed to define function %s",
1508 XSYMBOL (funname
)->name
->data
);
1511 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1512 "Evaluate FORM and return its value.")
1516 Lisp_Object fun
, val
, original_fun
, original_args
;
1518 struct backtrace backtrace
;
1519 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1521 if (XTYPE (form
) == Lisp_Symbol
)
1523 if (EQ (Vmocklisp_arguments
, Qt
))
1524 return Fsymbol_value (form
);
1525 val
= Fsymbol_value (form
);
1528 else if (EQ (val
, Qt
))
1536 if (consing_since_gc
> gc_cons_threshold
)
1539 Fgarbage_collect ();
1543 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1545 if (max_lisp_eval_depth
< 100)
1546 max_lisp_eval_depth
= 100;
1547 if (lisp_eval_depth
> max_lisp_eval_depth
)
1548 error ("Lisp nesting exceeds max-lisp-eval-depth");
1551 original_fun
= Fcar (form
);
1552 original_args
= Fcdr (form
);
1554 backtrace
.next
= backtrace_list
;
1555 backtrace_list
= &backtrace
;
1556 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1557 backtrace
.args
= &original_args
;
1558 backtrace
.nargs
= UNEVALLED
;
1559 backtrace
.evalargs
= 1;
1560 backtrace
.debug_on_exit
= 0;
1562 if (debug_on_next_call
)
1563 do_debug_on_call (Qt
);
1565 /* At this point, only original_fun and original_args
1566 have values that will be used below */
1568 fun
= Findirect_function (original_fun
);
1570 if (XTYPE (fun
) == Lisp_Subr
)
1572 Lisp_Object numargs
;
1573 Lisp_Object argvals
[7];
1574 Lisp_Object args_left
;
1575 register int i
, maxargs
;
1577 args_left
= original_args
;
1578 numargs
= Flength (args_left
);
1580 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1581 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1582 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1584 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1586 backtrace
.evalargs
= 0;
1587 val
= (*XSUBR (fun
)->function
) (args_left
);
1591 if (XSUBR (fun
)->max_args
== MANY
)
1593 /* Pass a vector of evaluated arguments */
1595 register int argnum
= 0;
1597 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1599 GCPRO3 (args_left
, fun
, fun
);
1603 while (!NILP (args_left
))
1605 vals
[argnum
++] = Feval (Fcar (args_left
));
1606 args_left
= Fcdr (args_left
);
1607 gcpro3
.nvars
= argnum
;
1610 backtrace
.args
= vals
;
1611 backtrace
.nargs
= XINT (numargs
);
1613 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1618 GCPRO3 (args_left
, fun
, fun
);
1619 gcpro3
.var
= argvals
;
1622 maxargs
= XSUBR (fun
)->max_args
;
1623 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1625 argvals
[i
] = Feval (Fcar (args_left
));
1631 backtrace
.args
= argvals
;
1632 backtrace
.nargs
= XINT (numargs
);
1637 val
= (*XSUBR (fun
)->function
) ();
1640 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1643 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1646 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1650 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1651 argvals
[2], argvals
[3]);
1654 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1655 argvals
[3], argvals
[4]);
1658 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1659 argvals
[3], argvals
[4], argvals
[5]);
1662 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1663 argvals
[3], argvals
[4], argvals
[5],
1668 /* Someone has created a subr that takes more arguments than
1669 is supported by this code. We need to either rewrite the
1670 subr to use a different argument protocol, or add more
1671 cases to this switch. */
1675 if (XTYPE (fun
) == Lisp_Compiled
)
1676 val
= apply_lambda (fun
, original_args
, 1);
1680 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1681 funcar
= Fcar (fun
);
1682 if (XTYPE (funcar
) != Lisp_Symbol
)
1683 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1684 if (EQ (funcar
, Qautoload
))
1686 do_autoload (fun
, original_fun
);
1689 if (EQ (funcar
, Qmacro
))
1690 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1691 else if (EQ (funcar
, Qlambda
))
1692 val
= apply_lambda (fun
, original_args
, 1);
1693 else if (EQ (funcar
, Qmocklisp
))
1694 val
= ml_apply (fun
, original_args
);
1696 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1699 if (!EQ (Vmocklisp_arguments
, Qt
))
1703 else if (EQ (val
, Qt
))
1707 if (backtrace
.debug_on_exit
)
1708 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1709 backtrace_list
= backtrace
.next
;
1713 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1714 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1715 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1720 register int i
, numargs
;
1721 register Lisp_Object spread_arg
;
1722 register Lisp_Object
*funcall_args
;
1724 struct gcpro gcpro1
;
1728 spread_arg
= args
[nargs
- 1];
1729 CHECK_LIST (spread_arg
, nargs
);
1731 numargs
= XINT (Flength (spread_arg
));
1734 return Ffuncall (nargs
- 1, args
);
1735 else if (numargs
== 1)
1737 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1738 return Ffuncall (nargs
, args
);
1741 numargs
+= nargs
- 2;
1743 fun
= indirect_function (fun
);
1744 if (EQ (fun
, Qunbound
))
1746 /* Let funcall get the error */
1751 if (XTYPE (fun
) == Lisp_Subr
)
1753 if (numargs
< XSUBR (fun
)->min_args
1754 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1755 goto funcall
; /* Let funcall get the error */
1756 else if (XSUBR (fun
)->max_args
> numargs
)
1758 /* Avoid making funcall cons up a yet another new vector of arguments
1759 by explicitly supplying nil's for optional values */
1760 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1761 * sizeof (Lisp_Object
));
1762 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1763 funcall_args
[++i
] = Qnil
;
1764 GCPRO1 (*funcall_args
);
1765 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1769 /* We add 1 to numargs because funcall_args includes the
1770 function itself as well as its arguments. */
1773 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1774 * sizeof (Lisp_Object
));
1775 GCPRO1 (*funcall_args
);
1776 gcpro1
.nvars
= 1 + numargs
;
1779 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1780 /* Spread the last arg we got. Its first element goes in
1781 the slot that it used to occupy, hence this value of I. */
1783 while (!NILP (spread_arg
))
1785 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1786 spread_arg
= XCONS (spread_arg
)->cdr
;
1789 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1792 /* Apply fn to arg */
1795 Lisp_Object fn
, arg
;
1797 struct gcpro gcpro1
;
1801 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1805 Lisp_Object args
[2];
1809 RETURN_UNGCPRO (Fapply (2, args
));
1811 #else /* not NO_ARG_ARRAY */
1812 RETURN_UNGCPRO (Fapply (2, &fn
));
1813 #endif /* not NO_ARG_ARRAY */
1816 /* Call function fn on no arguments */
1821 struct gcpro gcpro1
;
1824 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1827 /* Call function fn with 1 argument arg1 */
1831 Lisp_Object fn
, arg1
;
1833 struct gcpro gcpro1
;
1835 Lisp_Object args
[2];
1841 RETURN_UNGCPRO (Ffuncall (2, args
));
1842 #else /* not NO_ARG_ARRAY */
1845 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1846 #endif /* not NO_ARG_ARRAY */
1849 /* Call function fn with 2 arguments arg1, arg2 */
1852 call2 (fn
, arg1
, arg2
)
1853 Lisp_Object fn
, arg1
, arg2
;
1855 struct gcpro gcpro1
;
1857 Lisp_Object args
[3];
1863 RETURN_UNGCPRO (Ffuncall (3, args
));
1864 #else /* not NO_ARG_ARRAY */
1867 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1868 #endif /* not NO_ARG_ARRAY */
1871 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1874 call3 (fn
, arg1
, arg2
, arg3
)
1875 Lisp_Object fn
, arg1
, arg2
, arg3
;
1877 struct gcpro gcpro1
;
1879 Lisp_Object args
[4];
1886 RETURN_UNGCPRO (Ffuncall (4, args
));
1887 #else /* not NO_ARG_ARRAY */
1890 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1891 #endif /* not NO_ARG_ARRAY */
1894 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1897 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1898 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1900 struct gcpro gcpro1
;
1902 Lisp_Object args
[5];
1910 RETURN_UNGCPRO (Ffuncall (5, args
));
1911 #else /* not NO_ARG_ARRAY */
1914 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1915 #endif /* not NO_ARG_ARRAY */
1918 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1921 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1922 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1924 struct gcpro gcpro1
;
1926 Lisp_Object args
[6];
1935 RETURN_UNGCPRO (Ffuncall (6, args
));
1936 #else /* not NO_ARG_ARRAY */
1939 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1940 #endif /* not NO_ARG_ARRAY */
1943 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1946 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1947 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1949 struct gcpro gcpro1
;
1951 Lisp_Object args
[7];
1961 RETURN_UNGCPRO (Ffuncall (7, args
));
1962 #else /* not NO_ARG_ARRAY */
1965 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1966 #endif /* not NO_ARG_ARRAY */
1969 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1970 "Call first argument as a function, passing remaining arguments to it.\n\
1971 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1978 int numargs
= nargs
- 1;
1979 Lisp_Object lisp_numargs
;
1981 struct backtrace backtrace
;
1982 register Lisp_Object
*internal_args
;
1986 if (consing_since_gc
> gc_cons_threshold
)
1987 Fgarbage_collect ();
1989 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1991 if (max_lisp_eval_depth
< 100)
1992 max_lisp_eval_depth
= 100;
1993 if (lisp_eval_depth
> max_lisp_eval_depth
)
1994 error ("Lisp nesting exceeds max-lisp-eval-depth");
1997 backtrace
.next
= backtrace_list
;
1998 backtrace_list
= &backtrace
;
1999 backtrace
.function
= &args
[0];
2000 backtrace
.args
= &args
[1];
2001 backtrace
.nargs
= nargs
- 1;
2002 backtrace
.evalargs
= 0;
2003 backtrace
.debug_on_exit
= 0;
2005 if (debug_on_next_call
)
2006 do_debug_on_call (Qlambda
);
2012 fun
= Findirect_function (fun
);
2014 if (XTYPE (fun
) == Lisp_Subr
)
2016 if (numargs
< XSUBR (fun
)->min_args
2017 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2019 XFASTINT (lisp_numargs
) = numargs
;
2020 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2023 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2024 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2026 if (XSUBR (fun
)->max_args
== MANY
)
2028 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2032 if (XSUBR (fun
)->max_args
> numargs
)
2034 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2035 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2036 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2037 internal_args
[i
] = Qnil
;
2040 internal_args
= args
+ 1;
2041 switch (XSUBR (fun
)->max_args
)
2044 val
= (*XSUBR (fun
)->function
) ();
2047 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2050 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2054 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2058 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2063 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2064 internal_args
[2], internal_args
[3],
2068 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2069 internal_args
[2], internal_args
[3],
2070 internal_args
[4], internal_args
[5]);
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],
2081 /* If a subr takes more than 6 arguments without using MANY
2082 or UNEVALLED, we need to extend this function to support it.
2083 Until this is done, there is no way to call the function. */
2087 if (XTYPE (fun
) == Lisp_Compiled
)
2088 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2092 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2093 funcar
= Fcar (fun
);
2094 if (XTYPE (funcar
) != Lisp_Symbol
)
2095 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2096 if (EQ (funcar
, Qlambda
))
2097 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2098 else if (EQ (funcar
, Qmocklisp
))
2099 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2100 else if (EQ (funcar
, Qautoload
))
2102 do_autoload (fun
, args
[0]);
2106 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2110 if (backtrace
.debug_on_exit
)
2111 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2112 backtrace_list
= backtrace
.next
;
2117 apply_lambda (fun
, args
, eval_flag
)
2118 Lisp_Object fun
, args
;
2121 Lisp_Object args_left
;
2122 Lisp_Object numargs
;
2123 register Lisp_Object
*arg_vector
;
2124 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2126 register Lisp_Object tem
;
2128 numargs
= Flength (args
);
2129 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2132 GCPRO3 (*arg_vector
, args_left
, fun
);
2135 for (i
= 0; i
< XINT (numargs
);)
2137 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2138 if (eval_flag
) tem
= Feval (tem
);
2139 arg_vector
[i
++] = tem
;
2147 backtrace_list
->args
= arg_vector
;
2148 backtrace_list
->nargs
= i
;
2150 backtrace_list
->evalargs
= 0;
2151 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2153 /* Do the debug-on-exit now, while arg_vector still exists. */
2154 if (backtrace_list
->debug_on_exit
)
2155 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2156 /* Don't do it again when we return to eval. */
2157 backtrace_list
->debug_on_exit
= 0;
2161 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2162 and return the result of evaluation.
2163 FUN must be either a lambda-expression or a compiled-code object. */
2166 funcall_lambda (fun
, nargs
, arg_vector
)
2169 register Lisp_Object
*arg_vector
;
2171 Lisp_Object val
, tem
;
2172 register Lisp_Object syms_left
;
2173 Lisp_Object numargs
;
2174 register Lisp_Object next
;
2175 int count
= specpdl_ptr
- specpdl
;
2177 int optional
= 0, rest
= 0;
2179 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2181 XFASTINT (numargs
) = nargs
;
2183 if (XTYPE (fun
) == Lisp_Cons
)
2184 syms_left
= Fcar (Fcdr (fun
));
2185 else if (XTYPE (fun
) == Lisp_Compiled
)
2186 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2190 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2193 next
= Fcar (syms_left
);
2194 while (XTYPE (next
) != Lisp_Symbol
)
2195 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2196 if (EQ (next
, Qand_rest
))
2198 else if (EQ (next
, Qand_optional
))
2202 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2207 tem
= arg_vector
[i
++];
2208 specbind (next
, tem
);
2211 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2213 specbind (next
, Qnil
);
2217 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2219 if (XTYPE (fun
) == Lisp_Cons
)
2220 val
= Fprogn (Fcdr (Fcdr (fun
)));
2222 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2223 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2224 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2225 return unbind_to (count
, val
);
2231 register int count
= specpdl_ptr
- specpdl
;
2232 if (specpdl_size
>= max_specpdl_size
)
2234 if (max_specpdl_size
< 400)
2235 max_specpdl_size
= 400;
2236 if (specpdl_size
>= max_specpdl_size
)
2238 if (!NILP (Vdebug_on_error
))
2239 /* Leave room for some specpdl in the debugger. */
2240 max_specpdl_size
= specpdl_size
+ 100;
2242 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2246 if (specpdl_size
> max_specpdl_size
)
2247 specpdl_size
= max_specpdl_size
;
2248 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2249 specpdl_ptr
= specpdl
+ count
;
2253 specbind (symbol
, value
)
2254 Lisp_Object symbol
, value
;
2256 extern void store_symval_forwarding (); /* in eval.c */
2259 CHECK_SYMBOL (symbol
, 0);
2261 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2263 specpdl_ptr
->symbol
= symbol
;
2264 specpdl_ptr
->func
= 0;
2265 ovalue
= XSYMBOL (symbol
)->value
;
2266 specpdl_ptr
->old_value
= EQ (ovalue
, Qunbound
) ? Qunbound
: Fsymbol_value (symbol
);
2268 if (XTYPE (ovalue
) == Lisp_Buffer_Objfwd
)
2269 store_symval_forwarding (symbol
, ovalue
, value
);
2271 Fset (symbol
, value
);
2275 record_unwind_protect (function
, arg
)
2276 Lisp_Object (*function
)();
2279 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2281 specpdl_ptr
->func
= function
;
2282 specpdl_ptr
->symbol
= Qnil
;
2283 specpdl_ptr
->old_value
= arg
;
2288 unbind_to (count
, value
)
2292 int quitf
= !NILP (Vquit_flag
);
2293 struct gcpro gcpro1
;
2299 while (specpdl_ptr
!= specpdl
+ count
)
2302 if (specpdl_ptr
->func
!= 0)
2303 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2304 /* Note that a "binding" of nil is really an unwind protect,
2305 so in that case the "old value" is a list of forms to evaluate. */
2306 else if (NILP (specpdl_ptr
->symbol
))
2307 Fprogn (specpdl_ptr
->old_value
);
2309 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2311 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2320 /* Get the value of symbol's global binding, even if that binding
2321 is not now dynamically visible. */
2324 top_level_value (symbol
)
2327 register struct specbinding
*ptr
= specpdl
;
2329 CHECK_SYMBOL (symbol
, 0);
2330 for (; ptr
!= specpdl_ptr
; ptr
++)
2332 if (EQ (ptr
->symbol
, symbol
))
2333 return ptr
->old_value
;
2335 return Fsymbol_value (symbol
);
2339 top_level_set (symbol
, newval
)
2340 Lisp_Object symbol
, newval
;
2342 register struct specbinding
*ptr
= specpdl
;
2344 CHECK_SYMBOL (symbol
, 0);
2345 for (; ptr
!= specpdl_ptr
; ptr
++)
2347 if (EQ (ptr
->symbol
, symbol
))
2349 ptr
->old_value
= newval
;
2353 return Fset (symbol
, newval
);
2358 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2359 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2360 The debugger is entered when that frame exits, if the flag is non-nil.")
2362 Lisp_Object level
, flag
;
2364 register struct backtrace
*backlist
= backtrace_list
;
2367 CHECK_NUMBER (level
, 0);
2369 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2371 backlist
= backlist
->next
;
2375 backlist
->debug_on_exit
= !NILP (flag
);
2380 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2381 "Print a trace of Lisp function calls currently active.\n\
2382 Output stream used is value of `standard-output'.")
2385 register struct backtrace
*backlist
= backtrace_list
;
2389 extern Lisp_Object Vprint_level
;
2390 struct gcpro gcpro1
;
2392 XFASTINT (Vprint_level
) = 3;
2399 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2400 if (backlist
->nargs
== UNEVALLED
)
2402 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2406 tem
= *backlist
->function
;
2407 Fprin1 (tem
, Qnil
); /* This can QUIT */
2408 write_string ("(", -1);
2409 if (backlist
->nargs
== MANY
)
2411 for (tail
= *backlist
->args
, i
= 0;
2413 tail
= Fcdr (tail
), i
++)
2415 if (i
) write_string (" ", -1);
2416 Fprin1 (Fcar (tail
), Qnil
);
2421 for (i
= 0; i
< backlist
->nargs
; i
++)
2423 if (i
) write_string (" ", -1);
2424 Fprin1 (backlist
->args
[i
], Qnil
);
2428 write_string (")\n", -1);
2429 backlist
= backlist
->next
;
2432 Vprint_level
= Qnil
;
2437 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2438 "Return the function and arguments N frames up from current execution point.\n\
2439 If that frame has not evaluated the arguments yet (or is a special form),\n\
2440 the value is (nil FUNCTION ARG-FORMS...).\n\
2441 If that frame has evaluated its arguments and called its function already,\n\
2442 the value is (t FUNCTION ARG-VALUES...).\n\
2443 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2444 FUNCTION is whatever was supplied as car of evaluated list,\n\
2445 or a lambda expression for macro calls.\n\
2446 If N is more than the number of frames, the value is nil.")
2448 Lisp_Object nframes
;
2450 register struct backtrace
*backlist
= backtrace_list
;
2454 CHECK_NATNUM (nframes
, 0);
2456 /* Find the frame requested. */
2457 for (i
= 0; i
< XFASTINT (nframes
); i
++)
2458 backlist
= backlist
->next
;
2462 if (backlist
->nargs
== UNEVALLED
)
2463 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2466 if (backlist
->nargs
== MANY
)
2467 tem
= *backlist
->args
;
2469 tem
= Flist (backlist
->nargs
, backlist
->args
);
2471 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2477 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2478 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2480 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2481 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2482 This limit is to catch infinite recursions for you before they cause\n\
2483 actual stack overflow in C, which would be fatal for Emacs.\n\
2484 You can safely make it considerably larger than its default value,\n\
2485 if that proves inconveniently small.");
2487 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2488 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2489 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2492 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2493 "Non-nil inhibits C-g quitting from happening immediately.\n\
2494 Note that `quit-flag' will still be set by typing C-g,\n\
2495 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2496 To prevent this happening, set `quit-flag' to nil\n\
2497 before making `inhibit-quit' nil.");
2498 Vinhibit_quit
= Qnil
;
2500 Qinhibit_quit
= intern ("inhibit-quit");
2501 staticpro (&Qinhibit_quit
);
2503 Qautoload
= intern ("autoload");
2504 staticpro (&Qautoload
);
2506 Qdebug_on_error
= intern ("debug-on-error");
2507 staticpro (&Qdebug_on_error
);
2509 Qmacro
= intern ("macro");
2510 staticpro (&Qmacro
);
2512 /* Note that the process handling also uses Qexit, but we don't want
2513 to staticpro it twice, so we just do it here. */
2514 Qexit
= intern ("exit");
2517 Qinteractive
= intern ("interactive");
2518 staticpro (&Qinteractive
);
2520 Qcommandp
= intern ("commandp");
2521 staticpro (&Qcommandp
);
2523 Qdefun
= intern ("defun");
2524 staticpro (&Qdefun
);
2526 Qand_rest
= intern ("&rest");
2527 staticpro (&Qand_rest
);
2529 Qand_optional
= intern ("&optional");
2530 staticpro (&Qand_optional
);
2532 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2533 "*Non-nil means automatically display a backtrace buffer\n\
2534 after any error that is handled by the editor command loop.\n\
2535 If the value is a list, an error only means to display a backtrace\n\
2536 if one of its condition symbols appears in the list.");
2537 Vstack_trace_on_error
= Qnil
;
2539 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2540 "*Non-nil means enter debugger if an error is signaled.\n\
2541 Does not apply to errors handled by `condition-case'.\n\
2542 If the value is a list, an error only means to enter the debugger\n\
2543 if one of its condition symbols appears in the list.\n\
2544 See also variable `debug-on-quit'.");
2545 Vdebug_on_error
= Qnil
;
2547 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2548 "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
2549 Does not apply if quit is handled by a `condition-case'.");
2552 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2553 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2555 DEFVAR_LISP ("debugger", &Vdebugger
,
2556 "Function to call to invoke debugger.\n\
2557 If due to frame exit, args are `exit' and the value being returned;\n\
2558 this function's value will be returned instead of that.\n\
2559 If due to error, args are `error' and a list of the args to `signal'.\n\
2560 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2561 If due to `eval' entry, one arg, t.");
2564 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2565 staticpro (&Qmocklisp_arguments
);
2566 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2567 "While in a mocklisp function, the list of its unevaluated args.");
2568 Vmocklisp_arguments
= Qt
;
2570 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2571 "Set to the function `run-hooks', if that function has been defined.\n\
2572 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2575 staticpro (&Vautoload_queue
);
2576 Vautoload_queue
= Qnil
;
2587 defsubr (&Sfunction
);
2589 defsubr (&Sdefmacro
);
2591 defsubr (&Sdefconst
);
2592 defsubr (&Suser_variable_p
);
2596 defsubr (&Smacroexpand
);
2599 defsubr (&Sunwind_protect
);
2600 defsubr (&Scondition_case
);
2602 defsubr (&Sinteractive_p
);
2603 defsubr (&Scommandp
);
2604 defsubr (&Sautoload
);
2607 defsubr (&Sfuncall
);
2608 defsubr (&Sbacktrace_debug
);
2609 defsubr (&Sbacktrace
);
2610 defsubr (&Sbacktrace_frame
);