/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <config.h>
#include "lisp.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
+#include "blockinput.h"
#ifndef standalone
#include "commands.h"
struct backtrace *backtrace_list;
+/* This structure helps implement the `catch' and `throw' control
+ structure. A struct catchtag contains all the information needed
+ to restore the state of the interpreter after a non-local jump.
+
+ Handlers for error conditions (represented by `struct handler'
+ structures) just point to a catch tag to do the cleanup required
+ for their jumps.
+
+ catchtag structures are chained together in the C calling stack;
+ the `next' member points to the next outer catchtag.
+
+ A call like (throw TAG VAL) searches for a catchtag whose `tag'
+ member is TAG, and then unbinds to it. The `val' member is used to
+ hold VAL while the stack is unwound; `val' is returned as the value
+ of the catch form.
+
+ All the other members are concerned with restoring the interpreter
+ state. */
struct catchtag
{
Lisp_Object tag;
is handled by the command loop's error handler. */
int debug_on_quit;
-/* Nonzero means we are trying to enter the debugger.
- This is to prevent recursive attempts. */
-int entering_debugger;
+/* The value of num_nonmacro_input_chars as of the last time we
+ started to enter the debugger. If we decide to enter the debugger
+ again when this is still equal to num_nonmacro_input_chars, then we
+ know that the debugger itself has an error, and we should just
+ signal the error instead of entering an infinite loop of debugger
+ invocations. */
+int when_entered_debugger;
Lisp_Object Vdebugger;
init_eval_once ()
{
specpdl_size = 50;
- specpdl = (struct specbinding *) malloc (specpdl_size * sizeof (struct specbinding));
+ specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
max_specpdl_size = 600;
max_lisp_eval_depth = 200;
+
+ Vrun_hooks = Qnil;
}
init_eval ()
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
- entering_debugger = 0;
+ /* This is less than the initial value of num_nonmacro_input_chars. */
+ when_entered_debugger = -1;
}
Lisp_Object
if (specpdl_size + 40 > max_specpdl_size)
max_specpdl_size = specpdl_size + 40;
debug_on_next_call = 0;
- entering_debugger = 1;
+ when_entered_debugger = num_nonmacro_input_chars;
return apply1 (Vdebugger, arg);
}
}
DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
- "(prog1 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
+ "(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
The value of Y is saved during the evaluation of the remaining args,\n\
whose values are discarded.")
(args)
val = Qnil;
- if (NILP(args))
+ if (NILP (args))
return Qnil;
args_left = args;
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
}
- while (!NILP(args_left));
+ while (!NILP (args_left));
UNGCPRO;
return val;
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
"(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
-The SYMs are not evaluated. Thus (setq x y) sets x to the value of y.\n\
-Each SYM is set before the next VAL is computed.")
+The symbols SYM are variables; they are literal (not evaluated).\n\
+The values VAL are expressions; they are evaluated.\n\
+Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\
+The second VAL is not computed until after the first SYM is set, and so on;\n\
+each VAL can use the new value of variables set earlier in the `setq'.\n\
+The return value of the `setq' form is the value of the last VAL.")
(args)
Lisp_Object args;
{
if (!NILP (Vpurify_flag))
defn = Fpurecopy (defn);
Ffset (fn_name, defn);
+ LOADHIST_ATTACH (fn_name);
return fn_name;
}
if (!NILP (Vpurify_flag))
defn = Fpurecopy (defn);
Ffset (fn_name, defn);
+ LOADHIST_ATTACH (fn_name);
return fn_name;
}
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
+ LOADHIST_ATTACH (sym);
return sym;
}
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
+ LOADHIST_ATTACH (sym);
return sym;
}
test = Fcar (args);
body = Fcdr (args);
- while (tem = Feval (test), !NILP (tem))
+ while (tem = Feval (test),
+ (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
{
QUIT;
Fprogn (body);
if (EQ (XCONS (def)->car, Qautoload))
{
/* Autoloading function: will it be a macro when loaded? */
- tem = Fcar (Fnthcdr (make_number (4), def));
- if (NILP (tem))
+ tem = Fnth (make_number (4), def);
+ if (EQ (tem, Qt) || EQ (tem, Qmacro))
+ /* Yes, load it and try again. */
+ {
+ do_autoload (def, sym);
+ continue;
+ }
+ else
break;
- /* Yes, load it and try again. */
- do_autoload (def, sym);
- continue;
}
else if (!EQ (XCONS (def)->car, Qmacro))
break;
return c.val;
}
-/* Discard from the catchlist all catch tags back through CATCH.
- Before each catch is discarded, unbind all special bindings
- made within that catch. Also, when discarding a catch that
- corresponds to a condition handler, discard that handler.
+/* Unwind the specbind, catch, and handler stacks back to CATCH, and
+ jump to that CATCH, returning VALUE as the value of that catch.
+
+ This is the guts Fthrow and Fsignal; they differ only in the way
+ they choose the catch tag to throw to. A catch tag for a
+ condition-case form has a TAG of Qnil.
- At the end, restore some static info saved in CATCH.
+ Before each catch is discarded, unbind all special bindings and
+ execute all unwind-protect clauses made above that catch. Unwind
+ the handler stack as we go, so that the proper handlers are in
+ effect for each unwind-protect clause we run. At the end, restore
+ some static info saved in CATCH, and longjmp to the location
+ specified in the
- This is used for correct unwinding in Fthrow and Fsignal,
- before doing the longjmp that actually destroys the stack frames
- in which these handlers and catches reside. */
+ This is used for correct unwinding in Fthrow and Fsignal. */
static void
-unbind_catch (catch)
+unwind_to_catch (catch, value)
struct catchtag *catch;
+ Lisp_Object value;
{
register int last_time;
+ /* Save the value in the tag. */
+ catch->val = value;
+
+ /* Restore the polling-suppression count. */
+ set_poll_suppress_count (catch->poll_suppress_count);
+
do
{
last_time = catchlist == catch;
+
+ /* Unwind the specpdl stack, and then restore the proper set of
+ handlers. */
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
gcprolist = catch->gcpro;
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
+
+ _longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
for (c = catchlist; c; c = c->next)
{
if (EQ (c->tag, tag))
- {
- /* Restore the polling-suppression count. */
- if (c->poll_suppress_count > poll_suppress_count)
- abort ();
- while (c->poll_suppress_count < poll_suppress_count)
- start_polling ();
- c->val = val;
- unbind_catch (c);
- _longjmp (c->jmp, 1);
- }
+ unwind_to_catch (c, val);
}
tag = Fsignal (Qno_catch, Fcons (tag, Fcons (val, Qnil)));
}
if CONDITION-NAME is one of the error's condition names.\n\
If an error happens, the first applicable handler is run.\n\
\n\
+The car of a handler may be a list of condition names\n\
+instead of a single condition name.\n\
+\n\
When a handler handles an error,\n\
control returns to the condition-case and the handler BODY... is executed\n\
with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
Lisp_Object val;
struct catchtag c;
struct handler h;
- register Lisp_Object tem;
+ register Lisp_Object var, bodyform, handlers;
+
+ var = Fcar (args);
+ bodyform = Fcar (Fcdr (args));
+ handlers = Fcdr (Fcdr (args));
+ CHECK_SYMBOL (var, 0);
- tem = Fcar (args);
- CHECK_SYMBOL (tem, 0);
+ for (val = handlers; ! NILP (val); val = Fcdr (val))
+ {
+ Lisp_Object tem;
+ tem = Fcar (val);
+ if (! (NILP (tem)
+ || (CONSP (tem)
+ && (SYMBOLP (XCONS (tem)->car)
+ || CONSP (XCONS (tem)->car)))))
+ error ("Invalid condition handler", tem);
+ }
c.tag = Qnil;
c.val = Qnil;
if (_setjmp (c.jmp))
{
if (!NILP (h.var))
- specbind (h.var, Fcdr (c.val));
- val = Fprogn (Fcdr (Fcar (c.val)));
+ specbind (h.var, c.val);
+ val = Fprogn (Fcdr (h.chosen_clause));
+
+ /* Note that this just undoes the binding of h.var; whoever
+ longjumped to us unwound the stack to c.pdlcount before
+ throwing. */
unbind_to (c.pdlcount, Qnil);
return val;
}
c.next = catchlist;
catchlist = &c;
- h.var = Fcar (args);
- h.handler = Fcdr (Fcdr (args));
-
- for (val = h.handler; ! NILP (val); val = Fcdr (val))
- {
- tem = Fcar (val);
- if ((!NILP (tem)) &&
- (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
- error ("Invalid condition handler", tem);
- }
+ h.var = var;
+ h.handler = handlers;
h.next = handlerlist;
- h.poll_suppress_count = poll_suppress_count;
h.tag = &c;
handlerlist = &h;
- val = Feval (Fcar (Fcdr (args)));
+ val = Feval (bodyform);
catchlist = c.next;
handlerlist = h.next;
return val;
c.gcpro = gcprolist;
if (_setjmp (c.jmp))
{
- return (*hfun) (Fcdr (c.val));
+ return (*hfun) (c.val);
}
c.next = catchlist;
catchlist = &c;
h.handler = handlers;
h.var = Qnil;
- h.poll_suppress_count = poll_suppress_count;
h.next = handlerlist;
h.tag = &c;
handlerlist = &h;
return val;
}
+Lisp_Object
+internal_condition_case_1 (bfun, arg, handlers, hfun)
+ Lisp_Object (*bfun) ();
+ Lisp_Object arg;
+ Lisp_Object handlers;
+ Lisp_Object (*hfun) ();
+{
+ Lisp_Object val;
+ struct catchtag c;
+ struct handler h;
+
+ c.tag = Qnil;
+ c.val = Qnil;
+ c.backlist = backtrace_list;
+ c.handlerlist = handlerlist;
+ c.lisp_eval_depth = lisp_eval_depth;
+ c.pdlcount = specpdl_ptr - specpdl;
+ c.poll_suppress_count = poll_suppress_count;
+ c.gcpro = gcprolist;
+ if (_setjmp (c.jmp))
+ {
+ return (*hfun) (c.val);
+ }
+ c.next = catchlist;
+ catchlist = &c;
+ h.handler = handlers;
+ h.var = Qnil;
+ h.next = handlerlist;
+ h.tag = &c;
+ handlerlist = &h;
+
+ val = (*bfun) (arg);
+ catchlist = c.next;
+ handlerlist = h.next;
+ return val;
+}
+\f
static Lisp_Object find_handler_clause ();
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
- "Signal an error. Args are SIGNAL-NAME, and associated DATA.\n\
+ "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
This function does not return.\n\n\
-A signal name is a symbol with an `error-conditions' property\n\
+An error symbol is a symbol with an `error-conditions' property\n\
that is a list of condition names.\n\
A handler for any of those names will get to handle this signal.\n\
The symbol `error' should normally be one of them.\n\
DATA should be a list. Its elements are printed as part of the error message.\n\
If the signal is handled, DATA is made available to the handler.\n\
See also the function `condition-case'.")
- (sig, data)
- Lisp_Object sig, data;
+ (error_symbol, data)
+ Lisp_Object error_symbol, data;
{
register struct handler *allhandlers = handlerlist;
Lisp_Object conditions;
TOTALLY_UNBLOCK_INPUT;
#endif
- conditions = Fget (sig, Qerror_conditions);
+ conditions = Fget (error_symbol, Qerror_conditions);
for (; handlerlist; handlerlist = handlerlist->next)
{
register Lisp_Object clause;
clause = find_handler_clause (handlerlist->handler, conditions,
- sig, data, &debugger_value);
+ error_symbol, data, &debugger_value);
#if 0 /* Most callers are not prepared to handle gc if this returns.
So, since this feature is not very useful, take it out. */
return debugger_value;
#else
if (EQ (clause, Qlambda))
- error ("Returning a value from an error is no longer supported");
+ {
+ /* We can't return values to code which signalled an error, but we
+ can continue code which has signalled a quit. */
+ if (EQ (error_symbol, Qquit))
+ return Qnil;
+ else
+ error ("Cannot return from the debugger in an error");
+ }
#endif
if (!NILP (clause))
{
+ Lisp_Object unwind_data;
struct handler *h = handlerlist;
- /* Restore the polling-suppression count. */
- if (h->poll_suppress_count > poll_suppress_count)
- abort ();
- while (h->poll_suppress_count < poll_suppress_count)
- start_polling ();
+
handlerlist = allhandlers;
- unbind_catch (h->tag);
- h->tag->val = Fcons (clause, Fcons (sig, data));
- _longjmp (h->tag->jmp, 1);
+ if (EQ (data, memory_signal_data))
+ unwind_data = memory_signal_data;
+ else
+ unwind_data = Fcons (error_symbol, data);
+ h->chosen_clause = clause;
+ unwind_to_catch (h->tag, unwind_data);
}
}
handlerlist = allhandlers;
/* If no handler is present now, try to run the debugger,
and if that fails, throw to top level. */
- find_handler_clause (Qerror, conditions, sig, data, &debugger_value);
+ find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
Fthrow (Qtop_level, Qt);
}
wants_debugger (list, conditions)
Lisp_Object list, conditions;
{
- static int looking = 0;
-
- if (looking)
- {
- /* We got an error while looking in LIST. */
- looking = 0;
- return 1;
- }
-
if (NILP (list))
return 0;
if (! CONSP (list))
return 1;
- looking = 1;
- while (!NILP (conditions))
+ while (CONSP (conditions))
{
- Lisp_Object tem;
- tem = Fmemq (XCONS (conditions)->car, list);
- if (! NILP (tem))
- {
- looking = 0;
+ Lisp_Object this, tail;
+ this = XCONS (conditions)->car;
+ for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
+ if (EQ (XCONS (tail)->car, this))
return 1;
- }
conditions = XCONS (conditions)->cdr;
}
+ return 0;
}
/* Value of Qlambda means we have called debugger and user has continued.
{
register Lisp_Object h;
register Lisp_Object tem;
- register Lisp_Object tem1;
if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */
return Qt;
{
if (wants_debugger (Vstack_trace_on_error, conditions))
internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
- if (!entering_debugger
- && ((EQ (sig, Qquit) && debug_on_quit)
- || wants_debugger (Vdebug_on_error, conditions)))
+ if ((EQ (sig, Qquit)
+ ? debug_on_quit
+ : wants_debugger (Vdebug_on_error, conditions))
+ && when_entered_debugger < num_nonmacro_input_chars)
{
int count = specpdl_ptr - specpdl;
specbind (Qdebug_on_error, Qnil);
}
for (h = handlers; CONSP (h); h = Fcdr (h))
{
- tem1 = Fcar (h);
- if (!CONSP (tem1))
+ Lisp_Object handler, condit;
+
+ handler = Fcar (h);
+ if (!CONSP (handler))
continue;
- tem = Fmemq (Fcar (tem1), conditions);
- if (!NILP (tem))
- return tem1;
+ condit = Fcar (handler);
+ /* Handle a single condition name in handler HANDLER. */
+ if (SYMBOLP (condit))
+ {
+ tem = Fmemq (Fcar (handler), conditions);
+ if (!NILP (tem))
+ return handler;
+ }
+ /* Handle a list of condition names in handler HANDLER. */
+ else if (CONSP (condit))
+ {
+ while (CONSP (condit))
+ {
+ tem = Fmemq (Fcar (condit), conditions);
+ if (!NILP (tem))
+ return handler;
+ condit = XCONS (condit)->cdr;
+ }
+ }
}
return Qnil;
}
void
error (m, a1, a2, a3)
char *m;
+ char *a1, *a2, *a3;
{
char buf[200];
- sprintf (buf, m, a1, a2, a3);
+ int size = 200;
+ int mlen;
+ char *buffer = buf;
+ char *args[3];
+ int allocated = 0;
+ Lisp_Object string;
+
+ args[0] = a1;
+ args[1] = a2;
+ args[2] = a3;
+
+ mlen = strlen (m);
while (1)
- Fsignal (Qerror, Fcons (build_string (buf), Qnil));
+ {
+ int used = doprnt (buf, size, m, m + mlen, 3, args);
+ if (used < size)
+ break;
+ size *= 2;
+ if (allocated)
+ buffer = (char *) xrealloc (buffer, size);
+ else
+ {
+ buffer = (char *) xmalloc (size);
+ allocated = 1;
+ }
+ }
+
+ string = build_string (buf);
+ if (allocated)
+ free (buffer);
+
+ Fsignal (Qerror, Fcons (string, Qnil));
}
\f
DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
Third arg DOCSTRING is documentation for the function.\n\
Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
-Fifth arg MACRO if non-nil says the function is really a macro.\n\
+Fifth arg TYPE indicates the type of the object:\n\
+ nil or omitted says FUNCTION is a function,\n\
+ `keymap' says FUNCTION is really a keymap, and\n\
+ `macro' or t says FUNCTION is really a macro.\n\
Third through fifth args give info about the real definition.\n\
They default to nil.\n\
If FUNCTION is already defined other than as an autoload,\n\
this does nothing and returns nil.")
- (function, file, docstring, interactive, macro)
- Lisp_Object function, file, docstring, interactive, macro;
+ (function, file, docstring, interactive, type)
+ Lisp_Object function, file, docstring, interactive, type;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[4];
args[0] = file;
args[1] = docstring;
args[2] = interactive;
- args[3] = macro;
+ args[3] = type;
return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
#else /* NO_ARG_ARRAY */
Lisp_Object fundef, funname;
{
int count = specpdl_ptr - specpdl;
- Lisp_Object fun, val;
+ Lisp_Object fun, val, queue, first, second;
fun = funname;
CHECK_SYMBOL (funname, 0);
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
+
+ /* Save the old autoloads, in case we ever do an unload. */
+ queue = Vautoload_queue;
+ while (CONSP (queue))
+ {
+ first = Fcar (queue);
+ second = Fcdr (first);
+ first = Fcar (first);
+
+ /* Note: This test is subtle. The cdr of an autoload-queue entry
+ may be an atom if the autoload entry was generated by a defalias
+ or fset. */
+ if (CONSP (second))
+ Fput (first, Qautoload, (Fcdr (second)));
+
+ queue = Fcdr (queue);
+ }
+
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
fun = Findirect_function (fun);
- if (XTYPE (fun) == Lisp_Cons
- && EQ (XCONS (fun)->car, Qautoload))
+ if (!NILP (Fequal (fun, fundef)))
error ("Autoloading failed to define function %s",
XSYMBOL (funname)->name->data);
}
val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
argvals[3], argvals[4], argvals[5]);
goto done;
+ case 7:
+ val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ argvals[6]);
+ goto done;
default:
/* Someone has created a subr that takes more arguments than
RETURN_UNGCPRO (Ffuncall (1, &fn));
}
-/* Call function fn with argument arg */
+/* Call function fn with 1 argument arg1 */
/* ARGSUSED */
Lisp_Object
-call1 (fn, arg)
- Lisp_Object fn, arg;
+call1 (fn, arg1)
+ Lisp_Object fn, arg1;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
args[0] = fn;
- args[1] = arg;
+ args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 2;
RETURN_UNGCPRO (Ffuncall (2, args));
#endif /* not NO_ARG_ARRAY */
}
-/* Call function fn with arguments arg, arg1 */
+/* Call function fn with 2 arguments arg1, arg2 */
/* ARGSUSED */
Lisp_Object
-call2 (fn, arg, arg1)
- Lisp_Object fn, arg, arg1;
+call2 (fn, arg1, arg2)
+ Lisp_Object fn, arg1, arg2;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[3];
args[0] = fn;
- args[1] = arg;
- args[2] = arg1;
+ args[1] = arg1;
+ args[2] = arg2;
GCPRO1 (args[0]);
gcpro1.nvars = 3;
RETURN_UNGCPRO (Ffuncall (3, args));
#endif /* not NO_ARG_ARRAY */
}
-/* Call function fn with arguments arg, arg1, arg2 */
+/* Call function fn with 3 arguments arg1, arg2, arg3 */
/* ARGSUSED */
Lisp_Object
-call3 (fn, arg, arg1, arg2)
- Lisp_Object fn, arg, arg1, arg2;
+call3 (fn, arg1, arg2, arg3)
+ Lisp_Object fn, arg1, arg2, arg3;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[4];
args[0] = fn;
- args[1] = arg;
- args[2] = arg1;
- args[3] = arg2;
+ args[1] = arg1;
+ args[2] = arg2;
+ args[3] = arg3;
GCPRO1 (args[0]);
gcpro1.nvars = 4;
RETURN_UNGCPRO (Ffuncall (4, args));
#endif /* not NO_ARG_ARRAY */
}
+/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
+/* ARGSUSED */
+Lisp_Object
+call4 (fn, arg1, arg2, arg3, arg4)
+ Lisp_Object fn, arg1, arg2, arg3, arg4;
+{
+ struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+ Lisp_Object args[5];
+ args[0] = fn;
+ args[1] = arg1;
+ args[2] = arg2;
+ args[3] = arg3;
+ args[4] = arg4;
+ GCPRO1 (args[0]);
+ gcpro1.nvars = 5;
+ RETURN_UNGCPRO (Ffuncall (5, args));
+#else /* not NO_ARG_ARRAY */
+ GCPRO1 (fn);
+ gcpro1.nvars = 5;
+ RETURN_UNGCPRO (Ffuncall (5, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
+/* ARGSUSED */
+Lisp_Object
+call5 (fn, arg1, arg2, arg3, arg4, arg5)
+ Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
+{
+ struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+ Lisp_Object args[6];
+ args[0] = fn;
+ args[1] = arg1;
+ args[2] = arg2;
+ args[3] = arg3;
+ args[4] = arg4;
+ args[5] = arg5;
+ GCPRO1 (args[0]);
+ gcpro1.nvars = 6;
+ RETURN_UNGCPRO (Ffuncall (6, args));
+#else /* not NO_ARG_ARRAY */
+ GCPRO1 (fn);
+ gcpro1.nvars = 6;
+ RETURN_UNGCPRO (Ffuncall (6, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
+/* ARGSUSED */
+Lisp_Object
+call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
+ Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
+{
+ struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+ Lisp_Object args[7];
+ args[0] = fn;
+ args[1] = arg1;
+ args[2] = arg2;
+ args[3] = arg3;
+ args[4] = arg4;
+ args[5] = arg5;
+ args[6] = arg6;
+ GCPRO1 (args[0]);
+ gcpro1.nvars = 7;
+ RETURN_UNGCPRO (Ffuncall (7, args));
+#else /* not NO_ARG_ARRAY */
+ GCPRO1 (fn);
+ gcpro1.nvars = 7;
+ RETURN_UNGCPRO (Ffuncall (7, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
"Call first argument as a function, passing remaining arguments to it.\n\
Thus, (funcall 'cons 'x 'y) returns (x . y).")
internal_args[2], internal_args[3],
internal_args[4], internal_args[5]);
goto done;
+ case 7:
+ val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5],
+ internal_args[6]);
+ goto done;
default:
max_specpdl_size = 400;
if (specpdl_size >= max_specpdl_size)
{
+ if (!NILP (Vdebug_on_error))
+ /* Leave room for some specpdl in the debugger. */
+ max_specpdl_size = specpdl_size + 100;
Fsignal (Qerror,
Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
- max_specpdl_size *= 2;
}
}
specpdl_size *= 2;
grow_specpdl ();
specpdl_ptr->symbol = symbol;
specpdl_ptr->func = 0;
- ovalue = XSYMBOL (symbol)->value;
- specpdl_ptr->old_value = EQ (ovalue, Qunbound) ? Qunbound : Fsymbol_value (symbol);
+ specpdl_ptr->old_value = ovalue = find_symbol_value (symbol);
specpdl_ptr++;
if (XTYPE (ovalue) == Lisp_Buffer_Objfwd)
store_symval_forwarding (symbol, ovalue, value);
extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
- entering_debugger = 0;
-
XFASTINT (Vprint_level) = 3;
tail = Qnil;
if (backlist->nargs == UNEVALLED)
{
Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
+ write_string ("\n", -1);
}
else
{
Fprin1 (backlist->args[i], Qnil);
}
}
+ write_string (")\n", -1);
}
- write_string (")\n", -1);
backlist = backlist->next;
}
CHECK_NATNUM (nframes, 0);
/* Find the frame requested. */
- for (i = 0; i < XFASTINT (nframes); i++)
+ for (i = 0; backlist && i < XFASTINT (nframes); i++)
backlist = backlist->next;
if (!backlist)
DEFVAR_LISP ("quit-flag", &Vquit_flag,
"Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
-Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
+Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
Vquit_flag = Qnil;
DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
Vdebug_on_error = Qnil;
DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
- "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
-Does not apply if quit is handled by a `condition-case'.\n\
-A non-nil value is equivalent to a `debug-on-error' value containing `quit'.");
+ "*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\
+Does not apply if quit is handled by a `condition-case'.");
debug_on_quit = 0;
DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
DEFVAR_LISP ("run-hooks", &Vrun_hooks,
"Set to the function `run-hooks', if that function has been defined.\n\
Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
- Vrun_hooks = Qnil;
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
HCoop / bpt / emacs.git / blobdiff