1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include "blockinput.h"
34 /* This definition is duplicated in alloc.c and keyboard.c */
35 /* Putting it in lisp.h makes cc bomb out! */
39 struct backtrace
*next
;
40 Lisp_Object
*function
;
41 Lisp_Object
*args
; /* Points to vector of args. */
42 int nargs
; /* Length of vector.
43 If nargs is UNEVALLED, args points to slot holding
44 list of unevalled args */
46 /* Nonzero means call value of debugger when done with this operation. */
50 struct backtrace
*backtrace_list
;
52 /* This structure helps implement the `catch' and `throw' control
53 structure. A struct catchtag contains all the information needed
54 to restore the state of the interpreter after a non-local jump.
56 Handlers for error conditions (represented by `struct handler'
57 structures) just point to a catch tag to do the cleanup required
60 catchtag structures are chained together in the C calling stack;
61 the `next' member points to the next outer catchtag.
63 A call like (throw TAG VAL) searches for a catchtag whose `tag'
64 member is TAG, and then unbinds to it. The `val' member is used to
65 hold VAL while the stack is unwound; `val' is returned as the value
68 All the other members are concerned with restoring the interpreter
74 struct catchtag
*next
;
77 struct backtrace
*backlist
;
78 struct handler
*handlerlist
;
81 int poll_suppress_count
;
84 struct catchtag
*catchlist
;
86 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
87 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
88 Lisp_Object Qmocklisp_arguments
, Vmocklisp_arguments
, Qmocklisp
;
89 Lisp_Object Qand_rest
, Qand_optional
;
90 Lisp_Object Qdebug_on_error
;
92 Lisp_Object Vrun_hooks
;
94 /* Non-nil means record all fset's and provide's, to be undone
95 if the file being autoloaded is not fully loaded.
96 They are recorded by being consed onto the front of Vautoload_queue:
97 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
99 Lisp_Object Vautoload_queue
;
101 /* Current number of specbindings allocated in specpdl. */
104 /* Pointer to beginning of specpdl. */
105 struct specbinding
*specpdl
;
107 /* Pointer to first unused element in specpdl. */
108 struct specbinding
*specpdl_ptr
;
110 /* Maximum size allowed for specpdl allocation */
111 int max_specpdl_size
;
113 /* Depth in Lisp evaluations and function calls. */
116 /* Maximum allowed depth in Lisp evaluations and function calls. */
117 int max_lisp_eval_depth
;
119 /* Nonzero means enter debugger before next function call */
120 int debug_on_next_call
;
122 /* List of conditions (non-nil atom means all) which cause a backtrace
123 if an error is handled by the command loop's error handler. */
124 Lisp_Object Vstack_trace_on_error
;
126 /* List of conditions (non-nil atom means all) which enter the debugger
127 if an error is handled by the command loop's error handler. */
128 Lisp_Object Vdebug_on_error
;
130 /* Nonzero means enter debugger if a quit signal
131 is handled by the command loop's error handler. */
134 /* The value of num_nonmacro_input_chars as of the last time we
135 started to enter the debugger. If we decide to enter the debugger
136 again when this is still equal to num_nonmacro_input_chars, then we
137 know that the debugger itself has an error, and we should just
138 signal the error instead of entering an infinite loop of debugger
140 int when_entered_debugger
;
142 Lisp_Object Vdebugger
;
144 void specbind (), record_unwind_protect ();
146 Lisp_Object
funcall_lambda ();
147 extern Lisp_Object
ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
152 specpdl
= (struct specbinding
*) malloc (specpdl_size
* sizeof (struct specbinding
));
153 max_specpdl_size
= 600;
154 max_lisp_eval_depth
= 200;
159 specpdl_ptr
= specpdl
;
164 debug_on_next_call
= 0;
166 when_entered_debugger
= 0;
173 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
174 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
175 if (specpdl_size
+ 40 > max_specpdl_size
)
176 max_specpdl_size
= specpdl_size
+ 40;
177 debug_on_next_call
= 0;
178 when_entered_debugger
= num_nonmacro_input_chars
;
179 return apply1 (Vdebugger
, arg
);
182 do_debug_on_call (code
)
185 debug_on_next_call
= 0;
186 backtrace_list
->debug_on_exit
= 1;
187 call_debugger (Fcons (code
, Qnil
));
190 /* NOTE!!! Every function that can call EVAL must protect its args
191 and temporaries from garbage collection while it needs them.
192 The definition of `For' shows what you have to do. */
194 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
195 "Eval args until one of them yields non-nil, then return that value.\n\
196 The remaining args are not evalled at all.\n\
197 If all args return nil, return nil.")
201 register Lisp_Object val
;
202 Lisp_Object args_left
;
213 val
= Feval (Fcar (args_left
));
216 args_left
= Fcdr (args_left
);
218 while (!NILP(args_left
));
224 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
225 "Eval args until one of them yields nil, then return nil.\n\
226 The remaining args are not evalled at all.\n\
227 If no arg yields nil, return the last arg's value.")
231 register Lisp_Object val
;
232 Lisp_Object args_left
;
243 val
= Feval (Fcar (args_left
));
246 args_left
= Fcdr (args_left
);
248 while (!NILP(args_left
));
254 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
255 "(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...\n\
256 Returns the value of THEN or the value of the last of the ELSE's.\n\
257 THEN must be one expression, but ELSE... can be zero or more expressions.\n\
258 If COND yields nil, and there are no ELSE's, the value is nil.")
262 register Lisp_Object cond
;
266 cond
= Feval (Fcar (args
));
270 return Feval (Fcar (Fcdr (args
)));
271 return Fprogn (Fcdr (Fcdr (args
)));
274 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
275 "(cond CLAUSES...): try each clause until one succeeds.\n\
276 Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\
277 and, if the value is non-nil, this clause succeeds:\n\
278 then the expressions in BODY are evaluated and the last one's\n\
279 value is the value of the cond-form.\n\
280 If no clause succeeds, cond returns nil.\n\
281 If a clause has one element, as in (CONDITION),\n\
282 CONDITION's value if non-nil is returned from the cond-form.")
286 register Lisp_Object clause
, val
;
293 clause
= Fcar (args
);
294 val
= Feval (Fcar (clause
));
297 if (!EQ (XCONS (clause
)->cdr
, Qnil
))
298 val
= Fprogn (XCONS (clause
)->cdr
);
301 args
= XCONS (args
)->cdr
;
308 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
309 "(progn BODY...): eval BODY forms sequentially and return value of last one.")
313 register Lisp_Object val
, tem
;
314 Lisp_Object args_left
;
317 /* In Mocklisp code, symbols at the front of the progn arglist
318 are to be bound to zero. */
319 if (!EQ (Vmocklisp_arguments
, Qt
))
321 val
= make_number (0);
322 while (!NILP (args
) && (tem
= Fcar (args
), XTYPE (tem
) == Lisp_Symbol
))
325 specbind (tem
, val
), args
= Fcdr (args
);
337 val
= Feval (Fcar (args_left
));
338 args_left
= Fcdr (args_left
);
340 while (!NILP(args_left
));
346 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
347 "(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.\n\
348 The value of FIRST is saved during the evaluation of the remaining args,\n\
349 whose values are discarded.")
354 register Lisp_Object args_left
;
355 struct gcpro gcpro1
, gcpro2
;
356 register int argnum
= 0;
368 val
= Feval (Fcar (args_left
));
370 Feval (Fcar (args_left
));
371 args_left
= Fcdr (args_left
);
373 while (!NILP(args_left
));
379 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
380 "(prog1 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
381 The value of Y is saved during the evaluation of the remaining args,\n\
382 whose values are discarded.")
387 register Lisp_Object args_left
;
388 struct gcpro gcpro1
, gcpro2
;
389 register int argnum
= -1;
403 val
= Feval (Fcar (args_left
));
405 Feval (Fcar (args_left
));
406 args_left
= Fcdr (args_left
);
408 while (!NILP(args_left
));
414 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
415 "(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
416 The SYMs are not evaluated. Thus (setq x y) sets x to the value of y.\n\
417 Each SYM is set before the next VAL is computed.")
421 register Lisp_Object args_left
;
422 register Lisp_Object val
, sym
;
433 val
= Feval (Fcar (Fcdr (args_left
)));
434 sym
= Fcar (args_left
);
436 args_left
= Fcdr (Fcdr (args_left
));
438 while (!NILP(args_left
));
444 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
445 "Return the argument, without evaluating it. `(quote x)' yields `x'.")
452 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
453 "Like `quote', but preferred for objects which are functions.\n\
454 In byte compilation, `function' causes its argument to be compiled.\n\
455 `quote' cannot do that.")
462 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
463 "Return t if function in which this appears was called interactively.\n\
464 This means that the function was called with call-interactively (which\n\
465 includes being called as the binding of a key)\n\
466 and input is currently coming from the keyboard (not in keyboard macro).")
469 register struct backtrace
*btp
;
470 register Lisp_Object fun
;
475 btp
= backtrace_list
;
477 /* If this isn't a byte-compiled function, there may be a frame at
478 the top for Finteractive_p itself. If so, skip it. */
479 fun
= Findirect_function (*btp
->function
);
480 if (XTYPE (fun
) == Lisp_Subr
481 && (struct Lisp_Subr
*) XPNTR (fun
) == &Sinteractive_p
)
484 /* If we're running an Emacs 18-style byte-compiled function, there
485 may be a frame for Fbytecode. Now, given the strictest
486 definition, this function isn't really being called
487 interactively, but because that's the way Emacs 18 always builds
488 byte-compiled functions, we'll accept it for now. */
489 if (EQ (*btp
->function
, Qbytecode
))
492 /* If this isn't a byte-compiled function, then we may now be
493 looking at several frames for special forms. Skip past them. */
495 btp
->nargs
== UNEVALLED
)
498 /* btp now points at the frame of the innermost function that isn't
499 a special form, ignoring frames for Finteractive_p and/or
500 Fbytecode at the top. If this frame is for a built-in function
501 (such as load or eval-region) return nil. */
502 fun
= Findirect_function (*btp
->function
);
503 if (XTYPE (fun
) == Lisp_Subr
)
505 /* btp points to the frame of a Lisp function that called interactive-p.
506 Return t if that function was called interactively. */
507 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
512 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
513 "(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.\n\
514 The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
515 See also the function `interactive'.")
519 register Lisp_Object fn_name
;
520 register Lisp_Object defn
;
522 fn_name
= Fcar (args
);
523 defn
= Fcons (Qlambda
, Fcdr (args
));
524 if (!NILP (Vpurify_flag
))
525 defn
= Fpurecopy (defn
);
526 Ffset (fn_name
, defn
);
527 LOADHIST_ATTACH (fn_name
);
531 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
532 "(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.\n\
533 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
534 When the macro is called, as in (NAME ARGS...),\n\
535 the function (lambda ARGLIST BODY...) is applied to\n\
536 the list ARGS... as it appears in the expression,\n\
537 and the result should be a form to be evaluated instead of the original.")
541 register Lisp_Object fn_name
;
542 register Lisp_Object defn
;
544 fn_name
= Fcar (args
);
545 defn
= Fcons (Qmacro
, Fcons (Qlambda
, Fcdr (args
)));
546 if (!NILP (Vpurify_flag
))
547 defn
= Fpurecopy (defn
);
548 Ffset (fn_name
, defn
);
549 LOADHIST_ATTACH (fn_name
);
553 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
554 "(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.\n\
555 You are not required to define a variable in order to use it,\n\
556 but the definition can supply documentation and an initial value\n\
557 in a way that tags can recognize.\n\n\
558 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
559 If SYMBOL is buffer-local, its default value is what is set;\n\
560 buffer-local values are not affected.\n\
561 INITVALUE and DOCSTRING are optional.\n\
562 If DOCSTRING starts with *, this variable is identified as a user option.\n\
563 This means that M-x set-variable and M-x edit-options recognize it.\n\
564 If INITVALUE is missing, SYMBOL's value is not set.")
568 register Lisp_Object sym
, tem
;
574 tem
= Fdefault_boundp (sym
);
576 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
578 tem
= Fcar (Fcdr (Fcdr (args
)));
581 if (!NILP (Vpurify_flag
))
582 tem
= Fpurecopy (tem
);
583 Fput (sym
, Qvariable_documentation
, tem
);
585 LOADHIST_ATTACH (sym
);
589 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
590 "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
591 The intent is that programs do not change this value, but users may.\n\
592 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
593 If SYMBOL is buffer-local, its default value is what is set;\n\
594 buffer-local values are not affected.\n\
595 DOCSTRING is optional.\n\
596 If DOCSTRING starts with *, this variable is identified as a user option.\n\
597 This means that M-x set-variable and M-x edit-options recognize it.\n\n\
598 Note: do not use `defconst' for user options in libraries that are not\n\
599 normally loaded, since it is useful for users to be able to specify\n\
600 their own values for such variables before loading the library.\n\
601 Since `defconst' unconditionally assigns the variable,\n\
602 it would override the user's choice.")
606 register Lisp_Object sym
, tem
;
609 Fset_default (sym
, Feval (Fcar (Fcdr (args
))));
610 tem
= Fcar (Fcdr (Fcdr (args
)));
613 if (!NILP (Vpurify_flag
))
614 tem
= Fpurecopy (tem
);
615 Fput (sym
, Qvariable_documentation
, tem
);
617 LOADHIST_ATTACH (sym
);
621 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
622 "Returns t if VARIABLE is intended to be set and modified by users.\n\
623 \(The alternative is a variable used internally in a Lisp program.)\n\
624 Determined by whether the first character of the documentation\n\
625 for the variable is \"*\"")
627 Lisp_Object variable
;
629 Lisp_Object documentation
;
631 documentation
= Fget (variable
, Qvariable_documentation
);
632 if (XTYPE (documentation
) == Lisp_Int
&& XINT (documentation
) < 0)
634 if ((XTYPE (documentation
) == Lisp_String
) &&
635 ((unsigned char) XSTRING (documentation
)->data
[0] == '*'))
640 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
641 "(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
642 The value of the last form in BODY is returned.\n\
643 Each element of VARLIST is a symbol (which is bound to nil)\n\
644 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
645 Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
649 Lisp_Object varlist
, val
, elt
;
650 int count
= specpdl_ptr
- specpdl
;
651 struct gcpro gcpro1
, gcpro2
, gcpro3
;
653 GCPRO3 (args
, elt
, varlist
);
655 varlist
= Fcar (args
);
656 while (!NILP (varlist
))
659 elt
= Fcar (varlist
);
660 if (XTYPE (elt
) == Lisp_Symbol
)
661 specbind (elt
, Qnil
);
662 else if (! NILP (Fcdr (Fcdr (elt
))))
664 Fcons (build_string ("`let' bindings can have only one value-form"),
668 val
= Feval (Fcar (Fcdr (elt
)));
669 specbind (Fcar (elt
), val
);
671 varlist
= Fcdr (varlist
);
674 val
= Fprogn (Fcdr (args
));
675 return unbind_to (count
, val
);
678 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
679 "(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\
680 The value of the last form in BODY is returned.\n\
681 Each element of VARLIST is a symbol (which is bound to nil)\n\
682 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
683 All the VALUEFORMs are evalled before any symbols are bound.")
687 Lisp_Object
*temps
, tem
;
688 register Lisp_Object elt
, varlist
;
689 int count
= specpdl_ptr
- specpdl
;
691 struct gcpro gcpro1
, gcpro2
;
693 varlist
= Fcar (args
);
695 /* Make space to hold the values to give the bound variables */
696 elt
= Flength (varlist
);
697 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
699 /* Compute the values and store them in `temps' */
701 GCPRO2 (args
, *temps
);
704 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
707 elt
= Fcar (varlist
);
708 if (XTYPE (elt
) == Lisp_Symbol
)
709 temps
[argnum
++] = Qnil
;
710 else if (! NILP (Fcdr (Fcdr (elt
))))
712 Fcons (build_string ("`let' bindings can have only one value-form"),
715 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
716 gcpro2
.nvars
= argnum
;
720 varlist
= Fcar (args
);
721 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
723 elt
= Fcar (varlist
);
724 tem
= temps
[argnum
++];
725 if (XTYPE (elt
) == Lisp_Symbol
)
728 specbind (Fcar (elt
), tem
);
731 elt
= Fprogn (Fcdr (args
));
732 return unbind_to (count
, elt
);
735 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
736 "(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.\n\
737 The order of execution is thus TEST, BODY, TEST, BODY and so on\n\
738 until TEST returns nil.")
742 Lisp_Object test
, body
, tem
;
743 struct gcpro gcpro1
, gcpro2
;
749 while (tem
= Feval (test
),
750 (!EQ (Vmocklisp_arguments
, Qt
) ? XINT (tem
) : !NILP (tem
)))
760 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
761 "Return result of expanding macros at top level of FORM.\n\
762 If FORM is not a macro call, it is returned unchanged.\n\
763 Otherwise, the macro is expanded and the expansion is considered\n\
764 in place of FORM. When a non-macro-call results, it is returned.\n\n\
765 The second optional arg ENVIRONMENT species an environment of macro\n\
766 definitions to shadow the loaded ones for use in file byte-compilation.")
768 register Lisp_Object form
;
771 /* With cleanups from Hallvard Furuseth. */
772 register Lisp_Object expander
, sym
, def
, tem
;
776 /* Come back here each time we expand a macro call,
777 in case it expands into another macro call. */
778 if (XTYPE (form
) != Lisp_Cons
)
780 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
781 def
= sym
= XCONS (form
)->car
;
783 /* Trace symbols aliases to other symbols
784 until we get a symbol that is not an alias. */
785 while (XTYPE (def
) == Lisp_Symbol
)
789 tem
= Fassq (sym
, env
);
792 def
= XSYMBOL (sym
)->function
;
793 if (!EQ (def
, Qunbound
))
798 /* Right now TEM is the result from SYM in ENV,
799 and if TEM is nil then DEF is SYM's function definition. */
802 /* SYM is not mentioned in ENV.
803 Look at its function definition. */
804 if (EQ (def
, Qunbound
)
805 || XTYPE (def
) != Lisp_Cons
)
806 /* Not defined or definition not suitable */
808 if (EQ (XCONS (def
)->car
, Qautoload
))
810 /* Autoloading function: will it be a macro when loaded? */
811 tem
= Fnth (make_number (4), def
);
812 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
813 /* Yes, load it and try again. */
815 do_autoload (def
, sym
);
821 else if (!EQ (XCONS (def
)->car
, Qmacro
))
823 else expander
= XCONS (def
)->cdr
;
827 expander
= XCONS (tem
)->cdr
;
831 form
= apply1 (expander
, XCONS (form
)->cdr
);
836 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
837 "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\
838 TAG is evalled to get the tag to use. Then the BODY is executed.\n\
839 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\
840 If no throw happens, `catch' returns the value of the last BODY form.\n\
841 If a throw happens, it specifies the value to return from `catch'.")
845 register Lisp_Object tag
;
849 tag
= Feval (Fcar (args
));
851 return internal_catch (tag
, Fprogn
, Fcdr (args
));
854 /* Set up a catch, then call C function FUNC on argument ARG.
855 FUNC should return a Lisp_Object.
856 This is how catches are done from within C code. */
859 internal_catch (tag
, func
, arg
)
861 Lisp_Object (*func
) ();
864 /* This structure is made part of the chain `catchlist'. */
867 /* Fill in the components of c, and put it on the list. */
871 c
.backlist
= backtrace_list
;
872 c
.handlerlist
= handlerlist
;
873 c
.lisp_eval_depth
= lisp_eval_depth
;
874 c
.pdlcount
= specpdl_ptr
- specpdl
;
875 c
.poll_suppress_count
= poll_suppress_count
;
880 if (! _setjmp (c
.jmp
))
881 c
.val
= (*func
) (arg
);
883 /* Throw works by a longjmp that comes right here. */
888 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
889 jump to that CATCH, returning VALUE as the value of that catch.
891 This is the guts Fthrow and Fsignal; they differ only in the way
892 they choose the catch tag to throw to. A catch tag for a
893 condition-case form has a TAG of Qnil.
895 Before each catch is discarded, unbind all special bindings and
896 execute all unwind-protect clauses made above that catch. Unwind
897 the handler stack as we go, so that the proper handlers are in
898 effect for each unwind-protect clause we run. At the end, restore
899 some static info saved in CATCH, and longjmp to the location
902 This is used for correct unwinding in Fthrow and Fsignal. */
905 unwind_to_catch (catch, value
)
906 struct catchtag
*catch;
909 register int last_time
;
911 /* Save the value in the tag. */
914 /* Restore the polling-suppression count. */
915 set_poll_suppress_count (catch->poll_suppress_count
);
919 last_time
= catchlist
== catch;
921 /* Unwind the specpdl stack, and then restore the proper set of
923 unbind_to (catchlist
->pdlcount
, Qnil
);
924 handlerlist
= catchlist
->handlerlist
;
925 catchlist
= catchlist
->next
;
929 gcprolist
= catch->gcpro
;
930 backtrace_list
= catch->backlist
;
931 lisp_eval_depth
= catch->lisp_eval_depth
;
933 _longjmp (catch->jmp
, 1);
936 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
937 "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
938 Both TAG and VALUE are evalled.")
940 register Lisp_Object tag
, val
;
942 register struct catchtag
*c
;
947 for (c
= catchlist
; c
; c
= c
->next
)
949 if (EQ (c
->tag
, tag
))
950 unwind_to_catch (c
, val
);
952 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (val
, Qnil
)));
957 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
958 "Do BODYFORM, protecting with UNWINDFORMS.\n\
959 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\
960 If BODYFORM completes normally, its value is returned\n\
961 after executing the UNWINDFORMS.\n\
962 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
967 int count
= specpdl_ptr
- specpdl
;
969 record_unwind_protect (0, Fcdr (args
));
970 val
= Feval (Fcar (args
));
971 return unbind_to (count
, val
);
974 /* Chain of condition handlers currently in effect.
975 The elements of this chain are contained in the stack frames
976 of Fcondition_case and internal_condition_case.
977 When an error is signaled (by calling Fsignal, below),
978 this chain is searched for an element that applies. */
980 struct handler
*handlerlist
;
982 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
983 "Regain control when an error is signaled.\n\
984 Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\
985 executes BODYFORM and returns its value if no error happens.\n\
986 Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
987 where the BODY is made of Lisp expressions.\n\n\
988 A handler is applicable to an error\n\
989 if CONDITION-NAME is one of the error's condition names.\n\
990 If an error happens, the first applicable handler is run.\n\
992 When a handler handles an error,\n\
993 control returns to the condition-case and the handler BODY... is executed\n\
994 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
995 VAR may be nil; then you do not get access to the signal information.\n\
997 The value of the last BODY form is returned from the condition-case.\n\
998 See also the function `signal' for more info.")
1005 register Lisp_Object var
, bodyform
, handlers
;
1008 bodyform
= Fcar (Fcdr (args
));
1009 handlers
= Fcdr (Fcdr (args
));
1010 CHECK_SYMBOL (var
, 0);
1012 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1016 if ((!NILP (tem
)) &&
1017 (!CONSP (tem
) || (XTYPE (XCONS (tem
)->car
) != Lisp_Symbol
)))
1018 error ("Invalid condition handler", tem
);
1023 c
.backlist
= backtrace_list
;
1024 c
.handlerlist
= handlerlist
;
1025 c
.lisp_eval_depth
= lisp_eval_depth
;
1026 c
.pdlcount
= specpdl_ptr
- specpdl
;
1027 c
.poll_suppress_count
= poll_suppress_count
;
1028 c
.gcpro
= gcprolist
;
1029 if (_setjmp (c
.jmp
))
1032 specbind (h
.var
, Fcdr (c
.val
));
1033 val
= Fprogn (Fcdr (Fcar (c
.val
)));
1035 /* Note that this just undoes the binding of h.var; whoever
1036 longjumped to us unwound the stack to c.pdlcount before
1038 unbind_to (c
.pdlcount
, Qnil
);
1045 h
.handler
= handlers
;
1046 h
.next
= handlerlist
;
1050 val
= Feval (bodyform
);
1052 handlerlist
= h
.next
;
1057 internal_condition_case (bfun
, handlers
, hfun
)
1058 Lisp_Object (*bfun
) ();
1059 Lisp_Object handlers
;
1060 Lisp_Object (*hfun
) ();
1068 c
.backlist
= backtrace_list
;
1069 c
.handlerlist
= handlerlist
;
1070 c
.lisp_eval_depth
= lisp_eval_depth
;
1071 c
.pdlcount
= specpdl_ptr
- specpdl
;
1072 c
.poll_suppress_count
= poll_suppress_count
;
1073 c
.gcpro
= gcprolist
;
1074 if (_setjmp (c
.jmp
))
1076 return (*hfun
) (Fcdr (c
.val
));
1080 h
.handler
= handlers
;
1082 h
.next
= handlerlist
;
1088 handlerlist
= h
.next
;
1092 static Lisp_Object
find_handler_clause ();
1094 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1095 "Signal an error. Args are SIGNAL-NAME, and associated DATA.\n\
1096 This function does not return.\n\n\
1097 A signal name is a symbol with an `error-conditions' property\n\
1098 that is a list of condition names.\n\
1099 A handler for any of those names will get to handle this signal.\n\
1100 The symbol `error' should normally be one of them.\n\
1102 DATA should be a list. Its elements are printed as part of the error message.\n\
1103 If the signal is handled, DATA is made available to the handler.\n\
1104 See also the function `condition-case'.")
1106 Lisp_Object sig
, data
;
1108 register struct handler
*allhandlers
= handlerlist
;
1109 Lisp_Object conditions
;
1110 extern int gc_in_progress
;
1111 extern int waiting_for_input
;
1112 Lisp_Object debugger_value
;
1114 quit_error_check ();
1116 if (gc_in_progress
|| waiting_for_input
)
1119 #ifdef HAVE_X_WINDOWS
1120 TOTALLY_UNBLOCK_INPUT
;
1123 conditions
= Fget (sig
, Qerror_conditions
);
1125 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1127 register Lisp_Object clause
;
1128 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1129 sig
, data
, &debugger_value
);
1131 #if 0 /* Most callers are not prepared to handle gc if this returns.
1132 So, since this feature is not very useful, take it out. */
1133 /* If have called debugger and user wants to continue,
1135 if (EQ (clause
, Qlambda
))
1136 return debugger_value
;
1138 if (EQ (clause
, Qlambda
))
1140 /* We can't return values to code which signalled an error, but we
1141 can continue code which has signalled a quit. */
1142 if (EQ (sig
, Qquit
))
1145 error ("Cannot return from the debugger in an error");
1151 struct handler
*h
= handlerlist
;
1152 handlerlist
= allhandlers
;
1153 unwind_to_catch (h
->tag
, Fcons (clause
, Fcons (sig
, data
)));
1157 handlerlist
= allhandlers
;
1158 /* If no handler is present now, try to run the debugger,
1159 and if that fails, throw to top level. */
1160 find_handler_clause (Qerror
, conditions
, sig
, data
, &debugger_value
);
1161 Fthrow (Qtop_level
, Qt
);
1164 /* Return nonzero iff LIST is a non-nil atom or
1165 a list containing one of CONDITIONS. */
1168 wants_debugger (list
, conditions
)
1169 Lisp_Object list
, conditions
;
1176 while (CONSP (conditions
))
1178 Lisp_Object
this, tail
;
1179 this = XCONS (conditions
)->car
;
1180 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1181 if (EQ (XCONS (tail
)->car
, this))
1183 conditions
= XCONS (conditions
)->cdr
;
1188 /* Value of Qlambda means we have called debugger and user has continued.
1189 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1192 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1193 Lisp_Object handlers
, conditions
, sig
, data
;
1194 Lisp_Object
*debugger_value_ptr
;
1196 register Lisp_Object h
;
1197 register Lisp_Object tem
;
1198 register Lisp_Object tem1
;
1200 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1202 if (EQ (handlers
, Qerror
)) /* error is used similarly, but means display a backtrace too */
1204 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1205 internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace
, Qnil
);
1206 if ((EQ (sig
, Qquit
)
1208 : wants_debugger (Vdebug_on_error
, conditions
))
1209 && when_entered_debugger
< num_nonmacro_input_chars
)
1211 int count
= specpdl_ptr
- specpdl
;
1212 specbind (Qdebug_on_error
, Qnil
);
1213 *debugger_value_ptr
=
1214 call_debugger (Fcons (Qerror
,
1215 Fcons (Fcons (sig
, data
),
1217 return unbind_to (count
, Qlambda
);
1221 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1226 tem
= Fmemq (Fcar (tem1
), conditions
);
1233 /* dump an error message; called like printf */
1237 error (m
, a1
, a2
, a3
)
1241 sprintf (buf
, m
, a1
, a2
, a3
);
1244 Fsignal (Qerror
, Fcons (build_string (buf
), Qnil
));
1247 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 1, 0,
1248 "T if FUNCTION makes provisions for interactive calling.\n\
1249 This means it contains a description for how to read arguments to give it.\n\
1250 The value is nil for an invalid function or a symbol with no function\n\
1253 Interactively callable functions include strings and vectors (treated\n\
1254 as keyboard macros), lambda-expressions that contain a top-level call\n\
1255 to `interactive', autoload definitions made by `autoload' with non-nil\n\
1256 fourth argument, and some of the built-in functions of Lisp.\n\
1258 Also, a symbol satisfies `commandp' if its function definition does so.")
1260 Lisp_Object function
;
1262 register Lisp_Object fun
;
1263 register Lisp_Object funcar
;
1264 register Lisp_Object tem
;
1269 fun
= indirect_function (fun
);
1270 if (EQ (fun
, Qunbound
))
1273 /* Emacs primitives are interactive if their DEFUN specifies an
1274 interactive spec. */
1275 if (XTYPE (fun
) == Lisp_Subr
)
1277 if (XSUBR (fun
)->prompt
)
1283 /* Bytecode objects are interactive if they are long enough to
1284 have an element whose index is COMPILED_INTERACTIVE, which is
1285 where the interactive spec is stored. */
1286 else if (XTYPE (fun
) == Lisp_Compiled
)
1287 return (XVECTOR (fun
)->size
> COMPILED_INTERACTIVE
1290 /* Strings and vectors are keyboard macros. */
1291 if (XTYPE (fun
) == Lisp_String
1292 || XTYPE (fun
) == Lisp_Vector
)
1295 /* Lists may represent commands. */
1298 funcar
= Fcar (fun
);
1299 if (XTYPE (funcar
) != Lisp_Symbol
)
1300 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1301 if (EQ (funcar
, Qlambda
))
1302 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1303 if (EQ (funcar
, Qmocklisp
))
1304 return Qt
; /* All mocklisp functions can be called interactively */
1305 if (EQ (funcar
, Qautoload
))
1306 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1312 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1313 "Define FUNCTION to autoload from FILE.\n\
1314 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
1315 Third arg DOCSTRING is documentation for the function.\n\
1316 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
1317 Fifth arg TYPE indicates the type of the object:\n\
1318 nil or omitted says FUNCTION is a function,\n\
1319 `keymap' says FUNCTION is really a keymap, and\n\
1320 `macro' or t says FUNCTION is really a macro.\n\
1321 Third through fifth args give info about the real definition.\n\
1322 They default to nil.\n\
1323 If FUNCTION is already defined other than as an autoload,\n\
1324 this does nothing and returns nil.")
1325 (function
, file
, docstring
, interactive
, type
)
1326 Lisp_Object function
, file
, docstring
, interactive
, type
;
1329 Lisp_Object args
[4];
1332 CHECK_SYMBOL (function
, 0);
1333 CHECK_STRING (file
, 1);
1335 /* If function is defined and not as an autoload, don't override */
1336 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1337 && !(XTYPE (XSYMBOL (function
)->function
) == Lisp_Cons
1338 && EQ (XCONS (XSYMBOL (function
)->function
)->car
, Qautoload
)))
1343 args
[1] = docstring
;
1344 args
[2] = interactive
;
1347 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1348 #else /* NO_ARG_ARRAY */
1349 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1350 #endif /* not NO_ARG_ARRAY */
1354 un_autoload (oldqueue
)
1355 Lisp_Object oldqueue
;
1357 register Lisp_Object queue
, first
, second
;
1359 /* Queue to unwind is current value of Vautoload_queue.
1360 oldqueue is the shadowed value to leave in Vautoload_queue. */
1361 queue
= Vautoload_queue
;
1362 Vautoload_queue
= oldqueue
;
1363 while (CONSP (queue
))
1365 first
= Fcar (queue
);
1366 second
= Fcdr (first
);
1367 first
= Fcar (first
);
1368 if (EQ (second
, Qnil
))
1371 Ffset (first
, second
);
1372 queue
= Fcdr (queue
);
1377 do_autoload (fundef
, funname
)
1378 Lisp_Object fundef
, funname
;
1380 int count
= specpdl_ptr
- specpdl
;
1381 Lisp_Object fun
, val
, queue
, first
, second
;
1384 CHECK_SYMBOL (funname
, 0);
1386 /* Value saved here is to be restored into Vautoload_queue */
1387 record_unwind_protect (un_autoload
, Vautoload_queue
);
1388 Vautoload_queue
= Qt
;
1389 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
);
1391 /* Save the old autoloads, in case we ever do an unload. */
1392 queue
= Vautoload_queue
;
1393 while (CONSP (queue
))
1395 first
= Fcar (queue
);
1396 second
= Fcdr (first
);
1397 first
= Fcar (first
);
1399 /* Note: This test is subtle. The cdr of an autoload-queue entry
1400 may be an atom if the autoload entry was generated by a defalias
1403 Fput (first
, Qautoload
, (Fcdr (second
)));
1405 queue
= Fcdr (queue
);
1408 /* Once loading finishes, don't undo it. */
1409 Vautoload_queue
= Qt
;
1410 unbind_to (count
, Qnil
);
1412 fun
= Findirect_function (fun
);
1414 if (!NILP (Fequal (fun
, fundef
)))
1415 error ("Autoloading failed to define function %s",
1416 XSYMBOL (funname
)->name
->data
);
1419 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1420 "Evaluate FORM and return its value.")
1424 Lisp_Object fun
, val
, original_fun
, original_args
;
1426 struct backtrace backtrace
;
1427 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1429 if (XTYPE (form
) == Lisp_Symbol
)
1431 if (EQ (Vmocklisp_arguments
, Qt
))
1432 return Fsymbol_value (form
);
1433 val
= Fsymbol_value (form
);
1436 else if (EQ (val
, Qt
))
1444 if (consing_since_gc
> gc_cons_threshold
)
1447 Fgarbage_collect ();
1451 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1453 if (max_lisp_eval_depth
< 100)
1454 max_lisp_eval_depth
= 100;
1455 if (lisp_eval_depth
> max_lisp_eval_depth
)
1456 error ("Lisp nesting exceeds max-lisp-eval-depth");
1459 original_fun
= Fcar (form
);
1460 original_args
= Fcdr (form
);
1462 backtrace
.next
= backtrace_list
;
1463 backtrace_list
= &backtrace
;
1464 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1465 backtrace
.args
= &original_args
;
1466 backtrace
.nargs
= UNEVALLED
;
1467 backtrace
.evalargs
= 1;
1468 backtrace
.debug_on_exit
= 0;
1470 if (debug_on_next_call
)
1471 do_debug_on_call (Qt
);
1473 /* At this point, only original_fun and original_args
1474 have values that will be used below */
1476 fun
= Findirect_function (original_fun
);
1478 if (XTYPE (fun
) == Lisp_Subr
)
1480 Lisp_Object numargs
;
1481 Lisp_Object argvals
[7];
1482 Lisp_Object args_left
;
1483 register int i
, maxargs
;
1485 args_left
= original_args
;
1486 numargs
= Flength (args_left
);
1488 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
1489 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
1490 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
1492 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1494 backtrace
.evalargs
= 0;
1495 val
= (*XSUBR (fun
)->function
) (args_left
);
1499 if (XSUBR (fun
)->max_args
== MANY
)
1501 /* Pass a vector of evaluated arguments */
1503 register int argnum
= 0;
1505 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
1507 GCPRO3 (args_left
, fun
, fun
);
1511 while (!NILP (args_left
))
1513 vals
[argnum
++] = Feval (Fcar (args_left
));
1514 args_left
= Fcdr (args_left
);
1515 gcpro3
.nvars
= argnum
;
1518 backtrace
.args
= vals
;
1519 backtrace
.nargs
= XINT (numargs
);
1521 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
1526 GCPRO3 (args_left
, fun
, fun
);
1527 gcpro3
.var
= argvals
;
1530 maxargs
= XSUBR (fun
)->max_args
;
1531 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
1533 argvals
[i
] = Feval (Fcar (args_left
));
1539 backtrace
.args
= argvals
;
1540 backtrace
.nargs
= XINT (numargs
);
1545 val
= (*XSUBR (fun
)->function
) ();
1548 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
1551 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
1554 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1558 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
1559 argvals
[2], argvals
[3]);
1562 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1563 argvals
[3], argvals
[4]);
1566 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1567 argvals
[3], argvals
[4], argvals
[5]);
1570 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
1571 argvals
[3], argvals
[4], argvals
[5],
1576 /* Someone has created a subr that takes more arguments than
1577 is supported by this code. We need to either rewrite the
1578 subr to use a different argument protocol, or add more
1579 cases to this switch. */
1583 if (XTYPE (fun
) == Lisp_Compiled
)
1584 val
= apply_lambda (fun
, original_args
, 1);
1588 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1589 funcar
= Fcar (fun
);
1590 if (XTYPE (funcar
) != Lisp_Symbol
)
1591 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1592 if (EQ (funcar
, Qautoload
))
1594 do_autoload (fun
, original_fun
);
1597 if (EQ (funcar
, Qmacro
))
1598 val
= Feval (apply1 (Fcdr (fun
), original_args
));
1599 else if (EQ (funcar
, Qlambda
))
1600 val
= apply_lambda (fun
, original_args
, 1);
1601 else if (EQ (funcar
, Qmocklisp
))
1602 val
= ml_apply (fun
, original_args
);
1604 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1607 if (!EQ (Vmocklisp_arguments
, Qt
))
1611 else if (EQ (val
, Qt
))
1615 if (backtrace
.debug_on_exit
)
1616 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
1617 backtrace_list
= backtrace
.next
;
1621 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
1622 "Call FUNCTION with our remaining args, using our last arg as list of args.\n\
1623 Thus, (apply '+ 1 2 '(3 4)) returns 10.")
1628 register int i
, numargs
;
1629 register Lisp_Object spread_arg
;
1630 register Lisp_Object
*funcall_args
;
1632 struct gcpro gcpro1
;
1636 spread_arg
= args
[nargs
- 1];
1637 CHECK_LIST (spread_arg
, nargs
);
1639 numargs
= XINT (Flength (spread_arg
));
1642 return Ffuncall (nargs
- 1, args
);
1643 else if (numargs
== 1)
1645 args
[nargs
- 1] = XCONS (spread_arg
)->car
;
1646 return Ffuncall (nargs
, args
);
1649 numargs
+= nargs
- 2;
1651 fun
= indirect_function (fun
);
1652 if (EQ (fun
, Qunbound
))
1654 /* Let funcall get the error */
1659 if (XTYPE (fun
) == Lisp_Subr
)
1661 if (numargs
< XSUBR (fun
)->min_args
1662 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1663 goto funcall
; /* Let funcall get the error */
1664 else if (XSUBR (fun
)->max_args
> numargs
)
1666 /* Avoid making funcall cons up a yet another new vector of arguments
1667 by explicitly supplying nil's for optional values */
1668 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
1669 * sizeof (Lisp_Object
));
1670 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
1671 funcall_args
[++i
] = Qnil
;
1672 GCPRO1 (*funcall_args
);
1673 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
1677 /* We add 1 to numargs because funcall_args includes the
1678 function itself as well as its arguments. */
1681 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
1682 * sizeof (Lisp_Object
));
1683 GCPRO1 (*funcall_args
);
1684 gcpro1
.nvars
= 1 + numargs
;
1687 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
1688 /* Spread the last arg we got. Its first element goes in
1689 the slot that it used to occupy, hence this value of I. */
1691 while (!NILP (spread_arg
))
1693 funcall_args
[i
++] = XCONS (spread_arg
)->car
;
1694 spread_arg
= XCONS (spread_arg
)->cdr
;
1697 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
1700 /* Apply fn to arg */
1703 Lisp_Object fn
, arg
;
1705 struct gcpro gcpro1
;
1709 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1713 Lisp_Object args
[2];
1717 RETURN_UNGCPRO (Fapply (2, args
));
1719 #else /* not NO_ARG_ARRAY */
1720 RETURN_UNGCPRO (Fapply (2, &fn
));
1721 #endif /* not NO_ARG_ARRAY */
1724 /* Call function fn on no arguments */
1729 struct gcpro gcpro1
;
1732 RETURN_UNGCPRO (Ffuncall (1, &fn
));
1735 /* Call function fn with 1 argument arg1 */
1739 Lisp_Object fn
, arg1
;
1741 struct gcpro gcpro1
;
1743 Lisp_Object args
[2];
1749 RETURN_UNGCPRO (Ffuncall (2, args
));
1750 #else /* not NO_ARG_ARRAY */
1753 RETURN_UNGCPRO (Ffuncall (2, &fn
));
1754 #endif /* not NO_ARG_ARRAY */
1757 /* Call function fn with 2 arguments arg1, arg2 */
1760 call2 (fn
, arg1
, arg2
)
1761 Lisp_Object fn
, arg1
, arg2
;
1763 struct gcpro gcpro1
;
1765 Lisp_Object args
[3];
1771 RETURN_UNGCPRO (Ffuncall (3, args
));
1772 #else /* not NO_ARG_ARRAY */
1775 RETURN_UNGCPRO (Ffuncall (3, &fn
));
1776 #endif /* not NO_ARG_ARRAY */
1779 /* Call function fn with 3 arguments arg1, arg2, arg3 */
1782 call3 (fn
, arg1
, arg2
, arg3
)
1783 Lisp_Object fn
, arg1
, arg2
, arg3
;
1785 struct gcpro gcpro1
;
1787 Lisp_Object args
[4];
1794 RETURN_UNGCPRO (Ffuncall (4, args
));
1795 #else /* not NO_ARG_ARRAY */
1798 RETURN_UNGCPRO (Ffuncall (4, &fn
));
1799 #endif /* not NO_ARG_ARRAY */
1802 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
1805 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
1806 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
1808 struct gcpro gcpro1
;
1810 Lisp_Object args
[5];
1818 RETURN_UNGCPRO (Ffuncall (5, args
));
1819 #else /* not NO_ARG_ARRAY */
1822 RETURN_UNGCPRO (Ffuncall (5, &fn
));
1823 #endif /* not NO_ARG_ARRAY */
1826 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
1829 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
1830 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
1832 struct gcpro gcpro1
;
1834 Lisp_Object args
[6];
1843 RETURN_UNGCPRO (Ffuncall (6, args
));
1844 #else /* not NO_ARG_ARRAY */
1847 RETURN_UNGCPRO (Ffuncall (6, &fn
));
1848 #endif /* not NO_ARG_ARRAY */
1851 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
1854 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
1855 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
1857 struct gcpro gcpro1
;
1859 Lisp_Object args
[7];
1869 RETURN_UNGCPRO (Ffuncall (7, args
));
1870 #else /* not NO_ARG_ARRAY */
1873 RETURN_UNGCPRO (Ffuncall (7, &fn
));
1874 #endif /* not NO_ARG_ARRAY */
1877 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
1878 "Call first argument as a function, passing remaining arguments to it.\n\
1879 Thus, (funcall 'cons 'x 'y) returns (x . y).")
1886 int numargs
= nargs
- 1;
1887 Lisp_Object lisp_numargs
;
1889 struct backtrace backtrace
;
1890 register Lisp_Object
*internal_args
;
1894 if (consing_since_gc
> gc_cons_threshold
)
1895 Fgarbage_collect ();
1897 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1899 if (max_lisp_eval_depth
< 100)
1900 max_lisp_eval_depth
= 100;
1901 if (lisp_eval_depth
> max_lisp_eval_depth
)
1902 error ("Lisp nesting exceeds max-lisp-eval-depth");
1905 backtrace
.next
= backtrace_list
;
1906 backtrace_list
= &backtrace
;
1907 backtrace
.function
= &args
[0];
1908 backtrace
.args
= &args
[1];
1909 backtrace
.nargs
= nargs
- 1;
1910 backtrace
.evalargs
= 0;
1911 backtrace
.debug_on_exit
= 0;
1913 if (debug_on_next_call
)
1914 do_debug_on_call (Qlambda
);
1920 fun
= Findirect_function (fun
);
1922 if (XTYPE (fun
) == Lisp_Subr
)
1924 if (numargs
< XSUBR (fun
)->min_args
1925 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
1927 XFASTINT (lisp_numargs
) = numargs
;
1928 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
1931 if (XSUBR (fun
)->max_args
== UNEVALLED
)
1932 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1934 if (XSUBR (fun
)->max_args
== MANY
)
1936 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
1940 if (XSUBR (fun
)->max_args
> numargs
)
1942 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
1943 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
1944 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
1945 internal_args
[i
] = Qnil
;
1948 internal_args
= args
+ 1;
1949 switch (XSUBR (fun
)->max_args
)
1952 val
= (*XSUBR (fun
)->function
) ();
1955 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
1958 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
1962 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1966 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1971 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1972 internal_args
[2], internal_args
[3],
1976 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1977 internal_args
[2], internal_args
[3],
1978 internal_args
[4], internal_args
[5]);
1981 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
1982 internal_args
[2], internal_args
[3],
1983 internal_args
[4], internal_args
[5],
1989 /* If a subr takes more than 6 arguments without using MANY
1990 or UNEVALLED, we need to extend this function to support it.
1991 Until this is done, there is no way to call the function. */
1995 if (XTYPE (fun
) == Lisp_Compiled
)
1996 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2000 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2001 funcar
= Fcar (fun
);
2002 if (XTYPE (funcar
) != Lisp_Symbol
)
2003 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2004 if (EQ (funcar
, Qlambda
))
2005 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2006 else if (EQ (funcar
, Qmocklisp
))
2007 val
= ml_apply (fun
, Flist (numargs
, args
+ 1));
2008 else if (EQ (funcar
, Qautoload
))
2010 do_autoload (fun
, args
[0]);
2014 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2018 if (backtrace
.debug_on_exit
)
2019 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2020 backtrace_list
= backtrace
.next
;
2025 apply_lambda (fun
, args
, eval_flag
)
2026 Lisp_Object fun
, args
;
2029 Lisp_Object args_left
;
2030 Lisp_Object numargs
;
2031 register Lisp_Object
*arg_vector
;
2032 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2034 register Lisp_Object tem
;
2036 numargs
= Flength (args
);
2037 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2040 GCPRO3 (*arg_vector
, args_left
, fun
);
2043 for (i
= 0; i
< XINT (numargs
);)
2045 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2046 if (eval_flag
) tem
= Feval (tem
);
2047 arg_vector
[i
++] = tem
;
2055 backtrace_list
->args
= arg_vector
;
2056 backtrace_list
->nargs
= i
;
2058 backtrace_list
->evalargs
= 0;
2059 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2061 /* Do the debug-on-exit now, while arg_vector still exists. */
2062 if (backtrace_list
->debug_on_exit
)
2063 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2064 /* Don't do it again when we return to eval. */
2065 backtrace_list
->debug_on_exit
= 0;
2069 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2070 and return the result of evaluation.
2071 FUN must be either a lambda-expression or a compiled-code object. */
2074 funcall_lambda (fun
, nargs
, arg_vector
)
2077 register Lisp_Object
*arg_vector
;
2079 Lisp_Object val
, tem
;
2080 register Lisp_Object syms_left
;
2081 Lisp_Object numargs
;
2082 register Lisp_Object next
;
2083 int count
= specpdl_ptr
- specpdl
;
2085 int optional
= 0, rest
= 0;
2087 specbind (Qmocklisp_arguments
, Qt
); /* t means NOT mocklisp! */
2089 XFASTINT (numargs
) = nargs
;
2091 if (XTYPE (fun
) == Lisp_Cons
)
2092 syms_left
= Fcar (Fcdr (fun
));
2093 else if (XTYPE (fun
) == Lisp_Compiled
)
2094 syms_left
= XVECTOR (fun
)->contents
[COMPILED_ARGLIST
];
2098 for (; !NILP (syms_left
); syms_left
= Fcdr (syms_left
))
2101 next
= Fcar (syms_left
);
2102 while (XTYPE (next
) != Lisp_Symbol
)
2103 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2104 if (EQ (next
, Qand_rest
))
2106 else if (EQ (next
, Qand_optional
))
2110 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2115 tem
= arg_vector
[i
++];
2116 specbind (next
, tem
);
2119 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2121 specbind (next
, Qnil
);
2125 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2127 if (XTYPE (fun
) == Lisp_Cons
)
2128 val
= Fprogn (Fcdr (Fcdr (fun
)));
2130 val
= Fbyte_code (XVECTOR (fun
)->contents
[COMPILED_BYTECODE
],
2131 XVECTOR (fun
)->contents
[COMPILED_CONSTANTS
],
2132 XVECTOR (fun
)->contents
[COMPILED_STACK_DEPTH
]);
2133 return unbind_to (count
, val
);
2139 register int count
= specpdl_ptr
- specpdl
;
2140 if (specpdl_size
>= max_specpdl_size
)
2142 if (max_specpdl_size
< 400)
2143 max_specpdl_size
= 400;
2144 if (specpdl_size
>= max_specpdl_size
)
2146 if (!NILP (Vdebug_on_error
))
2147 /* Leave room for some specpdl in the debugger. */
2148 max_specpdl_size
= specpdl_size
+ 100;
2150 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2154 if (specpdl_size
> max_specpdl_size
)
2155 specpdl_size
= max_specpdl_size
;
2156 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2157 specpdl_ptr
= specpdl
+ count
;
2161 specbind (symbol
, value
)
2162 Lisp_Object symbol
, value
;
2164 extern void store_symval_forwarding (); /* in eval.c */
2167 CHECK_SYMBOL (symbol
, 0);
2169 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2171 specpdl_ptr
->symbol
= symbol
;
2172 specpdl_ptr
->func
= 0;
2173 ovalue
= XSYMBOL (symbol
)->value
;
2174 specpdl_ptr
->old_value
= EQ (ovalue
, Qunbound
) ? Qunbound
: Fsymbol_value (symbol
);
2176 if (XTYPE (ovalue
) == Lisp_Buffer_Objfwd
)
2177 store_symval_forwarding (symbol
, ovalue
, value
);
2179 Fset (symbol
, value
);
2183 record_unwind_protect (function
, arg
)
2184 Lisp_Object (*function
)();
2187 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2189 specpdl_ptr
->func
= function
;
2190 specpdl_ptr
->symbol
= Qnil
;
2191 specpdl_ptr
->old_value
= arg
;
2196 unbind_to (count
, value
)
2200 int quitf
= !NILP (Vquit_flag
);
2201 struct gcpro gcpro1
;
2207 while (specpdl_ptr
!= specpdl
+ count
)
2210 if (specpdl_ptr
->func
!= 0)
2211 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
2212 /* Note that a "binding" of nil is really an unwind protect,
2213 so in that case the "old value" is a list of forms to evaluate. */
2214 else if (NILP (specpdl_ptr
->symbol
))
2215 Fprogn (specpdl_ptr
->old_value
);
2217 Fset (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
2219 if (NILP (Vquit_flag
) && quitf
) Vquit_flag
= Qt
;
2228 /* Get the value of symbol's global binding, even if that binding
2229 is not now dynamically visible. */
2232 top_level_value (symbol
)
2235 register struct specbinding
*ptr
= specpdl
;
2237 CHECK_SYMBOL (symbol
, 0);
2238 for (; ptr
!= specpdl_ptr
; ptr
++)
2240 if (EQ (ptr
->symbol
, symbol
))
2241 return ptr
->old_value
;
2243 return Fsymbol_value (symbol
);
2247 top_level_set (symbol
, newval
)
2248 Lisp_Object symbol
, newval
;
2250 register struct specbinding
*ptr
= specpdl
;
2252 CHECK_SYMBOL (symbol
, 0);
2253 for (; ptr
!= specpdl_ptr
; ptr
++)
2255 if (EQ (ptr
->symbol
, symbol
))
2257 ptr
->old_value
= newval
;
2261 return Fset (symbol
, newval
);
2266 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
2267 "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
2268 The debugger is entered when that frame exits, if the flag is non-nil.")
2270 Lisp_Object level
, flag
;
2272 register struct backtrace
*backlist
= backtrace_list
;
2275 CHECK_NUMBER (level
, 0);
2277 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
2279 backlist
= backlist
->next
;
2283 backlist
->debug_on_exit
= !NILP (flag
);
2288 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
2289 "Print a trace of Lisp function calls currently active.\n\
2290 Output stream used is value of `standard-output'.")
2293 register struct backtrace
*backlist
= backtrace_list
;
2297 extern Lisp_Object Vprint_level
;
2298 struct gcpro gcpro1
;
2300 XFASTINT (Vprint_level
) = 3;
2307 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
2308 if (backlist
->nargs
== UNEVALLED
)
2310 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
2314 tem
= *backlist
->function
;
2315 Fprin1 (tem
, Qnil
); /* This can QUIT */
2316 write_string ("(", -1);
2317 if (backlist
->nargs
== MANY
)
2319 for (tail
= *backlist
->args
, i
= 0;
2321 tail
= Fcdr (tail
), i
++)
2323 if (i
) write_string (" ", -1);
2324 Fprin1 (Fcar (tail
), Qnil
);
2329 for (i
= 0; i
< backlist
->nargs
; i
++)
2331 if (i
) write_string (" ", -1);
2332 Fprin1 (backlist
->args
[i
], Qnil
);
2336 write_string (")\n", -1);
2337 backlist
= backlist
->next
;
2340 Vprint_level
= Qnil
;
2345 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, "",
2346 "Return the function and arguments N frames up from current execution point.\n\
2347 If that frame has not evaluated the arguments yet (or is a special form),\n\
2348 the value is (nil FUNCTION ARG-FORMS...).\n\
2349 If that frame has evaluated its arguments and called its function already,\n\
2350 the value is (t FUNCTION ARG-VALUES...).\n\
2351 A &rest arg is represented as the tail of the list ARG-VALUES.\n\
2352 FUNCTION is whatever was supplied as car of evaluated list,\n\
2353 or a lambda expression for macro calls.\n\
2354 If N is more than the number of frames, the value is nil.")
2356 Lisp_Object nframes
;
2358 register struct backtrace
*backlist
= backtrace_list
;
2362 CHECK_NATNUM (nframes
, 0);
2364 /* Find the frame requested. */
2365 for (i
= 0; i
< XFASTINT (nframes
); i
++)
2366 backlist
= backlist
->next
;
2370 if (backlist
->nargs
== UNEVALLED
)
2371 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
2374 if (backlist
->nargs
== MANY
)
2375 tem
= *backlist
->args
;
2377 tem
= Flist (backlist
->nargs
, backlist
->args
);
2379 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
2385 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
2386 "Limit on number of Lisp variable bindings & unwind-protects before error.");
2388 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
2389 "Limit on depth in `eval', `apply' and `funcall' before error.\n\
2390 This limit is to catch infinite recursions for you before they cause\n\
2391 actual stack overflow in C, which would be fatal for Emacs.\n\
2392 You can safely make it considerably larger than its default value,\n\
2393 if that proves inconveniently small.");
2395 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
2396 "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
2397 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
2400 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
2401 "Non-nil inhibits C-g quitting from happening immediately.\n\
2402 Note that `quit-flag' will still be set by typing C-g,\n\
2403 so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
2404 To prevent this happening, set `quit-flag' to nil\n\
2405 before making `inhibit-quit' nil.");
2406 Vinhibit_quit
= Qnil
;
2408 Qinhibit_quit
= intern ("inhibit-quit");
2409 staticpro (&Qinhibit_quit
);
2411 Qautoload
= intern ("autoload");
2412 staticpro (&Qautoload
);
2414 Qdebug_on_error
= intern ("debug-on-error");
2415 staticpro (&Qdebug_on_error
);
2417 Qmacro
= intern ("macro");
2418 staticpro (&Qmacro
);
2420 /* Note that the process handling also uses Qexit, but we don't want
2421 to staticpro it twice, so we just do it here. */
2422 Qexit
= intern ("exit");
2425 Qinteractive
= intern ("interactive");
2426 staticpro (&Qinteractive
);
2428 Qcommandp
= intern ("commandp");
2429 staticpro (&Qcommandp
);
2431 Qdefun
= intern ("defun");
2432 staticpro (&Qdefun
);
2434 Qand_rest
= intern ("&rest");
2435 staticpro (&Qand_rest
);
2437 Qand_optional
= intern ("&optional");
2438 staticpro (&Qand_optional
);
2440 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
2441 "*Non-nil means automatically display a backtrace buffer\n\
2442 after any error that is handled by the editor command loop.\n\
2443 If the value is a list, an error only means to display a backtrace\n\
2444 if one of its condition symbols appears in the list.");
2445 Vstack_trace_on_error
= Qnil
;
2447 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
2448 "*Non-nil means enter debugger if an error is signaled.\n\
2449 Does not apply to errors handled by `condition-case'.\n\
2450 If the value is a list, an error only means to enter the debugger\n\
2451 if one of its condition symbols appears in the list.\n\
2452 See also variable `debug-on-quit'.");
2453 Vdebug_on_error
= Qnil
;
2455 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
2456 "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
2457 Does not apply if quit is handled by a `condition-case'.");
2460 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
2461 "Non-nil means enter debugger before next `eval', `apply' or `funcall'.");
2463 DEFVAR_LISP ("debugger", &Vdebugger
,
2464 "Function to call to invoke debugger.\n\
2465 If due to frame exit, args are `exit' and the value being returned;\n\
2466 this function's value will be returned instead of that.\n\
2467 If due to error, args are `error' and a list of the args to `signal'.\n\
2468 If due to `apply' or `funcall' entry, one arg, `lambda'.\n\
2469 If due to `eval' entry, one arg, t.");
2472 Qmocklisp_arguments
= intern ("mocklisp-arguments");
2473 staticpro (&Qmocklisp_arguments
);
2474 DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments
,
2475 "While in a mocklisp function, the list of its unevaluated args.");
2476 Vmocklisp_arguments
= Qt
;
2478 DEFVAR_LISP ("run-hooks", &Vrun_hooks
,
2479 "Set to the function `run-hooks', if that function has been defined.\n\
2480 Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
2483 staticpro (&Vautoload_queue
);
2484 Vautoload_queue
= Qnil
;
2495 defsubr (&Sfunction
);
2497 defsubr (&Sdefmacro
);
2499 defsubr (&Sdefconst
);
2500 defsubr (&Suser_variable_p
);
2504 defsubr (&Smacroexpand
);
2507 defsubr (&Sunwind_protect
);
2508 defsubr (&Scondition_case
);
2510 defsubr (&Sinteractive_p
);
2511 defsubr (&Scommandp
);
2512 defsubr (&Sautoload
);
2515 defsubr (&Sfuncall
);
2516 defsubr (&Sbacktrace_debug
);
2517 defsubr (&Sbacktrace
);
2518 defsubr (&Sbacktrace_frame
);