/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
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);
}
if (!EQ (Vmocklisp_arguments, Qt))
{
val = make_number (0);
- while (!NILP (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol))
+ while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))
{
QUIT;
specbind (tem, val), args = Fcdr (args);
}
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 this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p itself. If so, skip it. */
fun = Findirect_function (*btp->function);
- if (XTYPE (fun) == Lisp_Subr
- && (struct Lisp_Subr *) XPNTR (fun) == &Sinteractive_p)
+ if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
btp = btp->next;
/* If we're running an Emacs 18-style byte-compiled function, there
Fbytecode at the top. If this frame is for a built-in function
(such as load or eval-region) return nil. */
fun = Findirect_function (*btp->function);
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
return Qnil;
/* btp points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
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;
}
(args)
Lisp_Object args;
{
- register Lisp_Object sym, tem;
+ register Lisp_Object sym, tem, tail;
sym = Fcar (args);
- tem = Fcdr (args);
- if (!NILP (tem))
+ tail = Fcdr (args);
+ if (!NILP (Fcdr (Fcdr (tail))))
+ error ("too many arguments");
+
+ if (!NILP (tail))
{
tem = Fdefault_boundp (sym);
if (NILP (tem))
Fset_default (sym, Feval (Fcar (Fcdr (args))));
}
- tem = Fcar (Fcdr (Fcdr (args)));
- if (!NILP (tem))
+ tail = Fcdr (Fcdr (args));
+ if (!NILP (Fcar (tail)))
{
+ tem = Fcar (tail);
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
+ LOADHIST_ATTACH (sym);
return sym;
}
register Lisp_Object sym, tem;
sym = Fcar (args);
+ if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+ error ("too many arguments");
+
Fset_default (sym, Feval (Fcar (Fcdr (args))));
tem = Fcar (Fcdr (Fcdr (args)));
if (!NILP (tem))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
+ LOADHIST_ATTACH (sym);
return sym;
}
Lisp_Object documentation;
documentation = Fget (variable, Qvariable_documentation);
- if (XTYPE (documentation) == Lisp_Int && XINT (documentation) < 0)
+ if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
- if ((XTYPE (documentation) == Lisp_String) &&
+ if ((STRINGP (documentation)) &&
((unsigned char) XSTRING (documentation)->data[0] == '*'))
return Qt;
return Qnil;
{
QUIT;
elt = Fcar (varlist);
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
specbind (elt, Qnil);
else if (! NILP (Fcdr (Fcdr (elt))))
Fsignal (Qerror,
{
QUIT;
elt = Fcar (varlist);
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
temps [argnum++] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
Fsignal (Qerror,
{
elt = Fcar (varlist);
tem = temps[argnum++];
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
specbind (elt, tem);
else
specbind (Fcar (elt), tem);
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);
{
/* Come back here each time we expand a macro call,
in case it expands into another macro call. */
- if (XTYPE (form) != Lisp_Cons)
+ if (!CONSP (form))
break;
/* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
def = sym = XCONS (form)->car;
tem = Qnil;
/* Trace symbols aliases to other symbols
until we get a symbol that is not an alias. */
- while (XTYPE (def) == Lisp_Symbol)
+ while (SYMBOLP (def))
{
QUIT;
sym = def;
{
/* SYM is not mentioned in ENV.
Look at its function definition. */
- if (EQ (def, Qunbound)
- || XTYPE (def) != Lisp_Cons)
+ if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable */
break;
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;
- tem = Fcar (args);
- CHECK_SYMBOL (tem, 0);
+ var = Fcar (args);
+ bodyform = Fcar (Fcdr (args));
+ handlers = Fcdr (Fcdr (args));
+ CHECK_SYMBOL (var, 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);
}
{
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,
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (XSUBR (fun)->prompt)
return Qt;
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
- else if (XTYPE (fun) == Lisp_Compiled)
- return (XVECTOR (fun)->size > COMPILED_INTERACTIVE
+ else if (COMPILEDP (fun))
+ return ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
? Qt : Qnil);
/* Strings and vectors are keyboard macros. */
- if (XTYPE (fun) == Lisp_String
- || XTYPE (fun) == Lisp_Vector)
+ if (STRINGP (fun) || VECTORP (fun))
return Qt;
/* Lists may represent commands. */
if (!CONSP (fun))
return Qnil;
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
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];
/* If function is defined and not as an autoload, don't override */
if (!EQ (XSYMBOL (function)->function, Qunbound)
- && !(XTYPE (XSYMBOL (function)->function) == Lisp_Cons
+ && !(CONSP (XSYMBOL (function)->function)
&& EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload)))
return Qnil;
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);
}
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (XTYPE (form) == Lisp_Symbol)
+ if (SYMBOLP (form))
{
if (EQ (Vmocklisp_arguments, Qt))
return Fsymbol_value (form);
val = Fsymbol_value (form);
if (NILP (val))
- XFASTINT (val) = 0;
+ XSETFASTINT (val, 0);
else if (EQ (val, Qt))
- XFASTINT (val) = 1;
+ XSETFASTINT (val, 1);
return val;
}
if (!CONSP (form))
retry:
fun = Findirect_function (original_fun);
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
Lisp_Object numargs;
Lisp_Object argvals[7];
abort ();
}
}
- if (XTYPE (fun) == Lisp_Compiled)
+ if (COMPILEDP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
if (!CONSP (fun))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qautoload))
{
if (!EQ (Vmocklisp_arguments, Qt))
{
if (NILP (val))
- XFASTINT (val) = 0;
+ XSETFASTINT (val, 0);
else if (EQ (val, Qt))
- XFASTINT (val) = 1;
+ XSETFASTINT (val, 1);
}
lisp_eval_depth--;
if (backtrace.debug_on_exit)
goto funcall;
}
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
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).")
fun = Findirect_function (fun);
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
{
- XFASTINT (lisp_numargs) = numargs;
+ XSETFASTINT (lisp_numargs, numargs);
return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
}
abort ();
}
}
- if (XTYPE (fun) == Lisp_Compiled)
+ if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
if (!CONSP (fun))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1);
specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */
- XFASTINT (numargs) = nargs;
+ XSETFASTINT (numargs, nargs);
- if (XTYPE (fun) == Lisp_Cons)
+ if (CONSP (fun))
syms_left = Fcar (Fcdr (fun));
- else if (XTYPE (fun) == Lisp_Compiled)
+ else if (COMPILEDP (fun))
syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST];
else abort ();
{
QUIT;
next = Fcar (syms_left);
- while (XTYPE (next) != Lisp_Symbol)
+ while (!SYMBOLP (next))
next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (next, Qand_rest))
rest = 1;
if (i < nargs)
return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
- if (XTYPE (fun) == Lisp_Cons)
+ if (CONSP (fun))
val = Fprogn (Fcdr (Fcdr (fun)));
else
- val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE],
- XVECTOR (fun)->contents[COMPILED_CONSTANTS],
- XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]);
+ {
+ /* If we have not actually read the bytecode string
+ and constants vector yet, fetch them from the file. */
+ if (CONSP (XVECTOR (fun)->contents[COMPILED_BYTECODE]))
+ {
+ tem = read_doc_string (XVECTOR (fun)->contents[COMPILED_BYTECODE]);
+ XVECTOR (fun)->contents[COMPILED_BYTECODE] = XCONS (tem)->car;
+ XVECTOR (fun)->contents[COMPILED_CONSTANTS] = XCONS (tem)->cdr;
+ }
+ val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE],
+ XVECTOR (fun)->contents[COMPILED_CONSTANTS],
+ XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]);
+ }
return unbind_to (count, val);
}
\f
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)
+ if (BUFFER_OBJFWDP (ovalue))
store_symval_forwarding (symbol, ovalue, value);
else
Fset (symbol, value);
extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
- entering_debugger = 0;
-
- XFASTINT (Vprint_level) = 3;
+ XSETFASTINT (Vprint_level, 3);
tail = Qnil;
GCPRO1 (tail);
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\
+ "*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_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;