Fixes: debbugs:17865
[bpt/emacs.git] / src / eval.c
index d3fcec5..a96d413 100644 (file)
@@ -1,6 +1,7 @@
 /* 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.
 
@@ -272,6 +273,8 @@ restore_stack_limits (Lisp_Object data)
   max_lisp_eval_depth = XINT (XCDR (data));
 }
 
+static void grow_specpdl (void);
+
 /* Call the Lisp debugger, giving it argument ARG.  */
 
 Lisp_Object
@@ -280,22 +283,29 @@ call_debugger (Lisp_Object arg)
   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)
@@ -1532,8 +1542,8 @@ See also the function `condition-case'.  */)
          || 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)))
@@ -3576,6 +3586,73 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
      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)
@@ -3646,7 +3723,9 @@ If Lisp code tries to increase the total number past this amount,
 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.
@@ -3824,6 +3903,7 @@ alist of active lexical bindings.  */);
   defsubr (&Sbacktrace);
   defsubr (&Sbacktrace_frame);
   defsubr (&Sbacktrace_eval);
+  defsubr (&Sbacktrace__locals);
   defsubr (&Sspecial_variable_p);
   defsubr (&Sfunctionp);
 }