/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
- 2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "xterm.h"
#endif
-/* This definition is duplicated in alloc.c and keyboard.c */
-/* Putting it in lisp.h makes cc bomb out! */
+/* This definition is duplicated in alloc.c and keyboard.c. */
+/* Putting it in lisp.h makes cc bomb out! */
struct backtrace
{
struct backtrace *next;
Lisp_Object *function;
Lisp_Object *args; /* Points to vector of args. */
- int nargs; /* Length of vector.
- If nargs is UNEVALLED, args points to slot holding
- list of unevalled args */
+ size_t nargs; /* Length of vector.
+ If nargs is (size_t) UNEVALLED, args points
+ to slot holding list of unevalled args. */
char evalargs;
- /* Nonzero means call value of debugger when done with this operation. */
+ /* Nonzero means call value of debugger when done with this operation. */
char debug_on_exit;
};
int handling_signal;
-static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
+static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object*);
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
when_entered_debugger = -1;
}
-/* unwind-protect function used by call_debugger. */
+/* Unwind-protect function used by call_debugger. */
static Lisp_Object
restore_stack_limits (Lisp_Object data)
/* Call the Lisp debugger, giving it argument ARG. */
-Lisp_Object
+static Lisp_Object
call_debugger (Lisp_Object arg)
{
int debug_while_redisplaying;
return unbind_to (count, val);
}
-void
+static void
do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
looking at several frames for special forms. Skip past them. */
while (btp
&& (EQ (*btp->function, Qbytecode)
- || btp->nargs == UNEVALLED))
+ || btp->nargs == (size_t) UNEVALLED))
btp = btp->next;
- /* btp now points at the frame of the innermost function that isn't
+ /* `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. */
if (exclude_subrs_p && SUBRP (fun))
return 0;
- /* btp points to the frame of a Lisp function that called interactive-p.
+ /* `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))
return 1;
if (SYMBOL_CONSTANT_P (sym))
{
/* For upward compatibility, allow (defvar :foo (quote :foo)). */
- Lisp_Object tem = Fcar (tail);
- if (! (CONSP (tem)
- && EQ (XCAR (tem), Qquote)
- && CONSP (XCDR (tem))
- && EQ (XCAR (XCDR (tem)), sym)))
+ 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)));
}
LOADHIST_ATTACH (sym);
}
else
- /* 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. */
- ;
+ {
+ /* 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;
}
static Lisp_Object
lisp_indirect_variable (Lisp_Object sym)
{
- XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
+ struct Lisp_Symbol *s = indirect_variable (XSYMBOL (sym));
+ XSETSYMBOL (sym, s);
return sym;
}
Lisp_Object *temps, tem;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
- register int argnum;
+ register size_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
varlist = Fcar (args);
- /* Make space to hold the values to give the bound variables */
+ /* Make space to hold the values to give the bound variables. */
elt = Flength (varlist);
SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
- /* Compute the values and store them in `temps' */
+ /* Compute the values and store them in `temps'. */
GCPRO2 (args, *temps);
gcpro2.nvars = 0;
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
if (EQ (def, Qunbound) || !CONSP (def))
- /* Not defined or definition not suitable */
+ /* Not defined or definition not suitable. */
break;
if (EQ (XCAR (def), Qautoload))
{
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
- if (gcprolist != 0)
- gcpro_level = gcprolist->level + 1;
- else
- gcpro_level = 0;
+ gcpro_level = gcprolist ? gcprolist->level + 1 : gcpro_level = 0;
#endif
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
and ARGS as second argument. */
Lisp_Object
-internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*),
- int nargs,
+internal_condition_case_n (Lisp_Object (*bfun) (size_t, Lisp_Object *),
+ size_t nargs,
Lisp_Object *args,
Lisp_Object handlers,
Lisp_Object (*hfun) (Lisp_Object))
\f
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
+static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
+ Lisp_Object data);
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
/* When memory is full, ERROR-SYMBOL is nil,
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;
Lisp_Object string;
- Lisp_Object real_error_symbol;
+ Lisp_Object real_error_symbol
+ = (NILP (error_symbol) ? Fcar (data) : error_symbol);
+ register Lisp_Object clause = Qnil;
+ struct handler *h;
struct backtrace *bp;
immediate_quit = handling_signal = 0;
if (gc_in_progress || waiting_for_input)
abort ();
- if (NILP (error_symbol))
- real_error_symbol = Fcar (data);
- 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_WINDOW_SYSTEM
Vsignaling_function = *bp->function;
}
- for (; handlerlist; handlerlist = handlerlist->next)
+ for (h = handlerlist; h; h = h->next)
{
- register Lisp_Object clause;
-
- clause = find_handler_clause (handlerlist->handler, conditions,
+ clause = find_handler_clause (h->handler, conditions,
error_symbol, data);
-
- if (EQ (clause, Qlambda))
- {
- /* We can't return values to code which signaled an error, but we
- can continue code which has signaled a quit. */
- if (EQ (real_error_symbol, Qquit))
- return Qnil;
- else
- error ("Cannot return from the debugger in an error");
- }
-
if (!NILP (clause))
- {
- Lisp_Object unwind_data;
- struct handler *h = handlerlist;
-
- handlerlist = allhandlers;
+ break;
+ }
- if (NILP (error_symbol))
- unwind_data = data;
- else
- unwind_data = Fcons (error_symbol, data);
- h->chosen_clause = clause;
- unwind_to_catch (h->tag, unwind_data);
- }
+ if (/* Don't run the debugger for a memory-full error.
+ (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. */
+ || NILP (clause)
+ /* Special handler that means "print a message and run debugger
+ if requested". */
+ || EQ (h->handler, Qerror)))
+ {
+ int 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. */
+ if (debugger_called && EQ (real_error_symbol, Qquit))
+ return Qnil;
}
- handlerlist = allhandlers;
- /* If no handler is present now, try to run the debugger,
- and if that fails, throw to top level. */
- find_handler_clause (Qerror, conditions, error_symbol, data);
- if (catchlist != 0)
- Fthrow (Qtop_level, Qt);
+ if (!NILP (clause))
+ {
+ Lisp_Object unwind_data
+ = (NILP (error_symbol) ? data : Fcons (error_symbol, data));
+
+ h->chosen_clause = clause;
+ unwind_to_catch (h->tag, unwind_data);
+ }
+ else
+ {
+ if (catchlist != 0)
+ Fthrow (Qtop_level, Qt);
+ }
if (! NILP (error_symbol))
data = Fcons (error_symbol, data);
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, combined_data)
- /* rms: what's this for? */
+ /* RMS: What's this for? */
&& when_entered_debugger < num_nonmacro_input_events)
{
call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
Lisp_Object sig, Lisp_Object data)
{
register Lisp_Object h;
- register Lisp_Object tem;
- int debugger_called = 0;
- int debugger_considered = 0;
/* t is used by handlers for all conditions, set up by C code. */
if (EQ (handlers, Qt))
return Qt;
- /* Don't run the debugger for a memory-full error.
- (There is no room in memory to do that!) */
- if (NILP (sig))
- debugger_considered = 1;
-
/* error is used similarly, but means print an error message
and run the debugger if that is enabled. */
- if (EQ (handlers, Qerror)
- || !NILP (Vdebug_on_signal)) /* This says call debugger even if
- there is a handler. */
- {
- if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
- {
- max_lisp_eval_depth += 15;
- max_specpdl_size++;
- if (noninteractive)
- Fbacktrace ();
- else
- internal_with_output_to_temp_buffer
- ("*Backtrace*",
- (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
- Qnil);
- max_specpdl_size--;
- max_lisp_eval_depth -= 15;
- }
-
- if (!debugger_considered)
- {
- debugger_considered = 1;
- debugger_called = maybe_call_debugger (conditions, sig, data);
- }
-
- /* If there is no handler, return saying whether we ran the debugger. */
- if (EQ (handlers, Qerror))
- {
- if (debugger_called)
- return Qlambda;
- return Qt;
- }
- }
+ if (EQ (handlers, Qerror))
+ return Qt;
- for (h = handlers; CONSP (h); h = Fcdr (h))
+ for (h = handlers; CONSP (h); h = XCDR (h))
{
- Lisp_Object handler, condit;
+ Lisp_Object handler = XCAR (h);
+ Lisp_Object condit, tem;
- handler = Fcar (h);
if (!CONSP (handler))
continue;
- condit = Fcar (handler);
+ condit = XCAR (handler);
/* Handle a single condition name in handler HANDLER. */
if (SYMBOLP (condit))
{
Lisp_Object tail;
for (tail = condit; CONSP (tail); tail = XCDR (tail))
{
- tem = Fmemq (Fcar (tail), conditions);
+ tem = Fmemq (XCAR (tail), conditions);
if (!NILP (tem))
- {
- /* This handler is going to apply.
- Does it allow the debugger to run first? */
- if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
- maybe_call_debugger (conditions, sig, data);
- return handler;
- }
+ return handler;
}
}
}
}
-/* dump an error message; called like vprintf */
+/* Dump an error message; called like vprintf. */
void
verror (const char *m, va_list ap)
{
EMACS_INT size = 200;
int mlen;
char *buffer = buf;
- char *args[3];
int allocated = 0;
Lisp_Object string;
}
-/* dump an error message; called like printf */
+/* Dump an error message; called like printf. */
/* VARARGS 1 */
void
CHECK_SYMBOL (function);
CHECK_STRING (file);
- /* If function is defined and not as an autoload, don't override */
+ /* If function is defined and not as an autoload, don't override. */
if (!EQ (XSYMBOL (function)->function, Qunbound)
&& !(CONSP (XSYMBOL (function)->function)
&& EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
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.evalargs = 1;
do_debug_on_call (Qt);
/* At this point, only original_fun and original_args
- have values that will be used below */
+ have values that will be used below. */
retry:
/* Optimize for no indirection. */
CHECK_CONS_LIST ();
- if (XINT (numargs) < XSUBR (fun)->min_args ||
- (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
+ if (XINT (numargs) < XSUBR (fun)->min_args
+ || (0 <= XSUBR (fun)->max_args
+ && XSUBR (fun)->max_args < XINT (numargs)))
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
}
else if (XSUBR (fun)->max_args == MANY)
{
- /* Pass a vector of evaluated arguments */
+ /* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
- register int argnum = 0;
+ register size_t argnum = 0;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (vals, XINT (numargs));
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
- register int i, numargs;
+ register size_t i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
{
- /* Let funcall get the error */
+ /* Let funcall get the error. */
fun = args[0];
goto funcall;
}
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
- goto funcall; /* Let funcall get the error */
- else if (XSUBR (fun)->max_args > numargs)
+ goto funcall; /* Let funcall get the error. */
+ else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs)
{
/* Avoid making funcall cons up a yet another new vector of arguments
- by explicitly supplying nil's for optional values */
+ by explicitly supplying nil's for optional values. */
SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
for (i = numargs; i < XSUBR (fun)->max_args;)
funcall_args[++i] = Qnil;
\f
/* Run hook variables in various ways. */
-enum run_hooks_condition {to_completion, until_success, until_failure};
-static Lisp_Object run_hook_with_args (int, Lisp_Object *,
- enum run_hooks_condition);
+static Lisp_Object
+funcall_nil (size_t nargs, Lisp_Object *args)
+{
+ Ffuncall (nargs, args);
+ return Qnil;
+}
DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
Lisp_Object hook[1];
- register int i;
+ register size_t i;
for (i = 0; i < nargs; i++)
{
hook[0] = args[i];
- run_hook_with_args (1, hook, to_completion);
+ run_hook_with_args (1, hook, funcall_nil);
}
return Qnil;
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args HOOK &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
- return run_hook_with_args (nargs, args, to_completion);
+ return run_hook_with_args (nargs, args, funcall_nil);
}
DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
- return run_hook_with_args (nargs, args, until_success);
+ return run_hook_with_args (nargs, args, Ffuncall);
+}
+
+static Lisp_Object
+funcall_not (size_t nargs, Lisp_Object *args)
+{
+ return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
}
DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
+{
+ return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil;
+}
+
+static Lisp_Object
+run_hook_wrapped_funcall (size_t nargs, Lisp_Object *args)
{
- return run_hook_with_args (nargs, args, until_failure);
+ Lisp_Object tmp = args[0], ret;
+ args[0] = args[1];
+ args[1] = tmp;
+ ret = Ffuncall (nargs, args);
+ args[1] = args[0];
+ args[0] = tmp;
+ return ret;
+}
+
+DEFUN ("run-hook-wrapped", Frun_hook_wrapped, Srun_hook_wrapped, 2, MANY, 0,
+ doc: /* Run HOOK, passing each function through WRAP-FUNCTION.
+I.e. instead of calling each function FUN directly with arguments ARGS,
+it calls WRAP-FUNCTION with arguments FUN and ARGS.
+As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
+aborts and returns that value.
+usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
+ (size_t nargs, Lisp_Object *args)
+{
+ return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
}
/* ARGS[0] should be a hook symbol.
Call each of the functions in the hook value, passing each of them
as arguments all the rest of ARGS (all NARGS - 1 elements).
- COND specifies a condition to test after each call
- to decide whether to stop.
+ FUNCALL specifies how to call each function on the hook.
The caller (or its caller, etc) must gcpro all of ARGS,
except that it isn't necessary to gcpro ARGS[0]. */
-static Lisp_Object
-run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
+Lisp_Object
+run_hook_with_args (size_t nargs, Lisp_Object *args,
+ Lisp_Object (*funcall) (size_t nargs, Lisp_Object *args))
{
- Lisp_Object sym, val, ret;
+ Lisp_Object sym, val, ret = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
/* If we are dying or still initializing,
sym = args[0];
val = find_symbol_value (sym);
- ret = (cond == until_failure ? Qt : Qnil);
if (EQ (val, Qunbound) || NILP (val))
return ret;
else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
{
args[0] = val;
- return Ffuncall (nargs, args);
+ return funcall (nargs, args);
}
else
{
- Lisp_Object globals = Qnil;
- GCPRO3 (sym, val, globals);
+ Lisp_Object global_vals = Qnil;
+ GCPRO3 (sym, val, global_vals);
for (;
- CONSP (val) && ((cond == to_completion)
- || (cond == until_success ? NILP (ret)
- : !NILP (ret)));
+ CONSP (val) && NILP (ret);
val = XCDR (val))
{
if (EQ (XCAR (val), Qt))
{
/* t indicates this hook has a local binding;
it means to run the global binding too. */
- globals = Fdefault_value (sym);
- if (NILP (globals)) continue;
+ global_vals = Fdefault_value (sym);
+ if (NILP (global_vals)) continue;
- if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
+ if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda))
{
- args[0] = globals;
- ret = Ffuncall (nargs, args);
+ args[0] = global_vals;
+ ret = funcall (nargs, args);
}
else
{
for (;
- CONSP (globals) && ((cond == to_completion)
- || (cond == until_success ? NILP (ret)
- : !NILP (ret)));
- globals = XCDR (globals))
+ CONSP (global_vals) && NILP (ret);
+ global_vals = XCDR (global_vals))
{
- args[0] = XCAR (globals);
+ args[0] = XCAR (global_vals);
/* In a global value, t should not occur. If it does, we
must ignore it to avoid an endless loop. */
if (!EQ (args[0], Qt))
- ret = Ffuncall (nargs, args);
+ ret = funcall (nargs, args);
}
}
}
else
{
args[0] = XCAR (val);
- ret = Ffuncall (nargs, args);
+ ret = funcall (nargs, args);
}
}
Frun_hook_with_args (3, temp);
}
\f
-/* Apply fn to arg */
+/* Apply fn to arg. */
Lisp_Object
apply1 (Lisp_Object fn, Lisp_Object arg)
{
}
}
-/* Call function fn on no arguments */
+/* Call function fn on no arguments. */
Lisp_Object
call0 (Lisp_Object fn)
{
RETURN_UNGCPRO (Ffuncall (1, &fn));
}
-/* Call function fn with 1 argument arg1 */
+/* Call function fn with 1 argument arg1. */
/* ARGSUSED */
Lisp_Object
call1 (Lisp_Object fn, Lisp_Object arg1)
RETURN_UNGCPRO (Ffuncall (2, args));
}
-/* Call function fn with 2 arguments arg1, arg2 */
+/* Call function fn with 2 arguments arg1, arg2. */
/* ARGSUSED */
Lisp_Object
call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
RETURN_UNGCPRO (Ffuncall (3, args));
}
-/* Call function fn with 3 arguments arg1, arg2, arg3 */
+/* Call function fn with 3 arguments arg1, arg2, arg3. */
/* ARGSUSED */
Lisp_Object
call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
RETURN_UNGCPRO (Ffuncall (4, args));
}
-/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
+/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
/* ARGSUSED */
Lisp_Object
call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
RETURN_UNGCPRO (Ffuncall (5, args));
}
-/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
+/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
/* ARGSUSED */
Lisp_Object
call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
RETURN_UNGCPRO (Ffuncall (6, args));
}
-/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
+/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
/* ARGSUSED */
Lisp_Object
call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
RETURN_UNGCPRO (Ffuncall (7, args));
}
-/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
+/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
/* ARGSUSED */
Lisp_Object
call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
Lisp_Object fun, original_fun;
Lisp_Object funcar;
- int numargs = nargs - 1;
+ size_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
struct backtrace backtrace;
register Lisp_Object *internal_args;
- register int i;
+ register size_t i;
QUIT;
if ((consing_since_gc > gc_cons_threshold
apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
{
Lisp_Object args_left;
- Lisp_Object numargs;
+ size_t numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
- register int i;
+ register size_t i;
register Lisp_Object tem;
USE_SAFE_ALLOCA;
- numargs = Flength (args);
- SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
+ numargs = XINT (Flength (args));
+ SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
GCPRO3 (*arg_vector, args_left, fun);
gcpro1.nvars = 0;
- for (i = 0; i < XINT (numargs);)
+ for (i = 0; i < numargs; )
{
tem = Fcar (args_left), args_left = Fcdr (args_left);
if (eval_flag) tem = Feval (tem);
backtrace_list->nargs = i;
}
backtrace_list->evalargs = 0;
- tem = funcall_lambda (fun, XINT (numargs), arg_vector);
+ tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
if (backtrace_list->debug_on_exit)
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (Lisp_Object fun, int nargs, register Lisp_Object *arg_vector)
+funcall_lambda (Lisp_Object fun, size_t nargs,
+ register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next;
int count = SPECPDL_INDEX ();
- int i, optional, rest;
+ size_t i;
+ int optional, rest;
if (CONSP (fun))
{
return object;
}
\f
-void
+static void
grow_specpdl (void)
{
register int count = SPECPDL_INDEX ();
specpdl_ptr = specpdl + count;
}
-/* specpdl_ptr->symbol is a field which describes which variable is
+/* `specpdl_ptr->symbol' is a field which describes which variable is
let-bound, so it can be properly undone when we unbind_to.
It can have the following two shapes:
- SYMBOL : if it's a plain symbol, it means that we have let-bound
(void)
{
register struct backtrace *backlist = backtrace_list;
- register int i;
Lisp_Object tail;
Lisp_Object tem;
struct gcpro gcpro1;
while (backlist)
{
write_string (backlist->debug_on_exit ? "* " : " ", 2);
- if (backlist->nargs == UNEVALLED)
+ if (backlist->nargs == (size_t) UNEVALLED)
{
Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
write_string ("\n", -1);
else
{
tem = *backlist->function;
- Fprin1 (tem, Qnil); /* This can QUIT */
+ Fprin1 (tem, Qnil); /* This can QUIT. */
write_string ("(", -1);
- if (backlist->nargs == MANY)
+ if (backlist->nargs == (size_t) MANY)
{
+ int i;
for (tail = *backlist->args, i = 0;
!NILP (tail);
- tail = Fcdr (tail), i++)
+ tail = Fcdr (tail), i = 1)
{
if (i) write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
}
else
{
+ size_t i;
for (i = 0; i < backlist->nargs; i++)
{
if (i) write_string (" ", -1);
(Lisp_Object nframes)
{
register struct backtrace *backlist = backtrace_list;
- register int i;
+ register EMACS_INT i;
Lisp_Object tem;
CHECK_NATNUM (nframes);
if (!backlist)
return Qnil;
- if (backlist->nargs == UNEVALLED)
+ if (backlist->nargs == (size_t) UNEVALLED)
return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
else
{
- if (backlist->nargs == MANY)
+ if (backlist->nargs == (size_t) MANY)
tem = *backlist->args;
else
tem = Flist (backlist->nargs, backlist->args);
mark_backtrace (void)
{
register struct backtrace *backlist;
- register int i;
+ register size_t i;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
mark_object (*backlist->function);
- if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
- i = 0;
+ if (backlist->nargs == (size_t) UNEVALLED
+ || backlist->nargs == (size_t) MANY)
+ i = 1;
else
- i = backlist->nargs - 1;
- for (; i >= 0; i--)
+ i = backlist->nargs;
+ while (i--)
mark_object (backlist->args[i]);
}
}
Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
- DEFVAR_LISP ("stack-trace-on-error", Vstack_trace_on_error,
- 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;
-
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
defsubr (&Srun_hook_with_args);
defsubr (&Srun_hook_with_args_until_success);
defsubr (&Srun_hook_with_args_until_failure);
+ defsubr (&Srun_hook_wrapped);
defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
}
-