#include <config.h>
+#include <limits.h>
#include <setjmp.h>
+#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
#include "xterm.h"
#endif
-/* 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. */
-#define NARGS_BITS (BITS_PER_INT - 2)
- /* Let's not use size_t because we want to allow negative values (for
- UNEVALLED). Also let's steal 2 bits so we save a word (or more for
- alignment). In any case I doubt Emacs would survive a function call with
- more than 500M arguments. */
- int nargs : NARGS_BITS; /* Length of vector.
- If nargs is UNEVALLED, args points
- to slot holding list of unevalled args. */
- char evalargs : 1;
+ ptrdiff_t nargs; /* Length of vector. */
/* Nonzero means call value of debugger when done with this operation. */
- char debug_on_exit : 1;
+ unsigned int debug_on_exit : 1;
};
-struct backtrace *backtrace_list;
+static struct backtrace *backtrace_list;
+
+#if !BYTE_MARK_STACK
+static
+#endif
struct catchtag *catchlist;
+/* Chain of condition handlers currently in effect.
+ The elements of this chain are contained in the stack frames
+ of Fcondition_case and internal_condition_case.
+ When an error is signaled (by calling Fsignal, below),
+ this chain is searched for an element that applies. */
+
+#if !BYTE_MARK_STACK
+static
+#endif
+struct handler *handlerlist;
+
#ifdef DEBUG_GCPRO
/* Count levels of GCPRO to detect failure to UNGCPRO. */
int gcpro_level;
Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
Lisp_Object Qinhibit_quit;
-Lisp_Object Qand_rest, Qand_optional;
-Lisp_Object Qdebug_on_error;
-Lisp_Object Qdeclare;
+Lisp_Object Qand_rest;
+static Lisp_Object Qand_optional;
+static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
-Lisp_Object Qdebug;
+static Lisp_Object Qdebug;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
/* Depth in Lisp evaluations and function calls. */
-EMACS_INT lisp_eval_depth;
+static EMACS_INT lisp_eval_depth;
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
signal the error instead of entering an infinite loop of debugger
invocations. */
-int when_entered_debugger;
+static int when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
int handling_signal;
-static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *);
+static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_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 fun, Lisp_Object args);
+static Lisp_Object Ffetch_bytecode (Lisp_Object);
\f
void
init_eval_once (void)
}
sym->declared_special = 1;
+ XSYMBOL (base_variable)->declared_special = 1;
sym->redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
- register size_t argnum;
+ ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
return unbind_to (count, val);
}
\f
-/* Chain of condition handlers currently in effect.
- The elements of this chain are contained in the stack frames
- of Fcondition_case and internal_condition_case.
- When an error is signaled (by calling Fsignal, below),
- this chain is searched for an element that applies. */
-
-struct handler *handlerlist;
-
DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
doc: /* Regain control when an error is signaled.
Executes BODYFORM and returns its value if no error happens.
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
- error ("Invalid condition handler");
+ error ("Invalid condition handler: %s",
+ SDATA (Fprin1_to_string (tem, Qt)));
}
c.tag = Qnil;
and ARGS as second argument. */
Lisp_Object
-internal_condition_case_n (Lisp_Object (*bfun) (size_t, Lisp_Object *),
- size_t nargs,
+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))
}
\f
-static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
- Lisp_Object, 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);
for (h = handlerlist; h; h = h->next)
{
- clause = find_handler_clause (h->handler, conditions,
- error_symbol, data);
+ clause = find_handler_clause (h->handler, conditions);
if (!NILP (clause))
break;
}
}
/* Call the debugger if calling it is currently enabled for CONDITIONS.
- SIG and DATA describe the signal, as in find_handler_clause. */
-
+ SIG and DATA describe the signal. There are two ways to pass them:
+ = 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
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
return 0;
}
-/* Value of Qlambda means we have called debugger and user has continued.
- There are two ways to pass SIG and 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.
-
- We need to increase max_specpdl_size temporarily around
- anything we do that can push on the specpdl, so as not to get
- a second error here in case we're handling specpdl overflow. */
-
static Lisp_Object
-find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
- Lisp_Object sig, Lisp_Object data)
+find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
{
register Lisp_Object h;
{
char buf[4000];
size_t size = sizeof buf;
- size_t size_max = (size_t) -1;
+ size_t size_max = STRING_BYTES_BOUND + 1;
+ size_t mlen = strlen (m);
char *buffer = buf;
- int allocated = 0;
- int used;
+ size_t used;
Lisp_Object string;
while (1)
{
- used = vsnprintf (buffer, size, m, ap);
- if (used < 0)
- used = 0;
- if (used < size)
+ va_list ap_copy;
+ va_copy (ap_copy, ap);
+ used = doprnt (buffer, size, m, m + mlen, ap_copy);
+ va_end (ap_copy);
+
+ /* Note: the -1 below is because `doprnt' returns the number of bytes
+ excluding the terminating null byte, and it always terminates with a
+ null byte, even when producing a truncated message. */
+ if (used < size - 1)
break;
if (size <= size_max / 2)
size *= 2;
else if (size < size_max)
size = size_max;
else
- memory_full ();
- if (allocated)
- buffer = (char *) xrealloc (buffer, size);
- else
- {
- buffer = (char *) xmalloc (size);
- allocated = 1;
- }
+ break; /* and leave the message truncated */
+
+ if (buffer != buf)
+ xfree (buffer);
+ buffer = (char *) xmalloc (size);
}
string = make_string (buffer, used);
- if (allocated)
+ if (buffer != buf)
xfree (buffer);
xsignal1 (Qerror, string);
We used to use 0 here, but that leads to accidental sharing in
purecopy's hash-consing, so we use a (hopefully) unique integer
instead. */
- docstring = make_number (XHASH (function));
+ docstring = make_number (XPNTR (function));
return Ffset (function,
Fpurecopy (list5 (Qautoload, file, docstring,
interactive, type)));
backtrace.function = &original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
- backtrace.evalargs = 1;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
- {
- backtrace.evalargs = 0;
- val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- }
+ val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
else if (XSUBR (fun)->max_args == MANY)
{
/* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
- register size_t argnum = 0;
+ ptrdiff_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) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- register size_t i, numargs;
+ ptrdiff_t i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
/* Run hook variables in various ways. */
static Lisp_Object
-funcall_nil (size_t nargs, Lisp_Object *args)
+funcall_nil (ptrdiff_t nargs, Lisp_Object *args)
{
Ffuncall (nargs, args);
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-hooks &rest HOOKS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object hook[1];
- register size_t i;
+ ptrdiff_t i;
for (i = 0; i < nargs; i++)
{
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) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, funcall_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.
usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, Ffuncall);
}
static Lisp_Object
-funcall_not (size_t nargs, Lisp_Object *args)
+funcall_not (ptrdiff_t nargs, Lisp_Object *args)
{
return NILP (Ffuncall (nargs, args)) ? Qt : 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-until-failure HOOK &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_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)
+run_hook_wrapped_funcall (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object tmp = args[0], ret;
args[0] = args[1];
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)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
}
except that it isn't necessary to gcpro ARGS[0]. */
Lisp_Object
-run_hook_with_args (size_t nargs, Lisp_Object *args,
- Lisp_Object (*funcall) (size_t nargs, Lisp_Object *args))
+run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
+ Lisp_Object (*funcall) (ptrdiff_t nargs, Lisp_Object *args))
{
Lisp_Object sym, val, ret = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object fun, original_fun;
Lisp_Object funcar;
- size_t numargs = nargs - 1;
+ ptrdiff_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
struct backtrace backtrace;
register Lisp_Object *internal_args;
- register size_t i;
+ ptrdiff_t i;
QUIT;
if ((consing_since_gc > gc_cons_threshold
backtrace.function = &args[0];
backtrace.args = &args[1];
backtrace.nargs = nargs - 1;
- backtrace.evalargs = 0;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
- size_t numargs;
+ ptrdiff_t i, numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
- register size_t i;
register Lisp_Object tem;
USE_SAFE_ALLOCA;
- numargs = XINT (Flength (args));
+ numargs = XFASTINT (Flength (args));
SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
- backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (Lisp_Object fun, size_t nargs,
+funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
int count = SPECPDL_INDEX ();
- size_t i;
+ ptrdiff_t i;
int optional, rest;
if (CONSP (fun))
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
- Byte-code objects with either a non-existant, or a nil value for
+ Byte-code objects with either a non-existent, or a nil value for
the `push args' slot (the default), have dynamically-bound
arguments, and use the argument-binding code below instead (as do
all interpreted functions, even lexically bound ones). */
}
else
{
- size_t i;
+ ptrdiff_t i;
for (i = 0; i < backlist->nargs; i++)
{
if (i) write_string (" ", -1);
}
\f
+#if BYTE_MARK_STACK
void
mark_backtrace (void)
{
register struct backtrace *backlist;
- register size_t i;
+ ptrdiff_t i;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
mark_object (backlist->args[i]);
}
}
-
-EXFUN (Funintern, 2);
+#endif
void
syms_of_eval (void)
before making `inhibit-quit' nil. */);
Vinhibit_quit = Qnil;
- Qinhibit_quit = intern_c_string ("inhibit-quit");
- staticpro (&Qinhibit_quit);
-
- Qautoload = intern_c_string ("autoload");
- staticpro (&Qautoload);
-
- Qdebug_on_error = intern_c_string ("debug-on-error");
- staticpro (&Qdebug_on_error);
-
- Qmacro = intern_c_string ("macro");
- staticpro (&Qmacro);
-
- Qdeclare = intern_c_string ("declare");
- staticpro (&Qdeclare);
+ DEFSYM (Qinhibit_quit, "inhibit-quit");
+ DEFSYM (Qautoload, "autoload");
+ DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qmacro, "macro");
+ DEFSYM (Qdeclare, "declare");
/* 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_c_string ("exit");
- staticpro (&Qexit);
-
- Qinteractive = intern_c_string ("interactive");
- staticpro (&Qinteractive);
-
- Qcommandp = intern_c_string ("commandp");
- staticpro (&Qcommandp);
-
- Qdefun = intern_c_string ("defun");
- staticpro (&Qdefun);
-
- Qand_rest = intern_c_string ("&rest");
- staticpro (&Qand_rest);
-
- Qand_optional = intern_c_string ("&optional");
- staticpro (&Qand_optional);
-
- Qclosure = intern_c_string ("closure");
- staticpro (&Qclosure);
+ DEFSYM (Qexit, "exit");
- Qdebug = intern_c_string ("debug");
- staticpro (&Qdebug);
+ DEFSYM (Qinteractive, "interactive");
+ DEFSYM (Qcommandp, "commandp");
+ DEFSYM (Qdefun, "defun");
+ DEFSYM (Qand_rest, "&rest");
+ DEFSYM (Qand_optional, "&optional");
+ DEFSYM (Qclosure, "closure");
+ DEFSYM (Qdebug, "debug");
DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
doc: /* *Non-nil means enter debugger if an error is signaled.
Every element of this list can be either a cons (VAR . VAL)
specifying a lexical binding, or a single symbol VAR indicating
that this variable should use dynamic scoping. */
- Qinternal_interpreter_environment
- = intern_c_string ("internal-interpreter-environment");
- staticpro (&Qinternal_interpreter_environment);
+ DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment");
DEFVAR_LISP ("internal-interpreter-environment",
Vinternal_interpreter_environment,
doc: /* If non-nil, the current lexical environment of the lisp interpreter.
(Just imagine if someone makes it buffer-local). */
Funintern (Qinternal_interpreter_environment, Qnil);
- Vrun_hooks = intern_c_string ("run-hooks");
- staticpro (&Vrun_hooks);
+ DEFSYM (Vrun_hooks, "run-hooks");
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
HCoop / bpt / emacs.git / blobdiff