/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software
- Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1995, 1999-2014 Free Software Foundation,
+Inc.
This file is part of GNU Emacs.
Vrun_hooks = Qnil;
}
+static struct handler handlerlist_sentinel;
+
void
init_eval (void)
{
specpdl_ptr = specpdl;
- handlerlist = NULL;
+ { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
+ This is important since handlerlist->nextfree holds the freelist
+ which would otherwise leak every time we unwind back to top-level. */
+ struct handler *c;
+ handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel;
+ PUSH_HANDLER (c, Qunbound, CATCHER);
+ eassert (c == &handlerlist_sentinel);
+ handlerlist_sentinel.nextfree = NULL;
+ handlerlist_sentinel.next = NULL;
+ }
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
max_lisp_eval_depth = XINT (XCDR (data));
}
+static void grow_specpdl (void);
+
/* Call the Lisp debugger, giving it argument ARG. */
Lisp_Object
bool debug_while_redisplaying;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
- EMACS_INT old_max = max_specpdl_size;
-
- /* Temporarily bump up the stack limits,
- so the debugger won't run out of stack. */
-
- max_specpdl_size += 1;
- record_unwind_protect (restore_stack_limits,
- Fcons (make_number (old_max),
- make_number (max_lisp_eval_depth)));
- max_specpdl_size = old_max;
+ EMACS_INT old_depth = max_lisp_eval_depth;
+ /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
+ EMACS_INT old_max = max (max_specpdl_size, count);
if (lisp_eval_depth + 40 > max_lisp_eval_depth)
max_lisp_eval_depth = lisp_eval_depth + 40;
- if (max_specpdl_size - 100 < SPECPDL_INDEX ())
- max_specpdl_size = SPECPDL_INDEX () + 100;
+ /* While debugging Bug#16603, previous value of 100 was found
+ too small to avoid specpdl overflow in the debugger itself. */
+ if (max_specpdl_size - 200 < count)
+ max_specpdl_size = count + 200;
+
+ if (old_max == count)
+ {
+ /* We can enter the debugger due to specpdl overflow (Bug#16603). */
+ specpdl_ptr--;
+ grow_specpdl ();
+ }
+
+ /* Restore limits after leaving the debugger. */
+ record_unwind_protect (restore_stack_limits,
+ Fcons (make_number (old_max),
+ make_number (old_depth)));
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
and, if the value is non-nil, this clause succeeds:
then the expressions in BODY are evaluated and the last one's
value is the value of the cond-form.
+If a clause has one element, as in (CONDITION), then the cond-form
+returns CONDITION's value, if that is non-nil.
If no clause succeeds, cond returns nil.
-If a clause has one element, as in (CONDITION),
-CONDITION's value if non-nil is returned from the cond-form.
usage: (cond CLAUSES...) */)
(Lisp_Object args)
{
{
bool last_time;
+ eassert (catch->next);
+
/* Save the value in the tag. */
catch->val = value;
|| 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))))
+ || (CONSP (clause) && CONSP (clause)
+ && !NILP (Fmemq (Qdebug, clause)))
/* Special handler that means "print a message and run debugger
if requested". */
|| EQ (h->tag_or_ch, Qerror)))
}
else
{
- if (handlerlist != 0)
+ if (handlerlist != &handlerlist_sentinel)
+ /* FIXME: This will come right back here if there's no `top-level'
+ catcher. A better solution would be to abort here, and instead
+ add a catch-all condition handler so we never come here. */
Fthrow (Qtop_level, Qt);
}
if (EQ (val, Qunbound) || NILP (val))
return ret;
- else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
+ else if (!CONSP (val) || FUNCTIONP (val))
{
args[0] = val;
return funcall (nargs, args);
from the debugger. */
return unbind_to (count, eval_sub (exp));
}
+
+DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL,
+ doc: /* Return names and values of local variables of a stack frame.
+NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
+ (Lisp_Object nframes, Lisp_Object base)
+{
+ union specbinding *frame = get_backtrace_frame (nframes, base);
+ union specbinding *prevframe
+ = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base);
+ ptrdiff_t distance = specpdl_ptr - frame;
+ Lisp_Object result = Qnil;
+ eassert (distance >= 0);
+
+ if (!backtrace_p (prevframe))
+ error ("Activation frame not found!");
+ if (!backtrace_p (frame))
+ error ("Activation frame not found!");
+
+ /* The specpdl entries normally contain the symbol being bound along with its
+ `old_value', so it can be restored. The new value to which it is bound is
+ available in one of two places: either in the current value of the
+ variable (if it hasn't been rebound yet) or in the `old_value' slot of the
+ next specpdl entry for it.
+ `backtrace_eval_unrewind' happens to swap the role of `old_value'
+ and "new value", so we abuse it here, to fetch the new value.
+ It's ugly (we'd rather not modify global data) and a bit inefficient,
+ but it does the job for now. */
+ backtrace_eval_unrewind (distance);
+
+ /* Grab values. */
+ {
+ union specbinding *tmp = prevframe;
+ for (; tmp > frame; tmp--)
+ {
+ switch (tmp->kind)
+ {
+ case SPECPDL_LET:
+ case SPECPDL_LET_DEFAULT:
+ case SPECPDL_LET_LOCAL:
+ {
+ Lisp_Object sym = specpdl_symbol (tmp);
+ Lisp_Object val = specpdl_old_value (tmp);
+ if (EQ (sym, Qinternal_interpreter_environment))
+ {
+ Lisp_Object env = val;
+ for (; CONSP (env); env = XCDR (env))
+ {
+ Lisp_Object binding = XCAR (env);
+ if (CONSP (binding))
+ result = Fcons (Fcons (XCAR (binding),
+ XCDR (binding)),
+ result);
+ }
+ }
+ else
+ result = Fcons (Fcons (sym, val), result);
+ }
+ }
+ }
+ }
+
+ /* Restore values from specpdl to original place. */
+ backtrace_eval_unrewind (-distance);
+
+ return result;
+}
+
\f
void
mark_specpdl (void)
an error is signaled.
You can safely use a value considerably larger than the default value,
if that proves inconveniently small. However, if you increase it too far,
-Emacs could run out of memory trying to make the stack bigger. */);
+Emacs could run out of memory trying to make the stack bigger.
+Note that this limit may be silently increased by the debugger
+if `debug-on-error' or `debug-on-quit' is set. */);
DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
doc: /* Limit on depth in `eval', `apply' and `funcall' before error.
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
defsubr (&Sbacktrace_eval);
+ defsubr (&Sbacktrace__locals);
defsubr (&Sspecial_variable_p);
defsubr (&Sfunctionp);
}