#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
+#ifndef SIZE_MAX
+# define SIZE_MAX ((size_t) -1)
+#endif
+
/* This definition is duplicated in alloc.c and keyboard.c. */
/* Putting it in lisp.h makes cc bomb out! */
char 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;
/* 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. */
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)
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", tem);
+ error ("Invalid condition handler: %s",
+ SDATA (Fprin1_to_string (tem, Qt)));
}
c.tag = Qnil;
data = Fcons (error_symbol, data);
string = Ferror_message_string (data);
- fatal ("%s", SDATA (string), 0);
+ fatal ("%s", SDATA (string));
}
/* Internal version of Fsignal that never returns.
void
verror (const char *m, va_list ap)
{
- char buf[200];
- EMACS_INT size = 200;
- int mlen;
+ char buf[4000];
+ size_t size = sizeof buf;
+ size_t size_max = min (MOST_POSITIVE_FIXNUM, SIZE_MAX);
+ size_t mlen = strlen (m);
char *buffer = buf;
- int allocated = 0;
+ size_t used;
Lisp_Object string;
- mlen = strlen (m);
-
while (1)
{
- EMACS_INT used;
used = doprnt (buffer, size, m, m + mlen, ap);
- if (used < size)
+
+ /* 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;
- size *= 2;
- if (allocated)
- buffer = (char *) xrealloc (buffer, size);
+ if (size <= size_max / 2)
+ size *= 2;
+ else if (size < size_max)
+ size = size_max;
else
- {
- buffer = (char *) xmalloc (size);
- allocated = 1;
- }
+ break; /* and leave the message truncated */
+
+ if (buffer != buf)
+ xfree (buffer);
+ buffer = (char *) xmalloc (size);
}
- string = build_string (buffer);
- if (allocated)
+ string = make_string (buffer, used);
+ if (buffer != buf)
xfree (buffer);
xsignal1 (Qerror, string);
}
\f
+#if BYTE_MARK_STACK
void
mark_backtrace (void)
{
mark_object (backlist->args[i]);
}
}
-
-EXFUN (Funintern, 2);
+#endif
void
syms_of_eval (void)