1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994 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
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
153 max_specpdl_size
= 600;
154 max_lisp_eval_depth
= 200;
161 specpdl_ptr
= specpdl
;
166 debug_on_next_call
= 0;
168 /* This is less than the initial value of num_nonmacro_input_chars. */
169 when_entered_debugger
= -1;
176 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
177 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
178 if (specpdl_size
+ 40 > max_specpdl_size
)
179 max_specpdl_size
= specpdl_size
+ 40;
180 debug_on_next_call
= 0;
181 when_entered_debugger
= num_nonmacro_input_chars
;
182 return apply1 (Vdebugger
, arg
);
185 do_debug_on_call (code
)
188 debug_on_next_call
= 0;
189 backtrace_list
->debug_on_exit
= 1;
190 call_debugger (Fcons (code
, Qnil
));
193 /* NOTE!!! Every function that can call EVAL must protect its args
194 and temporaries from garbage collection while it needs them.
195 The definition of `For' shows what you have to do. */
197 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
198 "Eval args until one of them yields non-nil, then return that value.\n\
199 The remaining args are not evalled at all.\n\
200 If all args return nil, return nil.")
204 register Lisp_Object val
;
205 Lisp_Object args_left
;
216 val
= Feval (Fcar (args_left
));
219 args_left
= Fcdr (args_left
);
221 while (!NILP(args_left
));
227 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
228 "Eval args until one of them yields nil, then return nil.\n\
229 The remaining args are not evalled at all.\n\
230 If no arg yields nil, return the last arg's value.")
234 register Lisp_Object val
;
235 Lisp_Object args_left
;
246 val
= Feval (Fcar (args_left
));
249 args_left
= Fcdr (args_left
);
251 while (!NILP(args_left
));
257 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
258 "(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...\n\
259 Returns the value of THEN or the value of the last of the ELSE's.\n\
260 THEN must be one expression, but ELSE... can be zero or more expressions.\n\
261 If COND yields nil, and there are no ELSE's, the value is nil.")
265 register Lisp_Object cond
;
269 cond
= Feval (Fcar (args
));
273 return Feval (Fcar (Fcdr (args
)));
274 return Fprogn (Fcdr (Fcdr (args
)));
277 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
278 "(cond CLAUSES...): try each clause until one succeeds.\n\
279 Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\
280 and, if the value is non-nil, this clause succeeds:\n\
281 then the expressions in BODY are evaluated and the last one's\n\
282 value is the value of the cond-form.\n\
283 If no clause succeeds, cond returns nil.\n\
284 If a clause has one element, as in (CONDITION),\n\
285 CONDITION's value if non-nil is returned from the cond-form.")
289 register Lisp_Object clause
, val
;
296 clause
= Fcar (args
);
297 val
= Feval (Fcar (clause
));
300 if (!EQ (XCONS (clause
)->cdr
, Qnil
))
301 val
= Fprogn (XCONS (clause
)->cdr
);
304 args
= XCONS (args
)->cdr
;
311 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
312 "(progn BODY...): eval BODY forms sequentially and return value of last one.")
316 register Lisp_Object val
, tem
;
317 Lisp_Object args_left
;
320 /* In Mocklisp code, symbols at the front of the progn arglist
321 are to be bound to zero. */
322 if (!EQ (Vmocklisp_arguments
, Qt
))
324 val
= make_number (0);
325 while (!NILP (args
) && (tem
= Fcar (args
), SYMBOLP (tem
)))
328 specbind (tem
, val
), args
= Fcdr (args
);
340 val
= Feval (Fcar (args_left
));
341 args_left
= Fcdr (args_left
);
343 while (!NILP(args_left
));
349 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
350 "(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.\n\
351 The value of FIRST is saved during the evaluation of the remaining args,\n\
352 whose values are discarded.")
357 register Lisp_Object args_left
;
358 struct gcpro gcpro1
, gcpro2
;
359 register int argnum
= 0;
371 val
= Feval (Fcar (args_left
));
373 Feval (Fcar (args_left
));
374 args_left
= Fcdr (args_left
);
376 while (!NILP(args_left
));
382 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
383 "(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
384 The value of Y is saved during the evaluation of the remaining args,\n\
385 whose values are discarded.")
390 register Lisp_Object args_left
;
391 struct gcpro gcpro1
, gcpro2
;
392 register int argnum
= -1;
406 val
= Feval (Fcar (args_left
));
408 Feval (Fcar (args_left
));
409 args_left
= Fcdr (args_left
);
411 while (!NILP (args_left
));
417 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
418 "(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
419 The symbols SYM are variables; they are literal (not evaluated).\n\
420 The values VAL are expressions; they are evaluated.\n\
421 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\
422 The second VAL is not computed until after the first SYM is set, and so on;\n\
423 each VAL can use the new value of variables set earlier in the `setq'.\n\
424 The return value of the `setq' form is the value of the last VAL.")
428 register Lisp_Object args_left
;
429 register Lisp_Object val
, sym
;
440 val
= Feval (Fcar (Fcdr (args_left
)));
441 sym
= Fcar (args_left
);
443 args_left
= Fcdr (Fcdr (args_left
));
445 while (!NILP(args_left
));
451 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
452 "Return the argument, without evaluating it. `(quote x)' yields `x'.")
459 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
460 "Like `quote', but preferred for objects which are functions.\n\
461 In byte compilation, `function' causes its argument to be compiled.\n\
462 `quote' cannot do that.")
469 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
470 "Return t if function in which this appears was called interactively.\n\
471 This means that the function was called with call-interactively (which\n\
472 includes being called as the binding of a key)\n\
473 and input is currently coming from the keyboard (not in keyboard macro).")
476 register struct backtrace
*btp
;
477 register Lisp_Object fun
;
482 btp
= backtrace_list
;
484 /* If this isn't a byte-compiled function, there may be a frame at
485 the top for Finteractive_p itself. If so, skip it. */
486 fun
= Findirect_function (*btp
->function
);
488 && (struct Lisp_Subr
*) XPNTR (fun
) == &Sinteractive_p
)
491 /* If we're running an Emacs 18-style byte-compiled function, there
492 may be a frame for Fbytecode. Now, given the strictest
493 definition, this function isn't really being called
494 interactively, but because that's the way Emacs 18 always builds
495 byte-compiled functions, we'll accept it for now. */
496 if (EQ (*btp
->function
, Qbytecode
))
499 /* If this isn't a byte-compiled function, then we may now be
500 looking at several frames for special forms. Skip past them. */
502 btp
->nargs
== UNEVALLED
)
505 /* btp now points at the frame of the innermost function that isn't
506 a special form, ignoring frames for Finteractive_p and/or
507 Fbytecode at the top. If this frame is for a built-in function
508 (such as load or eval-region) return nil. */
509 fun
= Findirect_function (*btp
->function
);
512 /* btp points to the frame of a Lisp function that called interactive-p.
513 Return t if that function was called interactively. */
514 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
519 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
520 "(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.\n\
521 The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
522 See also the function `interactive'.")
526 register Lisp_Object fn_name
;
527 register Lisp_Object defn
;
529 fn_name
= Fcar (args
);
530 defn
= Fcons (Qlambda
, Fcdr (args
));
531 if (!NILP (Vpurify_flag
))
532 defn
= Fpurecopy (defn
);
533 Ffset (fn_name
, defn
);
534 LOADHIST_ATTACH (fn_name
);
538 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
539 "(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.\n\
540 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
541 When the macro is called, as in (NAME ARGS...),\n\
542 the function (lambda ARGLIST BODY...) is applied to\n\
543 the list ARGS... as it appears in the expression,\n\
544 and the result should be a form to be evaluated instead of the original.")
548 register Lisp_Object fn_name
;
549 register Lisp_Object defn
;
551 fn_name
= Fcar (args
);
552 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
553 if (!NILP (Vpurify_flag
))
554 defn
= Fpurecopy (defn
);
555 Ffset (fn_name
, defn
);
556 LOADHIST_ATTACH (fn_name
);
560 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
561 "(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.\n\
562 You are not required to define a variable in order to use it,\n\
563 but the definition can supply documentation and an initial value\n\
564 in a way that tags can recognize.\n\n\
565 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
566 If SYMBOL is buffer-local, its default value is what is set;\n\
567 buffer-local values are not affected.\n\
568 INITVALUE and DOCSTRING are optional.\n\
569 If DOCSTRING starts with *, this variable is identified as a user option.\n\
570 This means that M-x set-variable and M-x edit-options recognize it.\n\
571 If INITVALUE is missing, SYMBOL's value is not set.")
575 register Lisp_Object sym
, tem
;
581 tem
= Fdefault_boundp (sym
);
583 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
585 tem
= Fcar (Fcdr (Fcdr (args
)));
588 if (!NILP (Vpurify_flag
))
589 tem
= Fpurecopy (tem
);
590 Fput (sym
, Qvariable_documentation
, tem
);
592 LOADHIST_ATTACH (sym
);
596 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
597 "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
598 The intent is that programs do not change this value, but users may.\n\
599 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
600 If SYMBOL is buffer-local, its default value is what is set;\n\
601 buffer-local values are not affected.\n\
602 DOCSTRING is optional.\n\
603 If DOCSTRING starts with *, this variable is identified as a user option.\n\
604 This means that M-x set-variable and M-x edit-options recognize it.\n\n\
605 Note: do not use `defconst' for user options in libraries that are not\n\
606 normally loaded, since it is useful for users to be able to specify\n\
607 their own values for such variables before loading the library.\n\
608 Since `defconst' unconditionally assigns the variable,\n\
609 it would override the user's choice.")
613 register Lisp_Object sym
, tem
;
616 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
617 tem
= Fcar (Fcdr (Fcdr (args
)));
620 if (!NILP (Vpurify_flag
))
621 tem
= Fpurecopy (tem
);
622 Fput (sym
, Qvariable_documentation
, tem
);
624 LOADHIST_ATTACH (sym
);
628 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
629 "Returns t if VARIABLE is intended to be set and modified by users.\n\
630 \(The alternative is a variable used internally in a Lisp program.)\n\
631 Determined by whether the first character of the documentation\n\
632 for the variable is \"*\"")
634 Lisp_Object variable
;
636 Lisp_Object documentation
;
638 documentation
= Fget (variable
, Qvariable_documentation
);
639 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
641 if ((STRINGP (documentation
)) &&
642 ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
647 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
648 "(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
649 The value of the last form in BODY is returned.\n\
650 Each element of VARLIST is a symbol (which is bound to nil)\n\
651 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
652 Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
656 Lisp_Object varlist
, val
, elt
;
657 int count
= specpdl_ptr
- specpdl
;
658 struct gcpro gcpro1
, gcpro2
, gcpro3
;
660 GCPRO3 (args
, elt
, varlist
);
662 varlist
= Fcar (args
);
663 while (!NILP (varlist
))
666 elt
= Fcar (varlist
);
668 specbind (elt
, Qnil
);
669 else if (! NILP (Fcdr (Fcdr (elt
))))
671 Fcons (build_string ("`let' bindings can have only one value-form"),
675 val
= Feval (Fcar (Fcdr (elt
)));
676 specbind (Fcar (elt
), val
);
678 varlist
= Fcdr (varlist
);
681 val
= Fprogn (Fcdr (args
));
682 return unbind_to (count
, val
);
685 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
686 "(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
687 The value of the last form in BODY is returned.\n\
688 Each element of VARLIST is a symbol (which is bound to nil)\n\
689 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
690 All the VALUEFORMs are evalled before any symbols are bound.")
694 Lisp_Object
*temps
, tem
;
695 register Lisp_Object elt
, varlist
;
696 int count
= specpdl_ptr
- specpdl
;
698 struct gcpro gcpro1
, gcpro2
;
700 varlist
= Fcar (args
);
702 /* Make space to hold the values to give the bound variables */
703 elt
= Flength (varlist
);
704 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
706 /* Compute the values and store them in `temps' */
708 GCPRO2 (args
, *temps
);
711 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
714 elt
= Fcar (varlist
);
716 temps
[argnum
++] = Qnil
;
717 else if (! NILP (Fcdr (Fcdr (elt
))))
719 Fcons (build_string ("`let' bindings can have only one value-form"),
722 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
723 gcpro2
.nvars
= argnum
;
727 varlist
= Fcar (args
);
728 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
730 elt
= Fcar (varlist
);
731 tem
= temps
[argnum
++];
735 specbind (Fcar (elt
), tem
);
738 elt
= Fprogn (Fcdr (args
));
739 return unbind_to (count
, elt
);
742 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
743 "(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.\n\
744 The order of execution is thus TEST, BODY, TEST, BODY and so on\n\
745 until TEST returns nil.")
749 Lisp_Object test
, body
, tem
;
750 struct gcpro gcpro1
, gcpro2
;
756 while (tem
= Feval (test
),
757 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
767 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
768 "Return result of expanding macros at top level of FORM.\n\
769 If FORM is not a macro call, it is returned unchanged.\n\
770 Otherwise, the macro is expanded and the expansion is considered\n\
771 in place of FORM. When a non-macro-call results, it is returned.\n\n\
772 The second optional arg ENVIRONMENT species an environment of macro\n\
773 definitions to shadow the loaded ones for use in file byte-compilation.")
775 register Lisp_Object form
;
778 /* With cleanups from Hallvard Furuseth. */
779 register Lisp_Object expander
, sym
, def
, tem
;
783 /* Come back here each time we expand a macro call,
784 in case it expands into another macro call. */
787 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
788 def
= sym
= XCONS (form
)->car
;
790 /* Trace symbols aliases to other symbols
791 until we get a symbol that is not an alias. */
792 while (SYMBOLP (def
))
796 tem
= Fassq (sym
, env
);
799 def
= XSYMBOL (sym
)->function
;
800 if (!EQ (def
, Qunbound
))
805 /* Right now TEM is the result from SYM in ENV,
806 and if TEM is nil then DEF is SYM's function definition. */
809 /* SYM is not mentioned in ENV.
810 Look at its function definition. */
811 if (EQ (def
, Qunbound
) || !CONSP (def
))
812 /* Not defined or definition not suitable */
814 if (EQ (XCONS (def
)->car
, Qautoload
))
816 /* Autoloading function: will it be a macro when loaded? */
817 tem
= Fnth (make_number (4), def
);
818 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
819 /* Yes, load it and try again. */
821 do_autoload (def
, sym
);
827 else if (!EQ (XCONS (def
)->car
, Qmacro
))
829 else expander
= XCONS (def
)->cdr
;
833 expander
= XCONS (tem
)->cdr
;
837 form
= apply1 (expander
, XCONS (form
)->cdr
);
842 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
843 "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
844 TAG is evalled to get the tag to use. Then the BODY is executed.\n\
845 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
846 If no throw happens, `catch' returns the value of the last BODY form.\n\
847 If a throw happens, it specifies the value to return from `catch'.")
851 register Lisp_Object tag
;
855 tag
= Feval (Fcar (args
));
857 return internal_catch (tag
, Fprogn
, Fcdr (args
));
860 /* Set up a catch, then call C function FUNC on argument ARG.
861 FUNC should return a Lisp_Object.
862 This is how catches are done from within C code. */
865 internal_catch (tag
, func
, arg
)
867 Lisp_Object (*func
) ();
870 /* This structure is made part of the chain `catchlist'. */
873 /* Fill in the components of c, and put it on the list. */
877 c
.backlist
= backtrace_list
;
878 c
.handlerlist
= handlerlist
;
879 c
.lisp_eval_depth
= lisp_eval_depth
;
880 c
.pdlcount
= specpdl_ptr
- specpdl
;
881 c
.poll_suppress_count
= poll_suppress_count
;
886 if (! _setjmp (c
.jmp
))
887 c
.val
= (*func
) (arg
);
889 /* Throw works by a longjmp that comes right here. */
894 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
895 jump to that CATCH, returning VALUE as the value of that catch.
897 This is the guts Fthrow and Fsignal; they differ only in the way
898 they choose the catch tag to throw to. A catch tag for a
899 condition-case form has a TAG of Qnil.
901 Before each catch is discarded, unbind all special bindings and
902 execute all unwind-protect clauses made above that catch. Unwind
903 the handler stack as we go, so that the proper handlers are in
904 effect for each unwind-protect clause we run. At the end, restore
905 some static info saved in CATCH, and longjmp to the location
908 This is used for correct unwinding in Fthrow and Fsignal. */
911 unwind_to_catch (catch, value
)
912 struct catchtag
*catch;
915 register int last_time
;
917 /* Save the value in the tag. */
920 /* Restore the polling-suppression count. */
921 set_poll_suppress_count (catch->poll_suppress_count
);
925 last_time
= catchlist
== catch;
927 /* Unwind the specpdl stack, and then restore the proper set of
929 unbind_to (catchlist
->pdlcount
, Qnil
);
930 handlerlist
= catchlist
->handlerlist
;
931 catchlist
= catchlist
->next
;
935 gcprolist
= catch->gcpro
;
936 backtrace_list
= catch->backlist
;
937 lisp_eval_depth
= catch->lisp_eval_depth
;
939 _longjmp (catch->jmp
, 1);
942 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
943 "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
944 Both TAG and VALUE are evalled.")
946 register Lisp_Object tag
, val
;
948 register struct catchtag
*c
;
953 for (c
= catchlist
; c
; c
= c
->next
)
955 if (EQ (c
->tag
, tag
))
956 unwind_to_catch (c
, val
);
958 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (val
, Qnil
)));
963 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
964 "Do BODYFORM, protecting with UNWINDFORMS.\n\
965 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\
966 If BODYFORM completes normally, its value is returned\n\
967 after executing the UNWINDFORMS.\n\
968 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
973 int count
= specpdl_ptr
- specpdl
;
975 record_unwind_protect (0, Fcdr (args
));
976 val
= Feval (Fcar (args
));
977 return unbind_to (count
, val
);
980 /* Chain of condition handlers currently in effect.
981 The elements of this chain are contained in the stack frames
982 of Fcondition_case and internal_condition_case.
983 When an error is signaled (by calling Fsignal, below),
984 this chain is searched for an element that applies. */
986 struct handler
*handlerlist
;
988 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
989 "Regain control when an error is signaled.\n\
990 Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\
991 executes BODYFORM and returns its value if no error happens.\n\
992 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
993 where the BODY is made of Lisp expressions.\n\n\
994 A handler is applicable to an error\n\
995 if CONDITION-NAME is one of the error's condition names.\n\
996 If an error happens, the first applicable handler is run.\n\
998 The car of a handler may be a list of condition names\n\
999 instead of a single condition name.\n\
1001 When a handler handles an error,\n\
1002 control returns to the condition-case and the handler BODY... is executed\n\
1003 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
1004 VAR may be nil; then you do not get access to the signal information.\n\
1006 The value of the last BODY form is returned from the condition-case.\n\
1007 See also the function `signal' for more info.")
1014 register Lisp_Object var
, bodyform
, handlers
;
1017 bodyform
= Fcar (Fcdr (args
));
1018 handlers
= Fcdr (Fcdr (args
));
1019 CHECK_SYMBOL (var
, 0);
1021 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1027 && (SYMBOLP (XCONS (tem
)->car
)
1028 || CONSP (XCONS (tem
)->car
)))))
1029 error ("Invalid condition handler", tem
);
1034 c
.backlist
= backtrace_list
;
1035 c
.handlerlist
= handlerlist
;
1036 c
.lisp_eval_depth
= lisp_eval_depth
;
1037 c
.pdlcount
= specpdl_ptr
- specpdl
;
1038 c
.poll_suppress_count
= poll_suppress_count
;
1039 c
.gcpro
= gcprolist
;
1040 if (_setjmp (c
.jmp
))
1043 specbind (h
.var
, c
.val
);
1044 val
= Fprogn (Fcdr (h
.chosen_clause
));
1046 /* Note that this just undoes the binding of h.var; whoever
1047 longjumped to us unwound the stack to c.pdlcount before
1049 unbind_to (c
.pdlcount
, Qnil
);
1056 h
.handler
= handlers
;
1057 h
.next
= handlerlist
;
1061 val
= Feval (bodyform
);
1063 handlerlist
= h
.next
;
1068 internal_condition_case (bfun
, handlers
, hfun
)
1069 Lisp_Object (*bfun
) ();
1070 Lisp_Object handlers
;
1071 Lisp_Object (*hfun
) ();
1079 c
.backlist
= backtrace_list
;
1080 c
.handlerlist
= handlerlist
;
1081 c
.lisp_eval_depth
= lisp_eval_depth
;
1082 c
.pdlcount
= specpdl_ptr
- specpdl
;
1083 c
.poll_suppress_count
= poll_suppress_count
;
1084 c
.gcpro
= gcprolist
;
1085 if (_setjmp (c
.jmp
))
1087 return (*hfun
) (c
.val
);
1091 h
.handler
= handlers
;
1093 h
.next
= handlerlist
;
1099 handlerlist
= h
.next
;
1104 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1105 Lisp_Object (*bfun
) ();
1107 Lisp_Object handlers
;
1108 Lisp_Object (*hfun
) ();
1116 c
.backlist
= backtrace_list
;
1117 c
.handlerlist
= handlerlist
;
1118 c
.lisp_eval_depth
= lisp_eval_depth
;
1119 c
.pdlcount
= specpdl_ptr
- specpdl
;
1120 c
.poll_suppress_count
= poll_suppress_count
;
1121 c
.gcpro
= gcprolist
;
1122 if (_setjmp (c
.jmp
))
1124 return (*hfun
) (c
.val
);
1128 h
.handler
= handlers
;
1130 h
.next
= handlerlist
;
1134 val
= (*bfun
) (arg
);
1136 handlerlist
= h
.next
;
1140 static Lisp_Object
find_handler_clause ();
1142 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1143 "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
1144 This function does not return.\n\n\
1145 An error symbol is a symbol with an `error-conditions' property\n\
1146 that is a list of condition names.\n\
1147 A handler for any of those names will get to handle this signal.\n\
1148 The symbol `error' should normally be one of them.\n\
1150 DATA should be a list. Its elements are printed as part of the error message.\n\
1151 If the signal is handled, DATA is made available to the handler.\n\
1152 See also the function `condition-case'.")
1153 (error_symbol
, data
)
1154 Lisp_Object error_symbol
, data
;
1156 register struct handler
*allhandlers
= handlerlist
;
1157 Lisp_Object conditions
;
1158 extern int gc_in_progress
;
1159 extern int waiting_for_input
;
1160 Lisp_Object debugger_value
;
1162 quit_error_check ();
1164 if (gc_in_progress
|| waiting_for_input
)
1167 #ifdef HAVE_X_WINDOWS
1168 TOTALLY_UNBLOCK_INPUT
;
1171 conditions
= Fget (error_symbol
, Qerror_conditions
);
1173 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1175 register Lisp_Object clause
;
1176 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1177 error_symbol
, data
, &debugger_value
);
1179 #if 0 /* Most callers are not prepared to handle gc if this returns.
1180 So, since this feature is not very useful, take it out. */
1181 /* If have called debugger and user wants to continue,
1183 if (EQ (clause
, Qlambda
))
1184 return debugger_value
;
1186 if (EQ (clause
, Qlambda
))
1188 /* We can't return values to code which signalled an error, but we
1189 can continue code which has signalled a quit. */
1190 if (EQ (error_symbol
, Qquit
))
1193 error ("Cannot return from the debugger in an error");
1199 Lisp_Object unwind_data
;
1200 struct handler
*h
= handlerlist
;
1202 handlerlist
= allhandlers
;
1203 if (EQ (data
, memory_signal_data
))
1204 unwind_data
= memory_signal_data
;
1206 unwind_data
= Fcons (error_symbol
, data
);
1207 h
->chosen_clause
= clause
;
1208 unwind_to_catch (h
->tag
, unwind_data
);
1212 handlerlist
= allhandlers
;
1213 /* If no handler is present now, try to run the debugger,
1214 and if that fails, throw to top level. */
1215 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1216 Fthrow (Qtop_level
, Qt
);
1219 /* Return nonzero iff LIST is a non-nil atom or
1220 a list containing one of CONDITIONS. */
1223 wants_debugger (list
, conditions
)
1224 Lisp_Object list
, conditions
;
1231 while (CONSP (conditions
))
1233 Lisp_Object
this, tail
;
1234 this = XCONS (conditions
)->car
;
1235 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1236 if (EQ (XCONS (tail
)->car
, this))
1238 conditions
= XCONS (conditions
)->cdr
;
1243 /* Value of Qlambda means we have called debugger and user has continued.
1244 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1247 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1248 Lisp_Object handlers
, conditions
, sig
, data
;
1249 Lisp_Object
*debugger_value_ptr
;
1251 register Lisp_Object h
;
1252 register Lisp_Object tem
;
1254 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1256 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1258 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1259 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1260 if ((EQ (sig
, Qquit
)
1262 : wants_debugger (Vdebug_on_error
, conditions
))
1263 && when_entered_debugger
< num_nonmacro_input_chars
)
1265 int count
= specpdl_ptr
- specpdl
;
1266 specbind (Qdebug_on_error
, Qnil
);
1267 *debugger_value_ptr
=
1268 call_debugger (Fcons (Qerror
,
1269 Fcons (Fcons (sig
, data
),
1271 return unbind_to (count
, Qlambda
);
1275 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1277 Lisp_Object handler
, condit
;
1280 if (!CONSP (handler
))
1282 condit
= Fcar (handler
);
1283 /* Handle a single condition name in handler HANDLER. */
1284 if (SYMBOLP (condit
))
1286 tem
= Fmemq (Fcar (handler
), conditions
);
1290 /* Handle a list of condition names in handler HANDLER. */
1291 else if (CONSP (condit
))
1293 while (CONSP (condit
))
1295 tem
= Fmemq (Fcar (condit
), conditions
);
1298 condit
= XCONS (condit
)->cdr
;
1305 /* dump an error message; called like printf */
1309 error (m
, a1
, a2
, a3
)
1329 int used
= doprnt (buf
, size
, m
, m
+ mlen
, 3, args
);
1334 buffer
= (char *) xrealloc (buffer
, size
);
1337 buffer
= (char *) xmalloc (size
);
1342 string
= build_string (buf
);
1346 Fsignal (Qerror
, Fcons (string
, Qnil
));
1349 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1350 "T if FUNCTION makes provisions for interactive calling.\n\
1351 This means it contains a description for how to read arguments to give it.\n\
1352 The value is nil for an invalid function or a symbol with no function\n\
1355 Interactively callable functions include strings and vectors (treated\n\
1356 as keyboard macros), lambda-expressions that contain a top-level call\n\
1357 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1358 fourth argument, and some of the built-in functions of Lisp.\n\
1360 Also, a symbol satisfies `commandp' if its function definition does so.")
1362 Lisp_Object function
;
1364 register Lisp_Object fun
;
1365 register Lisp_Object funcar
;
1366 register Lisp_Object tem
;
1371 fun
= indirect_function (fun
);
1372 if (EQ (fun
, Qunbound
))
1375 /* Emacs primitives are interactive if their DEFUN specifies an
1376 interactive spec. */
1379 if (XSUBR (fun
)->prompt
)
1385 /* Bytecode objects are interactive if they are long enough to
1386 have an element whose index is COMPILED_INTERACTIVE, which is
1387 where the interactive spec is stored. */
1388 else if (COMPILEDP (fun
))
1389 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1392 /* Strings and vectors are keyboard macros. */
1393 if (STRINGP (fun
) || VECTORP (fun
))
1396 /* Lists may represent commands. */
1399 funcar
= Fcar (fun
);
1400 if (!SYMBOLP (funcar
))
1401 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1402 if (EQ (funcar
, Qlambda
))
1403 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1404 if (EQ (funcar
, Qmocklisp
))
1405 return Qt
; /* All mocklisp functions can be called interactively */
1406 if (EQ (funcar
, Qautoload
))
1407 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1413 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1414 "Define FUNCTION to autoload from FILE.\n\
1415 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1416 Third arg DOCSTRING is documentation for the function.\n\
1417 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1418 Fifth arg TYPE indicates the type of the object:\n\
1419 nil or omitted says FUNCTION is a function,\n\
1420 `keymap' says FUNCTION is really a keymap, and\n\
1421 `macro' or t says FUNCTION is really a macro.\n\
1422 Third through fifth args give info about the real definition.\n\
1423 They default to nil.\n\
1424 If FUNCTION is already defined other than as an autoload,\n\
1425 this does nothing and returns nil.")
1426 (function
, file
, docstring
, interactive
, type
)
1427 Lisp_Object function
, file
, docstring
, interactive
, type
;
1430 Lisp_Object args
[4];
1433 CHECK_SYMBOL (function
, 0);
1434 CHECK_STRING (file
, 1);
1436 /* If function is defined and not as an autoload, don't override */
1437 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1438 && !(CONSP (XSYMBOL (function
)->function
)
1439 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1444 args
[1] = docstring
;
1445 args
[2] = interactive
;
1448 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1449 #else /* NO_ARG_ARRAY */
1450 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1451 #endif /* not NO_ARG_ARRAY */
1455 un_autoload (oldqueue
)
1456 Lisp_Object oldqueue
;
1458 register Lisp_Object queue
, first
, second
;
1460 /* Queue to unwind is current value of Vautoload_queue.
1461 oldqueue is the shadowed value to leave in Vautoload_queue. */
1462 queue
= Vautoload_queue
;
1463 Vautoload_queue
= oldqueue
;
1464 while (CONSP (queue
))
1466 first
= Fcar (queue
);
1467 second
= Fcdr (first
);
1468 first
= Fcar (first
);
1469 if (EQ (second
, Qnil
))
1472 Ffset (first
, second
);
1473 queue
= Fcdr (queue
);
1478 do_autoload (fundef
, funname
)
1479 Lisp_Object fundef
, funname
;
1481 int count
= specpdl_ptr
- specpdl
;
1482 Lisp_Object fun
, val
, queue
, first
, second
;
1485 CHECK_SYMBOL (funname
, 0);
1487 /* Value saved here is to be restored into Vautoload_queue */
1488 record_unwind_protect (un_autoload
, Vautoload_queue
);
1489 Vautoload_queue
= Qt
;
1490 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1492 /* Save the old autoloads, in case we ever do an unload. */
1493 queue
= Vautoload_queue
;
1494 while (CONSP (queue
))
1496 first
= Fcar (queue
);
1497 second
= Fcdr (first
);
1498 first
= Fcar (first
);
1500 /* Note: This test is subtle. The cdr of an autoload-queue entry
1501 may be an atom if the autoload entry was generated by a defalias
1504 Fput (first
, Qautoload
, (Fcdr (second
)));
1506 queue
= Fcdr (queue
);
1509 /* Once loading finishes, don't undo it. */
1510 Vautoload_queue
= Qt
;
1511 unbind_to (count
, Qnil
);
1513 fun
= Findirect_function (fun
);
1515 if (!NILP (Fequal (fun
, fundef
)))
1516 error ("Autoloading failed to define function %s",
1517 XSYMBOL (funname
)->name
->data
);
1520 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1521 "Evaluate FORM and return its value.")
1525 Lisp_Object fun
, val
, original_fun
, original_args
;
1527 struct backtrace backtrace
;
1528 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1532 if (EQ (Vmocklisp_arguments
, Qt
))
1533 return Fsymbol_value (form
);
1534 val
= Fsymbol_value (form
);
1537 else if (EQ (val
, Qt
))
1545 if (consing_since_gc
> gc_cons_threshold
)
1548 Fgarbage_collect ();
1552 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1554 if (max_lisp_eval_depth
< 100)
1555 max_lisp_eval_depth
= 100;
1556 if (lisp_eval_depth
> max_lisp_eval_depth
)
1557 error ("Lisp nesting exceeds max-lisp-eval-depth");
1560 original_fun
= Fcar (form
);
1561 original_args
= Fcdr (form
);
1563 backtrace
.next
= backtrace_list
;
1564 backtrace_list
= &backtrace
;
1565 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1566 backtrace
.args
= &original_args
;
1567 backtrace
.nargs
= UNEVALLED
;
1568 backtrace
.evalargs
= 1;
1569 backtrace
.debug_on_exit
= 0;
1571 if (debug_on_next_call
)
1572 do_debug_on_call (Qt
);
1574 /* At this point, only original_fun and original_args
1575 have values that will be used below */
1577 fun
= Findirect_function (original_fun
);
1581 Lisp_Object numargs
;
1582 Lisp_Object argvals
[7];
1583 Lisp_Object args_left
;
1584 register int i
, maxargs
;
1586 args_left
= original_args
;
1587 numargs
= Flength (args_left
);
1589 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1590 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1591 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1593 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1595 backtrace
.evalargs
= 0;
1596 val
= (*XSUBR (fun
)->function
) (args_left
);
1600 if (XSUBR (fun
)->max_args
== MANY
)
1602 /* Pass a vector of evaluated arguments */
1604 register int argnum
= 0;
1606 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1608 GCPRO3 (args_left
, fun
, fun
);
1612 while (!NILP (args_left
))
1614 vals
[argnum
++] = Feval (Fcar (args_left
));
1615 args_left
= Fcdr (args_left
);
1616 gcpro3
.nvars
= argnum
;
1619 backtrace
.args
= vals
;
1620 backtrace
.nargs
= XINT (numargs
);
1622 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1627 GCPRO3 (args_left
, fun
, fun
);
1628 gcpro3
.var
= argvals
;
1631 maxargs
= XSUBR (fun
)->max_args
;
1632 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1634 argvals
[i
] = Feval (Fcar (args_left
));
1640 backtrace
.args
= argvals
;
1641 backtrace
.nargs
= XINT (numargs
);
1646 val
= (*XSUBR (fun
)->function
) ();
1649 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1652 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1655 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1659 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1660 argvals
[2], argvals
[3]);
1663 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1664 argvals
[3], argvals
[4]);
1667 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1668 argvals
[3], argvals
[4], argvals
[5]);
1671 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1672 argvals
[3], argvals
[4], argvals
[5],
1677 /* Someone has created a subr that takes more arguments than
1678 is supported by this code. We need to either rewrite the
1679 subr to use a different argument protocol, or add more
1680 cases to this switch. */
1684 if (COMPILEDP (fun
))
1685 val
= apply_lambda (fun
, original_args
, 1);
1689 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1690 funcar
= Fcar (fun
);
1691 if (!SYMBOLP (funcar
))
1692 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1693 if (EQ (funcar
, Qautoload
))
1695 do_autoload (fun
, original_fun
);
1698 if (EQ (funcar
, Qmacro
))
1699 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1700 else if (EQ (funcar
, Qlambda
))
1701 val
= apply_lambda (fun
, original_args
, 1);
1702 else if (EQ (funcar
, Qmocklisp
))
1703 val
= ml_apply (fun
, original_args
);
1705 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1708 if (!EQ (Vmocklisp_arguments
, Qt
))
1712 else if (EQ (val
, Qt
))
1716 if (backtrace
.debug_on_exit
)
1717 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1718 backtrace_list
= backtrace
.next
;
1722 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1723 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1724 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1729 register int i
, numargs
;
1730 register Lisp_Object spread_arg
;
1731 register Lisp_Object
*funcall_args
;
1733 struct gcpro gcpro1
;
1737 spread_arg
= args
[nargs
- 1];
1738 CHECK_LIST (spread_arg
, nargs
);
1740 numargs
= XINT (Flength (spread_arg
));
1743 return Ffuncall (nargs
- 1, args
);
1744 else if (numargs
== 1)
1746 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1747 return Ffuncall (nargs
, args
);
1750 numargs
+= nargs
- 2;
1752 fun
= indirect_function (fun
);
1753 if (EQ (fun
, Qunbound
))
1755 /* Let funcall get the error */
1762 if (numargs
< XSUBR (fun
)->min_args
1763 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1764 goto funcall
; /* Let funcall get the error */
1765 else if (XSUBR (fun
)->max_args
> numargs
)
1767 /* Avoid making funcall cons up a yet another new vector of arguments
1768 by explicitly supplying nil's for optional values */
1769 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1770 * sizeof (Lisp_Object
));
1771 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1772 funcall_args
[++i
] = Qnil
;
1773 GCPRO1 (*funcall_args
);
1774 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1778 /* We add 1 to numargs because funcall_args includes the
1779 function itself as well as its arguments. */
1782 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1783 * sizeof (Lisp_Object
));
1784 GCPRO1 (*funcall_args
);
1785 gcpro1
.nvars
= 1 + numargs
;
1788 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1789 /* Spread the last arg we got. Its first element goes in
1790 the slot that it used to occupy, hence this value of I. */
1792 while (!NILP (spread_arg
))
1794 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1795 spread_arg
= XCONS (spread_arg
)->cdr
;
1798 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1801 /* Apply fn to arg */
1804 Lisp_Object fn
, arg
;
1806 struct gcpro gcpro1
;
1810 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1814 Lisp_Object args
[2];
1818 RETURN_UNGCPRO (Fapply (2, args
));
1820 #else /* not NO_ARG_ARRAY */
1821 RETURN_UNGCPRO (Fapply (2, &fn
));
1822 #endif /* not NO_ARG_ARRAY */
1825 /* Call function fn on no arguments */
1830 struct gcpro gcpro1
;
1833 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1836 /* Call function fn with 1 argument arg1 */
1840 Lisp_Object fn
, arg1
;
1842 struct gcpro gcpro1
;
1844 Lisp_Object args
[2];
1850 RETURN_UNGCPRO (Ffuncall (2, args
));
1851 #else /* not NO_ARG_ARRAY */
1854 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1855 #endif /* not NO_ARG_ARRAY */
1858 /* Call function fn with 2 arguments arg1, arg2 */
1861 call2 (fn
, arg1
, arg2
)
1862 Lisp_Object fn
, arg1
, arg2
;
1864 struct gcpro gcpro1
;
1866 Lisp_Object args
[3];
1872 RETURN_UNGCPRO (Ffuncall (3, args
));
1873 #else /* not NO_ARG_ARRAY */
1876 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1877 #endif /* not NO_ARG_ARRAY */
1880 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1883 call3 (fn
, arg1
, arg2
, arg3
)
1884 Lisp_Object fn
, arg1
, arg2
, arg3
;
1886 struct gcpro gcpro1
;
1888 Lisp_Object args
[4];
1895 RETURN_UNGCPRO (Ffuncall (4, args
));
1896 #else /* not NO_ARG_ARRAY */
1899 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1900 #endif /* not NO_ARG_ARRAY */
1903 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1906 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1907 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1909 struct gcpro gcpro1
;
1911 Lisp_Object args
[5];
1919 RETURN_UNGCPRO (Ffuncall (5, args
));
1920 #else /* not NO_ARG_ARRAY */
1923 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1924 #endif /* not NO_ARG_ARRAY */
1927 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1930 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1931 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1933 struct gcpro gcpro1
;
1935 Lisp_Object args
[6];
1944 RETURN_UNGCPRO (Ffuncall (6, args
));
1945 #else /* not NO_ARG_ARRAY */
1948 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1949 #endif /* not NO_ARG_ARRAY */
1952 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1955 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1956 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1958 struct gcpro gcpro1
;
1960 Lisp_Object args
[7];
1970 RETURN_UNGCPRO (Ffuncall (7, args
));
1971 #else /* not NO_ARG_ARRAY */
1974 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1975 #endif /* not NO_ARG_ARRAY */
1978 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1979 "Call first argument as a function, passing remaining arguments to it.\n\
1980 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1987 int numargs
= nargs
- 1;
1988 Lisp_Object lisp_numargs
;
1990 struct backtrace backtrace
;
1991 register Lisp_Object
*internal_args
;
1995 if (consing_since_gc
> gc_cons_threshold
)
1996 Fgarbage_collect ();
1998 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2000 if (max_lisp_eval_depth
< 100)
2001 max_lisp_eval_depth
= 100;
2002 if (lisp_eval_depth
> max_lisp_eval_depth
)
2003 error ("Lisp nesting exceeds max-lisp-eval-depth");
2006 backtrace
.next
= backtrace_list
;
2007 backtrace_list
= &backtrace
;
2008 backtrace
.function
= &args
[0];
2009 backtrace
.args
= &args
[1];
2010 backtrace
.nargs
= nargs
- 1;
2011 backtrace
.evalargs
= 0;
2012 backtrace
.debug_on_exit
= 0;
2014 if (debug_on_next_call
)
2015 do_debug_on_call (Qlambda
);
2021 fun
= Findirect_function (fun
);
2025 if (numargs
< XSUBR (fun
)->min_args
2026 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2028 XFASTINT (lisp_numargs
) = numargs
;
2029 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2032 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2033 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2035 if (XSUBR (fun
)->max_args
== MANY
)
2037 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2041 if (XSUBR (fun
)->max_args
> numargs
)
2043 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2044 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2045 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2046 internal_args
[i
] = Qnil
;
2049 internal_args
= args
+ 1;
2050 switch (XSUBR (fun
)->max_args
)
2053 val
= (*XSUBR (fun
)->function
) ();
2056 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2059 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2063 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2067 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2072 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2073 internal_args
[2], internal_args
[3],
2077 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2078 internal_args
[2], internal_args
[3],
2079 internal_args
[4], internal_args
[5]);
2082 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2083 internal_args
[2], internal_args
[3],
2084 internal_args
[4], internal_args
[5],
2090 /* If a subr takes more than 6 arguments without using MANY
2091 or UNEVALLED, we need to extend this function to support it.
2092 Until this is done, there is no way to call the function. */
2096 if (COMPILEDP (fun
))
2097 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2101 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2102 funcar
= Fcar (fun
);
2103 if (!SYMBOLP (funcar
))
2104 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2105 if (EQ (funcar
, Qlambda
))
2106 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2107 else if (EQ (funcar
, Qmocklisp
))
2108 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2109 else if (EQ (funcar
, Qautoload
))
2111 do_autoload (fun
, args
[0]);
2115 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2119 if (backtrace
.debug_on_exit
)
2120 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2121 backtrace_list
= backtrace
.next
;
2126 apply_lambda (fun
, args
, eval_flag
)
2127 Lisp_Object fun
, args
;
2130 Lisp_Object args_left
;
2131 Lisp_Object numargs
;
2132 register Lisp_Object
*arg_vector
;
2133 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2135 register Lisp_Object tem
;
2137 numargs
= Flength (args
);
2138 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2141 GCPRO3 (*arg_vector
, args_left
, fun
);
2144 for (i
= 0; i
< XINT (numargs
);)
2146 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2147 if (eval_flag
) tem
= Feval (tem
);
2148 arg_vector
[i
++] = tem
;
2156 backtrace_list
->args
= arg_vector
;
2157 backtrace_list
->nargs
= i
;
2159 backtrace_list
->evalargs
= 0;
2160 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2162 /* Do the debug-on-exit now, while arg_vector still exists. */
2163 if (backtrace_list
->debug_on_exit
)
2164 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2165 /* Don't do it again when we return to eval. */
2166 backtrace_list
->debug_on_exit
= 0;
2170 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2171 and return the result of evaluation.
2172 FUN must be either a lambda-expression or a compiled-code object. */
2175 funcall_lambda (fun
, nargs
, arg_vector
)
2178 register Lisp_Object
*arg_vector
;
2180 Lisp_Object val
, tem
;
2181 register Lisp_Object syms_left
;
2182 Lisp_Object numargs
;
2183 register Lisp_Object next
;
2184 int count
= specpdl_ptr
- specpdl
;
2186 int optional
= 0, rest
= 0;
2188 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2190 XFASTINT (numargs
) = nargs
;
2193 syms_left
= Fcar (Fcdr (fun
));
2194 else if (COMPILEDP (fun
))
2195 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2199 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2202 next
= Fcar (syms_left
);
2203 while (!SYMBOLP (next
))
2204 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2205 if (EQ (next
, Qand_rest
))
2207 else if (EQ (next
, Qand_optional
))
2211 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2216 tem
= arg_vector
[i
++];
2217 specbind (next
, tem
);
2220 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2222 specbind (next
, Qnil
);
2226 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2229 val
= Fprogn (Fcdr (Fcdr (fun
)));
2231 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2232 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2233 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2234 return unbind_to (count
, val
);
2240 register int count
= specpdl_ptr
- specpdl
;
2241 if (specpdl_size
>= max_specpdl_size
)
2243 if (max_specpdl_size
< 400)
2244 max_specpdl_size
= 400;
2245 if (specpdl_size
>= max_specpdl_size
)
2247 if (!NILP (Vdebug_on_error
))
2248 /* Leave room for some specpdl in the debugger. */
2249 max_specpdl_size
= specpdl_size
+ 100;
2251 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2255 if (specpdl_size
> max_specpdl_size
)
2256 specpdl_size
= max_specpdl_size
;
2257 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2258 specpdl_ptr
= specpdl
+ count
;
2262 specbind (symbol
, value
)
2263 Lisp_Object symbol
, value
;
2265 extern void store_symval_forwarding (); /* in eval.c */
2268 CHECK_SYMBOL (symbol
, 0);
2270 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2272 specpdl_ptr
->symbol
= symbol
;
2273 specpdl_ptr
->func
= 0;
2274 specpdl_ptr
->old_value
= ovalue
= find_symbol_value (symbol
);
2276 if (BUFFER_OBJFWDP (ovalue
))
2277 store_symval_forwarding (symbol
, ovalue
, value
);
2279 Fset (symbol
, value
);
2283 record_unwind_protect (function
, arg
)
2284 Lisp_Object (*function
)();
2287 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2289 specpdl_ptr
->func
= function
;
2290 specpdl_ptr
->symbol
= Qnil
;
2291 specpdl_ptr
->old_value
= arg
;
2296 unbind_to (count
, value
)
2300 int quitf
= !NILP (Vquit_flag
);
2301 struct gcpro gcpro1
;
2307 while (specpdl_ptr
!= specpdl
+ count
)
2310 if (specpdl_ptr
->func
!= 0)
2311 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2312 /* Note that a "binding" of nil is really an unwind protect,
2313 so in that case the "old value" is a list of forms to evaluate. */
2314 else if (NILP (specpdl_ptr
->symbol
))
2315 Fprogn (specpdl_ptr
->old_value
);
2317 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2319 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2328 /* Get the value of symbol's global binding, even if that binding
2329 is not now dynamically visible. */
2332 top_level_value (symbol
)
2335 register struct specbinding
*ptr
= specpdl
;
2337 CHECK_SYMBOL (symbol
, 0);
2338 for (; ptr
!= specpdl_ptr
; ptr
++)
2340 if (EQ (ptr
->symbol
, symbol
))
2341 return ptr
->old_value
;
2343 return Fsymbol_value (symbol
);
2347 top_level_set (symbol
, newval
)
2348 Lisp_Object symbol
, newval
;
2350 register struct specbinding
*ptr
= specpdl
;
2352 CHECK_SYMBOL (symbol
, 0);
2353 for (; ptr
!= specpdl_ptr
; ptr
++)
2355 if (EQ (ptr
->symbol
, symbol
))
2357 ptr
->old_value
= newval
;
2361 return Fset (symbol
, newval
);
2366 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2367 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2368 The debugger is entered when that frame exits, if the flag is non-nil.")
2370 Lisp_Object level
, flag
;
2372 register struct backtrace
*backlist
= backtrace_list
;
2375 CHECK_NUMBER (level
, 0);
2377 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2379 backlist
= backlist
->next
;
2383 backlist
->debug_on_exit
= !NILP (flag
);
2388 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2389 "Print a trace of Lisp function calls currently active.\n\
2390 Output stream used is value of `standard-output'.")
2393 register struct backtrace
*backlist
= backtrace_list
;
2397 extern Lisp_Object Vprint_level
;
2398 struct gcpro gcpro1
;
2400 XFASTINT (Vprint_level
) = 3;
2407 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2408 if (backlist
->nargs
== UNEVALLED
)
2410 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2411 write_string ("\n", -1);
2415 tem
= *backlist
->function
;
2416 Fprin1 (tem
, Qnil
); /* This can QUIT */
2417 write_string ("(", -1);
2418 if (backlist
->nargs
== MANY
)
2420 for (tail
= *backlist
->args
, i
= 0;
2422 tail
= Fcdr (tail
), i
++)
2424 if (i
) write_string (" ", -1);
2425 Fprin1 (Fcar (tail
), Qnil
);
2430 for (i
= 0; i
< backlist
->nargs
; i
++)
2432 if (i
) write_string (" ", -1);
2433 Fprin1 (backlist
->args
[i
], Qnil
);
2436 write_string (")\n", -1);
2438 backlist
= backlist
->next
;
2441 Vprint_level
= Qnil
;
2446 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2447 "Return the function and arguments N frames up from current execution point.\n\
2448 If that frame has not evaluated the arguments yet (or is a special form),\n\
2449 the value is (nil FUNCTION ARG-FORMS...).\n\
2450 If that frame has evaluated its arguments and called its function already,\n\
2451 the value is (t FUNCTION ARG-VALUES...).\n\
2452 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2453 FUNCTION is whatever was supplied as car of evaluated list,\n\
2454 or a lambda expression for macro calls.\n\
2455 If N is more than the number of frames, the value is nil.")
2457 Lisp_Object nframes
;
2459 register struct backtrace
*backlist
= backtrace_list
;
2463 CHECK_NATNUM (nframes
, 0);
2465 /* Find the frame requested. */
2466 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
2467 backlist
= backlist
->next
;
2471 if (backlist
->nargs
== UNEVALLED
)
2472 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2475 if (backlist
->nargs
== MANY
)
2476 tem
= *backlist
->args
;
2478 tem
= Flist (backlist
->nargs
, backlist
->args
);
2480 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2486 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2487 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2489 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2490 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2491 This limit is to catch infinite recursions for you before they cause\n\
2492 actual stack overflow in C, which would be fatal for Emacs.\n\
2493 You can safely make it considerably larger than its default value,\n\
2494 if that proves inconveniently small.");
2496 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2497 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2498 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2501 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2502 "Non-nil inhibits C-g quitting from happening immediately.\n\
2503 Note that `quit-flag' will still be set by typing C-g,\n\
2504 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2505 To prevent this happening, set `quit-flag' to nil\n\
2506 before making `inhibit-quit' nil.");
2507 Vinhibit_quit
= Qnil
;
2509 Qinhibit_quit
= intern ("inhibit-quit");
2510 staticpro (&Qinhibit_quit
);
2512 Qautoload
= intern ("autoload");
2513 staticpro (&Qautoload
);
2515 Qdebug_on_error
= intern ("debug-on-error");
2516 staticpro (&Qdebug_on_error
);
2518 Qmacro
= intern ("macro");
2519 staticpro (&Qmacro
);
2521 /* Note that the process handling also uses Qexit, but we don't want
2522 to staticpro it twice, so we just do it here. */
2523 Qexit
= intern ("exit");
2526 Qinteractive
= intern ("interactive");
2527 staticpro (&Qinteractive
);
2529 Qcommandp
= intern ("commandp");
2530 staticpro (&Qcommandp
);
2532 Qdefun
= intern ("defun");
2533 staticpro (&Qdefun
);
2535 Qand_rest
= intern ("&rest");
2536 staticpro (&Qand_rest
);
2538 Qand_optional
= intern ("&optional");
2539 staticpro (&Qand_optional
);
2541 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2542 "*Non-nil means automatically display a backtrace buffer\n\
2543 after any error that is handled by the editor command loop.\n\
2544 If the value is a list, an error only means to display a backtrace\n\
2545 if one of its condition symbols appears in the list.");
2546 Vstack_trace_on_error
= Qnil
;
2548 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2549 "*Non-nil means enter debugger if an error is signaled.\n\
2550 Does not apply to errors handled by `condition-case'.\n\
2551 If the value is a list, an error only means to enter the debugger\n\
2552 if one of its condition symbols appears in the list.\n\
2553 See also variable `debug-on-quit'.");
2554 Vdebug_on_error
= Qnil
;
2556 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2557 "*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\
2558 Does not apply if quit is handled by a `condition-case'.");
2561 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2562 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2564 DEFVAR_LISP ("debugger", &Vdebugger
,
2565 "Function to call to invoke debugger.\n\
2566 If due to frame exit, args are `exit' and the value being returned;\n\
2567 this function's value will be returned instead of that.\n\
2568 If due to error, args are `error' and a list of the args to `signal'.\n\
2569 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2570 If due to `eval' entry, one arg, t.");
2573 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2574 staticpro (&Qmocklisp_arguments
);
2575 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2576 "While in a mocklisp function, the list of its unevaluated args.");
2577 Vmocklisp_arguments
= Qt
;
2579 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2580 "Set to the function `run-hooks', if that function has been defined.\n\
2581 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2583 staticpro (&Vautoload_queue
);
2584 Vautoload_queue
= Qnil
;
2595 defsubr (&Sfunction
);
2597 defsubr (&Sdefmacro
);
2599 defsubr (&Sdefconst
);
2600 defsubr (&Suser_variable_p
);
2604 defsubr (&Smacroexpand
);
2607 defsubr (&Sunwind_protect
);
2608 defsubr (&Scondition_case
);
2610 defsubr (&Sinteractive_p
);
2611 defsubr (&Scommandp
);
2612 defsubr (&Sautoload
);
2615 defsubr (&Sfuncall
);
2616 defsubr (&Sbacktrace_debug
);
2617 defsubr (&Sbacktrace
);
2618 defsubr (&Sbacktrace_frame
);