/* Current number of specbindings allocated in specpdl. */
-EMACS_INT specpdl_size;
+ptrdiff_t specpdl_size;
/* Pointer to beginning of specpdl. */
signal the error instead of entering an infinite loop of debugger
invocations. */
-static int when_entered_debugger;
+static EMACS_INT when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
call_debugger (Lisp_Object arg)
{
int debug_while_redisplaying;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
EMACS_INT old_max = max_specpdl_size;
Lisp_Object val;
register Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
- register int argnum = 0;
-
- if (NILP (args))
- return Qnil;
args_left = args;
val = Qnil;
GCPRO2 (args, val);
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ val = eval_sub (XCAR (args_left));
+ while (CONSP (args_left = XCDR (args_left)))
+ eval_sub (XCAR (args_left));
UNGCPRO;
return val;
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
- Lisp_Object val;
- register Lisp_Object args_left;
- struct gcpro gcpro1, gcpro2;
- register int argnum = -1;
-
- val = Qnil;
-
- if (NILP (args))
- return Qnil;
-
- args_left = args;
- val = Qnil;
- GCPRO2 (args, val);
-
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ eval_sub (XCAR (args));
UNGCPRO;
- return val;
+ return Fprog1 (XCDR (args));
}
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
args_left = Fcdr (Fcdr (args_left));
}
- while (!NILP(args_left));
+ while (!NILP (args_left));
UNGCPRO;
return val;
DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
+Warning: `quote' does not construct its return value, but just returns
+the value that was pre-constructed by the Lisp reader (see info node
+`(elisp)Printed Representation').
+This means that '(a . b) is not identical to (cons 'a 'b): the former
+does not cons. Quoting should be reserved for constants that will
+never be modified by side-effects, unless you like self-modifying code.
+See the common pitfall in info node `(elisp)Rearrangement' for an example
+of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL
&& (EQ (new_alias,
CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
error ("Don't know how to make a let-bound variable an alias");
{ /* 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;
- while (--pdl >= specpdl)
+ while (pdl > specpdl)
{
- if (EQ (pdl->symbol, sym) && !pdl->func
+ if (EQ ((--pdl)->symbol, sym) && !pdl->func
&& EQ (pdl->old_value, Qunbound))
{
message_with_string ("Warning: defvar ignored because %s is let-bound",
(Lisp_Object args)
{
Lisp_Object varlist, var, val, elt, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
{
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
(Lisp_Object args)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
val = eval_sub (Fcar (args));
if CONDITION-NAME is one of the error's condition names.
If an error happens, the first applicable handler is run.
-The car of a handler may be a list of condition names
-instead of a single condition name. Then it handles all of them.
+The car of a handler may be a list of condition names instead of a
+single condition name; then it handles all of them. If the special
+condition name `debug' is present in this list, it allows another
+condition in the list to run the debugger if `debug-on-error' and the
+other usual mechanisms says it should (otherwise, `condition-case'
+suppresses the debugger).
When a handler handles an error, control returns to the `condition-case'
and it executes the handler's BODY...
struct catchtag c;
struct handler h;
- /* Since Fsignal will close off all calls to x_catch_errors,
- we will get the wrong results if some are not closed now. */
-#if HAVE_X_WINDOWS
- if (x_catching_errors ())
- abort ();
-#endif
-
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
struct catchtag c;
struct handler h;
- /* Since Fsignal will close off all calls to x_catch_errors,
- we will get the wrong results if some are not closed now. */
-#if HAVE_X_WINDOWS
- if (x_catching_errors ())
- abort ();
-#endif
-
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
struct catchtag c;
struct handler h;
- /* Since Fsignal will close off all calls to x_catch_errors,
- we will get the wrong results if some are not closed now. */
-#if HAVE_X_WINDOWS
- if (x_catching_errors ())
- abort ();
-#endif
-
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
struct catchtag c;
struct handler h;
- /* Since Fsignal will close off all calls to x_catch_errors,
- we will get the wrong results if some are not closed now. */
-#if HAVE_X_WINDOWS
- if (x_catching_errors ())
- abort ();
-#endif
-
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
|| NILP (clause)
+ /* A `debug' symbol in the handler list disables the normal
+ suppression of the debugger. */
+ || (CONSP (clause) && CONSP (XCAR (clause))
+ && !NILP (Fmemq (Qdebug, XCAR (clause))))
/* Special handler that means "print a message and run debugger
if requested". */
|| EQ (h->handler, Qerror)))
char buf[4000];
ptrdiff_t size = sizeof buf;
ptrdiff_t size_max = STRING_BYTES_BOUND + 1;
- char const *m_end = m + strlen (m);
char *buffer = buf;
ptrdiff_t used;
Lisp_Object string;
- while (1)
- {
- va_list ap_copy;
- va_copy (ap_copy, ap);
- used = doprnt (buffer, size, m, m_end, 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
- break; /* and leave the message truncated */
-
- if (buffer != buf)
- xfree (buffer);
- buffer = (char *) xmalloc (size);
- }
-
+ used = evxprintf (&buffer, &size, buf, size_max, m, ap);
string = make_string (buffer, used);
if (buffer != buf)
xfree (buffer);
void
do_autoload (Lisp_Object fundef, Lisp_Object funname)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object fun;
struct gcpro gcpro1, gcpro2, gcpro3;
If LEXICAL is t, evaluate using lexical scoping. */)
(Lisp_Object form, Lisp_Object lexical)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
return unbind_to (count, eval_sub (form));
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
register Lisp_Object tem;
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t i;
int optional, rest;
static void
grow_specpdl (void)
{
- register int count = SPECPDL_INDEX ();
- int max_size =
- min (max_specpdl_size,
- min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding),
- INT_MAX));
- int size;
+ register ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
- size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size;
- specpdl = xnrealloc (specpdl, size, sizeof *specpdl);
- specpdl_size = size;
+ specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
specpdl_ptr = specpdl + count;
}
}
Lisp_Object
-unbind_to (int count, Lisp_Object value)
+unbind_to (ptrdiff_t count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
(Lisp_Object level, Lisp_Object flag)
{
register struct backtrace *backlist = backtrace_list;
- register int i;
+ register EMACS_INT i;
CHECK_NUMBER (level);