/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 2002
Free Software Foundation, Inc.
This file is part of GNU Emacs.
int gcpro_level;
#endif
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object arg;
{
int debug_while_redisplaying;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object val;
if (lisp_eval_depth + 20 > max_lisp_eval_depth)
DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
doc: /* Define NAME as a macro.
-The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
+The actual definition looks like
+ (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
When the macro is called, as in (NAME ARGS...),
the function (lambda ARGLIST BODY...) is applied to
the list ARGS... as it appears in the expression,
and the result should be a form to be evaluated instead of the original.
-usage: (defmacro NAME ARGLIST [DOCSTRING] BODY...) */)
+
+DECL is a declaration, optional, which can specify how to indent
+calls to this macro and how Edebug should handle it. It looks like this:
+ (declare SPECS...)
+The elements can look like this:
+ (indent INDENT)
+ Set NAME's `lisp-indent-function' property to INDENT.
+
+ (edebug DEBUG)
+ Set NAME's `edebug-form-spec' property to DEBUG. (This is
+ equivalent to writing a `def-edebug-spec' for the macro.
+usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
(args)
Lisp_Object args;
{
}
-DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 2, 0,
+DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
doc: /* Make SYMBOL a variable alias for symbol ALIASED.
Setting the value of SYMBOL will subsequently set the value of ALIASED,
and getting the value of SYMBOL will return the value ALIASED has.
-ALIASED nil means remove the alias; SYMBOL is unbound after that. */)
- (symbol, aliased)
- Lisp_Object symbol, aliased;
+ALIASED nil means remove the alias; SYMBOL is unbound after that.
+Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. */)
+ (symbol, aliased, docstring)
+ Lisp_Object symbol, aliased, docstring;
{
struct Lisp_Symbol *sym;
-
+
CHECK_SYMBOL (symbol);
CHECK_SYMBOL (aliased);
sym->indirect_variable = 1;
sym->value = aliased;
sym->constant = SYMBOL_CONSTANT_P (aliased);
- LOADHIST_ATTACH (symbol);
-
+ LOADHIST_ATTACH (Fcons (Qdefvar, symbol));
+ if (!NILP (docstring))
+ Fput (symbol, Qvariable_documentation, docstring);
+
return aliased;
}
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
- LOADHIST_ATTACH (sym);
+ LOADHIST_ATTACH (Fcons (Qdefvar, sym));
}
else
- /* A (defvar <var>) should not take precedence in the load-history over
- an earlier (defvar <var> <val>), so only add to history if the default
- value is still unbound. */
- if (NILP (tem))
- LOADHIST_ATTACH (sym);
-
+ /* Simple (defvar <var>) should not count as a definition at all.
+ It could get in the way of other definitions, and unloading this
+ package could try to make the variable unbound. */
+ ;
+
return sym;
}
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
- LOADHIST_ATTACH (sym);
+ LOADHIST_ATTACH (Fcons (Qdefvar, sym));
return sym;
}
if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
if (STRINGP (documentation)
- && ((unsigned char) XSTRING (documentation)->data[0] == '*'))
+ && ((unsigned char) SREF (documentation, 0) == '*'))
return Qt;
/* If it is (STRING . INTEGER), a negative integer means a user variable. */
if (CONSP (documentation)
Lisp_Object args;
{
Lisp_Object varlist, val, elt;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
{
Lisp_Object *temps, tem;
register Lisp_Object elt, varlist;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
register int argnum;
struct gcpro gcpro1, gcpro2;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = specpdl_ptr - specpdl;
+ c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
Lisp_Object args;
{
Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
record_unwind_protect (0, Fcdr (args));
val = Feval (Fcar (args));
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = specpdl_ptr - specpdl;
+ c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = specpdl_ptr - specpdl;
+ c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = specpdl_ptr - specpdl;
+ c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = specpdl_ptr - specpdl;
+ c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
Lisp_Object error_symbol, data;
{
/* When memory is full, ERROR-SYMBOL is nil,
- and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). */
+ and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
+ That is a special case--don't do this in other situations. */
register struct handler *allhandlers = handlerlist;
Lisp_Object conditions;
extern int gc_in_progress;
else
real_error_symbol = error_symbol;
+#if 0 /* rms: I don't know why this was here,
+ but it is surely wrong for an error that is handled. */
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
+#endif
/* This hook is used by edebug. */
- if (! NILP (Vsignal_hook_function))
+ if (! NILP (Vsignal_hook_function)
+ && ! NILP (error_symbol))
call2 (Vsignal_hook_function, error_symbol, data);
conditions = Fget (real_error_symbol, Qerror_conditions);
/* Remember from where signal was called. Skip over the frame for
`signal' itself. If a frame for `error' follows, skip that,
- too. */
+ too. Don't do this when ERROR_SYMBOL is nil, because that
+ is a memory-full error. */
Vsignaling_function = Qnil;
- if (backtrace_list)
+ if (backtrace_list && !NILP (error_symbol))
{
bp = backtrace_list->next;
if (bp && bp->function && EQ (*bp->function, Qerror))
clause = find_handler_clause (handlerlist->handler, conditions,
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. */
- /* If have called debugger and user wants to continue,
- just return nil. */
- if (EQ (clause, Qlambda))
- return debugger_value;
-#else
if (EQ (clause, Qlambda))
{
/* We can't return values to code which signaled an error, but we
else
error ("Cannot return from the debugger in an error");
}
-#endif
if (!NILP (clause))
{
data = Fcons (error_symbol, data);
string = Ferror_message_string (data);
- fatal ("%s", XSTRING (string)->data, 0);
+ fatal ("%s", SDATA (string), 0);
}
/* Return nonzero iff LIST is a non-nil atom or
|| !NILP (Vdebug_on_signal)) /* This says call debugger even if
there is a handler. */
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int debugger_called = 0;
Lisp_Object sig_symbol, combined_data;
/* This is set to 1 if we are handling a memory-full error,
abort ();
}
\f
-DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
+DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
This means it contains a description for how to read arguments to give it.
The value is nil for an invalid function or a symbol with no function
to `interactive', autoload definitions made by `autoload' with non-nil
fourth argument, and some of the built-in functions of Lisp.
-Also, a symbol satisfies `commandp' if its function definition does so. */)
- (function)
- Lisp_Object function;
+Also, a symbol satisfies `commandp' if its function definition does so.
+
+If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
+then strings and vectors are not accepted. */)
+ (function, for_call_interactively)
+ Lisp_Object function, for_call_interactively;
{
register Lisp_Object fun;
register Lisp_Object funcar;
? Qt : Qnil);
/* Strings and vectors are keyboard macros. */
- if (STRINGP (fun) || VECTORP (fun))
+ if (NILP (for_call_interactively) && (STRINGP (fun) || VECTORP (fun)))
return Qt;
/* Lists may represent commands. */
do_autoload (fundef, funname)
Lisp_Object fundef, funname;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object fun, queue, first, second;
struct gcpro gcpro1, gcpro2, gcpro3;
+ /* This is to make sure that loadup.el gives a clear picture
+ of what files are preloaded and when. */
+ if (! NILP (Vpurify_flag))
+ error ("Attempt to autoload %s while preparing to dump",
+ SDATA (SYMBOL_NAME (funname)));
+
fun = funname;
CHECK_SYMBOL (funname);
GCPRO3 (fun, funname, fundef);
if (!NILP (Fequal (fun, fundef)))
error ("Autoloading failed to define function %s",
- XSYMBOL (funname)->name->data);
+ SDATA (SYMBOL_NAME (funname)));
UNGCPRO;
}
register Lisp_Object *arg_vector;
{
Lisp_Object val, syms_left, next;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int i, optional, rest;
if (CONSP (fun))
{
tem = AREF (object, COMPILED_BYTECODE);
if (CONSP (tem) && STRINGP (XCAR (tem)))
- error ("Invalid byte code in %s", XSTRING (XCAR (tem))->data);
+ error ("Invalid byte code in %s", SDATA (XCAR (tem)));
else
error ("Invalid byte code");
}
void
grow_specpdl ()
{
- register int count = specpdl_ptr - specpdl;
+ register int count = SPECPDL_INDEX ();
if (specpdl_size >= max_specpdl_size)
{
if (max_specpdl_size < 400)
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
doc: /* *Limit on number of Lisp variable bindings & unwind-protects.
If Lisp code tries to make more than this many at once,
-an error is signaled. */);
+an error is signaled.
+You can safely use a value considerably larger than the default value,
+if that proves inconveniently small. However, if you increase it too far,
+Emacs could run out of memory trying to make the stack bigger. */);
DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
-This limit is to catch infinite recursions for you before they cause
+
+This limit serves to catch infinite recursions for you before they cause
actual stack overflow in C, which would be fatal for Emacs.
You can safely make it considerably larger than its default value,
-if that proves inconveniently small. */);
+if that proves inconveniently small. However, if you increase it too far,
+Emacs could overflow the real C stack, and crash. */);
DEFVAR_LISP ("quit-flag", &Vquit_flag,
doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
Qdefun = intern ("defun");
staticpro (&Qdefun);
+ Qdefvar = intern ("defvar");
+ staticpro (&Qdefvar);
+
Qand_rest = intern ("&rest");
staticpro (&Qand_rest);