Lisp_Object Qinhibit_quit;
Lisp_Object Qand_rest;
static Lisp_Object Qand_optional;
-static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qinhibit_debugger;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
Lisp_Object inhibit_lisp_code;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
-static int interactive_p (int);
+static bool interactive_p (void);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-\f
+
+/* Functions to set Lisp_Object slots of struct specbinding. */
+
+static inline void
+set_specpdl_symbol (Lisp_Object symbol)
+{
+ specpdl_ptr->symbol = symbol;
+}
+
+static inline void
+set_specpdl_old_value (Lisp_Object oldval)
+{
+ specpdl_ptr->old_value = oldval;
+}
+
void
init_eval_once (void)
{
/* Call the Lisp debugger, giving it argument ARG. */
-static Lisp_Object
+Lisp_Object
call_debugger (Lisp_Object arg)
{
- int debug_while_redisplaying;
+ bool debug_while_redisplaying;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
EMACS_INT old_max = max_specpdl_size;
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
- specbind (Qdebug_on_error, Qnil);
+ specbind (Qinhibit_debugger, Qt);
#if 0 /* Binding this prevents execution of Lisp code during
redisplay, which necessarily leads to display problems. */
use `called-interactively-p'. */)
(void)
{
- return interactive_p (1) ? Qt : Qnil;
+ return interactive_p () ? Qt : Qnil;
}
you're making a mistake. Think: what do you want to do when the
command is called from a keyboard macro?
-This function is meant for implementing advice and other
-function-modifying features. Instead of using this, it is sometimes
-cleaner to give your function an extra optional argument whose
-`interactive' spec specifies non-nil unconditionally (\"p\" is a good
-way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
+Instead of using this function, it is sometimes cleaner to give your
+function an extra optional argument whose `interactive' spec specifies
+non-nil unconditionally (\"p\" is a good way to do this), or via
+\(not (or executing-kbd-macro noninteractive)). */)
(Lisp_Object kind)
{
- return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
- && interactive_p (1)) ? Qt : Qnil;
+ return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
+ && interactive_p ())
+ ? Qt : Qnil);
}
-/* Return 1 if function in which this appears was called using
- call-interactively.
-
- EXCLUDE_SUBRS_P non-zero means always return 0 if the function
- called is a built-in. */
+/* Return true if function in which this appears was called using
+ call-interactively and is not a built-in. */
-static int
-interactive_p (int exclude_subrs_p)
+static bool
+interactive_p (void)
{
struct backtrace *btp;
Lisp_Object fun;
/* `btp' now points at the frame of the innermost function that isn't
a special form, ignoring frames for Finteractive_p and/or
Fbytecode at the top. If this frame is for a built-in function
- (such as load or eval-region) return nil. */
+ (such as load or eval-region) return false. */
fun = Findirect_function (*btp->function, Qnil);
- if (exclude_subrs_p && SUBRP (fun))
+ if (SUBRP (fun))
return 0;
/* `btp' points to the frame of a Lisp function that called interactive-p.
/* Do it before evaluating the initial value, for self-references. */
XSYMBOL (sym)->declared_special = 1;
- if (SYMBOL_CONSTANT_P (sym))
- {
- /* For upward compatibility, allow (defvar :foo (quote :foo)). */
- Lisp_Object tem1 = Fcar (tail);
- if (! (CONSP (tem1)
- && EQ (XCAR (tem1), Qquote)
- && CONSP (XCDR (tem1))
- && EQ (XCAR (XCDR (tem1)), sym)))
- error ("Constant symbol `%s' specified in defvar",
- SDATA (SYMBOL_NAME (sym)));
- }
-
if (NILP (tem))
Fset_default (sym, eval_sub (Fcar (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
- volatile struct specbinding *pdl = specpdl_ptr;
+ struct specbinding *pdl = specpdl_ptr;
while (pdl > specpdl)
{
if (EQ ((--pdl)->symbol, sym) && !pdl->func
{
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
+ struct gcpro gcpro1;
+ GCPRO1 (form);
+ def = Fautoload_do_load (def, sym, Qmacro);
+ UNGCPRO;
if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable. */
break;
- if (EQ (XCAR (def), Qautoload))
- {
- /* Autoloading function: will it be a macro when loaded? */
- tem = Fnth (make_number (4), def);
- if (EQ (tem, Qt) || EQ (tem, Qmacro))
- /* Yes, load it and try again. */
- {
- struct gcpro gcpro1;
- GCPRO1 (form);
- do_autoload (def, sym);
- UNGCPRO;
- continue;
- }
- else
- break;
- }
- else if (!EQ (XCAR (def), Qmacro))
+ if (!EQ (XCAR (def), Qmacro))
break;
else expander = XCDR (def);
}
static _Noreturn void
unwind_to_catch (struct catchtag *catch, Lisp_Object value)
{
- int last_time;
+ bool last_time;
/* Save the value in the tag. */
catch->val = value;
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
{
- register Lisp_Object bodyform, handlers;
- volatile Lisp_Object var;
-
- var = Fcar (args);
- bodyform = Fcar (Fcdr (args));
- handlers = Fcdr (Fcdr (args));
+ Lisp_Object var = Fcar (args);
+ Lisp_Object bodyform = Fcar (Fcdr (args));
+ Lisp_Object handlers = Fcdr (Fcdr (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
ptrdiff_t nargs,
Lisp_Object *args,
Lisp_Object handlers,
- Lisp_Object (*hfun) (Lisp_Object))
+ Lisp_Object (*hfun) (Lisp_Object err,
+ ptrdiff_t nargs,
+ Lisp_Object *args))
{
Lisp_Object val;
struct catchtag c;
c.byte_stack = byte_stack_list;
if (_setjmp (c.jmp))
{
- return (*hfun) (c.val);
+ return (*hfun) (c.val, nargs, args);
}
c.next = catchlist;
catchlist = &c;
\f
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
-static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
- Lisp_Object data);
+static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
+ Lisp_Object data);
void
process_quit_flag (void)
immediate_quit = handling_signal = 0;
abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
- abort ();
+ emacs_abort ();
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
if requested". */
|| EQ (h->handler, Qerror)))
{
- int debugger_called
+ bool debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
xsignal (Lisp_Object error_symbol, Lisp_Object data)
{
Fsignal (error_symbol, data);
- abort ();
+ emacs_abort ();
}
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
}
-/* Return nonzero if LIST is a non-nil atom or
+/* Return true if LIST is a non-nil atom or
a list containing one of CONDITIONS. */
-static int
+static bool
wants_debugger (Lisp_Object list, Lisp_Object conditions)
{
if (NILP (list))
return 0;
}
-/* Return 1 if an error with condition-symbols CONDITIONS,
+/* Return true if an error with condition-symbols CONDITIONS,
and described by SIGNAL-DATA, should skip the debugger
according to debugger-ignored-errors. */
-static int
+static bool
skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
Lisp_Object tail;
- int first_string = 1;
+ bool first_string = 1;
Lisp_Object error_message;
error_message = Qnil;
= SIG is the error symbol, and DATA is the rest of the data.
= SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
This is for memory-full errors only. */
-static int
+static bool
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
Lisp_Object combined_data;
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
! INPUT_BLOCKED_P
+ && NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
? debug_on_quit
FUNNAME is the symbol which is the function's name.
FUNDEF is the autoload definition (a list). */
-void
-do_autoload (Lisp_Object fundef, Lisp_Object funname)
+DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
+ doc: /* Load FUNDEF which should be an autoload.
+If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
+in which case the function returns the new autoloaded function value.
+If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
+it is defines a macro. */)
+ (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
ptrdiff_t count = SPECPDL_INDEX ();
- Lisp_Object fun;
struct gcpro gcpro1, gcpro2, gcpro3;
+ if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
+ return fundef;
+
+ if (EQ (macro_only, Qmacro))
+ {
+ Lisp_Object kind = Fnth (make_number (4), fundef);
+ if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
+ return fundef;
+ }
+
/* 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);
+ GCPRO3 (funname, fundef, macro_only);
/* Preserve the match data. */
record_unwind_save_match_data ();
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
+ /* If `macro_only', assume this autoload to be a "best-effort",
+ so don't signal an error if autoloading fails. */
+ Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- fun = Findirect_function (fun, Qnil);
-
- if (!NILP (Fequal (fun, fundef)))
- error ("Autoloading failed to define function %s",
- SDATA (SYMBOL_NAME (funname)));
UNGCPRO;
+
+ if (NILP (funname))
+ return Qnil;
+ else
+ {
+ Lisp_Object fun = Findirect_function (funname, Qnil);
+
+ if (!NILP (Fequal (fun, fundef)))
+ error ("Autoloading failed to define function %s",
+ SDATA (SYMBOL_NAME (funname)));
+ else
+ return fun;
+ }
}
\f
struct gcpro gcpro1, gcpro2, gcpro3;
if (handling_signal)
- abort ();
+ emacs_abort ();
if (SYMBOLP (form))
{
return form;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- {
- GCPRO1 (form);
- Fgarbage_collect ();
- UNGCPRO;
- }
+ maybe_gc ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
args_left = original_args;
numargs = Flength (args_left);
- CHECK_CONS_LIST ();
+ check_cons_list ();
if (XINT (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
is supported by this code. We need to either rewrite the
subr to use a different argument protocol, or add more
cases to this switch. */
- abort ();
+ emacs_abort ();
}
}
}
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
+ Fautoload_do_load (fun, original_fun, Qnil);
goto retry;
}
if (EQ (funcar, Qmacro))
- val = eval_sub (apply1 (Fcdr (fun), original_args));
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object exp;
+ /* Bind lexical-binding during expansion of the macro, so the
+ macro can know reliably if the code it outputs will be
+ interpreted using lexical-binding or not. */
+ specbind (Qlexical_binding,
+ NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
+ exp = apply1 (Fcdr (fun), original_args);
+ unbind_to (count, Qnil);
+ val = eval_sub (exp);
+ }
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
val = apply_lambda (fun, original_args);
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
gcpro1.nvars = 1 + numargs;
}
- memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
+ memcpy (funcall_args, args, nargs * word_size);
/* Spread the last arg we got. Its first element goes in
the slot that it used to occupy, hence this value of I. */
i = nargs - 1;
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
{
- if (SYMBOLP (object) && !NILP (Ffboundp (object)))
- {
- object = Findirect_function (object, Qt);
-
- if (CONSP (object) && EQ (XCAR (object), Qautoload))
- {
- /* Autoloaded symbols are functions, except if they load
- macros or keymaps. */
- int i;
- for (i = 0; i < 4 && CONSP (object); i++)
- object = XCDR (object);
-
- return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
- }
- }
-
- if (SUBRP (object))
- return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
- else if (COMPILEDP (object))
+ if (FUNCTIONP (object))
return Qt;
- else if (CONSP (object))
- {
- Lisp_Object car = XCAR (object);
- return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
- }
- else
- return Qnil;
+ return Qnil;
}
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
ptrdiff_t i;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- Fgarbage_collect ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
backtrace.function = &args[0];
- backtrace.args = &args[1];
+ backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
+ /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
+ maybe_gc ();
+
if (debug_on_next_call)
do_debug_on_call (Qlambda);
- CHECK_CONS_LIST ();
+ check_cons_list ();
original_fun = args[0];
{
internal_args = alloca (XSUBR (fun)->max_args
* sizeof *internal_args);
- memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
+ memcpy (internal_args, args + 1, numargs * word_size);
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
/* If a subr takes more than 8 arguments without using MANY
or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
- abort ();
+ emacs_abort ();
}
}
}
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
- CHECK_CONS_LIST ();
+ Fautoload_do_load (fun, original_fun, Qnil);
+ check_cons_list ();
goto retry;
}
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
Lisp_Object val, syms_left, next, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t i;
- int optional, rest;
+ bool optional, rest;
if (CONSP (fun))
{
lexenv = Qnil;
}
else
- abort ();
+ emacs_abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = SYMBOL_VAL (sym);
+ set_specpdl_symbol (symbol);
+ set_specpdl_old_value (SYMBOL_VAL (sym));
specpdl_ptr->func = NULL;
++specpdl_ptr;
if (!sym->constant)
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
- specpdl_ptr->old_value = ovalue;
+ set_specpdl_old_value (ovalue);
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
- || (BLV_FOUND (SYMBOL_BLV (sym))
+ || (blv_found (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
- && BLV_FOUND (SYMBOL_BLV (sym)))
+ && blv_found (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
eassert (NILP (where) || EQ (where, cur_buf));
- specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+ set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
}
}
else
- specpdl_ptr->symbol = symbol;
+ set_specpdl_symbol (symbol);
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
- specpdl_ptr->symbol = Qnil;
- specpdl_ptr->old_value = arg;
+ set_specpdl_symbol (Qnil);
+ set_specpdl_old_value (arg);
specpdl_ptr++;
}
write_string ("(", -1);
if (backlist->nargs == MANY)
{ /* FIXME: Can this happen? */
- int i;
- for (tail = *backlist->args, i = 0;
- !NILP (tail);
- tail = Fcdr (tail), i = 1)
+ bool later_arg = 0;
+ for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
{
- if (i) write_string (" ", -1);
+ if (later_arg)
+ write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
+ later_arg = 1;
}
}
else
DEFSYM (Qinhibit_quit, "inhibit-quit");
DEFSYM (Qautoload, "autoload");
- DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qinhibit_debugger, "inhibit-debugger");
DEFSYM (Qmacro, "macro");
DEFSYM (Qdeclare, "declare");
DEFSYM (Qclosure, "closure");
DEFSYM (Qdebug, "debug");
+ DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
+ doc: /* Non-nil means never enter the debugger.
+Normally set while the debugger is already active, to avoid recursive
+invocations. */);
+ Vinhibit_debugger = Qnil;
+
DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
doc: /* Non-nil means enter debugger if an error is signaled.
Does not apply to errors handled by `condition-case' or those
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
The command `toggle-debug-on-error' toggles this.
-See also the variable `debug-on-quit'. */);
+See also the variable `debug-on-quit' and `inhibit-debugger'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
defsubr (&Scalled_interactively_p);
defsubr (&Scommandp);
defsubr (&Sautoload);
+ defsubr (&Sautoload_do_load);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
HCoop / bpt / emacs.git / blobdiff