1 /* Evaluator for XEmacs Lisp interpreter.
2 Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: FSF 19.30 (except for Fsignal), Mule 2.0. */
32 #include "backtrace.h"
38 struct backtrace *backtrace_list;
40 /* Note you must always fill all of the fields in a backtrace structure
41 before pushing them on the backtrace_list. The profiling code depends
44 #define PUSH_BACKTRACE(bt) \
45 do { (bt).next = backtrace_list; backtrace_list = &(bt); } while (0)
47 #define POP_BACKTRACE(bt) \
48 do { backtrace_list = (bt).next; } while (0)
50 /* This is the list of current catches (and also condition-cases).
51 This is a stack: the most recent catch is at the head of the
52 list. Catches are created by declaring a 'struct catchtag'
53 locally, filling the .TAG field in with the tag, and doing
54 a setjmp() on .JMP. Fthrow() will store the value passed
55 to it in .VAL and longjmp() back to .JMP, back to the function
56 that established the catch. This will always be either
57 internal_catch() (catches established internally or through
58 `catch') or condition_case_1 (condition-cases established
59 internally or through `condition-case').
61 The catchtag also records the current position in the
62 call stack (stored in BACKTRACE_LIST), the current position
63 in the specpdl stack (used for variable bindings and
64 unwind-protects), the value of LISP_EVAL_DEPTH, and the
65 current position in the GCPRO stack. All of these are
69 struct catchtag *catchlist;
71 Lisp_Object Qautoload, Qmacro, Qexit;
72 Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
73 Lisp_Object Vquit_flag, Vinhibit_quit;
74 Lisp_Object Qand_rest, Qand_optional;
75 Lisp_Object Qdebug_on_error, Qstack_trace_on_error;
76 Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal;
77 Lisp_Object Qdebugger;
78 Lisp_Object Qinhibit_quit;
79 Lisp_Object Qrun_hooks;
81 Lisp_Object Qdisplay_warning;
82 Lisp_Object Vpending_warnings, Vpending_warnings_tail;
84 /* Records whether we want errors to occur. This will be a boolean,
85 nil (errors OK) or t (no errors). If t, an error will cause a
86 throw to Qunbound_suspended_errors_tag.
88 See call_with_suspended_errors(). */
89 Lisp_Object Vcurrent_error_state;
91 /* Current warning class when warnings occur, or nil for no warnings.
92 Only meaningful when Vcurrent_error_state is non-nil.
93 See call_with_suspended_errors(). */
94 Lisp_Object Vcurrent_warning_class;
96 /* Special catch tag used in call_with_suspended_errors(). */
97 Lisp_Object Qunbound_suspended_errors_tag;
99 /* Non-nil means we're going down, so we better not run any hooks
100 or do other non-essential stuff. */
101 int preparing_for_armageddon;
103 /* Non-nil means record all fset's and provide's, to be undone
104 if the file being autoloaded is not fully loaded.
105 They are recorded by being consed onto the front of Vautoload_queue:
106 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
108 Lisp_Object Vautoload_queue;
110 /* Current number of specbindings allocated in specpdl. */
111 static int specpdl_size;
113 /* Pointer to beginning of specpdl. */
114 struct specbinding *specpdl;
116 /* Pointer to first unused element in specpdl. */
117 struct specbinding *specpdl_ptr;
119 /* specpdl_ptr - specpdl. Callers outside this file should use
120 * specpdl_depth () function-call */
121 static int specpdl_depth_counter;
123 /* Maximum size allowed for specpdl allocation */
124 int max_specpdl_size;
126 /* Depth in Lisp evaluations and function calls. */
129 /* Maximum allowed depth in Lisp evaluations and function calls. */
130 int max_lisp_eval_depth;
132 /* Nonzero means enter debugger before next function call */
133 static int debug_on_next_call;
135 /* List of conditions (non-nil atom means all) which cause a backtrace
136 if an error is handled by the command loop's error handler. */
137 Lisp_Object Vstack_trace_on_error;
139 /* List of conditions (non-nil atom means all) which enter the debugger
140 if an error is handled by the command loop's error handler. */
141 Lisp_Object Vdebug_on_error;
143 /* List of conditions and regexps specifying error messages which
144 do not enter the debugger even if Vdebug_on_error says they should. */
145 Lisp_Object Vdebug_ignored_errors;
147 /* List of conditions (non-nil atom means all) which cause a backtrace
148 if any error is signalled. */
149 Lisp_Object Vstack_trace_on_signal;
151 /* List of conditions (non-nil atom means all) which enter the debugger
152 if any error is signalled. */
153 Lisp_Object Vdebug_on_signal;
155 /* Nonzero means enter debugger if a quit signal
156 is handled by the command loop's error handler.
158 From lisp, this is a boolean variable and may have the values 0 and 1.
159 But, eval.c temporarily uses the second bit of this variable to indicate
160 that a critical_quit is in progress. The second bit is reset immediately
161 after it is processed in signal_call_debugger(). */
165 /* entering_debugger is basically equivalent */
166 /* The value of num_nonmacro_input_chars as of the last time we
167 started to enter the debugger. If we decide to enter the debugger
168 again when this is still equal to num_nonmacro_input_chars, then we
169 know that the debugger itself has an error, and we should just
170 signal the error instead of entering an infinite loop of debugger
172 int when_entered_debugger;
175 /* Nonzero means we are trying to enter the debugger.
176 This is to prevent recursive attempts.
177 Cleared by the debugger calling Fbacktrace */
178 static int entering_debugger;
180 /* Function to call to invoke the debugger */
181 Lisp_Object Vdebugger;
183 /* Chain of condition handlers currently in effect.
184 The elements of this chain are contained in the stack frames
185 of Fcondition_case and internal_condition_case.
186 When an error is signaled (by calling Fsignal, below),
187 this chain is searched for an element that applies.
189 Each element of this list is one of the following:
191 A list of a handler function and possibly args to pass to
192 the function. This is a handler established with
193 `call-with-condition-handler' (q.v.).
195 A list whose car is Qunbound and whose cdr is Qt.
196 This is a special condition-case handler established
197 by C code with condition_case_1(). All errors are
198 trapped; the debugger is not invoked even if
199 `debug-on-error' was set.
201 A list whose car is Qunbound and whose cdr is Qerror.
202 This is a special condition-case handler established
203 by C code with condition_case_1(). It is like Qt
204 except that the debugger is invoked normally if it is
207 A list whose car is Qunbound and whose cdr is a list
208 of lists (CONDITION-NAME BODY ...) exactly as in
209 `condition-case'. This is a normal `condition-case'
212 Note that in all cases *except* the first, there is a
213 corresponding catch, whose TAG is the value of
214 Vcondition_handlers just after the handler data just
215 described is pushed onto it. The reason is that
216 `condition-case' handlers need to throw back to the
217 place where the handler was installed before invoking
218 it, while `call-with-condition-handler' handlers are
219 invoked in the environment that `signal' was invoked
222 static Lisp_Object Vcondition_handlers;
224 /* Used for error catching purposes by throw_or_bomb_out */
225 static int throw_level;
227 static Lisp_Object primitive_funcall (lisp_fn_t fn, int nargs,
231 /**********************************************************************/
232 /* The subr and compiled-function types */
233 /**********************************************************************/
236 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
238 struct Lisp_Subr *subr = XSUBR (obj);
241 error ("printing unreadable object #<subr %s>",
244 write_c_string (((subr->max_args == UNEVALLED)
249 write_c_string (subr_name (subr), printcharfun);
250 write_c_string (((subr->prompt) ? " (interactive)>" : ">"),
254 DEFINE_LRECORD_IMPLEMENTATION ("subr", subr,
255 this_one_is_unmarkable, print_subr, 0, 0, 0,
259 mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object))
261 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (obj);
263 ((markobj) (b->bytecodes));
264 ((markobj) (b->arglist));
265 ((markobj) (b->doc_and_interactive));
266 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
267 ((markobj) (b->annotated));
269 /* tail-recurse on constants */
274 compiled_function_equal (Lisp_Object o1, Lisp_Object o2, int depth)
276 struct Lisp_Compiled_Function *b1 = XCOMPILED_FUNCTION (o1);
277 struct Lisp_Compiled_Function *b2 = XCOMPILED_FUNCTION (o2);
279 (b1->flags.documentationp == b2->flags.documentationp &&
280 b1->flags.interactivep == b2->flags.interactivep &&
281 b1->flags.domainp == b2->flags.domainp && /* I18N3 */
282 internal_equal (b1->bytecodes, b2->bytecodes, depth + 1) &&
283 internal_equal (b1->constants, b2->constants, depth + 1) &&
284 internal_equal (b1->arglist, b2->arglist, depth + 1) &&
285 internal_equal (b1->doc_and_interactive,
286 b2->doc_and_interactive, depth + 1));
290 compiled_function_hash (Lisp_Object obj, int depth)
292 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (obj);
293 return HASH3 ((b->flags.documentationp << 2) +
294 (b->flags.interactivep << 1) +
296 internal_hash (b->bytecodes, depth + 1),
297 internal_hash (b->constants, depth + 1));
300 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
301 mark_compiled_function,
302 print_compiled_function, 0,
303 compiled_function_equal,
304 compiled_function_hash,
305 struct Lisp_Compiled_Function);
307 /**********************************************************************/
308 /* Entering the debugger */
309 /**********************************************************************/
311 /* unwind-protect used by call_debugger() to restore the value of
312 enterring_debugger. (We cannot use specbind() because the
313 variable is not Lisp-accessible.) */
316 restore_entering_debugger (Lisp_Object arg)
318 entering_debugger = ! NILP (arg);
322 /* Actually call the debugger. ARG is a list of args that will be
323 passed to the debugger function, as follows;
325 If due to frame exit, args are `exit' and the value being returned;
326 this function's value will be returned instead of that.
327 If due to error, args are `error' and a list of the args to `signal'.
328 If due to `apply' or `funcall' entry, one arg, `lambda'.
329 If due to `eval' entry, one arg, t.
334 call_debugger_259 (Lisp_Object arg)
336 return apply1 (Vdebugger, arg);
339 /* Call the debugger, doing some encapsulation. We make sure we have
340 some room on the eval and specpdl stacks, and bind enterring_debugger
341 to 1 during this call. This is used to trap errors that may occur
342 when enterring the debugger (e.g. the value of `debugger' is invalid),
343 so that the debugger will not be recursively entered if debug-on-error
344 is set. (Otherwise, XEmacs would infinitely recurse, attempting to
345 enter the debugger.) enterring_debugger gets reset to 0 as soon
346 as a backtrace is displayed, so that further errors can indeed be
349 We also establish a catch for 'debugger. If the debugger function
350 throws to this instead of returning a value, it means that the user
351 pressed 'c' (pretend like the debugger was never entered). The
352 function then returns Qunbound. (If the user pressed 'r', for
353 return a value, then the debugger function returns normally with
356 The difference between 'c' and 'r' is as follows:
359 No difference. The call proceeds as normal.
361 With 'r', the specified value is returned as the function's
362 return value. With 'c', the value that would normally be
363 returned is returned.
365 With 'r', the specified value is returned as the return
366 value of `signal'. (This is the only time that `signal'
367 can return, instead of making a non-local exit.) With `c',
368 `signal' will continue looking for handlers as if the
369 debugger was never entered, and will probably end up
370 throwing to a handler or to top-level.
374 call_debugger (Lisp_Object arg)
380 if (lisp_eval_depth + 20 > max_lisp_eval_depth)
381 max_lisp_eval_depth = lisp_eval_depth + 20;
382 if (specpdl_size + 40 > max_specpdl_size)
383 max_specpdl_size = specpdl_size + 40;
384 debug_on_next_call = 0;
386 speccount = specpdl_depth_counter;
387 record_unwind_protect (restore_entering_debugger,
388 (entering_debugger ? Qt : Qnil));
389 entering_debugger = 1;
390 val = internal_catch (Qdebugger, call_debugger_259, arg, &threw);
392 return unbind_to (speccount, ((threw)
393 ? Qunbound /* Not returning a value */
397 /* Called when debug-on-exit behavior is called for. Enter the debugger
398 with the appropriate args for this. VAL is the exit value that is
399 about to be returned. */
402 do_debug_on_exit (Lisp_Object val)
404 /* This is falsified by call_debugger */
405 Lisp_Object v = call_debugger (list2 (Qexit, val));
407 return !UNBOUNDP (v) ? v : val;
410 /* Called when debug-on-call behavior is called for. Enter the debugger
411 with the appropriate args for this. VAL is either t for a call
412 through `eval' or 'lambda for a call through `funcall'.
414 #### The differentiation here between EVAL and FUNCALL is bogus.
415 FUNCALL can be defined as
417 (defmacro func (fun &rest args)
418 (cons (eval fun) args))
420 and should be treated as such.
424 do_debug_on_call (Lisp_Object code)
426 debug_on_next_call = 0;
427 backtrace_list->debug_on_exit = 1;
428 call_debugger (list1 (code));
431 /* LIST is the value of one of the variables `debug-on-error',
432 `debug-on-signal', `stack-trace-on-error', or `stack-trace-on-signal',
433 and CONDITIONS is the list of error conditions associated with
434 the error being signalled. This returns non-nil if LIST
435 matches CONDITIONS. (A nil value for LIST does not match
436 CONDITIONS. A non-list value for LIST does match CONDITIONS.
437 A list matches CONDITIONS when one of the symbols in LIST is the
438 same as one of the symbols in CONDITIONS.) */
441 wants_debugger (Lisp_Object list, Lisp_Object conditions)
448 while (CONSP (conditions))
450 Lisp_Object this, tail;
451 this = XCAR (conditions);
452 for (tail = list; CONSP (tail); tail = XCDR (tail))
453 if (EQ (XCAR (tail), this))
455 conditions = XCDR (conditions);
461 /* Return 1 if an error with condition-symbols CONDITIONS,
462 and described by SIGNAL-DATA, should skip the debugger
463 according to debugger-ignore-errors. */
466 skip_debugger (Lisp_Object conditions, Lisp_Object data)
468 /* This function can GC */
470 int first_string = 1;
471 Lisp_Object error_message = Qnil;
473 for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
475 if (STRINGP (XCAR (tail)))
479 error_message = Ferror_message_string (data);
482 if (fast_lisp_string_match (XCAR (tail), error_message) >= 0)
489 for (contail = conditions; CONSP (contail); contail = XCDR (contail))
490 if (EQ (XCAR (tail), XCAR (contail)))
498 /* Actually generate a backtrace on STREAM. */
501 backtrace_259 (Lisp_Object stream)
503 return Fbacktrace (stream, Qt);
506 /* An error was signaled. Maybe call the debugger, if the `debug-on-error'
507 etc. variables call for this. CONDITIONS is the list of conditions
508 associated with the error being signalled. SIG is the actual error
509 being signalled, and DATA is the associated data (these are exactly
510 the same as the arguments to `signal'). ACTIVE_HANDLERS is the
511 list of error handlers that are to be put in place while the debugger
512 is called. This is generally the remaining handlers that are
513 outside of the innermost handler trapping this error. This way,
514 if the same error occurs inside of the debugger, you usually don't get
515 the debugger entered recursively.
517 This function returns Qunbound if it didn't call the debugger or if
518 the user asked (through 'c') that XEmacs should pretend like the
519 debugger was never entered. Otherwise, it returns the value
520 that the user specified with `r'. (Note that much of the time,
521 the user will abort with C-], and we will never have a chance to
522 return anything at all.)
524 SIGNAL_VARS_ONLY means we should only look at debug-on-signal
525 and stack-trace-on-signal to control whether we do anything.
526 This is so that debug-on-error doesn't make handled errors
527 cause the debugger to get invoked.
529 STACK_TRACE_DISPLAYED and DEBUGGER_ENTERED are used so that
530 those functions aren't done more than once in a single `signal'
534 signal_call_debugger (Lisp_Object conditions,
535 Lisp_Object sig, Lisp_Object data,
536 Lisp_Object active_handlers,
537 int signal_vars_only,
538 int *stack_trace_displayed,
539 int *debugger_entered)
541 /* This function can GC */
542 Lisp_Object val = Qunbound;
543 Lisp_Object all_handlers = Vcondition_handlers;
544 Lisp_Object temp_data = Qnil;
545 int speccount = specpdl_depth_counter;
546 struct gcpro gcpro1, gcpro2;
547 GCPRO2 (all_handlers, temp_data);
549 Vcondition_handlers = active_handlers;
551 temp_data = Fcons (sig, data); /* needed for skip_debugger */
553 if (!entering_debugger && !*stack_trace_displayed && !signal_vars_only
554 && wants_debugger (Vstack_trace_on_error, conditions)
555 && !skip_debugger (conditions, temp_data))
557 specbind (Qdebug_on_error, Qnil);
558 specbind (Qstack_trace_on_error, Qnil);
559 specbind (Qdebug_on_signal, Qnil);
560 specbind (Qstack_trace_on_signal, Qnil);
562 internal_with_output_to_temp_buffer ("*Backtrace*",
566 unbind_to (speccount, Qnil);
567 *stack_trace_displayed = 1;
570 if (!entering_debugger && !*debugger_entered && !signal_vars_only
573 : wants_debugger (Vdebug_on_error, conditions))
574 && !skip_debugger (conditions, temp_data))
576 debug_on_quit &= ~2; /* reset critical bit */
577 specbind (Qdebug_on_error, Qnil);
578 specbind (Qstack_trace_on_error, Qnil);
579 specbind (Qdebug_on_signal, Qnil);
580 specbind (Qstack_trace_on_signal, Qnil);
582 val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
583 *debugger_entered = 1;
586 if (!entering_debugger && !*stack_trace_displayed
587 && wants_debugger (Vstack_trace_on_signal, conditions))
589 specbind (Qdebug_on_error, Qnil);
590 specbind (Qstack_trace_on_error, Qnil);
591 specbind (Qdebug_on_signal, Qnil);
592 specbind (Qstack_trace_on_signal, Qnil);
594 internal_with_output_to_temp_buffer ("*Backtrace*",
598 unbind_to (speccount, Qnil);
599 *stack_trace_displayed = 1;
602 if (!entering_debugger && !*debugger_entered
605 : wants_debugger (Vdebug_on_signal, conditions)))
607 debug_on_quit &= ~2; /* reset critical bit */
608 specbind (Qdebug_on_error, Qnil);
609 specbind (Qstack_trace_on_error, Qnil);
610 specbind (Qdebug_on_signal, Qnil);
611 specbind (Qstack_trace_on_signal, Qnil);
613 val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
614 *debugger_entered = 1;
618 Vcondition_handlers = all_handlers;
619 return unbind_to (speccount, val);
623 /**********************************************************************/
624 /* The basic special forms */
625 /**********************************************************************/
627 /* NOTE!!! Every function that can call EVAL must protect its args
628 and temporaries from garbage collection while it needs them.
629 The definition of `For' shows what you have to do. */
631 DEFUN ("or", For, 0, UNEVALLED, 0, /*
632 Eval args until one of them yields non-nil, then return that value.
633 The remaining args are not evalled at all.
634 If all args return nil, return nil.
638 /* This function can GC */
639 REGISTER Lisp_Object tail;
644 LIST_LOOP (tail, args)
646 Lisp_Object val = Feval (XCAR (tail));
658 DEFUN ("and", Fand, 0, UNEVALLED, 0, /*
659 Eval args until one of them yields nil, then return nil.
660 The remaining args are not evalled at all.
661 If no arg yields nil, return the last arg's value.
665 /* This function can GC */
666 REGISTER Lisp_Object tail, val = Qt;
671 LIST_LOOP (tail, args)
673 val = Feval (XCAR (tail));
682 DEFUN ("if", Fif, 2, UNEVALLED, 0, /*
683 \(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...
684 Returns the value of THEN or the value of the last of the ELSE's.
685 THEN must be one expression, but ELSE... can be zero or more expressions.
686 If COND yields nil, and there are no ELSE's, the value is nil.
690 /* This function can GC */
696 if (!NILP (Feval (XCAR (args))))
697 val = Feval (XCAR (XCDR ((args))));
699 val = Fprogn (XCDR (XCDR (args)));
705 DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /*
706 (cond CLAUSES...): try each clause until one succeeds.
707 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
708 and, if the value is non-nil, this clause succeeds:
709 then the expressions in BODY are evaluated and the last one's
710 value is the value of the cond-form.
711 If no clause succeeds, cond returns nil.
712 If a clause has one element, as in (CONDITION),
713 CONDITION's value if non-nil is returned from the cond-form.
717 /* This function can GC */
718 REGISTER Lisp_Object tail;
723 LIST_LOOP (tail, args)
726 Lisp_Object clause = XCAR (tail);
728 val = Feval (XCAR (clause));
731 Lisp_Object clause_tail = XCDR (clause);
732 if (!NILP (clause_tail))
734 CHECK_TRUE_LIST (clause_tail);
735 val = Fprogn (clause_tail);
746 DEFUN ("progn", Fprogn, 0, UNEVALLED, 0, /*
747 \(progn BODY...): eval BODY forms sequentially and return value of last one.
751 /* This function can GC */
752 REGISTER Lisp_Object tail, val = Qnil;
757 LIST_LOOP (tail, args)
758 val = Feval (XCAR (tail));
764 DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /*
765 \(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.
766 The value of FIRST is saved during the evaluation of the remaining args,
767 whose values are discarded.
771 /* This function can GC */
772 REGISTER Lisp_Object tail = args;
773 Lisp_Object val = Qnil;
774 struct gcpro gcpro1, gcpro2;
778 val = Feval (XCAR (tail));
780 LIST_LOOP (tail, XCDR (tail))
787 DEFUN ("prog2", Fprog2, 2, UNEVALLED, 0, /*
788 \(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.
789 The value of Y is saved during the evaluation of the remaining args,
790 whose values are discarded.
794 /* This function can GC */
795 REGISTER Lisp_Object tail = args;
796 Lisp_Object val = Qnil;
797 struct gcpro gcpro1, gcpro2;
803 val = Feval (XCAR (tail));
805 LIST_LOOP (tail, XCDR (tail))
812 DEFUN ("let*", FletX, 1, UNEVALLED, 0, /*
813 \(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.
814 The value of the last form in BODY is returned.
815 Each element of VARLIST is a symbol (which is bound to nil)
816 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
817 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
821 /* This function can GC */
822 Lisp_Object varlist = XCAR (args);
824 int speccount = specpdl_depth_counter;
829 EXTERNAL_LIST_LOOP (tail, varlist)
831 Lisp_Object elt = XCAR (tail);
834 specbind (elt, Qnil);
837 Lisp_Object sym, form;
850 ("`let' bindings can have only one value-form",
853 specbind (sym, Feval (form));
857 return unbind_to (speccount, Fprogn (XCDR (args)));
860 DEFUN ("let", Flet, 1, UNEVALLED, 0, /*
861 \(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.
862 The value of the last form in BODY is returned.
863 Each element of VARLIST is a symbol (which is bound to nil)
864 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
865 All the VALUEFORMs are evalled before any symbols are bound.
869 /* This function can GC */
870 Lisp_Object varlist = XCAR (args);
871 REGISTER Lisp_Object tail;
873 int speccount = specpdl_depth_counter;
874 REGISTER int argnum = 0;
875 struct gcpro gcpro1, gcpro2;
877 /* Make space to hold the values to give the bound variables. */
880 EXTERNAL_LIST_LOOP (tail, varlist)
882 temps = alloca_array (Lisp_Object, varcount);
885 /* Compute the values and store them in `temps' */
887 GCPRO2 (args, *temps);
890 LIST_LOOP (tail, varlist)
892 Lisp_Object elt = XCAR (tail);
895 temps[argnum++] = Qnil;
901 temps[argnum++] = Qnil;
905 temps[argnum++] = Feval (XCAR (elt));
906 gcpro2.nvars = argnum;
908 if (!NILP (XCDR (elt)))
910 ("`let' bindings can have only one value-form",
918 LIST_LOOP (tail, varlist)
920 Lisp_Object elt = XCAR (tail);
921 specbind (SYMBOLP (elt) ? elt : XCAR (elt), temps[argnum++]);
924 return unbind_to (speccount, Fprogn (XCDR (args)));
927 DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /*
928 \(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.
929 The order of execution is thus TEST, BODY, TEST, BODY and so on
930 until TEST returns nil.
934 /* This function can GC */
936 Lisp_Object test = XCAR (args);
937 Lisp_Object body = XCDR (args);
938 struct gcpro gcpro1, gcpro2;
942 while (tem = Feval (test), !NILP (tem))
952 DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /*
953 \(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.
954 The symbols SYM are variables; they are literal (not evaluated).
955 The values VAL are expressions; they are evaluated.
956 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
957 The second VAL is not computed until after the first SYM is set, and so on;
958 each VAL can use the new value of variables set earlier in the `setq'.
959 The return value of the `setq' form is the value of the last VAL.
963 /* This function can GC */
965 Lisp_Object val = Qnil;
972 for (args2 = args; !NILP (args2); args2 = XCDR (args2))
976 * uncomment the QUIT if there is some way a circular
977 * arglist can get in here. I think Feval or Fapply would
978 * spin first and the list would never get here.
982 if (i & 1) /* Odd number of arguments? */
983 Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i)));
988 Lisp_Object sym = XCAR (args);
989 val = Feval (XCAR (XCDR (args)));
991 args = XCDR (XCDR (args));
998 DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /*
999 Return the argument, without evaluating it. `(quote x)' yields `x'.
1006 DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /*
1007 Like `quote', but preferred for objects which are functions.
1008 In byte compilation, `function' causes its argument to be compiled.
1009 `quote' cannot do that.
1017 /**********************************************************************/
1018 /* Defining functions/variables */
1019 /**********************************************************************/
1021 DEFUN ("defun", Fdefun, 2, UNEVALLED, 0, /*
1022 \(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
1023 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
1024 See also the function `interactive'.
1028 /* This function can GC */
1029 Lisp_Object fn_name = XCAR (args);
1030 Lisp_Object defn = Fcons (Qlambda, XCDR (args));
1033 defn = Fpurecopy (defn);
1034 Ffset (fn_name, defn);
1035 LOADHIST_ATTACH (fn_name);
1039 DEFUN ("defmacro", Fdefmacro, 2, UNEVALLED, 0, /*
1040 \(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
1041 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
1042 When the macro is called, as in (NAME ARGS...),
1043 the function (lambda ARGLIST BODY...) is applied to
1044 the list ARGS... as it appears in the expression,
1045 and the result should be a form to be evaluated instead of the original.
1049 /* This function can GC */
1050 Lisp_Object fn_name = XCAR (args);
1051 Lisp_Object defn = Fcons (Qmacro, Fcons (Qlambda, XCDR (args)));
1054 defn = Fpurecopy (defn);
1055 Ffset (fn_name, defn);
1056 LOADHIST_ATTACH (fn_name);
1060 DEFUN ("defvar", Fdefvar, 1, UNEVALLED, 0, /*
1061 \(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.
1062 You are not required to define a variable in order to use it,
1063 but the definition can supply documentation and an initial value
1064 in a way that tags can recognize.
1066 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is
1067 void. (However, when you evaluate a defvar interactively, it acts like a
1068 defconst: SYMBOL's value is always set regardless of whether it's currently
1070 If SYMBOL is buffer-local, its default value is what is set;
1071 buffer-local values are not affected.
1072 INITVALUE and DOCSTRING are optional.
1073 If DOCSTRING starts with *, this variable is identified as a user option.
1074 This means that M-x set-variable and M-x edit-options recognize it.
1075 If INITVALUE is missing, SYMBOL's value is not set.
1077 In lisp-interaction-mode defvar is treated as defconst.
1081 /* This function can GC */
1082 Lisp_Object sym = XCAR (args);
1084 if (!NILP (args = XCDR (args)))
1086 Lisp_Object val = XCAR (args);
1088 if (NILP (Fdefault_boundp (sym)))
1089 Fset_default (sym, Feval (val));
1091 if (!NILP (args = XCDR (args)))
1093 Lisp_Object doc = XCAR (args);
1095 /* #### We should probably do this but it might be dangerous */
1097 doc = Fpurecopy (doc);
1098 Fput (sym, Qvariable_documentation, doc);
1100 pure_put (sym, Qvariable_documentation, doc);
1102 if (!NILP (args = XCDR (args)))
1103 error ("too many arguments");
1108 if (!NILP (Vfile_domain))
1109 pure_put (sym, Qvariable_domain, Vfile_domain);
1112 LOADHIST_ATTACH (sym);
1116 DEFUN ("defconst", Fdefconst, 2, UNEVALLED, 0, /*
1117 \(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant
1119 The intent is that programs do not change this value, but users may.
1120 Always sets the value of SYMBOL to the result of evalling INITVALUE.
1121 If SYMBOL is buffer-local, its default value is what is set;
1122 buffer-local values are not affected.
1123 DOCSTRING is optional.
1124 If DOCSTRING starts with *, this variable is identified as a user option.
1125 This means that M-x set-variable and M-x edit-options recognize it.
1127 Note: do not use `defconst' for user options in libraries that are not
1128 normally loaded, since it is useful for users to be able to specify
1129 their own values for such variables before loading the library.
1130 Since `defconst' unconditionally assigns the variable,
1131 it would override the user's choice.
1135 /* This function can GC */
1136 Lisp_Object sym = XCAR (args);
1137 Lisp_Object val = XCAR (args = XCDR (args));
1139 Fset_default (sym, Feval (val));
1141 if (!NILP (args = XCDR (args)))
1143 Lisp_Object doc = XCAR (args);
1145 /* #### We should probably do this but it might be dangerous */
1147 doc = Fpurecopy (doc);
1148 Fput (sym, Qvariable_documentation, doc);
1150 pure_put (sym, Qvariable_documentation, doc);
1152 if (!NILP (args = XCDR (args)))
1153 error ("too many arguments");
1157 if (!NILP (Vfile_domain))
1158 pure_put (sym, Qvariable_domain, Vfile_domain);
1161 LOADHIST_ATTACH (sym);
1165 DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /*
1166 Return t if VARIABLE is intended to be set and modified by users.
1167 \(The alternative is a variable used internally in a Lisp program.)
1168 Determined by whether the first character of the documentation
1169 for the variable is `*'.
1173 Lisp_Object documentation;
1175 documentation = Fget (variable, Qvariable_documentation, Qnil);
1176 if (INTP (documentation) && XINT (documentation) < 0)
1178 if ((STRINGP (documentation)) &&
1179 (string_byte (XSTRING (documentation), 0) == '*'))
1181 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
1182 if (CONSP (documentation)
1183 && STRINGP (XCAR (documentation))
1184 && INTP (XCDR (documentation))
1185 && XINT (XCDR (documentation)) < 0)
1190 DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /*
1191 Return result of expanding macros at top level of FORM.
1192 If FORM is not a macro call, it is returned unchanged.
1193 Otherwise, the macro is expanded and the expansion is considered
1194 in place of FORM. When a non-macro-call results, it is returned.
1196 The second optional arg ENVIRONMENT species an environment of macro
1197 definitions to shadow the loaded ones for use in file byte-compilation.
1201 /* This function can GC */
1202 /* With cleanups from Hallvard Furuseth. */
1203 REGISTER Lisp_Object expander, sym, def, tem;
1207 /* Come back here each time we expand a macro call,
1208 in case it expands into another macro call. */
1211 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1212 def = sym = XCAR (form);
1214 /* Trace symbols aliases to other symbols
1215 until we get a symbol that is not an alias. */
1216 while (SYMBOLP (def))
1220 tem = Fassq (sym, env);
1223 def = XSYMBOL (sym)->function;
1224 if (!UNBOUNDP (def))
1229 /* Right now TEM is the result from SYM in ENV,
1230 and if TEM is nil then DEF is SYM's function definition. */
1233 /* SYM is not mentioned in ENV.
1234 Look at its function definition. */
1237 /* Not defined or definition not suitable */
1239 if (EQ (XCAR (def), Qautoload))
1241 /* Autoloading function: will it be a macro when loaded? */
1242 tem = Felt (def, make_int (4));
1243 if (EQ (tem, Qt) || EQ (tem, Qmacro))
1245 /* Yes, load it and try again. */
1246 do_autoload (def, sym);
1252 else if (!EQ (XCAR (def), Qmacro))
1254 else expander = XCDR (def);
1258 expander = XCDR (tem);
1259 if (NILP (expander))
1262 form = apply1 (expander, XCDR (form));
1268 /**********************************************************************/
1269 /* Non-local exits */
1270 /**********************************************************************/
1272 DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /*
1273 \(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.
1274 TAG is evalled to get the tag to use. Then the BODY is executed.
1275 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1276 If no throw happens, `catch' returns the value of the last BODY form.
1277 If a throw happens, it specifies the value to return from `catch'.
1281 /* This function can GC */
1283 struct gcpro gcpro1;
1286 tag = Feval (XCAR (args));
1288 return internal_catch (tag, Fprogn, XCDR (args), 0);
1291 /* Set up a catch, then call C function FUNC on argument ARG.
1292 FUNC should return a Lisp_Object.
1293 This is how catches are done from within C code. */
1296 internal_catch (Lisp_Object tag,
1297 Lisp_Object (*func) (Lisp_Object arg),
1299 int * volatile threw)
1301 /* This structure is made part of the chain `catchlist'. */
1304 /* Fill in the components of c, and put it on the list. */
1308 c.backlist = backtrace_list;
1311 c.handlerlist = handlerlist;
1313 c.lisp_eval_depth = lisp_eval_depth;
1314 c.pdlcount = specpdl_depth_counter;
1316 c.poll_suppress_count = async_timer_suppress_count;
1318 c.gcpro = gcprolist;
1324 /* Throw works by a longjmp that comes right here. */
1325 if (threw) *threw = 1;
1328 c.val = (*func) (arg);
1329 if (threw) *threw = 0;
1335 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1336 jump to that CATCH, returning VALUE as the value of that catch.
1338 This is the guts Fthrow and Fsignal; they differ only in the way
1339 they choose the catch tag to throw to. A catch tag for a
1340 condition-case form has a TAG of Qnil.
1342 Before each catch is discarded, unbind all special bindings and
1343 execute all unwind-protect clauses made above that catch. Unwind
1344 the handler stack as we go, so that the proper handlers are in
1345 effect for each unwind-protect clause we run. At the end, restore
1346 some static info saved in CATCH, and longjmp to the location
1349 This is used for correct unwinding in Fthrow and Fsignal. */
1352 unwind_to_catch (struct catchtag *c, Lisp_Object val)
1356 REGISTER int last_time;
1359 /* Unwind the specbind, catch, and handler stacks back to CATCH
1360 Before each catch is discarded, unbind all special bindings
1361 and execute all unwind-protect clauses made above that catch.
1362 At the end, restore some static info saved in CATCH,
1363 and longjmp to the location specified.
1366 /* Save the value somewhere it will be GC'ed.
1367 (Can't overwrite tag slot because an unwind-protect may
1368 want to throw to this same tag, which isn't yet invalid.) */
1372 /* Restore the polling-suppression count. */
1373 set_poll_suppress_count (catch->poll_suppress_count);
1377 /* #### FSFmacs has the following loop. Is it more correct? */
1380 last_time = catchlist == c;
1382 /* Unwind the specpdl stack, and then restore the proper set of
1384 unbind_to (catchlist->pdlcount, Qnil);
1385 handlerlist = catchlist->handlerlist;
1386 catchlist = catchlist->next;
1388 while (! last_time);
1389 #else /* Actual XEmacs code */
1390 /* Unwind the specpdl stack */
1391 unbind_to (c->pdlcount, Qnil);
1392 catchlist = c->next;
1395 gcprolist = c->gcpro;
1396 backtrace_list = c->backlist;
1397 lisp_eval_depth = c->lisp_eval_depth;
1400 LONGJMP (c->jmp, 1);
1403 static DOESNT_RETURN
1404 throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
1405 Lisp_Object sig, Lisp_Object data)
1408 /* die if we recurse more than is reasonable */
1409 if (++throw_level > 20)
1413 /* If bomb_out_p is t, this is being called from Fsignal as a
1414 "last resort" when there is no handler for this error and
1415 the debugger couldn't be invoked, so we are throwing to
1416 'top-level. If this tag doesn't exist (happens during the
1417 initialization stages) we would get in an infinite recursive
1418 Fsignal/Fthrow loop, so instead we bomb out to the
1419 really-early-error-handler.
1421 Note that in fact the only time that the "last resort"
1422 occurs is when there's no catch for 'top-level -- the
1423 'top-level catch and the catch-all error handler are
1424 established at the same time, in initial_command_loop/
1427 #### Fix this horrifitude!
1432 REGISTER struct catchtag *c;
1435 if (!NILP (tag)) /* #### */
1437 for (c = catchlist; c; c = c->next)
1439 if (EQ (c->tag, tag))
1440 unwind_to_catch (c, val);
1443 tag = Fsignal (Qno_catch, list2 (tag, val));
1445 call1 (Qreally_early_error_handler, Fcons (sig, data));
1448 /* can't happen. who cares? - (Sun's compiler does) */
1449 /* throw_level--; */
1450 /* getting tired of compilation warnings */
1454 /* See above, where CATCHLIST is defined, for a description of how
1457 Fthrow() is also called by Fsignal(), to do a non-local jump
1458 back to the appropriate condition-case handler after (maybe)
1459 the debugger is entered. In that case, TAG is the value
1460 of Vcondition_handlers that was in place just after the
1461 condition-case handler was set up. The car of this will be
1462 some data referring to the handler: Its car will be Qunbound
1463 (thus, this tag can never be generated by Lisp code), and
1464 its CDR will be the HANDLERS argument to condition_case_1()
1465 (either Qerror, Qt, or a list of handlers as in `condition-case').
1466 This works fine because Fthrow() does not care what TAG was
1467 passed to it: it just looks up the catch list for something
1468 that is EQ() to TAG. When it finds it, it will longjmp()
1469 back to the place that established the catch (in this case,
1470 condition_case_1). See below for more info.
1473 DEFUN ("throw", Fthrow, 2, 2, 0, /*
1474 \(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.
1475 Both TAG and VALUE are evalled.
1479 throw_or_bomb_out (tag, val, 0, Qnil, Qnil); /* Doesn't return */
1483 DEFUN ("unwind-protect", Funwind_protect, 1, UNEVALLED, 0, /*
1484 Do BODYFORM, protecting with UNWINDFORMS.
1485 Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).
1486 If BODYFORM completes normally, its value is returned
1487 after executing the UNWINDFORMS.
1488 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1492 /* This function can GC */
1494 int speccount = specpdl_depth_counter;
1496 record_unwind_protect (Fprogn, XCDR (args));
1497 val = Feval (XCAR (args));
1498 return unbind_to (speccount, val);
1502 /**********************************************************************/
1503 /* Signalling and trapping errors */
1504 /**********************************************************************/
1507 condition_bind_unwind (Lisp_Object loser)
1509 struct Lisp_Cons *victim;
1510 /* ((handler-fun . handler-args) ... other handlers) */
1511 Lisp_Object tem = XCAR (loser);
1515 victim = XCONS (tem);
1519 victim = XCONS (loser);
1521 if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */
1522 Vcondition_handlers = victim->cdr;
1529 condition_case_unwind (Lisp_Object loser)
1531 struct Lisp_Cons *victim;
1533 /* ((<unbound> . clauses) ... other handlers */
1534 victim = XCONS (XCAR (loser));
1537 victim = XCONS (loser);
1538 if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */
1539 Vcondition_handlers = victim->cdr;
1545 /* Split out from condition_case_3 so that primitive C callers
1546 don't have to cons up a lisp handler form to be evaluated. */
1548 /* Call a function BFUN of one argument BARG, trapping errors as
1549 specified by HANDLERS. If no error occurs that is indicated by
1550 HANDLERS as something to be caught, the return value of this
1551 function is the return value from BFUN. If such an error does
1552 occur, HFUN is called, and its return value becomes the
1553 return value of condition_case_1(). The second argument passed
1554 to HFUN will always be HARG. The first argument depends on
1557 If HANDLERS is Qt, all errors (this includes QUIT, but not
1558 non-local exits with `throw') cause HFUN to be invoked, and VAL
1559 (the first argument to HFUN) is a cons (SIG . DATA) of the
1560 arguments passed to `signal'. The debugger is not invoked even if
1561 `debug-on-error' was set.
1563 A HANDLERS value of Qerror is the same as Qt except that the
1564 debugger is invoked if `debug-on-error' was set.
1566 Otherwise, HANDLERS should be a list of lists (CONDITION-NAME BODY ...)
1567 exactly as in `condition-case', and errors will be trapped
1568 as indicated in HANDLERS. VAL (the first argument to HFUN) will
1569 be a cons whose car is the cons (SIG . DATA) and whose CDR is the
1570 list (BODY ...) from the appropriate slot in HANDLERS.
1572 This function pushes HANDLERS onto the front of Vcondition_handlers
1573 (actually with a Qunbound marker as well -- see Fthrow() above
1574 for why), establishes a catch whose tag is this new value of
1575 Vcondition_handlers, and calls BFUN. When Fsignal() is called,
1576 it calls Fthrow(), setting TAG to this same new value of
1577 Vcondition_handlers and setting VAL to the same thing that will
1578 be passed to HFUN, as above. Fthrow() longjmp()s back to the
1579 jump point we just established, and we in turn just call the
1580 HFUN and return its value.
1582 For a real condition-case, HFUN will always be
1583 run_condition_case_handlers() and HARG is the argument VAR
1584 to condition-case. That function just binds VAR to the cons
1585 (SIG . DATA) that is the CAR of VAL, and calls the handler
1586 (BODY ...) that is the CDR of VAL. Note that before calling
1587 Fthrow(), Fsignal() restored Vcondition_handlers to the value
1588 it had *before* condition_case_1() was called. This maintains
1589 consistency (so that the state of things at exit of
1590 condition_case_1() is the same as at entry), and implies
1591 that the handler can signal the same error again (possibly
1592 after processing of its own), without getting in an infinite
1596 condition_case_1 (Lisp_Object handlers,
1597 Lisp_Object (*bfun) (Lisp_Object barg),
1599 Lisp_Object (*hfun) (Lisp_Object val, Lisp_Object harg),
1602 int speccount = specpdl_depth_counter;
1604 struct gcpro gcpro1;
1609 /* Do consing now so out-of-memory error happens up front */
1610 /* (unbound . stuff) is a special condition-case kludge marker
1611 which is known specially by Fsignal.
1612 This is an abomination, but to fix it would require either
1613 making condition_case cons (a union of the conditions of the clauses)
1614 or changing the byte-compiler output (no thanks). */
1615 c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers),
1616 Vcondition_handlers);
1619 c.backlist = backtrace_list;
1622 c.handlerlist = handlerlist;
1624 c.lisp_eval_depth = lisp_eval_depth;
1625 c.pdlcount = specpdl_depth_counter;
1627 c.poll_suppress_count = async_timer_suppress_count;
1629 c.gcpro = gcprolist;
1630 /* #### FSFmacs does the following statement *after* the setjmp(). */
1635 /* throw does ungcpro, etc */
1636 return (*hfun) (c.val, harg);
1639 record_unwind_protect (condition_case_unwind, c.tag);
1643 h.handler = handlers;
1645 h.next = handlerlist;
1649 Vcondition_handlers = c.tag;
1651 GCPRO1 (harg); /* Somebody has to gc-protect */
1653 c.val = ((*bfun) (barg));
1655 /* The following is *not* true: (ben)
1657 ungcpro, restoring catchlist and condition_handlers are actually
1658 redundant since unbind_to now restores them. But it looks funny not to
1659 have this code here, and it doesn't cost anything, so I'm leaving it.*/
1662 Vcondition_handlers = XCDR (c.tag);
1664 return unbind_to (speccount, c.val);
1668 run_condition_case_handlers (Lisp_Object val, Lisp_Object var)
1670 /* This function can GC */
1673 specbind (h.var, c.val);
1674 val = Fprogn (Fcdr (h.chosen_clause));
1676 /* Note that this just undoes the binding of h.var; whoever
1677 longjumped to us unwound the stack to c.pdlcount before
1679 unbind_to (c.pdlcount, Qnil);
1685 return Fprogn (Fcdr (val)); /* tailcall */
1687 speccount = specpdl_depth_counter;
1688 specbind (var, Fcar (val));
1689 val = Fprogn (Fcdr (val));
1690 return unbind_to (speccount, val);
1694 /* Here for bytecode to call non-consfully. This is exactly like
1695 condition-case except that it takes three arguments rather
1696 than a single list of arguments. */
1698 condition_case_3 (Lisp_Object bodyform, Lisp_Object var, Lisp_Object handlers)
1700 /* This function can GC */
1705 for (val = handlers; ! NILP (val); val = Fcdr (val))
1711 || (!SYMBOLP (XCAR (tem)) && !CONSP (XCAR (tem)))))
1712 signal_simple_error ("Invalid condition handler", tem);
1715 return condition_case_1 (handlers,
1717 run_condition_case_handlers,
1721 DEFUN ("condition-case", Fcondition_case, 2, UNEVALLED, 0, /*
1722 Regain control when an error is signalled.
1723 Usage looks like (condition-case VAR BODYFORM HANDLERS...).
1724 executes BODYFORM and returns its value if no error happens.
1725 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1726 where the BODY is made of Lisp expressions.
1728 A handler is applicable to an error if CONDITION-NAME is one of the
1729 error's condition names. If an error happens, the first applicable
1730 handler is run. As a special case, a CONDITION-NAME of t matches
1731 all errors, even those without the `error' condition name on them
1734 The car of a handler may be a list of condition names
1735 instead of a single condition name.
1737 When a handler handles an error,
1738 control returns to the condition-case and the handler BODY... is executed
1739 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1740 VAR may be nil; then you do not get access to the signal information.
1742 The value of the last BODY form is returned from the condition-case.
1743 See also the function `signal' for more info.
1745 Note that at the time the condition handler is invoked, the Lisp stack
1746 and the current catches, condition-cases, and bindings have all been
1747 popped back to the state they were in just before the call to
1748 `condition-case'. This means that resignalling the error from
1749 within the handler will not result in an infinite loop.
1751 If you want to establish an error handler that is called with the
1752 Lisp stack, bindings, etc. as they were when `signal' was called,
1753 rather than when the handler was set, use `call-with-condition-handler'.
1757 /* This function can GC */
1758 return condition_case_3 (XCAR (XCDR (args)),
1760 XCDR (XCDR (args)));
1763 DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /*
1764 Regain control when an error is signalled, without popping the stack.
1765 Usage looks like (call-with-condition-handler HANDLER FUNCTION &rest ARGS).
1766 This function is similar to `condition-case', but the handler is invoked
1767 with the same environment (Lisp stack, bindings, catches, condition-cases)
1768 that was current when `signal' was called, rather than when the handler
1771 HANDLER should be a function of one argument, which is a cons of the args
1772 \(SIG . DATA) that were passed to `signal'. It is invoked whenever
1773 `signal' is called (this differs from `condition-case', which allows
1774 you to specify which errors are trapped). If the handler function
1775 returns, `signal' continues as if the handler were never invoked.
1776 \(It continues to look for handlers established earlier than this one,
1777 and invokes the standard error-handler if none is found.)
1779 (int nargs, Lisp_Object *args)) /* Note! Args side-effected! */
1781 /* This function can GC */
1782 int speccount = specpdl_depth_counter;
1785 /* #### If there were a way to check that args[0] were a function
1786 which accepted one arg, that should be done here ... */
1788 /* (handler-fun . handler-args) */
1789 tem = noseeum_cons (list1 (args[0]), Vcondition_handlers);
1790 record_unwind_protect (condition_bind_unwind, tem);
1791 Vcondition_handlers = tem;
1793 /* Caller should have GC-protected args */
1794 tem = Ffuncall (nargs - 1, args + 1);
1795 return unbind_to (speccount, tem);
1799 condition_type_p (Lisp_Object type, Lisp_Object conditions)
1802 /* (condition-case c # (t c)) catches -all- signals
1803 * Use with caution! */
1809 return !NILP (Fmemq (type, conditions));
1811 else if (CONSP (type))
1813 while (CONSP (type))
1815 if (!NILP (Fmemq (Fcar (type), conditions)))
1827 return_from_signal (Lisp_Object value)
1830 /* Most callers are not prepared to handle gc if this
1831 returns. So, since this feature is not very useful,
1833 /* Have called debugger; return value to signaller */
1835 #else /* But the reality is that that stinks, because: */
1836 /* GACK!!! Really want some way for debug-on-quit errors
1837 to be continuable!! */
1838 error ("Returning a value from an error is no longer supported");
1842 extern int in_display;
1845 /****************** the workhorse error-signaling function ******************/
1847 /* #### This function has not been synched with FSF. It diverges
1851 signal_1 (Lisp_Object sig, Lisp_Object data)
1853 /* This function can GC */
1854 struct gcpro gcpro1, gcpro2;
1855 Lisp_Object conditions;
1856 Lisp_Object handlers;
1857 /* signal_call_debugger() could get called more than once
1858 (once when a call-with-condition-handler is about to
1859 be dealt with, and another when a condition-case handler
1860 is about to be invoked). So make sure the debugger and/or
1861 stack trace aren't done more than once. */
1862 int stack_trace_displayed = 0;
1863 int debugger_entered = 0;
1864 GCPRO2 (conditions, handlers);
1868 /* who knows how much has been initialized? Safest bet is
1869 just to bomb out immediately. */
1870 fprintf (stderr, "Error before initialization is complete!\n");
1874 if (gc_in_progress || in_display)
1875 /* This is one of many reasons why you can't run lisp code from redisplay.
1876 There is no sensible way to handle errors there. */
1879 conditions = Fget (sig, Qerror_conditions, Qnil);
1881 for (handlers = Vcondition_handlers;
1883 handlers = XCDR (handlers))
1885 Lisp_Object handler_fun = XCAR (XCAR (handlers));
1886 Lisp_Object handler_data = XCDR (XCAR (handlers));
1887 Lisp_Object outer_handlers = XCDR (handlers);
1889 if (!UNBOUNDP (handler_fun))
1891 /* call-with-condition-handler */
1893 Lisp_Object all_handlers = Vcondition_handlers;
1894 struct gcpro ngcpro1;
1895 NGCPRO1 (all_handlers);
1896 Vcondition_handlers = outer_handlers;
1898 tem = signal_call_debugger (conditions, sig, data,
1900 &stack_trace_displayed,
1902 if (!UNBOUNDP (tem))
1903 RETURN_NUNGCPRO (return_from_signal (tem));
1905 tem = Fcons (sig, data);
1906 if (NILP (handler_data))
1907 tem = call1 (handler_fun, tem);
1910 /* (This code won't be used (for now?).) */
1911 struct gcpro nngcpro1;
1912 Lisp_Object args[3];
1915 args[0] = handler_fun;
1917 args[2] = handler_data;
1918 nngcpro1.var = args;
1919 tem = Fapply (3, args);
1924 if (!EQ (tem, Qsignal))
1925 return return_from_signal (tem);
1927 /* If handler didn't throw, try another handler */
1928 Vcondition_handlers = all_handlers;
1931 /* It's a condition-case handler */
1933 /* t is used by handlers for all conditions, set up by C code.
1934 * debugger is not called even if debug_on_error */
1935 else if (EQ (handler_data, Qt))
1938 return Fthrow (handlers, Fcons (sig, data));
1940 /* `error' is used similarly to the way `t' is used, but in
1941 addition it invokes the debugger if debug_on_error.
1942 This is normally used for the outer command-loop error
1944 else if (EQ (handler_data, Qerror))
1946 Lisp_Object tem = signal_call_debugger (conditions, sig, data,
1948 &stack_trace_displayed,
1952 if (!UNBOUNDP (tem))
1953 return return_from_signal (tem);
1955 tem = Fcons (sig, data);
1956 return Fthrow (handlers, tem);
1960 /* handler established by real (Lisp) condition-case */
1963 for (h = handler_data; CONSP (h); h = Fcdr (h))
1965 Lisp_Object clause = Fcar (h);
1966 Lisp_Object tem = Fcar (clause);
1968 if (condition_type_p (tem, conditions))
1970 tem = signal_call_debugger (conditions, sig, data,
1972 &stack_trace_displayed,
1975 if (!UNBOUNDP (tem))
1976 return return_from_signal (tem);
1978 /* Doesn't return */
1979 tem = Fcons (Fcons (sig, data), Fcdr (clause));
1980 return Fthrow (handlers, tem);
1986 /* If no handler is present now, try to run the debugger,
1987 and if that fails, throw to top level.
1989 #### The only time that no handler is present is during
1990 temacs or perhaps very early in XEmacs. In both cases,
1991 there is no 'top-level catch. (That's why the
1992 "bomb-out" hack was added.)
1994 #### Fix this horrifitude!
1996 signal_call_debugger (conditions, sig, data, Qnil, 0,
1997 &stack_trace_displayed,
2000 throw_or_bomb_out (Qtop_level, Qt, 1, sig, data); /* Doesn't return */
2005 /****************** Error functions class 1 ******************/
2007 /* Class 1: General functions that signal an error.
2008 These functions take an error type and a list of associated error
2011 /* The simplest external error function: it would be called
2012 signal_continuable_error() in the terminology below, but it's
2015 DEFUN ("signal", Fsignal, 2, 2, 0, /*
2016 Signal a continuable error. Args are ERROR-SYMBOL, and associated DATA.
2017 An error symbol is a symbol defined using `define-error'.
2018 DATA should be a list. Its elements are printed as part of the error message.
2019 If the signal is handled, DATA is made available to the handler.
2020 See also the function `signal-error', and the functions to handle errors:
2021 `condition-case' and `call-with-condition-handler'.
2023 Note that this function can return, if the debugger is invoked and the
2024 user invokes the "return from signal" option.
2026 (error_symbol, data))
2028 /* Fsignal() is one of these functions that's called all the time
2029 with newly-created Lisp objects. We allow this; but we must GC-
2030 protect the objects because all sorts of weird stuff could
2033 struct gcpro gcpro1;
2036 if (!NILP (Vcurrent_error_state))
2038 if (!NILP (Vcurrent_warning_class))
2039 warn_when_safe_lispobj (Vcurrent_warning_class, Qwarning,
2040 Fcons (error_symbol, data));
2041 Fthrow (Qunbound_suspended_errors_tag, Qnil);
2042 abort (); /* Better not get here! */
2044 RETURN_UNGCPRO (signal_1 (error_symbol, data));
2047 /* Signal a non-continuable error. */
2050 signal_error (Lisp_Object sig, Lisp_Object data)
2053 Fsignal (sig, data);
2057 call_with_suspended_errors_1 (Lisp_Object opaque_arg)
2059 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
2060 return primitive_funcall ((lisp_fn_t) get_opaque_ptr (kludgy_args[0]),
2061 XINT (kludgy_args[1]), kludgy_args + 2);
2065 restore_current_warning_class (Lisp_Object warning_class)
2067 Vcurrent_warning_class = warning_class;
2072 restore_current_error_state (Lisp_Object error_state)
2074 Vcurrent_error_state = error_state;
2078 /* Many functions would like to do one of three things if an error
2081 (1) signal the error, as usual.
2082 (2) silently fail and return some error value.
2083 (3) do as (2) but issue a warning in the process.
2085 Currently there's lots of stuff that passes an Error_behavior
2086 value and calls maybe_signal_error() and other such functions.
2087 This approach is inherently error-prone and broken. A much
2088 more robust and easier approach is to use call_with_suspended_errors().
2089 Wrap this around any function in which you might want errors
2094 call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval,
2095 Lisp_Object class, Error_behavior errb,
2100 Lisp_Object kludgy_args[22];
2101 Lisp_Object *args = kludgy_args + 2;
2103 Lisp_Object no_error;
2105 assert (SYMBOLP (class)); /* sanity-check */
2106 assert (!NILP (class));
2107 assert (nargs >= 0 && nargs < 20);
2109 /* ERROR_ME means don't trap errors. (However, if errors are
2110 already trapped, we leave them trapped.)
2112 Otherwise, we trap errors, and trap warnings if ERROR_ME_WARN.
2114 If ERROR_ME_NOT, it causes no warnings even if warnings
2115 were previously enabled. However, we never change the
2116 warning class from one to another. */
2117 if (!ERRB_EQ (errb, ERROR_ME))
2119 if (ERRB_EQ (errb, ERROR_ME_NOT)) /* person wants no warnings */
2121 errb = ERROR_ME_NOT;
2127 va_start (vargs, nargs);
2128 for (i = 0; i < nargs; i++)
2129 args[i] = va_arg (vargs, Lisp_Object);
2132 /* If error-checking is not disabled, just call the function.
2133 It's important not to override disabled error-checking with
2134 enabled error-checking. */
2136 if (ERRB_EQ (errb, ERROR_ME))
2137 return primitive_funcall (fun, nargs, args);
2139 speccount = specpdl_depth_counter;
2140 if (NILP (class) || NILP (Vcurrent_warning_class))
2142 /* If we're currently calling for no warnings, then make it so.
2143 If we're currently calling for warnings and we weren't
2144 previously, then set our warning class; otherwise, leave
2145 the existing one alone. */
2146 record_unwind_protect (restore_current_warning_class,
2147 Vcurrent_warning_class);
2148 Vcurrent_warning_class = class;
2150 if (!EQ (Vcurrent_error_state, no_error))
2152 record_unwind_protect (restore_current_error_state,
2153 Vcurrent_error_state);
2154 Vcurrent_error_state = no_error;
2159 Lisp_Object the_retval;
2160 Lisp_Object opaque1 = make_opaque_ptr (kludgy_args);
2161 Lisp_Object opaque2 = make_opaque_ptr ((void *) fun);
2162 struct gcpro gcpro1, gcpro2;
2164 GCPRO2 (opaque1, opaque2);
2165 kludgy_args[0] = opaque2;
2166 kludgy_args[1] = make_int (nargs);
2167 the_retval = internal_catch (Qunbound_suspended_errors_tag,
2168 call_with_suspended_errors_1,
2170 free_opaque_ptr (opaque1);
2171 free_opaque_ptr (opaque2);
2173 /* Use the returned value except in non-local exit, when
2175 /* Some perverse compilers require the perverse cast below. */
2176 return unbind_to (speccount,
2177 threw ? *((Lisp_Object*) &(retval)) : the_retval);
2181 /* Signal a non-continuable error or display a warning or do nothing,
2182 according to ERRB. CLASS is the class of warning and should
2183 refer to what sort of operation is being done (e.g. Qtoolbar,
2184 Qresource, etc.). */
2187 maybe_signal_error (Lisp_Object sig, Lisp_Object data, Lisp_Object class,
2188 Error_behavior errb)
2190 if (ERRB_EQ (errb, ERROR_ME_NOT))
2192 else if (ERRB_EQ (errb, ERROR_ME_WARN))
2193 warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data));
2196 Fsignal (sig, data);
2199 /* Signal a continuable error or display a warning or do nothing,
2200 according to ERRB. */
2203 maybe_signal_continuable_error (Lisp_Object sig, Lisp_Object data,
2204 Lisp_Object class, Error_behavior errb)
2206 if (ERRB_EQ (errb, ERROR_ME_NOT))
2208 else if (ERRB_EQ (errb, ERROR_ME_WARN))
2210 warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data));
2214 return Fsignal (sig, data);
2218 /****************** Error functions class 2 ******************/
2220 /* Class 2: Printf-like functions that signal an error.
2221 These functions signal an error of type Qerror, whose data
2222 is a single string, created using the arguments. */
2224 /* dump an error message; called like printf */
2227 error (CONST char *fmt, ...)
2232 va_start (args, fmt);
2233 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2237 /* Fsignal GC-protects its args */
2238 signal_error (Qerror, list1 (obj));
2242 maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...)
2248 if (ERRB_EQ (errb, ERROR_ME_NOT))
2251 va_start (args, fmt);
2252 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2256 /* Fsignal GC-protects its args */
2257 maybe_signal_error (Qerror, list1 (obj), class, errb);
2261 continuable_error (CONST char *fmt, ...)
2266 va_start (args, fmt);
2267 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2271 /* Fsignal GC-protects its args */
2272 return Fsignal (Qerror, list1 (obj));
2276 maybe_continuable_error (Lisp_Object class, Error_behavior errb,
2277 CONST char *fmt, ...)
2283 if (ERRB_EQ (errb, ERROR_ME_NOT))
2286 va_start (args, fmt);
2287 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2291 /* Fsignal GC-protects its args */
2292 return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb);
2296 /****************** Error functions class 3 ******************/
2298 /* Class 3: Signal an error with a string and an associated object.
2299 These functions signal an error of type Qerror, whose data
2300 is two objects, a string and a related Lisp object (usually the object
2301 where the error is occurring). */
2304 signal_simple_error (CONST char *reason, Lisp_Object frob)
2306 signal_error (Qerror, list2 (build_translated_string (reason), frob));
2310 maybe_signal_simple_error (CONST char *reason, Lisp_Object frob,
2311 Lisp_Object class, Error_behavior errb)
2314 if (ERRB_EQ (errb, ERROR_ME_NOT))
2316 maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob),
2321 signal_simple_continuable_error (CONST char *reason, Lisp_Object frob)
2323 return Fsignal (Qerror, list2 (build_translated_string (reason), frob));
2327 maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob,
2328 Lisp_Object class, Error_behavior errb)
2331 if (ERRB_EQ (errb, ERROR_ME_NOT))
2333 return maybe_signal_continuable_error
2334 (Qerror, list2 (build_translated_string (reason),
2335 frob), class, errb);
2339 /****************** Error functions class 4 ******************/
2341 /* Class 4: Printf-like functions that signal an error.
2342 These functions signal an error of type Qerror, whose data
2343 is a two objects, a string (created using the arguments) and a
2348 error_with_frob (Lisp_Object frob, CONST char *fmt, ...)
2353 va_start (args, fmt);
2354 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2358 /* Fsignal GC-protects its args */
2359 signal_error (Qerror, list2 (obj, frob));
2363 maybe_error_with_frob (Lisp_Object frob, Lisp_Object class,
2364 Error_behavior errb, CONST char *fmt, ...)
2370 if (ERRB_EQ (errb, ERROR_ME_NOT))
2373 va_start (args, fmt);
2374 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2378 /* Fsignal GC-protects its args */
2379 maybe_signal_error (Qerror, list2 (obj, frob), class, errb);
2383 continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...)
2388 va_start (args, fmt);
2389 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2393 /* Fsignal GC-protects its args */
2394 return Fsignal (Qerror, list2 (obj, frob));
2398 maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class,
2399 Error_behavior errb, CONST char *fmt, ...)
2405 if (ERRB_EQ (errb, ERROR_ME_NOT))
2408 va_start (args, fmt);
2409 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
2413 /* Fsignal GC-protects its args */
2414 return maybe_signal_continuable_error (Qerror, list2 (obj, frob),
2419 /****************** Error functions class 5 ******************/
2421 /* Class 5: Signal an error with a string and two associated objects.
2422 These functions signal an error of type Qerror, whose data
2423 is three objects, a string and two related Lisp objects. */
2426 signal_simple_error_2 (CONST char *reason,
2427 Lisp_Object frob0, Lisp_Object frob1)
2429 signal_error (Qerror, list3 (build_translated_string (reason), frob0,
2434 maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0,
2435 Lisp_Object frob1, Lisp_Object class,
2436 Error_behavior errb)
2439 if (ERRB_EQ (errb, ERROR_ME_NOT))
2441 maybe_signal_error (Qerror, list3 (build_translated_string (reason), frob0,
2442 frob1), class, errb);
2447 signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0,
2450 return Fsignal (Qerror, list3 (build_translated_string (reason), frob0,
2455 maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0,
2456 Lisp_Object frob1, Lisp_Object class,
2457 Error_behavior errb)
2460 if (ERRB_EQ (errb, ERROR_ME_NOT))
2462 return maybe_signal_continuable_error
2463 (Qerror, list3 (build_translated_string (reason), frob0,
2469 /* This is what the QUIT macro calls to signal a quit */
2473 /* This function can GC */
2474 if (EQ (Vquit_flag, Qcritical))
2475 debug_on_quit |= 2; /* set critical bit. */
2477 /* note that this is continuable. */
2478 Fsignal (Qquit, Qnil);
2482 /**********************************************************************/
2484 /**********************************************************************/
2486 DEFUN ("commandp", Fcommandp, 1, 1, 0, /*
2487 Return t if FUNCTION makes provisions for interactive calling.
2488 This means it contains a description for how to read arguments to give it.
2489 The value is nil for an invalid function or a symbol with no function
2492 Interactively callable functions include
2494 -- strings and vectors (treated as keyboard macros)
2495 -- lambda-expressions that contain a top-level call to `interactive'
2496 -- autoload definitions made by `autoload' with non-nil fourth argument
2497 (i.e. the interactive flag)
2498 -- compiled-function objects with a non-nil `compiled-function-interactive'
2500 -- subrs (built-in functions) that are interactively callable
2502 Also, a symbol satisfies `commandp' if its function definition does so.
2506 Lisp_Object fun = indirect_function (function, 0);
2511 /* Emacs primitives are interactive if their DEFUN specifies an
2512 interactive spec. */
2514 return XSUBR (fun)->prompt ? Qt : Qnil;
2516 if (COMPILED_FUNCTIONP (fun))
2517 return XCOMPILED_FUNCTION (fun)->flags.interactivep ? Qt : Qnil;
2519 /* Strings and vectors are keyboard macros. */
2520 if (VECTORP (fun) || STRINGP (fun))
2523 /* Lists may represent commands. */
2527 Lisp_Object funcar = XCAR (fun);
2528 if (!SYMBOLP (funcar))
2529 return Fsignal (Qinvalid_function, list1 (fun));
2530 if (EQ (funcar, Qlambda))
2531 return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
2532 if (EQ (funcar, Qautoload))
2533 return Fcar (Fcdr (Fcdr (Fcdr (fun))));
2539 DEFUN ("command-execute", Fcommand_execute, 1, 3, 0, /*
2540 Execute CMD as an editor command.
2541 CMD must be an object that satisfies the `commandp' predicate.
2542 Optional second arg RECORD-FLAG is as in `call-interactively'.
2543 The argument KEYS specifies the value to use instead of (this-command-keys)
2544 when reading the arguments.
2546 (cmd, record, keys))
2548 /* This function can GC */
2549 Lisp_Object prefixarg;
2550 Lisp_Object final = cmd;
2551 struct backtrace backtrace;
2552 struct console *con = XCONSOLE (Vselected_console);
2554 prefixarg = con->prefix_arg;
2555 con->prefix_arg = Qnil;
2556 Vcurrent_prefix_arg = prefixarg;
2557 debug_on_next_call = 0; /* #### from FSFmacs; correct? */
2559 if (SYMBOLP (cmd) && !NILP (Fget (cmd, Qdisabled, Qnil)))
2560 return run_hook (Vdisabled_command_hook);
2564 final = indirect_function (cmd, 1);
2565 if (CONSP (final) && EQ (Fcar (final), Qautoload))
2566 do_autoload (final, cmd);
2571 if (CONSP (final) || SUBRP (final) || COMPILED_FUNCTIONP (final))
2574 backtrace.id_number = 0;
2576 backtrace.function = &Qcall_interactively;
2577 backtrace.args = &cmd;
2578 backtrace.nargs = 1;
2579 backtrace.evalargs = 0;
2580 backtrace.pdlcount = specpdl_depth_counter;
2581 backtrace.debug_on_exit = 0;
2582 PUSH_BACKTRACE (backtrace);
2584 final = Fcall_interactively (cmd, record, keys);
2586 POP_BACKTRACE (backtrace);
2589 else if (STRINGP (final) || VECTORP (final))
2591 return Fexecute_kbd_macro (final, prefixarg);
2595 Fsignal (Qwrong_type_argument,
2599 : list2 (cmd, final))));
2604 DEFUN ("interactive-p", Finteractive_p, 0, 0, 0, /*
2605 Return t if function in which this appears was called interactively.
2606 This means that the function was called with call-interactively (which
2607 includes being called as the binding of a key)
2608 and input is currently coming from the keyboard (not in keyboard macro).
2612 REGISTER struct backtrace *btp;
2613 REGISTER Lisp_Object fun;
2618 /* Unless the object was compiled, skip the frame of interactive-p itself
2619 (if interpreted) or the frame of byte-code (if called from a compiled
2620 function). Note that *btp->function may be a symbol pointing at a
2621 compiled function. */
2622 btp = backtrace_list;
2626 /* #### FSFmacs does the following instead. I can't figure
2627 out which one is more correct. */
2628 /* If this isn't a byte-compiled function, there may be a frame at
2629 the top for Finteractive_p itself. If so, skip it. */
2630 fun = Findirect_function (*btp->function);
2631 if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
2634 /* If we're running an Emacs 18-style byte-compiled function, there
2635 may be a frame for Fbyte_code. Now, given the strictest
2636 definition, this function isn't really being called
2637 interactively, but because that's the way Emacs 18 always builds
2638 byte-compiled functions, we'll accept it for now. */
2639 if (EQ (*btp->function, Qbyte_code))
2642 /* If this isn't a byte-compiled function, then we may now be
2643 looking at several frames for special forms. Skip past them. */
2645 btp->nargs == UNEVALLED)
2650 if (! (COMPILED_FUNCTIONP (Findirect_function (*btp->function))))
2653 btp && (btp->nargs == UNEVALLED
2654 || EQ (*btp->function, Qbyte_code));
2657 /* btp now points at the frame of the innermost function
2658 that DOES eval its args.
2659 If it is a built-in function (such as load or eval-region)
2661 /* Beats me why this is necessary, but it is */
2662 if (btp && EQ (*btp->function, Qcall_interactively))
2667 fun = Findirect_function (*btp->function);
2670 /* btp points to the frame of a Lisp function that called interactive-p.
2671 Return t if that function was called interactively. */
2672 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
2678 /**********************************************************************/
2680 /**********************************************************************/
2682 DEFUN ("autoload", Fautoload, 2, 5, 0, /*
2683 Define FUNCTION to autoload from FILE.
2684 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2685 Third arg DOCSTRING is documentation for the function.
2686 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2687 Fifth arg TYPE indicates the type of the object:
2688 nil or omitted says FUNCTION is a function,
2689 `keymap' says FUNCTION is really a keymap, and
2690 `macro' or t says FUNCTION is really a macro.
2691 Third through fifth args give info about the real definition.
2692 They default to nil.
2693 If FUNCTION is already defined other than as an autoload,
2694 this does nothing and returns nil.
2696 (function, file, docstring, interactive, type))
2698 /* This function can GC */
2699 CHECK_SYMBOL (function);
2700 CHECK_STRING (file);
2702 /* If function is defined and not as an autoload, don't override */
2703 if (!UNBOUNDP (XSYMBOL (function)->function)
2704 && !(CONSP (XSYMBOL (function)->function)
2705 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
2710 /* Attempt to avoid consing identical (string=) pure strings. */
2711 file = Fsymbol_name (Fintern (file, Qnil));
2714 return Ffset (function,
2715 Fpurecopy (Fcons (Qautoload, list4 (file,
2722 un_autoload (Lisp_Object oldqueue)
2724 /* This function can GC */
2725 REGISTER Lisp_Object queue, first, second;
2727 /* Queue to unwind is current value of Vautoload_queue.
2728 oldqueue is the shadowed value to leave in Vautoload_queue. */
2729 queue = Vautoload_queue;
2730 Vautoload_queue = oldqueue;
2731 while (CONSP (queue))
2733 first = Fcar (queue);
2734 second = Fcdr (first);
2735 first = Fcar (first);
2739 Ffset (first, second);
2740 queue = Fcdr (queue);
2746 do_autoload (Lisp_Object fundef,
2747 Lisp_Object funname)
2749 /* This function can GC */
2750 int speccount = specpdl_depth_counter;
2751 Lisp_Object fun = funname;
2752 struct gcpro gcpro1, gcpro2;
2754 CHECK_SYMBOL (funname);
2755 GCPRO2 (fun, funname);
2757 /* Value saved here is to be restored into Vautoload_queue */
2758 record_unwind_protect (un_autoload, Vautoload_queue);
2759 Vautoload_queue = Qt;
2760 call4 (Qload, Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil,
2764 Lisp_Object queue = Vautoload_queue;
2766 /* Save the old autoloads, in case we ever do an unload. */
2767 queue = Vautoload_queue;
2768 while (CONSP (queue))
2770 Lisp_Object first = Fcar (queue);
2771 Lisp_Object second = Fcdr (first);
2773 first = Fcar (first);
2775 /* Note: This test is subtle. The cdr of an autoload-queue entry
2776 may be an atom if the autoload entry was generated by a defalias
2779 Fput (first, Qautoload, (Fcdr (second)));
2781 queue = Fcdr (queue);
2785 /* Once loading finishes, don't undo it. */
2786 Vautoload_queue = Qt;
2787 unbind_to (speccount, Qnil);
2789 fun = indirect_function (fun, 0);
2792 if (!NILP (Fequal (fun, fundef)))
2796 && EQ (XCAR (fun), Qautoload)))
2798 error ("Autoloading failed to define function %s",
2799 string_data (XSYMBOL (funname)->name));
2804 /**********************************************************************/
2805 /* eval, funcall, apply */
2806 /**********************************************************************/
2808 static Lisp_Object funcall_lambda (Lisp_Object fun,
2809 int nargs, Lisp_Object args[]);
2810 static Lisp_Object apply_lambda (Lisp_Object fun,
2811 int nargs, Lisp_Object args);
2812 static int in_warnings;
2815 in_warnings_restore (Lisp_Object minimus)
2822 #define AV_1(av) av[0]
2823 #define AV_2(av) AV_1(av), av[1]
2824 #define AV_3(av) AV_2(av), av[2]
2825 #define AV_4(av) AV_3(av), av[3]
2826 #define AV_5(av) AV_4(av), av[4]
2827 #define AV_6(av) AV_5(av), av[5]
2828 #define AV_7(av) AV_6(av), av[6]
2829 #define AV_8(av) AV_7(av), av[7]
2831 #define PRIMITIVE_FUNCALL(fn, av, ac) \
2832 (((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av)))
2834 /* If subr's take more than 8 arguments, more cases need to be added
2835 to this switch. (But don't do it - if you really need a SUBR with
2836 more than 8 arguments, use max_args == MANY.
2837 See the DEFUN macro in lisp.h) */
2838 #define inline_funcall_fn(rv, fn, av, ac) do { \
2840 case 0: rv = PRIMITIVE_FUNCALL(fn, av, 0); break; \
2841 case 1: rv = PRIMITIVE_FUNCALL(fn, av, 1); break; \
2842 case 2: rv = PRIMITIVE_FUNCALL(fn, av, 2); break; \
2843 case 3: rv = PRIMITIVE_FUNCALL(fn, av, 3); break; \
2844 case 4: rv = PRIMITIVE_FUNCALL(fn, av, 4); break; \
2845 case 5: rv = PRIMITIVE_FUNCALL(fn, av, 5); break; \
2846 case 6: rv = PRIMITIVE_FUNCALL(fn, av, 6); break; \
2847 case 7: rv = PRIMITIVE_FUNCALL(fn, av, 7); break; \
2848 case 8: rv = PRIMITIVE_FUNCALL(fn, av, 8); break; \
2849 default: abort(); rv = Qnil; break; \
2853 #define inline_funcall_subr(rv, subr, av) do { \
2854 void (*fn)() = (void (*)()) (subr_function(subr)); \
2855 inline_funcall_fn (rv, fn, av, subr->max_args); \
2859 primitive_funcall (lisp_fn_t fn, int nargs, Lisp_Object args[])
2862 inline_funcall_fn (rv, fn, args, nargs);
2866 DEFUN ("eval", Feval, 1, 1, 0, /*
2867 Evaluate FORM and return its value.
2871 /* This function can GC */
2872 Lisp_Object fun, val, original_fun, original_args;
2874 struct backtrace backtrace;
2876 /* I think this is a pretty safe place to call Lisp code, don't you? */
2877 while (!in_warnings && !NILP (Vpending_warnings))
2879 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2880 int speccount = specpdl_depth_counter;
2881 Lisp_Object this_warning_cons, this_warning, class, level, messij;
2883 record_unwind_protect (in_warnings_restore, Qnil);
2885 this_warning_cons = Vpending_warnings;
2886 this_warning = XCAR (this_warning_cons);
2887 /* in case an error occurs in the warn function, at least
2888 it won't happen infinitely */
2889 Vpending_warnings = XCDR (Vpending_warnings);
2890 free_cons (XCONS (this_warning_cons));
2891 class = XCAR (this_warning);
2892 level = XCAR (XCDR (this_warning));
2893 messij = XCAR (XCDR (XCDR (this_warning)));
2894 free_list (this_warning);
2896 if (NILP (Vpending_warnings))
2897 Vpending_warnings_tail = Qnil; /* perhaps not strictly necessary,
2900 GCPRO4 (form, class, level, messij);
2901 if (!STRINGP (messij))
2902 messij = Fprin1_to_string (messij, Qnil);
2903 call3 (Qdisplay_warning, class, messij, level);
2905 unbind_to (speccount, Qnil);
2909 return Fsymbol_value (form);
2915 if ((consing_since_gc > gc_cons_threshold) || always_gc)
2917 struct gcpro gcpro1;
2919 garbage_collect_1 ();
2923 if (++lisp_eval_depth > max_lisp_eval_depth)
2925 if (max_lisp_eval_depth < 100)
2926 max_lisp_eval_depth = 100;
2927 if (lisp_eval_depth > max_lisp_eval_depth)
2928 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2932 * At this point we know that `form' is a Lisp_Cons so we can safely
2933 * use XCAR and XCDR.
2935 original_fun = XCAR (form);
2936 original_args = XCDR (form);
2939 * Formerly we used a call to Flength here, but that is slow and
2940 * wasteful due to type checking, stack push/pop and initialization.
2941 * We know we're dealing with a cons, so open code it for speed.
2943 * We call QUIT in the loop so that a circular arg list won't lock
2946 for (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val))
2952 signal_simple_error ("Argument list must be nil-terminated",
2956 backtrace.id_number = 0;
2958 backtrace.pdlcount = specpdl_depth_counter;
2959 backtrace.function = &original_fun; /* This also protects them from gc */
2960 backtrace.args = &original_args;
2961 backtrace.nargs = UNEVALLED;
2962 backtrace.evalargs = 1;
2963 backtrace.debug_on_exit = 0;
2964 PUSH_BACKTRACE (backtrace);
2966 if (debug_on_next_call)
2967 do_debug_on_call (Qt);
2969 if (profiling_active)
2970 profile_increase_call_count (original_fun);
2972 /* At this point, only original_fun and original_args
2973 have values that will be used below */
2975 fun = indirect_function (original_fun, 1);
2979 struct Lisp_Subr *subr = XSUBR (fun);
2980 int max_args = subr->max_args;
2981 Lisp_Object argvals[SUBR_MAX_ARGS];
2982 Lisp_Object args_left;
2985 args_left = original_args;
2987 if (nargs < subr->min_args
2988 || (max_args >= 0 && max_args < nargs))
2990 return Fsignal (Qwrong_number_of_arguments,
2991 list2 (fun, make_int (nargs)));
2994 if (max_args == UNEVALLED)
2996 backtrace.evalargs = 0;
2997 val = ((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) (args_left);
3000 else if (max_args == MANY)
3002 /* Pass a vector of evaluated arguments */
3004 REGISTER int argnum;
3005 struct gcpro gcpro1, gcpro2, gcpro3;
3007 vals = alloca_array (Lisp_Object, nargs);
3009 GCPRO3 (args_left, fun, vals[0]);
3013 while (CONSP (args_left))
3015 vals[argnum++] = Feval (XCAR (args_left));
3016 args_left = XCDR (args_left);
3017 gcpro3.nvars = argnum;
3020 backtrace.args = vals;
3021 backtrace.nargs = nargs;
3023 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
3026 /* Have to duplicate this code because if the
3027 * debugger is called it must be in a scope in
3028 * which the `alloca'-ed data in vals is still valid.
3029 * (And GC-protected.)
3032 if (backtrace.debug_on_exit)
3033 val = do_debug_on_exit (val);
3034 POP_BACKTRACE (backtrace);
3041 struct gcpro gcpro1, gcpro2, gcpro3;
3043 GCPRO3 (args_left, fun, fun);
3044 gcpro3.var = argvals;
3047 for (i = 0; i < nargs; args_left = XCDR (args_left))
3049 argvals[i] = Feval (XCAR (args_left));
3055 /* i == nargs at this point */
3056 for (; i < max_args; i++)
3059 backtrace.args = argvals;
3060 backtrace.nargs = nargs;
3062 /* val = funcall_subr (subr, argvals); */
3063 inline_funcall_subr (val, subr, argvals);
3066 else if (COMPILED_FUNCTIONP (fun))
3067 val = apply_lambda (fun, nargs, original_args);
3073 goto invalid_function;
3074 funcar = XCAR (fun);
3075 if (!SYMBOLP (funcar))
3076 goto invalid_function;
3077 if (EQ (funcar, Qautoload))
3079 do_autoload (fun, original_fun);
3082 if (EQ (funcar, Qmacro))
3083 val = Feval (apply1 (XCDR (fun), original_args));
3084 else if (EQ (funcar, Qlambda))
3085 val = apply_lambda (fun, nargs, original_args);
3089 return Fsignal (Qinvalid_function, list1 (fun));
3094 if (backtrace.debug_on_exit)
3095 val = do_debug_on_exit (val);
3096 POP_BACKTRACE (backtrace);
3102 funcall_recording_as (Lisp_Object recorded_as, int nargs,
3105 /* This function can GC */
3108 struct backtrace backtrace;
3112 if ((consing_since_gc > gc_cons_threshold) || always_gc)
3113 /* Callers should gcpro lexpr args */
3114 garbage_collect_1 ();
3116 if (++lisp_eval_depth > max_lisp_eval_depth)
3118 if (max_lisp_eval_depth < 100)
3119 max_lisp_eval_depth = 100;
3120 if (lisp_eval_depth > max_lisp_eval_depth)
3121 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
3124 /* Count number of arguments to function */
3128 backtrace.id_number = 0;
3130 backtrace.pdlcount = specpdl_depth_counter;
3131 backtrace.function = &args[0];
3132 backtrace.args = &args[1];
3133 backtrace.nargs = nargs;
3134 backtrace.evalargs = 0;
3135 backtrace.debug_on_exit = 0;
3136 PUSH_BACKTRACE (backtrace);
3138 if (debug_on_next_call)
3139 do_debug_on_call (Qlambda);
3147 extern int emacs_btl_elisp_only_p;
3148 extern int btl_symbol_id_number ();
3149 if (emacs_btl_elisp_only_p)
3150 backtrace.id_number = btl_symbol_id_number (fun);
3154 /* It might be useful to place this *after* all the checks. */
3155 if (profiling_active)
3156 profile_increase_call_count (fun);
3159 fun = indirect_function (fun, 1);
3163 struct Lisp_Subr *subr = XSUBR (fun);
3164 int max_args = subr->max_args;
3166 if (max_args == UNEVALLED)
3167 return Fsignal (Qinvalid_function, list1 (fun));
3169 if (nargs < subr->min_args
3170 || (max_args >= 0 && max_args < nargs))
3172 return Fsignal (Qwrong_number_of_arguments,
3173 list2 (fun, make_int (nargs)));
3176 if (max_args == MANY)
3178 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
3182 else if (max_args > nargs)
3184 Lisp_Object argvals[SUBR_MAX_ARGS];
3186 /* Default optionals to nil */
3187 for (i = 0; i < nargs; i++)
3188 argvals[i] = args[i + 1];
3189 for (i = nargs; i < max_args; i++)
3192 /* val = funcall_subr (subr, argvals); */
3193 inline_funcall_subr (val, subr, argvals);
3196 /* val = funcall_subr (subr, args + 1); */
3197 inline_funcall_subr (val, subr, (&args[1]));
3199 else if (COMPILED_FUNCTIONP (fun))
3200 val = funcall_lambda (fun, nargs, args + 1);
3201 else if (!CONSP (fun))
3204 return Fsignal (Qinvalid_function, list1 (fun));
3208 /* `fun' is a Lisp_Cons so XCAR is safe */
3209 Lisp_Object funcar = XCAR (fun);
3211 if (!SYMBOLP (funcar))
3212 goto invalid_function;
3213 if (EQ (funcar, Qlambda))
3214 val = funcall_lambda (fun, nargs, args + 1);
3215 else if (EQ (funcar, Qautoload))
3217 do_autoload (fun, args[0]);
3222 goto invalid_function;
3226 if (backtrace.debug_on_exit)
3227 val = do_debug_on_exit (val);
3228 POP_BACKTRACE (backtrace);
3232 DEFUN ("funcall", Ffuncall, 1, MANY, 0, /*
3233 Call first argument as a function, passing remaining arguments to it.
3234 Thus, (funcall 'cons 'x 'y) returns (x . y).
3236 (int nargs, Lisp_Object *args))
3238 return funcall_recording_as (args[0], nargs, args);
3241 DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /*
3242 Return the number of arguments a function may be called with. The
3243 function may be any form that can be passed to `funcall', any special
3248 Lisp_Object orig_function = function;
3249 Lisp_Object arglist;
3254 if (SYMBOLP (function))
3255 function = indirect_function (function, 1);
3257 if (SUBRP (function))
3258 return Fsubr_min_args (function);
3259 else if (!COMPILED_FUNCTIONP (function) && !CONSP (function))
3262 return Fsignal (Qinvalid_function, list1 (function));
3265 if (CONSP (function))
3267 Lisp_Object funcar = XCAR (function);
3269 if (!SYMBOLP (funcar))
3270 goto invalid_function;
3271 if (EQ (funcar, Qmacro))
3273 function = XCDR (function);
3276 if (EQ (funcar, Qautoload))
3278 do_autoload (function, orig_function);
3281 if (EQ (funcar, Qlambda))
3282 arglist = Fcar (XCDR (function));
3284 goto invalid_function;
3287 arglist = XCOMPILED_FUNCTION (function)->arglist;
3290 while (!NILP (arglist))
3293 if (EQ (Fcar (arglist), Qand_optional)
3294 || EQ (Fcar (arglist), Qand_rest))
3297 arglist = Fcdr (arglist);
3300 return make_int (argcount);
3303 DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /*
3304 Return the number of arguments a function may be called with. If the
3305 function takes an arbitrary number of arguments or is a built-in
3306 special form, nil is returned. The function may be any form that can
3307 be passed to `funcall', any special form, or any macro.
3311 Lisp_Object orig_function = function;
3312 Lisp_Object arglist;
3317 if (SYMBOLP (function))
3318 function = indirect_function (function, 1);
3320 if (SUBRP (function))
3321 return Fsubr_max_args (function);
3322 else if (!COMPILED_FUNCTIONP (function) && !CONSP (function))
3325 return Fsignal (Qinvalid_function, list1 (function));
3328 if (CONSP (function))
3330 Lisp_Object funcar = XCAR (function);
3332 if (!SYMBOLP (funcar))
3333 goto invalid_function;
3334 if (EQ (funcar, Qmacro))
3336 function = XCDR (function);
3339 if (EQ (funcar, Qautoload))
3341 do_autoload (function, orig_function);
3344 if (EQ (funcar, Qlambda))
3345 arglist = Fcar (XCDR (function));
3347 goto invalid_function;
3350 arglist = XCOMPILED_FUNCTION (function)->arglist;
3353 while (!NILP (arglist))
3356 if (EQ (Fcar (arglist), Qand_optional))
3358 arglist = Fcdr (arglist);
3361 if (EQ (Fcar (arglist), Qand_rest))
3364 arglist = Fcdr (arglist);
3367 return make_int (argcount);
3371 DEFUN ("apply", Fapply, 2, MANY, 0, /*
3372 Call FUNCTION with our remaining args, using our last arg as list of args.
3373 Thus, (apply '+ 1 2 '(3 4)) returns 10.
3375 (int nargs, Lisp_Object *args))
3377 /* This function can GC */
3378 Lisp_Object fun = args[0];
3379 Lisp_Object spread_arg = args [nargs - 1], p;
3383 CHECK_LIST (spread_arg);
3386 * Formerly we used a call to Flength here, but that is slow and
3387 * wasteful due to type checking, stack push/pop and initialization.
3388 * We know we're dealing with a cons, so open code it for speed.
3390 * We call QUIT in the loop so that a circular arg list won't lock
3393 for (numargs = 0, p = spread_arg ; CONSP (p) ; p = XCDR (p))
3399 signal_simple_error ("Argument list must be nil-terminated", spread_arg);
3402 /* (apply foo 0 1 '()) */
3403 return Ffuncall (nargs - 1, args);
3404 else if (numargs == 1)
3406 /* (apply foo 0 1 '(2)) */
3407 args [nargs - 1] = XCAR (spread_arg);
3408 return Ffuncall (nargs, args);
3411 /* -1 for function, -1 for spread arg */
3412 numargs = nargs - 2 + numargs;
3413 /* +1 for function */
3414 funcall_nargs = 1 + numargs;
3417 fun = indirect_function (fun, 0);
3420 /* Let funcall get the error */
3423 else if (SUBRP (fun))
3425 struct Lisp_Subr *subr = XSUBR (fun);
3426 int max_args = subr->max_args;
3428 if (numargs < subr->min_args
3429 || (max_args >= 0 && max_args < numargs))
3431 /* Let funcall get the error */
3433 else if (max_args > numargs)
3435 /* Avoid having funcall cons up yet another new vector of arguments
3436 by explicitly supplying nil's for optional values */
3437 funcall_nargs += (max_args - numargs);
3442 Lisp_Object *funcall_args = alloca_array (Lisp_Object, funcall_nargs);
3443 struct gcpro gcpro1;
3445 GCPRO1 (*funcall_args);
3446 gcpro1.nvars = funcall_nargs;
3448 /* Copy in the unspread args */
3449 memcpy (funcall_args, args, (nargs - 1) * sizeof (Lisp_Object));
3450 /* Spread the last arg we got. Its first element goes in
3451 the slot that it used to occupy, hence this value of I. */
3453 !NILP (spread_arg); /* i < 1 + numargs */
3454 i++, spread_arg = XCDR (spread_arg))
3456 funcall_args [i] = XCAR (spread_arg);
3458 /* Supply nil for optional args (to subrs) */
3459 for (; i < funcall_nargs; i++)
3460 funcall_args[i] = Qnil;
3463 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args));
3468 /* FSFmacs has an extra arg EVAL_FLAG. If false, some of
3469 the statements below are not done. But it's always true
3470 in all the calls to apply_lambda(). */
3473 apply_lambda (Lisp_Object fun, int numargs, Lisp_Object unevalled_args)
3475 /* This function can GC */
3476 struct gcpro gcpro1, gcpro2, gcpro3;
3478 REGISTER Lisp_Object tem;
3479 REGISTER Lisp_Object *arg_vector = alloca_array (Lisp_Object, numargs);
3481 GCPRO3 (*arg_vector, unevalled_args, fun);
3484 for (i = 0; i < numargs;)
3487 * unevalled_args is always a normal list, or Feval would have
3488 * rejected it, so use XCAR and XCDR.
3490 tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args);
3492 arg_vector[i++] = tem;
3498 backtrace_list->args = arg_vector;
3499 backtrace_list->nargs = i;
3500 backtrace_list->evalargs = 0;
3501 tem = funcall_lambda (fun, numargs, arg_vector);
3503 /* Do the debug-on-exit now, while arg_vector still exists. */
3504 if (backtrace_list->debug_on_exit)
3505 tem = do_debug_on_exit (tem);
3506 /* Don't do it again when we return to eval. */
3507 backtrace_list->debug_on_exit = 0;
3511 DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
3512 If byte-compiled OBJECT is lazy-loaded, fetch it now.
3516 if (COMPILED_FUNCTIONP (object)
3517 && CONSP (XCOMPILED_FUNCTION (object)->bytecodes))
3520 read_doc_string (XCOMPILED_FUNCTION (object)->bytecodes);
3522 signal_simple_error ("invalid lazy-loaded byte code", tem);
3523 /* v18 or v19 bytecode file. Need to Ebolify. */
3524 if (XCOMPILED_FUNCTION (object)->flags.ebolified
3525 && VECTORP (XCDR (tem)))
3526 ebolify_bytecode_constants (XCDR (tem));
3527 /* VERY IMPORTANT to purecopy here!!!!!
3528 See load_force_doc_string_unwind. */
3529 XCOMPILED_FUNCTION (object)->bytecodes = Fpurecopy (XCAR (tem));
3530 XCOMPILED_FUNCTION (object)->constants = Fpurecopy (XCDR (tem));
3535 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3536 and return the result of evaluation.
3537 FUN must be either a lambda-expression or a compiled-code object. */
3540 funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object arg_vector[])
3542 /* This function can GC */
3543 Lisp_Object val, tem;
3544 REGISTER Lisp_Object syms_left;
3545 REGISTER Lisp_Object next;
3546 int speccount = specpdl_depth_counter;
3548 int optional = 0, rest = 0;
3551 syms_left = Fcar (XCDR (fun));
3552 else if (COMPILED_FUNCTIONP (fun))
3553 syms_left = XCOMPILED_FUNCTION (fun)->arglist;
3557 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
3560 next = XCAR (syms_left);
3561 if (!SYMBOLP (next))
3562 signal_error (Qinvalid_function, list1 (fun));
3563 if (EQ (next, Qand_rest))
3565 else if (EQ (next, Qand_optional))
3569 specbind (next, Flist (nargs - i, &arg_vector[i]));
3574 tem = arg_vector[i++];
3575 specbind (next, tem);
3578 return Fsignal (Qwrong_number_of_arguments,
3579 list2 (fun, make_int (nargs)));
3581 specbind (next, Qnil);
3585 return Fsignal (Qwrong_number_of_arguments,
3586 list2 (fun, make_int (nargs)));
3589 val = Fprogn (Fcdr (XCDR (fun)));
3592 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);
3593 /* If we have not actually read the bytecode string
3594 and constants vector yet, fetch them from the file. */
3595 if (CONSP (b->bytecodes))
3596 Ffetch_bytecode (fun);
3597 val = Fbyte_code (b->bytecodes,
3599 make_int (b->maxdepth));
3601 return unbind_to (speccount, val);
3604 /**********************************************************************/
3605 /* Run hook variables in various ways. */
3606 /**********************************************************************/
3608 DEFUN ("run-hooks", Frun_hooks, 1, MANY, 0, /*
3609 Run each hook in HOOKS. Major mode functions use this.
3610 Each argument should be a symbol, a hook variable.
3611 These symbols are processed in the order specified.
3612 If a hook symbol has a non-nil value, that value may be a function
3613 or a list of functions to be called to run the hook.
3614 If the value is a function, it is called with no arguments.
3615 If it is a list, the elements are called, in order, with no arguments.
3617 To make a hook variable buffer-local, use `make-local-hook',
3618 not `make-local-variable'.
3620 (int nargs, Lisp_Object *args))
3624 for (i = 0; i < nargs; i++)
3625 run_hook_with_args (1, args + i, RUN_HOOKS_TO_COMPLETION);
3630 DEFUN ("run-hook-with-args", Frun_hook_with_args, 1, MANY, 0, /*
3631 Run HOOK with the specified arguments ARGS.
3632 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
3633 value, that value may be a function or a list of functions to be
3634 called to run the hook. If the value is a function, it is called with
3635 the given arguments and its return value is returned. If it is a list
3636 of functions, those functions are called, in order,
3637 with the given arguments ARGS.
3638 It is best not to depend on the value return by `run-hook-with-args',
3641 To make a hook variable buffer-local, use `make-local-hook',
3642 not `make-local-variable'.
3644 (int nargs, Lisp_Object *args))
3646 return run_hook_with_args (nargs, args, RUN_HOOKS_TO_COMPLETION);
3649 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 1, MANY, 0, /*
3650 Run HOOK with the specified arguments ARGS.
3651 HOOK should be a symbol, a hook variable. Its value should
3652 be a list of functions. We call those functions, one by one,
3653 passing arguments ARGS to each of them, until one of them
3654 returns a non-nil value. Then we return that value.
3655 If all the functions return nil, we return nil.
3657 To make a hook variable buffer-local, use `make-local-hook',
3658 not `make-local-variable'.
3660 (int nargs, Lisp_Object *args))
3662 return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_SUCCESS);
3665 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 1, MANY, 0, /*
3666 Run HOOK with the specified arguments ARGS.
3667 HOOK should be a symbol, a hook variable. Its value should
3668 be a list of functions. We call those functions, one by one,
3669 passing arguments ARGS to each of them, until one of them
3670 returns nil. Then we return nil.
3671 If all the functions return non-nil, we return non-nil.
3673 To make a hook variable buffer-local, use `make-local-hook',
3674 not `make-local-variable'.
3676 (int nargs, Lisp_Object *args))
3678 return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_FAILURE);
3681 /* ARGS[0] should be a hook symbol.
3682 Call each of the functions in the hook value, passing each of them
3683 as arguments all the rest of ARGS (all NARGS - 1 elements).
3684 COND specifies a condition to test after each call
3685 to decide whether to stop.
3686 The caller (or its caller, etc) must gcpro all of ARGS,
3687 except that it isn't necessary to gcpro ARGS[0]. */
3690 run_hook_with_args_in_buffer (struct buffer *buf, int nargs, Lisp_Object *args,
3691 enum run_hooks_condition cond)
3693 Lisp_Object sym, val, ret;
3694 struct gcpro gcpro1, gcpro2;
3696 if (!initialized || preparing_for_armageddon)
3697 /* We need to bail out of here pronto. */
3700 /* Whenever gc_in_progress is true, preparing_for_armageddon
3701 will also be true unless something is really hosed. */
3702 assert (!gc_in_progress);
3705 val = symbol_value_in_buffer (sym, make_buffer (buf));
3706 ret = (cond == RUN_HOOKS_UNTIL_FAILURE ? Qt : Qnil);
3708 if (UNBOUNDP (val) || NILP (val))
3710 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
3713 return Ffuncall (nargs, args);
3720 CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
3721 || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret)
3725 if (EQ (XCAR (val), Qt))
3727 /* t indicates this hook has a local binding;
3728 it means to run the global binding too. */
3729 Lisp_Object globals = Fdefault_value (sym);
3731 if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) &&
3735 ret = Ffuncall (nargs, args);
3740 CONSP (globals) && ((cond == RUN_HOOKS_TO_COMPLETION)
3741 || (cond == RUN_HOOKS_UNTIL_SUCCESS
3744 globals = XCDR (globals))
3746 args[0] = XCAR (globals);
3747 /* In a global value, t should not occur. If it does, we
3748 must ignore it to avoid an endless loop. */
3749 if (!EQ (args[0], Qt))
3750 ret = Ffuncall (nargs, args);
3756 args[0] = XCAR (val);
3757 ret = Ffuncall (nargs, args);
3767 run_hook_with_args (int nargs, Lisp_Object *args,
3768 enum run_hooks_condition cond)
3770 return run_hook_with_args_in_buffer (current_buffer, nargs, args, cond);
3775 /* From FSF 19.30, not currently used */
3777 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
3778 present value of that symbol.
3779 Call each element of FUNLIST,
3780 passing each of them the rest of ARGS.
3781 The caller (or its caller, etc) must gcpro all of ARGS,
3782 except that it isn't necessary to gcpro ARGS[0]. */
3785 run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
3789 struct gcpro gcpro1, gcpro2;
3794 for (val = funlist; CONSP (val); val = XCDR (val))
3796 if (EQ (XCAR (val), Qt))
3798 /* t indicates this hook has a local binding;
3799 it means to run the global binding too. */
3800 Lisp_Object globals;
3802 for (globals = Fdefault_value (sym);
3804 globals = XCDR (globals))
3806 args[0] = XCAR (globals);
3807 /* In a global value, t should not occur. If it does, we
3808 must ignore it to avoid an endless loop. */
3809 if (!EQ (args[0], Qt))
3810 Ffuncall (nargs, args);
3815 args[0] = XCAR (val);
3816 Ffuncall (nargs, args);
3826 va_run_hook_with_args (Lisp_Object hook_var, int nargs, ...)
3828 /* This function can GC */
3829 struct gcpro gcpro1;
3832 Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs);
3834 va_start (vargs, nargs);
3835 funcall_args[0] = hook_var;
3836 for (i = 0; i < nargs; i++)
3837 funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
3840 GCPRO1 (*funcall_args);
3841 gcpro1.nvars = nargs + 1;
3842 run_hook_with_args (nargs + 1, funcall_args, RUN_HOOKS_TO_COMPLETION);
3847 va_run_hook_with_args_in_buffer (struct buffer *buf, Lisp_Object hook_var,
3850 /* This function can GC */
3851 struct gcpro gcpro1;
3854 Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs);
3856 va_start (vargs, nargs);
3857 funcall_args[0] = hook_var;
3858 for (i = 0; i < nargs; i++)
3859 funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
3862 GCPRO1 (*funcall_args);
3863 gcpro1.nvars = nargs + 1;
3864 run_hook_with_args_in_buffer (buf, nargs + 1, funcall_args,
3865 RUN_HOOKS_TO_COMPLETION);
3870 run_hook (Lisp_Object hook)
3872 Frun_hooks (1, &hook);
3877 /**********************************************************************/
3878 /* Front-ends to eval, funcall, apply */
3879 /**********************************************************************/
3881 /* Apply fn to arg */
3883 apply1 (Lisp_Object fn, Lisp_Object arg)
3885 /* This function can GC */
3886 struct gcpro gcpro1;
3887 Lisp_Object args[2];
3890 return Ffuncall (1, &fn);
3895 RETURN_UNGCPRO (Fapply (2, args));
3898 /* Call function fn on no arguments */
3900 call0 (Lisp_Object fn)
3902 /* This function can GC */
3903 struct gcpro gcpro1;
3906 RETURN_UNGCPRO (Ffuncall (1, &fn));
3909 /* Call function fn with argument arg0 */
3911 call1 (Lisp_Object fn,
3914 /* This function can GC */
3915 struct gcpro gcpro1;
3916 Lisp_Object args[2];
3921 RETURN_UNGCPRO (Ffuncall (2, args));
3924 /* Call function fn with arguments arg0, arg1 */
3926 call2 (Lisp_Object fn,
3927 Lisp_Object arg0, Lisp_Object arg1)
3929 /* This function can GC */
3930 struct gcpro gcpro1;
3931 Lisp_Object args[3];
3937 RETURN_UNGCPRO (Ffuncall (3, args));
3940 /* Call function fn with arguments arg0, arg1, arg2 */
3942 call3 (Lisp_Object fn,
3943 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2)
3945 /* This function can GC */
3946 struct gcpro gcpro1;
3947 Lisp_Object args[4];
3954 RETURN_UNGCPRO (Ffuncall (4, args));
3957 /* Call function fn with arguments arg0, arg1, arg2, arg3 */
3959 call4 (Lisp_Object fn,
3960 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
3963 /* This function can GC */
3964 struct gcpro gcpro1;
3965 Lisp_Object args[5];
3973 RETURN_UNGCPRO (Ffuncall (5, args));
3976 /* Call function fn with arguments arg0, arg1, arg2, arg3, arg4 */
3978 call5 (Lisp_Object fn,
3979 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
3980 Lisp_Object arg3, Lisp_Object arg4)
3982 /* This function can GC */
3983 struct gcpro gcpro1;
3984 Lisp_Object args[6];
3993 RETURN_UNGCPRO (Ffuncall (6, args));
3997 call6 (Lisp_Object fn,
3998 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
3999 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5)
4001 /* This function can GC */
4002 struct gcpro gcpro1;
4003 Lisp_Object args[7];
4013 RETURN_UNGCPRO (Ffuncall (7, args));
4017 call7 (Lisp_Object fn,
4018 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
4019 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
4022 /* This function can GC */
4023 struct gcpro gcpro1;
4024 Lisp_Object args[8];
4035 RETURN_UNGCPRO (Ffuncall (8, args));
4039 call8 (Lisp_Object fn,
4040 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
4041 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
4042 Lisp_Object arg6, Lisp_Object arg7)
4044 /* This function can GC */
4045 struct gcpro gcpro1;
4046 Lisp_Object args[9];
4058 RETURN_UNGCPRO (Ffuncall (9, args));
4062 call0_in_buffer (struct buffer *buf, Lisp_Object fn)
4064 if (current_buffer == buf)
4069 int speccount = specpdl_depth_counter;
4070 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4071 set_buffer_internal (buf);
4073 unbind_to (speccount, Qnil);
4079 call1_in_buffer (struct buffer *buf, Lisp_Object fn,
4082 if (current_buffer == buf)
4083 return call1 (fn, arg0);
4087 int speccount = specpdl_depth_counter;
4088 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4089 set_buffer_internal (buf);
4090 val = call1 (fn, arg0);
4091 unbind_to (speccount, Qnil);
4097 call2_in_buffer (struct buffer *buf, Lisp_Object fn,
4098 Lisp_Object arg0, Lisp_Object arg1)
4100 if (current_buffer == buf)
4101 return call2 (fn, arg0, arg1);
4105 int speccount = specpdl_depth_counter;
4106 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4107 set_buffer_internal (buf);
4108 val = call2 (fn, arg0, arg1);
4109 unbind_to (speccount, Qnil);
4115 call3_in_buffer (struct buffer *buf, Lisp_Object fn,
4116 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2)
4118 if (current_buffer == buf)
4119 return call3 (fn, arg0, arg1, arg2);
4123 int speccount = specpdl_depth_counter;
4124 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4125 set_buffer_internal (buf);
4126 val = call3 (fn, arg0, arg1, arg2);
4127 unbind_to (speccount, Qnil);
4133 call4_in_buffer (struct buffer *buf, Lisp_Object fn,
4134 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
4137 if (current_buffer == buf)
4138 return call4 (fn, arg0, arg1, arg2, arg3);
4142 int speccount = specpdl_depth_counter;
4143 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4144 set_buffer_internal (buf);
4145 val = call4 (fn, arg0, arg1, arg2, arg3);
4146 unbind_to (speccount, Qnil);
4152 eval_in_buffer (struct buffer *buf, Lisp_Object form)
4154 if (current_buffer == buf)
4155 return Feval (form);
4159 int speccount = specpdl_depth_counter;
4160 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4161 set_buffer_internal (buf);
4163 unbind_to (speccount, Qnil);
4169 /***** Error-catching front-ends to eval, funcall, apply */
4171 /* Call function fn on no arguments, with condition handler */
4173 call0_with_handler (Lisp_Object handler, Lisp_Object fn)
4175 /* This function can GC */
4176 struct gcpro gcpro1;
4177 Lisp_Object args[2];
4182 RETURN_UNGCPRO (Fcall_with_condition_handler (2, args));
4185 /* Call function fn with argument arg0, with condition handler */
4187 call1_with_handler (Lisp_Object handler, Lisp_Object fn,
4190 /* This function can GC */
4191 struct gcpro gcpro1;
4192 Lisp_Object args[3];
4198 RETURN_UNGCPRO (Fcall_with_condition_handler (3, args));
4202 /* The following functions provide you with error-trapping versions
4203 of the various front-ends above. They take an additional
4204 "warning_string" argument; if non-zero, a warning with this
4205 string and the actual error that occurred will be displayed
4206 in the *Warnings* buffer if an error occurs. In all cases,
4207 QUIT is inhibited while these functions are running, and if
4208 an error occurs, Qunbound is returned instead of the normal
4212 /* #### This stuff needs to catch throws as well. We need to
4213 improve internal_catch() so it can take a "catch anything"
4214 argument similar to Qt or Qerror for condition_case_1(). */
4217 caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
4219 if (!NILP (errordata))
4221 Lisp_Object args[2];
4225 char *str = (char *) get_opaque_ptr (arg);
4226 args[0] = build_string (str);
4229 args[0] = build_string ("error");
4230 /* #### This should call
4231 (with-output-to-string (display-error errordata))
4232 but that stuff is all in Lisp currently. */
4233 args[1] = errordata;
4234 warn_when_safe_lispobj
4236 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
4237 Qnil, -1, 2, args));
4243 allow_quit_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
4245 if (CONSP (errordata) && EQ (XCAR (errordata), Qquit))
4246 return Fsignal (Qquit, XCDR (errordata));
4247 return caught_a_squirmer (errordata, arg);
4251 safe_run_hook_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
4253 Lisp_Object hook = Fcar (arg);
4255 /* Clear out the hook. */
4257 return caught_a_squirmer (errordata, arg);
4261 allow_quit_safe_run_hook_caught_a_squirmer (Lisp_Object errordata,
4264 Lisp_Object hook = Fcar (arg);
4266 if (!CONSP (errordata) || !EQ (XCAR (errordata), Qquit))
4267 /* Clear out the hook. */
4269 return allow_quit_caught_a_squirmer (errordata, arg);
4273 catch_them_squirmers_eval_in_buffer (Lisp_Object cons)
4275 return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons));
4279 eval_in_buffer_trapping_errors (CONST char *warning_string,
4280 struct buffer *buf, Lisp_Object form)
4282 int speccount = specpdl_depth_counter;
4287 struct gcpro gcpro1, gcpro2;
4289 XSETBUFFER (buffer, buf);
4291 specbind (Qinhibit_quit, Qt);
4292 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4294 cons = noseeum_cons (buffer, form);
4295 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
4296 GCPRO2 (cons, opaque);
4297 /* Qerror not Qt, so you can get a backtrace */
4298 tem = condition_case_1 (Qerror,
4299 catch_them_squirmers_eval_in_buffer, cons,
4300 caught_a_squirmer, opaque);
4301 free_cons (XCONS (cons));
4302 if (OPAQUEP (opaque))
4303 free_opaque_ptr (opaque);
4306 /* gc_currently_forbidden = 0; */
4307 return unbind_to (speccount, tem);
4311 catch_them_squirmers_run_hook (Lisp_Object hook_symbol)
4313 /* This function can GC */
4314 run_hook (hook_symbol);
4319 run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol)
4324 struct gcpro gcpro1;
4326 if (!initialized || preparing_for_armageddon)
4328 tem = find_symbol_value (hook_symbol);
4329 if (NILP (tem) || UNBOUNDP (tem))
4332 speccount = specpdl_depth_counter;
4333 specbind (Qinhibit_quit, Qt);
4335 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
4337 /* Qerror not Qt, so you can get a backtrace */
4338 tem = condition_case_1 (Qerror,
4339 catch_them_squirmers_run_hook, hook_symbol,
4340 caught_a_squirmer, opaque);
4341 if (OPAQUEP (opaque))
4342 free_opaque_ptr (opaque);
4345 return unbind_to (speccount, tem);
4348 /* Same as run_hook_trapping_errors() but also set the hook to nil
4349 if an error occurs. */
4352 safe_run_hook_trapping_errors (CONST char *warning_string,
4353 Lisp_Object hook_symbol,
4356 int speccount = specpdl_depth_counter;
4358 Lisp_Object cons = Qnil;
4359 struct gcpro gcpro1;
4361 if (!initialized || preparing_for_armageddon)
4363 tem = find_symbol_value (hook_symbol);
4364 if (NILP (tem) || UNBOUNDP (tem))
4368 specbind (Qinhibit_quit, Qt);
4370 cons = noseeum_cons (hook_symbol,
4371 warning_string ? make_opaque_ptr (warning_string)
4374 /* Qerror not Qt, so you can get a backtrace */
4375 tem = condition_case_1 (Qerror,
4376 catch_them_squirmers_run_hook,
4379 allow_quit_safe_run_hook_caught_a_squirmer :
4380 safe_run_hook_caught_a_squirmer,
4382 if (OPAQUEP (XCDR (cons)))
4383 free_opaque_ptr (XCDR (cons));
4384 free_cons (XCONS (cons));
4387 return unbind_to (speccount, tem);
4391 catch_them_squirmers_call0 (Lisp_Object function)
4393 /* This function can GC */
4394 return call0 (function);
4398 call0_trapping_errors (CONST char *warning_string, Lisp_Object function)
4402 Lisp_Object opaque = Qnil;
4403 struct gcpro gcpro1, gcpro2;
4405 if (SYMBOLP (function))
4407 tem = XSYMBOL (function)->function;
4408 if (NILP (tem) || UNBOUNDP (tem))
4412 GCPRO2 (opaque, function);
4413 speccount = specpdl_depth_counter;
4414 specbind (Qinhibit_quit, Qt);
4415 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4417 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
4418 /* Qerror not Qt, so you can get a backtrace */
4419 tem = condition_case_1 (Qerror,
4420 catch_them_squirmers_call0, function,
4421 caught_a_squirmer, opaque);
4422 if (OPAQUEP (opaque))
4423 free_opaque_ptr (opaque);
4426 /* gc_currently_forbidden = 0; */
4427 return unbind_to (speccount, tem);
4431 catch_them_squirmers_call1 (Lisp_Object cons)
4433 /* This function can GC */
4434 return call1 (XCAR (cons), XCDR (cons));
4438 catch_them_squirmers_call2 (Lisp_Object cons)
4440 /* This function can GC */
4441 return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons))));
4445 call1_trapping_errors (CONST char *warning_string, Lisp_Object function,
4448 int speccount = specpdl_depth_counter;
4450 Lisp_Object cons = Qnil;
4451 Lisp_Object opaque = Qnil;
4452 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4454 if (SYMBOLP (function))
4456 tem = XSYMBOL (function)->function;
4457 if (NILP (tem) || UNBOUNDP (tem))
4461 GCPRO4 (cons, opaque, function, object);
4463 specbind (Qinhibit_quit, Qt);
4464 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4466 cons = noseeum_cons (function, object);
4467 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
4468 /* Qerror not Qt, so you can get a backtrace */
4469 tem = condition_case_1 (Qerror,
4470 catch_them_squirmers_call1, cons,
4471 caught_a_squirmer, opaque);
4472 if (OPAQUEP (opaque))
4473 free_opaque_ptr (opaque);
4474 free_cons (XCONS (cons));
4477 /* gc_currently_forbidden = 0; */
4478 return unbind_to (speccount, tem);
4482 call2_trapping_errors (CONST char *warning_string, Lisp_Object function,
4483 Lisp_Object object1, Lisp_Object object2)
4485 int speccount = specpdl_depth_counter;
4487 Lisp_Object cons = Qnil;
4488 Lisp_Object opaque = Qnil;
4489 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4491 if (SYMBOLP (function))
4493 tem = XSYMBOL (function)->function;
4494 if (NILP (tem) || UNBOUNDP (tem))
4498 GCPRO5 (cons, opaque, function, object1, object2);
4499 specbind (Qinhibit_quit, Qt);
4500 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4502 cons = list3 (function, object1, object2);
4503 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
4504 /* Qerror not Qt, so you can get a backtrace */
4505 tem = condition_case_1 (Qerror,
4506 catch_them_squirmers_call2, cons,
4507 caught_a_squirmer, opaque);
4508 if (OPAQUEP (opaque))
4509 free_opaque_ptr (opaque);
4513 /* gc_currently_forbidden = 0; */
4514 return unbind_to (speccount, tem);
4518 /**********************************************************************/
4519 /* The special binding stack */
4520 /**********************************************************************/
4522 #define min_max_specpdl_size 400
4527 if (specpdl_size >= max_specpdl_size)
4529 if (max_specpdl_size < min_max_specpdl_size)
4530 max_specpdl_size = min_max_specpdl_size;
4531 if (specpdl_size >= max_specpdl_size)
4533 if (!NILP (Vdebug_on_error) || !NILP (Vdebug_on_signal))
4534 /* Leave room for some specpdl in the debugger. */
4535 max_specpdl_size = specpdl_size + 100;
4537 ("Variable binding depth exceeds max-specpdl-size");
4541 if (specpdl_size > max_specpdl_size)
4542 specpdl_size = max_specpdl_size;
4543 XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size);
4544 specpdl_ptr = specpdl + specpdl_depth_counter;
4548 /* Handle unbinding buffer-local variables */
4550 specbind_unwind_local (Lisp_Object ovalue)
4552 Lisp_Object current = Fcurrent_buffer ();
4553 Lisp_Object symbol = specpdl_ptr->symbol;
4554 struct Lisp_Cons *victim = XCONS (ovalue);
4555 Lisp_Object buf = get_buffer (victim->car, 0);
4556 ovalue = victim->cdr;
4562 /* Deleted buffer -- do nothing */
4564 else if (symbol_value_buffer_local_info (symbol, XBUFFER (buf)) == 0)
4566 /* Was buffer-local when binding was made, now no longer is.
4567 * (kill-local-variable can do this.)
4568 * Do nothing in this case.
4571 else if (EQ (buf, current))
4572 Fset (symbol, ovalue);
4575 /* Urk! Somebody switched buffers */
4576 struct gcpro gcpro1;
4579 Fset (symbol, ovalue);
4580 Fset_buffer (current);
4587 specbind_unwind_wasnt_local (Lisp_Object buffer)
4589 Lisp_Object current = Fcurrent_buffer ();
4590 Lisp_Object symbol = specpdl_ptr->symbol;
4592 buffer = get_buffer (buffer, 0);
4595 /* Deleted buffer -- do nothing */
4597 else if (symbol_value_buffer_local_info (symbol, XBUFFER (buffer)) == 0)
4599 /* Was buffer-local when binding was made, now no longer is.
4600 * (kill-local-variable can do this.)
4601 * Do nothing in this case.
4604 else if (EQ (buffer, current))
4605 Fkill_local_variable (symbol);
4608 /* Urk! Somebody switched buffers */
4609 struct gcpro gcpro1;
4611 Fset_buffer (buffer);
4612 Fkill_local_variable (symbol);
4613 Fset_buffer (current);
4621 specbind (Lisp_Object symbol, Lisp_Object value)
4625 CHECK_SYMBOL (symbol);
4627 if (specpdl_depth_counter >= specpdl_size)
4630 buffer_local = symbol_value_buffer_local_info (symbol, current_buffer);
4631 if (buffer_local == 0)
4633 specpdl_ptr->old_value = find_symbol_value (symbol);
4634 specpdl_ptr->func = 0; /* Handled specially by unbind_to */
4636 else if (buffer_local > 0)
4638 /* Already buffer-local */
4639 specpdl_ptr->old_value = noseeum_cons (Fcurrent_buffer (),
4640 find_symbol_value (symbol));
4641 specpdl_ptr->func = specbind_unwind_local;
4645 /* About to become buffer-local */
4646 specpdl_ptr->old_value = Fcurrent_buffer ();
4647 specpdl_ptr->func = specbind_unwind_wasnt_local;
4650 specpdl_ptr->symbol = symbol;
4652 specpdl_depth_counter++;
4654 Fset (symbol, value);
4658 record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg),
4661 if (specpdl_depth_counter >= specpdl_size)
4663 specpdl_ptr->func = function;
4664 specpdl_ptr->symbol = Qnil;
4665 specpdl_ptr->old_value = arg;
4667 specpdl_depth_counter++;
4670 extern int check_sigio (void);
4673 unbind_to (int count, Lisp_Object value)
4676 struct gcpro gcpro1;
4680 check_quit (); /* make Vquit_flag accurate */
4681 quitf = !NILP (Vquit_flag);
4684 while (specpdl_depth_counter != count)
4688 --specpdl_depth_counter;
4690 ovalue = specpdl_ptr->old_value;
4691 if (specpdl_ptr->func != 0)
4692 /* An unwind-protect */
4693 (*specpdl_ptr->func) (ovalue);
4695 Fset (specpdl_ptr->symbol, ovalue);
4697 #ifndef EXCEEDINGLY_QUESTIONABLE_CODE
4698 /* There should never be anything here for us to remove.
4699 If so, it indicates a logic error in Emacs. Catches
4700 should get removed when a throw or signal occurs, or
4701 when a catch or condition-case exits normally. But
4702 it's too dangerous to just remove this code. --ben */
4704 /* Furthermore, this code is not in FSFmacs!!!
4705 Braino on mly's part? */
4706 /* If we're unwound past the pdlcount of a catch frame,
4707 that catch can't possibly still be valid. */
4708 while (catchlist && catchlist->pdlcount > specpdl_depth_counter)
4710 catchlist = catchlist->next;
4711 /* Don't mess with gcprolist, backtrace_list here */
4725 specpdl_depth (void)
4727 return specpdl_depth_counter;
4731 /* Get the value of symbol's global binding, even if that binding is
4732 not now dynamically visible. May return Qunbound or magic values. */
4735 top_level_value (Lisp_Object symbol)
4737 REGISTER struct specbinding *ptr = specpdl;
4739 CHECK_SYMBOL (symbol);
4740 for (; ptr != specpdl_ptr; ptr++)
4742 if (EQ (ptr->symbol, symbol))
4743 return ptr->old_value;
4745 return XSYMBOL (symbol)->value;
4751 top_level_set (Lisp_Object symbol, Lisp_Object newval)
4753 REGISTER struct specbinding *ptr = specpdl;
4755 CHECK_SYMBOL (symbol);
4756 for (; ptr != specpdl_ptr; ptr++)
4758 if (EQ (ptr->symbol, symbol))
4760 ptr->old_value = newval;
4764 return Fset (symbol, newval);
4770 /**********************************************************************/
4772 /**********************************************************************/
4774 DEFUN ("backtrace-debug", Fbacktrace_debug, 2, 2, 0, /*
4775 Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
4776 The debugger is entered when that frame exits, if the flag is non-nil.
4780 REGISTER struct backtrace *backlist = backtrace_list;
4785 for (i = 0; backlist && i < XINT (level); i++)
4787 backlist = backlist->next;
4791 backlist->debug_on_exit = !NILP (flag);
4797 backtrace_specials (int speccount, int speclimit, Lisp_Object stream)
4799 int printing_bindings = 0;
4801 for (; speccount > speclimit; speccount--)
4803 if (specpdl[speccount - 1].func == 0
4804 || specpdl[speccount - 1].func == specbind_unwind_local
4805 || specpdl[speccount - 1].func == specbind_unwind_wasnt_local)
4807 write_c_string (((!printing_bindings) ? " # bind (" : " "),
4809 Fprin1 (specpdl[speccount - 1].symbol, stream);
4810 printing_bindings = 1;
4814 if (printing_bindings) write_c_string (")\n", stream);
4815 write_c_string (" # (unwind-protect ...)\n", stream);
4816 printing_bindings = 0;
4819 if (printing_bindings) write_c_string (")\n", stream);
4822 DEFUN ("backtrace", Fbacktrace, 0, 2, "", /*
4823 Print a trace of Lisp function calls currently active.
4824 Option arg STREAM specifies the output stream to send the backtrace to,
4825 and defaults to the value of `standard-output'. Optional second arg
4826 DETAILED means show places where currently active variable bindings,
4827 catches, condition-cases, and unwind-protects were made as well as
4832 /* This function can GC */
4833 struct backtrace *backlist = backtrace_list;
4834 struct catchtag *catches = catchlist;
4835 int speccount = specpdl_depth_counter;
4837 int old_nl = print_escape_newlines;
4838 int old_pr = print_readably;
4839 Lisp_Object old_level = Vprint_level;
4840 Lisp_Object oiq = Vinhibit_quit;
4841 struct gcpro gcpro1, gcpro2;
4843 /* We can't allow quits in here because that could cause the values
4844 of print_readably and print_escape_newlines to get screwed up.
4845 Normally we would use a record_unwind_protect but that would
4846 screw up the functioning of this function. */
4849 entering_debugger = 0;
4851 Vprint_level = make_int (3);
4853 print_escape_newlines = 1;
4855 GCPRO2 (stream, old_level);
4858 stream = Vstandard_output;
4859 if (!noninteractive && (NILP (stream) || EQ (stream, Qt)))
4860 stream = Fselected_frame (Qnil);
4864 if (!NILP (detailed) && catches && catches->backlist == backlist)
4866 int catchpdl = catches->pdlcount;
4867 if (specpdl[catchpdl].func == condition_case_unwind
4868 && speccount > catchpdl)
4869 /* This is a condition-case catchpoint */
4870 catchpdl = catchpdl + 1;
4872 backtrace_specials (speccount, catchpdl, stream);
4874 speccount = catches->pdlcount;
4875 if (catchpdl == speccount)
4877 write_c_string (" # (catch ", stream);
4878 Fprin1 (catches->tag, stream);
4879 write_c_string (" ...)\n", stream);
4883 write_c_string (" # (condition-case ... . ", stream);
4884 Fprin1 (Fcdr (Fcar (catches->tag)), stream);
4885 write_c_string (")\n", stream);
4887 catches = catches->next;
4893 if (!NILP (detailed) && backlist->pdlcount < speccount)
4895 backtrace_specials (speccount, backlist->pdlcount, stream);
4896 speccount = backlist->pdlcount;
4898 write_c_string (((backlist->debug_on_exit) ? "* " : " "),
4900 if (backlist->nargs == UNEVALLED)
4902 Fprin1 (Fcons (*backlist->function, *backlist->args), stream);
4903 write_c_string ("\n", stream); /* from FSFmacs 19.30 */
4907 Lisp_Object tem = *backlist->function;
4908 Fprin1 (tem, stream); /* This can QUIT */
4909 write_c_string ("(", stream);
4910 if (backlist->nargs == MANY)
4913 Lisp_Object tail = Qnil;
4914 struct gcpro ngcpro1;
4917 for (tail = *backlist->args, i = 0;
4919 tail = Fcdr (tail), i++)
4921 if (i != 0) write_c_string (" ", stream);
4922 Fprin1 (Fcar (tail), stream);
4929 for (i = 0; i < backlist->nargs; i++)
4931 if (!i && EQ(tem, Qbyte_code)) {
4932 write_c_string("\"...\"", stream);
4935 if (i != 0) write_c_string (" ", stream);
4936 Fprin1 (backlist->args[i], stream);
4940 write_c_string (")\n", stream);
4941 backlist = backlist->next;
4944 Vprint_level = old_level;
4945 print_readably = old_pr;
4946 print_escape_newlines = old_nl;
4948 Vinhibit_quit = oiq;
4953 DEFUN ("backtrace-frame", Fbacktrace_frame, 1, 1, "", /*
4954 Return the function and arguments N frames up from current execution point.
4955 If that frame has not evaluated the arguments yet (or is a special form),
4956 the value is (nil FUNCTION ARG-FORMS...).
4957 If that frame has evaluated its arguments and called its function already,
4958 the value is (t FUNCTION ARG-VALUES...).
4959 A &rest arg is represented as the tail of the list ARG-VALUES.
4960 FUNCTION is whatever was supplied as car of evaluated list,
4961 or a lambda expression for macro calls.
4962 If N is more than the number of frames, the value is nil.
4966 REGISTER struct backtrace *backlist = backtrace_list;
4970 CHECK_NATNUM (nframes);
4972 /* Find the frame requested. */
4973 for (i = XINT (nframes); backlist && (i-- > 0);)
4974 backlist = backlist->next;
4978 if (backlist->nargs == UNEVALLED)
4979 return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
4982 if (backlist->nargs == MANY)
4983 tem = *backlist->args;
4985 tem = Flist (backlist->nargs, backlist->args);
4987 return Fcons (Qt, Fcons (*backlist->function, tem));
4992 /**********************************************************************/
4994 /**********************************************************************/
4997 warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level,
5000 obj = list1 (list3 (class, level, obj));
5001 if (NILP (Vpending_warnings))
5002 Vpending_warnings = Vpending_warnings_tail = obj;
5005 Fsetcdr (Vpending_warnings_tail, obj);
5006 Vpending_warnings_tail = obj;
5010 /* #### This should probably accept Lisp objects; but then we have
5011 to make sure that Feval() isn't called, since it might not be safe.
5013 An alternative approach is to just pass some non-string type of
5014 Lisp Object to warn_when_safe_lispobj(); `prin1-to-string' will
5015 automatically be called when it is safe to do so. */
5018 warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...)
5023 va_start (args, fmt);
5024 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt),
5028 warn_when_safe_lispobj (class, level, obj);
5034 /**********************************************************************/
5035 /* Initialization */
5036 /**********************************************************************/
5041 defsymbol (&Qinhibit_quit, "inhibit-quit");
5042 defsymbol (&Qautoload, "autoload");
5043 defsymbol (&Qdebug_on_error, "debug-on-error");
5044 defsymbol (&Qstack_trace_on_error, "stack-trace-on-error");
5045 defsymbol (&Qdebug_on_signal, "debug-on-signal");
5046 defsymbol (&Qstack_trace_on_signal, "stack-trace-on-signal");
5047 defsymbol (&Qdebugger, "debugger");
5048 defsymbol (&Qmacro, "macro");
5049 defsymbol (&Qand_rest, "&rest");
5050 defsymbol (&Qand_optional, "&optional");
5051 /* Note that the process code also uses Qexit */
5052 defsymbol (&Qexit, "exit");
5053 defsymbol (&Qsetq, "setq");
5054 defsymbol (&Qinteractive, "interactive");
5055 defsymbol (&Qcommandp, "commandp");
5056 defsymbol (&Qdefun, "defun");
5057 defsymbol (&Qprogn, "progn");
5058 defsymbol (&Qvalues, "values");
5059 defsymbol (&Qdisplay_warning, "display-warning");
5060 defsymbol (&Qrun_hooks, "run-hooks");
5071 DEFSUBR (Ffunction);
5073 DEFSUBR (Fdefmacro);
5075 DEFSUBR (Fdefconst);
5076 DEFSUBR (Fuser_variable_p);
5080 DEFSUBR (Fmacroexpand_internal);
5083 DEFSUBR (Funwind_protect);
5084 DEFSUBR (Fcondition_case);
5085 DEFSUBR (Fcall_with_condition_handler);
5087 DEFSUBR (Finteractive_p);
5088 DEFSUBR (Fcommandp);
5089 DEFSUBR (Fcommand_execute);
5090 DEFSUBR (Fautoload);
5094 DEFSUBR (Ffunction_min_args);
5095 DEFSUBR (Ffunction_max_args);
5096 DEFSUBR (Frun_hooks);
5097 DEFSUBR (Frun_hook_with_args);
5098 DEFSUBR (Frun_hook_with_args_until_success);
5099 DEFSUBR (Frun_hook_with_args_until_failure);
5100 DEFSUBR (Ffetch_bytecode);
5101 DEFSUBR (Fbacktrace_debug);
5102 DEFSUBR (Fbacktrace);
5103 DEFSUBR (Fbacktrace_frame);
5109 specpdl_ptr = specpdl;
5110 specpdl_depth_counter = 0;
5112 Vcondition_handlers = Qnil;
5115 debug_on_next_call = 0;
5116 lisp_eval_depth = 0;
5117 entering_debugger = 0;
5123 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /*
5124 Limit on number of Lisp variable bindings & unwind-protects before error.
5127 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /*
5128 Limit on depth in `eval', `apply' and `funcall' before error.
5129 This limit is to catch infinite recursions for you before they cause
5130 actual stack overflow in C, which would be fatal for Emacs.
5131 You can safely make it considerably larger than its default value,
5132 if that proves inconveniently small.
5135 DEFVAR_LISP ("quit-flag", &Vquit_flag /*
5136 Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
5137 Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.
5141 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit /*
5142 Non-nil inhibits C-g quitting from happening immediately.
5143 Note that `quit-flag' will still be set by typing C-g,
5144 so a quit will be signalled as soon as `inhibit-quit' is nil.
5145 To prevent this happening, set `quit-flag' to nil
5146 before making `inhibit-quit' nil. The value of `inhibit-quit' is
5147 ignored if a critical quit is requested by typing control-shift-G in
5150 Vinhibit_quit = Qnil;
5152 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error /*
5153 *Non-nil means automatically display a backtrace buffer
5154 after any error that is not handled by a `condition-case'.
5155 If the value is a list, an error only means to display a backtrace
5156 if one of its condition symbols appears in the list.
5157 See also variable `stack-trace-on-signal'.
5159 Vstack_trace_on_error = Qnil;
5161 DEFVAR_LISP ("stack-trace-on-signal", &Vstack_trace_on_signal /*
5162 *Non-nil means automatically display a backtrace buffer
5163 after any error that is signalled, whether or not it is handled by
5165 If the value is a list, an error only means to display a backtrace
5166 if one of its condition symbols appears in the list.
5167 See also variable `stack-trace-on-error'.
5169 Vstack_trace_on_signal = Qnil;
5171 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors /*
5172 *List of errors for which the debugger should not be called.
5173 Each element may be a condition-name or a regexp that matches error messages.
5174 If any element applies to a given error, that error skips the debugger
5175 and just returns to top level.
5176 This overrides the variable `debug-on-error'.
5177 It does not apply to errors handled by `condition-case'.
5179 Vdebug_ignored_errors = Qnil;
5181 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error /*
5182 *Non-nil means enter debugger if an unhandled error is signalled.
5183 The debugger will not be entered if the error is handled by
5185 If the value is a list, an error only means to enter the debugger
5186 if one of its condition symbols appears in the list.
5187 This variable is overridden by `debug-ignored-errors'.
5188 See also variables `debug-on-quit' and `debug-on-signal'.
5190 Vdebug_on_error = Qnil;
5192 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal /*
5193 *Non-nil means enter debugger if an error is signalled.
5194 The debugger will be entered whether or not the error is handled by
5196 If the value is a list, an error only means to enter the debugger
5197 if one of its condition symbols appears in the list.
5198 See also variable `debug-on-quit'.
5200 Vdebug_on_signal = Qnil;
5202 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit /*
5203 *Non-nil means enter debugger if quit is signalled (C-G, for example).
5204 Does not apply if quit is handled by a `condition-case'. Entering the
5205 debugger can also be achieved at any time (for X11 console) by typing
5206 control-shift-G to signal a critical quit.
5210 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call /*
5211 Non-nil means enter debugger before next `eval', `apply' or `funcall'.
5214 DEFVAR_LISP ("debugger", &Vdebugger /*
5215 Function to call to invoke debugger.
5216 If due to frame exit, args are `exit' and the value being returned;
5217 this function's value will be returned instead of that.
5218 If due to error, args are `error' and a list of the args to `signal'.
5219 If due to `apply' or `funcall' entry, one arg, `lambda'.
5220 If due to `eval' entry, one arg, t.
5224 preparing_for_armageddon = 0;
5226 staticpro (&Vpending_warnings);
5227 Vpending_warnings = Qnil;
5228 Vpending_warnings_tail = Qnil; /* no need to protect this */
5232 staticpro (&Vautoload_queue);
5233 Vautoload_queue = Qnil;
5235 staticpro (&Vcondition_handlers);
5237 staticpro (&Vcurrent_warning_class);
5238 Vcurrent_warning_class = Qnil;
5240 staticpro (&Vcurrent_error_state);
5241 Vcurrent_error_state = Qnil; /* errors as normal */
5243 Qunbound_suspended_errors_tag = make_opaque_long (0);
5244 staticpro (&Qunbound_suspended_errors_tag);
5247 specpdl_depth_counter = 0;
5248 specpdl = xnew_array (struct specbinding, specpdl_size);
5249 /* XEmacs change: increase these values. */
5250 max_specpdl_size = 3000;
5251 max_lisp_eval_depth = 500;