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
/* Maximum size allowed for specpdl allocation */
-int max_specpdl_size;
+EMACS_INT max_specpdl_size;
/* Depth in Lisp evaluations and function calls. */
/* Maximum allowed depth in Lisp evaluations and function calls. */
-int max_lisp_eval_depth;
+EMACS_INT max_lisp_eval_depth;
/* Nonzero means enter debugger before next function call */
int handling_signal;
-void specbind (), record_unwind_protect ();
+/* Function to process declarations in defmacro forms. */
-Lisp_Object run_hook_with_args ();
+Lisp_Object Vmacro_declaration_function;
-Lisp_Object funcall_lambda ();
-extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
+
+static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, 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;
}
\f
-static Lisp_Object find_handler_clause ();
+static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object,
+ Lisp_Object *));
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
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;
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
else if (COMPILEDP (fun))
- return ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
+ return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
? 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)));
/* Run hook variables in various ways. */
enum run_hooks_condition {to_completion, until_success, until_failure};
+static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
+ enum run_hooks_condition));
DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS. Major mode functions use this.
The caller (or its caller, etc) must gcpro all of ARGS,
except that it isn't necessary to gcpro ARGS[0]. */
-Lisp_Object
+static Lisp_Object
run_hook_with_args (nargs, args, cond)
int nargs;
Lisp_Object *args;
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]);
and return the result of evaluation.
FUN must be either a lambda-expression or a compiled-code object. */
-Lisp_Object
+static Lisp_Object
funcall_lambda (fun, nargs, arg_vector)
Lisp_Object fun;
int nargs;
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);
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
else if (COMPILEDP (fun))
- syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST];
+ syms_left = AREF (fun, COMPILED_ARGLIST);
else
abort ();
{
/* 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]))
+ if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
- val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE],
- XVECTOR (fun)->contents[COMPILED_CONSTANTS],
- XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]);
+ val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
+ AREF (fun, COMPILED_CONSTANTS),
+ AREF (fun, COMPILED_STACK_DEPTH));
}
return unbind_to (count, val);
{
Lisp_Object tem;
- if (COMPILEDP (object)
- && CONSP (XVECTOR (object)->contents[COMPILED_BYTECODE]))
+ if (COMPILEDP (object) && CONSP (AREF (object, COMPILED_BYTECODE)))
{
- tem = read_doc_string (XVECTOR (object)->contents[COMPILED_BYTECODE]);
+ tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
if (!CONSP (tem))
- error ("invalid byte code");
- XVECTOR (object)->contents[COMPILED_BYTECODE] = XCAR (tem);
- XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCDR (tem);
+ {
+ tem = AREF (object, COMPILED_BYTECODE);
+ if (CONSP (tem) && STRINGP (XCAR (tem)))
+ error ("Invalid byte code in %s", SDATA (XCAR (tem)));
+ else
+ error ("Invalid byte code");
+ }
+ AREF (object, COMPILED_BYTECODE) = XCAR (tem);
+ AREF (object, COMPILED_CONSTANTS) = XCDR (tem);
}
return object;
}
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);
staticpro (&Qand_optional);
DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
- doc: /* *Non-nil means automatically display a backtrace buffer
-after any error that is handled by the editor command loop.
+ doc: /* *Non-nil means errors display a backtrace buffer.
+More precisely, this happens for any error that is handled
+by the editor command loop.
If the value is a list, an error only means to display a backtrace
if one of its condition symbols appears in the list. */);
Vstack_trace_on_error = Qnil;
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);
HCoop / bpt / emacs.git / blobdiff