X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9f6f48455f7d25e5cc2d50485d98ff3af43946a2..7f590b0c3b25602499432bf986e7b593fc158c0b:/src/eval.c
diff --git a/src/eval.c b/src/eval.c
index e6d4a4ceac..975204da01 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -19,7 +19,6 @@ along with GNU Emacs. If not, see . */
#include
#include
-#include
#include
#include "lisp.h"
#include "blockinput.h"
@@ -32,17 +31,7 @@ along with GNU Emacs. If not, see . */
#include "xterm.h"
#endif
-struct backtrace
-{
- struct backtrace *next;
- Lisp_Object *function;
- Lisp_Object *args; /* Points to vector of args. */
- ptrdiff_t nargs; /* Length of vector. */
- /* Nonzero means call value of debugger when done with this operation. */
- unsigned int debug_on_exit : 1;
-};
-
-static struct backtrace *backtrace_list;
+struct backtrace *backtrace_list;
#if !BYTE_MARK_STACK
static
@@ -69,7 +58,7 @@ Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
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;
@@ -118,12 +107,6 @@ static EMACS_INT when_entered_debugger;
Lisp_Object Vsignaling_function;
-/* Set to non-zero while processing X events. Checked in Feval to
- make sure the Lisp interpreter isn't called from a signal handler,
- which is unsafe because the interpreter isn't reentrant. */
-
-int handling_signal;
-
/* If non-nil, Lisp code must not be run since some part of Emacs is
in an inconsistent state. Currently, x-create-frame uses this to
avoid triggering window-configuration-change-hook while the new
@@ -131,9 +114,23 @@ int handling_signal;
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);
-
+
+/* Functions to set Lisp_Object slots of struct specbinding. */
+
+static void
+set_specpdl_symbol (Lisp_Object symbol)
+{
+ specpdl_ptr->symbol = symbol;
+}
+
+static void
+set_specpdl_old_value (Lisp_Object oldval)
+{
+ specpdl_ptr->old_value = oldval;
+}
+
void
init_eval_once (void)
{
@@ -177,10 +174,10 @@ restore_stack_limits (Lisp_Object data)
/* 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;
@@ -215,7 +212,7 @@ call_debugger (Lisp_Object arg)
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. */
@@ -511,7 +508,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
use `called-interactively-p'. */)
(void)
{
- return interactive_p (1) ? Qt : Qnil;
+ return interactive_p () ? Qt : Qnil;
}
@@ -530,26 +527,23 @@ thinking of using it for any other purpose, it is quite likely that
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;
@@ -558,7 +552,7 @@ interactive_p (int exclude_subrs_p)
/* If this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p. If so, skip it. */
- fun = Findirect_function (*btp->function, Qnil);
+ fun = Findirect_function (btp->function, Qnil);
if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
|| XSUBR (fun) == &Scalled_interactively_p))
btp = btp->next;
@@ -571,21 +565,21 @@ interactive_p (int exclude_subrs_p)
If this isn't a byte-compiled function, then we may now be
looking at several frames for special forms. Skip past them. */
while (btp
- && (EQ (*btp->function, Qbytecode)
+ && (EQ (btp->function, Qbytecode)
|| btp->nargs == UNEVALLED))
btp = btp->next;
/* `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. */
- fun = Findirect_function (*btp->function, Qnil);
- if (exclude_subrs_p && SUBRP (fun))
+ (such as load or eval-region) return false. */
+ fun = Findirect_function (btp->function, Qnil);
+ if (SUBRP (fun))
return 0;
/* `btp' points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
- if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
+ if (btp && btp->next && EQ (btp->next->function, Qcall_interactively))
return 1;
return 0;
}
@@ -696,7 +690,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
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
@@ -976,7 +970,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
tem = Fassq (sym, environment);
if (NILP (tem))
{
- def = SVAR (XSYMBOL (sym), function);
+ def = XSYMBOL (sym)->function;
if (!EQ (def, Qunbound))
continue;
}
@@ -1061,7 +1055,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
catchlist = &c;
/* Call FUNC. */
- if (! _setjmp (c.jmp))
+ if (! sys_setjmp (c.jmp))
c.val = (*func) (arg);
/* Throw works by a longjmp that comes right here. */
@@ -1072,7 +1066,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
jump to that CATCH, returning VALUE as the value of that catch.
- This is the guts Fthrow and Fsignal; they differ only in the way
+ This is the guts of Fthrow and Fsignal; they differ only in the way
they choose the catch tag to throw to. A catch tag for a
condition-case form has a TAG of Qnil.
@@ -1081,22 +1075,21 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
the handler stack as we go, so that the proper handlers are in
effect for each unwind-protect clause we run. At the end, restore
some static info saved in CATCH, and longjmp to the location
- specified in the
+ specified there.
This is used for correct unwinding in Fthrow and Fsignal. */
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;
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
- UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
- handling_signal = 0;
+ unblock_input_to (catch->interrupt_input_blocked);
immediate_quit = 0;
do
@@ -1111,16 +1104,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
}
while (! last_time);
-#if HAVE_X_WINDOWS
- /* If x_catch_errors was done, turn it off now.
- (First we give unbind_to a chance to do that.) */
-#if 0 /* This would disable x_catch_errors after x_connection_closed.
- The catch must remain in effect during that delicate
- state. --lorentey */
- x_fully_uncatch_errors ();
-#endif
-#endif
-
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
@@ -1129,7 +1112,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
- _longjmp (catch->jmp, 1);
+ sys_longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
@@ -1193,12 +1176,9 @@ See also the function `signal' for more info.
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);
}
@@ -1238,7 +1218,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
if (!NILP (h.var))
specbind (h.var, c.val);
@@ -1293,7 +1273,7 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1331,7 +1311,7 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1373,7 +1353,7 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1399,7 +1379,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
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;
@@ -1415,9 +1397,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
- return (*hfun) (c.val);
+ return (*hfun) (c.val, nargs, args);
}
c.next = catchlist;
catchlist = &c;
@@ -1435,8 +1417,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
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)
@@ -1477,10 +1459,10 @@ See also the function `condition-case'. */)
struct handler *h;
struct backtrace *bp;
- immediate_quit = handling_signal = 0;
+ immediate_quit = 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. */
@@ -1514,10 +1496,10 @@ See also the function `condition-case'. */)
if (backtrace_list && !NILP (error_symbol))
{
bp = backtrace_list->next;
- if (bp && bp->function && EQ (*bp->function, Qerror))
+ if (bp && EQ (bp->function, Qerror))
bp = bp->next;
- if (bp && bp->function)
- Vsignaling_function = *bp->function;
+ if (bp)
+ Vsignaling_function = bp->function;
}
for (h = handlerlist; h; h = h->next)
@@ -1528,7 +1510,7 @@ See also the function `condition-case'. */)
}
if (/* Don't run the debugger for a memory-full error.
- (There is no room in memory to do that!) */
+ (There is no room in memory to do that!) */
!NILP (error_symbol)
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
@@ -1541,7 +1523,7 @@ See also the function `condition-case'. */)
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. */
@@ -1577,7 +1559,7 @@ void
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. */
@@ -1635,10 +1617,10 @@ signal_error (const char *s, Lisp_Object arg)
}
-/* 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))
@@ -1658,15 +1640,15 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
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;
@@ -1701,7 +1683,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
= 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;
@@ -1711,7 +1693,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
+ ! input_blocked_p ()
+ && NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
? debug_on_quit
@@ -1893,9 +1876,11 @@ this does nothing and returns nil. */)
CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */
- if (!EQ (SVAR (XSYMBOL (function), function), Qunbound)
- && !(CONSP (SVAR (XSYMBOL (function), function))
- && EQ (XCAR (SVAR (XSYMBOL (function), function)), Qautoload)))
+ if ((CONSP (XSYMBOL (function)->function)
+ && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
+ /* Remember that the function was already an autoload. */
+ LOADHIST_ATTACH (Fcons (Qt, function));
+ else if (!EQ (XSYMBOL (function)->function, Qunbound))
return Qnil;
if (NILP (Vpurify_flag))
@@ -2029,9 +2014,6 @@ eval_sub (Lisp_Object form)
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (handling_signal)
- abort ();
-
if (SYMBOLP (form))
{
/* Look up its binding in the lexical environment.
@@ -2065,11 +2047,11 @@ eval_sub (Lisp_Object form)
original_args = XCDR (form);
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &original_fun; /* This also protects them from gc. */
+ backtrace.function = original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
if (debug_on_next_call)
do_debug_on_call (Qt);
@@ -2081,7 +2063,7 @@ eval_sub (Lisp_Object form)
/* Optimize for no indirection. */
fun = original_fun;
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
- && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun)))
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
@@ -2194,7 +2176,7 @@ eval_sub (Lisp_Object form)
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 ();
}
}
}
@@ -2215,7 +2197,18 @@ eval_sub (Lisp_Object form)
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);
@@ -2266,7 +2259,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
- && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun)))
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
{
@@ -2360,14 +2353,10 @@ usage: (run-hooks &rest HOOKS) */)
DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned. If it is a list
-of functions, those functions are called, in order,
-with the given arguments ARGS.
-It is best not to depend on the value returned by `run-hook-with-args',
-as that may change.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS. The final return value
+is unspecified.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2377,17 +2366,18 @@ usage: (run-hook-with-args HOOK &rest ARGS) */)
return run_hook_with_args (nargs, args, funcall_nil);
}
+/* NB this one still documents a specific non-nil return value.
+ (As did run-hook-with-args and run-hook-with-args-until-failure
+ until they were changed in 24.1.) */
DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
Srun_hook_with_args_until_success, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them
-returns a non-nil value. Then we return that value.
-However, if they all return nil, we return nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns non-nil, and return that value. Otherwise (if
+all functions return nil, or if there are no functions to call),
+return nil.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2406,13 +2396,12 @@ funcall_not (ptrdiff_t nargs, Lisp_Object *args)
DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them returns nil.
-Then we return nil. However, if they all return non-nil, we return non-nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns nil, and return nil. Otherwise (if all functions
+return non-nil, or if there are no functions to call), return non-nil
+\(do not rely on the precise return value in this case).
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2694,33 +2683,9 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
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,
@@ -2750,11 +2715,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &args[0];
+ backtrace.function = args[0];
backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
/* Call GC after setting up the backtrace, so the latter GCPROs the args. */
maybe_gc ();
@@ -2771,7 +2736,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */
fun = original_fun;
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
- && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun)))
+ && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
@@ -2850,7 +2815,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* 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 ();
}
}
}
@@ -2937,7 +2902,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
Lisp_Object val, syms_left, next, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t i;
- int optional, rest;
+ bool optional, rest;
if (CONSP (fun))
{
@@ -2981,7 +2946,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
lexenv = Qnil;
}
else
- abort ();
+ emacs_abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
@@ -3107,8 +3072,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
{
struct Lisp_Symbol *sym;
- eassert (!handling_signal);
-
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
@@ -3122,8 +3085,8 @@ specbind (Lisp_Object symbol, Lisp_Object value)
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)
@@ -3138,7 +3101,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
{
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,
@@ -3155,12 +3118,12 @@ specbind (Lisp_Object symbol, Lisp_Object value)
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;
@@ -3172,7 +3135,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
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
@@ -3189,26 +3152,24 @@ specbind (Lisp_Object symbol, Lisp_Object value)
}
}
else
- specpdl_ptr->symbol = symbol;
+ set_specpdl_symbol (symbol);
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
void
record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
- eassert (!handling_signal);
-
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++;
}
@@ -3254,7 +3215,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
local binding, but only if that binding still exists. */
else if (BUFFERP (where)
? !NILP (Flocal_variable_p (symbol, where))
- : !NILP (Fassq (symbol, FGET (XFRAME (where), param_alist))))
+ : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
set_internal (symbol, this_binding.old_value, where, 1);
}
/* If variable has a trivial value (no forwarding), we can
@@ -3330,23 +3291,23 @@ Output stream used is value of `standard-output'. */)
write_string (backlist->debug_on_exit ? "* " : " ", 2);
if (backlist->nargs == UNEVALLED)
{
- Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
+ Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
write_string ("\n", -1);
}
else
{
- tem = *backlist->function;
+ tem = backlist->function;
Fprin1 (tem, Qnil); /* This can QUIT. */
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
@@ -3393,7 +3354,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
if (!backlist)
return Qnil;
if (backlist->nargs == UNEVALLED)
- return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
+ return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
else
{
if (backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3401,7 +3362,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
else
tem = Flist (backlist->nargs, backlist->args);
- return Fcons (Qt, Fcons (*backlist->function, tem));
+ return Fcons (Qt, Fcons (backlist->function, tem));
}
}
@@ -3467,7 +3428,7 @@ before making `inhibit-quit' nil. */);
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");
@@ -3482,6 +3443,12 @@ before making `inhibit-quit' nil. */);
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
@@ -3491,7 +3458,7 @@ if one of its condition symbols appears in the list.
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,