Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
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 ()
}
DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
- doc: /* Eval args until one of them yields nil, then return nil.
+ doc: /* Eval args until one of them yields nil, then return nil.
The remaining args are not evalled at all.
If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS ...) */)
}
DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
- doc: /* If COND yields non-nil, do THEN, else do ELSE...
+ doc: /* If COND yields non-nil, do THEN, else do ELSE...
Returns the value of THEN or the value of the last of the ELSE's.
THEN must be one expression, but ELSE... can be zero or more expressions.
If COND yields nil, and there are no ELSE's, the value is nil.
(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;
{
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);
This means that M-x set-variable recognizes it.
See also `user-variable-p'.
If INITVALUE is missing, SYMBOL's value is not set.
-usage: (defvar SYMBOL [INITVALUE DOCSTRING]) */)
+usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(args)
Lisp_Object args;
{
(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);
}
\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 debugger_value;
Lisp_Object string;
Lisp_Object real_error_symbol;
- extern int display_hourglass_p;
struct backtrace *bp;
immediate_quit = handling_signal = 0;
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 strins 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
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",
+ XSYMBOL (funname)->name->data);
+
fun = funname;
CHECK_SYMBOL (funname);
GCPRO3 (fun, funname, fundef);
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;
int count = specpdl_ptr - specpdl;
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", XSTRING (XCAR (tem))->data);
+ else
+ error ("Invalid byte code");
+ }
+ AREF (object, COMPILED_BYTECODE) = XCAR (tem);
+ AREF (object, COMPILED_CONSTANTS) = XCDR (tem);
}
return object;
}
return value;
}
\f
-#if 0
-
-/* Get the value of symbol's global binding, even if that binding
- is not now dynamically visible. */
-
-Lisp_Object
-top_level_value (symbol)
- Lisp_Object symbol;
-{
- register struct specbinding *ptr = specpdl;
-
- CHECK_SYMBOL (symbol);
- for (; ptr != specpdl_ptr; ptr++)
- {
- if (EQ (ptr->symbol, symbol))
- return ptr->old_value;
- }
- return Fsymbol_value (symbol);
-}
-
-Lisp_Object
-top_level_set (symbol, newval)
- Lisp_Object symbol, newval;
-{
- register struct specbinding *ptr = specpdl;
-
- CHECK_SYMBOL (symbol);
- for (; ptr != specpdl_ptr; ptr++)
- {
- if (EQ (ptr->symbol, symbol))
- {
- ptr->old_value = newval;
- return newval;
- }
- }
- return Fset (symbol, newval);
-}
-
-#endif /* 0 */
-\f
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
The debugger is entered when that frame exits, if the flag 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");
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);