/* 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 Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
+Lisp_Object Qdeclare;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
int handling_signal;
+/* Function to process declarations in defmacro forms. */
+
+Lisp_Object Vmacro_declaration_function;
+
+
static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
-/* Apply a mocklisp function to unevaluated argument list. */
-extern Lisp_Object ml_apply P_ ((Lisp_Object, Lisp_Object));
void
init_eval_once ()
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)
(args)
Lisp_Object args;
{
- register Lisp_Object val, tem;
+ register Lisp_Object val;
Lisp_Object args_left;
struct gcpro gcpro1;
- /* In Mocklisp code, symbols at the front of the progn arglist
- are to be bound to zero. */
- if (!EQ (Vmocklisp_arguments, Qt))
- {
- val = make_number (0);
- while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))
- {
- QUIT;
- specbind (tem, val), args = Fcdr (args);
- }
- }
-
if (NILP(args))
return Qnil;
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;
{
register Lisp_Object fn_name;
register Lisp_Object defn;
+ Lisp_Object lambda_list, doc, tail;
fn_name = Fcar (args);
- defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
+ lambda_list = Fcar (Fcdr (args));
+ tail = Fcdr (Fcdr (args));
+
+ doc = Qnil;
+ if (STRINGP (Fcar (tail)))
+ {
+ doc = Fcar (tail);
+ tail = Fcdr (tail);
+ }
+
+ while (CONSP (Fcar (tail))
+ && EQ (Fcar (Fcar (tail)), Qdeclare))
+ {
+ if (!NILP (Vmacro_declaration_function))
+ {
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
+ UNGCPRO;
+ }
+
+ tail = Fcdr (tail);
+ }
+
+ if (NILP (doc))
+ tail = Fcons (lambda_list, tail);
+ else
+ tail = Fcons (lambda_list, Fcons (doc, tail));
+ defn = Fcons (Qmacro, Fcons (Qlambda, tail));
+
if (!NILP (Vpurify_flag))
defn = Fpurecopy (defn);
Ffset (fn_name, defn);
}
-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;
(args)
Lisp_Object args;
{
- Lisp_Object test, body, tem;
+ Lisp_Object test, body;
struct gcpro gcpro1, gcpro2;
GCPRO2 (test, body);
test = Fcar (args);
body = Fcdr (args);
- while (tem = Feval (test),
- (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
+ while (!NILP (Feval (test)))
{
QUIT;
Fprogn (body);
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;
Lisp_Object debugger_value;
Lisp_Object string;
Lisp_Object real_error_symbol;
- extern int display_hourglass_p;
struct backtrace *bp;
immediate_quit = handling_signal = 0;
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. */
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
- if (EQ (funcar, Qmocklisp))
- return Qt; /* All mocklisp functions can be called interactively */
if (EQ (funcar, Qautoload))
return Fcar (Fcdr (Fcdr (Fcdr (fun))));
else
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;
}
abort ();
if (SYMBOLP (form))
- {
- if (EQ (Vmocklisp_arguments, Qt))
- return Fsymbol_value (form);
- val = Fsymbol_value (form);
- if (NILP (val))
- XSETFASTINT (val, 0);
- else if (EQ (val, Qt))
- XSETFASTINT (val, 1);
- return val;
- }
+ return Fsymbol_value (form);
if (!CONSP (form))
return form;
val = Feval (apply1 (Fcdr (fun), original_args));
else if (EQ (funcar, Qlambda))
val = apply_lambda (fun, original_args, 1);
- else if (EQ (funcar, Qmocklisp))
- val = ml_apply (fun, original_args);
else
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
done:
- if (!EQ (Vmocklisp_arguments, Qt))
- {
- if (NILP (val))
- XSETFASTINT (val, 0);
- else if (EQ (val, Qt))
- XSETFASTINT (val, 1);
- }
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1);
- else if (EQ (funcar, Qmocklisp))
- val = ml_apply (fun, Flist (numargs, args + 1));
else if (EQ (funcar, Qautoload))
{
do_autoload (fun, args[0]);
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 (NILP (Vmocklisp_arguments))
- specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */
-
if (CONSP (fun))
{
syms_left = XCDR (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.
Qmacro = intern ("macro");
staticpro (&Qmacro);
+ Qdeclare = intern ("declare");
+ staticpro (&Qdeclare);
+
/* Note that the process handling also uses Qexit, but we don't want
to staticpro it twice, so we just do it here. */
Qexit = intern ("exit");
Qdefun = intern ("defun");
staticpro (&Qdefun);
+ Qdefvar = intern ("defvar");
+ staticpro (&Qdefvar);
+
Qand_rest = intern ("&rest");
staticpro (&Qand_rest);
The Edebug package uses this to regain control. */);
Vsignal_hook_function = Qnil;
- Qmocklisp_arguments = intern ("mocklisp-arguments");
- staticpro (&Qmocklisp_arguments);
- DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments,
- doc: /* While in a mocklisp function, the list of its unevaluated args. */);
- Vmocklisp_arguments = Qt;
-
DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
doc: /* *Non-nil means call the debugger regardless of condition handlers.
Note that `debug-on-error', `debug-on-quit' and friends
still determine whether to handle the particular condition. */);
Vdebug_on_signal = Qnil;
+ DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function,
+ doc: /* Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used. */);
+ Vmacro_declaration_function = Qnil;
+
Vrun_hooks = intern ("run-hooks");
staticpro (&Vrun_hooks);