merge from trunk

1 files changed, 314 insertions, 106 deletions

diff --git a/src/eval.c b/src/eval.c
index 97e812dd890..e93c3473ae8 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -138,6 +138,13 @@ specpdl_old_value (union specbinding *pdl)
   return pdl->let.old_value;
 }
 
+static void
+set_specpdl_old_value (union specbinding *pdl, Lisp_Object val)
+{
+  eassert (pdl->kind >= SPECPDL_LET);
+  pdl->let.old_value = val;
+}
+
 static Lisp_Object
 specpdl_where (union specbinding *pdl)
 {
@@ -159,13 +166,6 @@ specpdl_arg (union specbinding *pdl)
   return pdl->unwind.arg;
 }
 
-static specbinding_func
-specpdl_func (union specbinding *pdl)
-{
-  eassert (pdl->kind == SPECPDL_UNWIND);
-  return pdl->unwind.func;
-}
-
 Lisp_Object
 backtrace_function (union specbinding *pdl)
 {
@@ -287,12 +287,11 @@ mark_catchlist (struct catchtag *catch)
 
 /* Unwind-protect function used by call_debugger.  */
 
-static Lisp_Object
+static void
 restore_stack_limits (Lisp_Object data)
 {
   max_specpdl_size = XINT (XCAR (data));
   max_lisp_eval_depth = XINT (XCDR (data));
-  return Qnil;
 }
 
 /* Call the Lisp debugger, giving it argument ARG.  */
@@ -358,7 +357,7 @@ do_debug_on_call (Lisp_Object code)
 {
   debug_on_next_call = 0;
   set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
-  call_debugger (Fcons (code, Qnil));
+  call_debugger (list1 (code));
 }
 
 /* NOTE!!! Every function that can call EVAL must protect its args
@@ -421,16 +420,16 @@ If COND yields nil, and there are no ELSE's, the value is nil.
 usage: (if COND THEN ELSE...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object cond;
+  Lisp_Object cond;
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  cond = eval_sub (Fcar (args));
+  cond = eval_sub (XCAR (args));
   UNGCPRO;
 
   if (!NILP (cond))
-    return eval_sub (Fcar (Fcdr (args)));
-  return Fprogn (Fcdr (Fcdr (args)));
+    return eval_sub (Fcar (XCDR (args)));
+  return Fprogn (XCDR (XCDR (args)));
 }
 
 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -445,18 +444,17 @@ CONDITION's value if non-nil is returned from the cond-form.
 usage: (cond CLAUSES...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object clause, val;
+  Lisp_Object val = args;
   struct gcpro gcpro1;
 
-  val = Qnil;
   GCPRO1 (args);
-  while (!NILP (args))
+  while (CONSP (args))
     {
-      clause = Fcar (args);
+      Lisp_Object clause = XCAR (args);
       val = eval_sub (Fcar (clause));
       if (!NILP (val))
 	{
-	  if (!EQ (XCDR (clause), Qnil))
+	  if (!NILP (XCDR (clause)))
 	    val = Fprogn (XCDR (clause));
 	  break;
 	}
@@ -470,23 +468,32 @@ usage: (cond CLAUSES...)  */)
 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
        doc: /* Eval BODY forms sequentially and return value of last one.
 usage: (progn BODY...)  */)
-  (Lisp_Object args)
+  (Lisp_Object body)
 {
-  register Lisp_Object val = Qnil;
+  Lisp_Object val = Qnil;
   struct gcpro gcpro1;
 
-  GCPRO1 (args);
+  GCPRO1 (body);
 
-  while (CONSP (args))
+  while (CONSP (body))
     {
-      val = eval_sub (XCAR (args));
-      args = XCDR (args);
+      val = eval_sub (XCAR (body));
+      body = XCDR (body);
     }
 
   UNGCPRO;
   return val;
 }
 
+/* Evaluate BODY sequentially, discarding its value.  Suitable for
+   record_unwind_protect.  */
+
+void
+unwind_body (Lisp_Object body)
+{
+  Fprogn (body);
+}
+
 DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
        doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
 The value of FIRST is saved during the evaluation of the remaining args,
@@ -495,11 +502,11 @@ usage: (prog1 FIRST BODY...)  */)
   (Lisp_Object args)
 {
   Lisp_Object val;
-  register Lisp_Object args_left;
+  Lisp_Object args_left;
   struct gcpro gcpro1, gcpro2;
 
   args_left = args;
-  val = Qnil;
+  val = args;
   GCPRO2 (args, val);
 
   val = eval_sub (XCAR (args_left));
@@ -536,36 +543,37 @@ The return value of the `setq' form is the value of the last VAL.
 usage: (setq [SYM VAL]...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object args_left;
-  register Lisp_Object val, sym, lex_binding;
-  struct gcpro gcpro1;
-
-  if (NILP (args))
-    return Qnil;
+  Lisp_Object val, sym, lex_binding;
 
-  args_left = args;
-  GCPRO1 (args);
-
-  do
+  val = args;
+  if (CONSP (args))
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
-      sym = Fcar (args_left);
+      Lisp_Object args_left = args;
+      struct gcpro gcpro1;
+      GCPRO1 (args);
 
-      /* Like for eval_sub, we do not check declared_special here since
-	 it's been done when let-binding.  */
-      if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
-	  && SYMBOLP (sym)
-	  && !NILP (lex_binding
-		    = Fassq (sym, Vinternal_interpreter_environment)))
-	XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
-      else
-	Fset (sym, val);	/* SYM is dynamically bound.  */
+      do
+	{
+	  val = eval_sub (Fcar (XCDR (args_left)));
+	  sym = XCAR (args_left);
+
+	  /* Like for eval_sub, we do not check declared_special here since
+	     it's been done when let-binding.  */
+	  if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
+	      && SYMBOLP (sym)
+	      && !NILP (lex_binding
+			= Fassq (sym, Vinternal_interpreter_environment)))
+	    XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
+	  else
+	    Fset (sym, val);	/* SYM is dynamically bound.  */
+
+	  args_left = Fcdr (XCDR (args_left));
+	}
+      while (CONSP (args_left));
 
-      args_left = Fcdr (Fcdr (args_left));
+      UNGCPRO;
     }
-  while (!NILP (args_left));
 
-  UNGCPRO;
   return val;
 }
 
@@ -582,9 +590,9 @@ of unexpected results when a quoted object is modified.
 usage: (quote ARG)  */)
   (Lisp_Object args)
 {
-  if (!NILP (Fcdr (args)))
+  if (CONSP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
-  return Fcar (args);
+  return XCAR (args);
 }
 
 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
@@ -596,7 +604,7 @@ usage: (function ARG)  */)
 {
   Lisp_Object quoted = XCAR (args);
 
-  if (!NILP (Fcdr (args)))
+  if (CONSP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
 
   if (!NILP (Vinternal_interpreter_environment)
@@ -698,21 +706,23 @@ To define a user option, use `defcustom' instead of `defvar'.
 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object sym, tem, tail;
+  Lisp_Object sym, tem, tail;
 
-  sym = Fcar (args);
-  tail = Fcdr (args);
-  if (!NILP (Fcdr (Fcdr (tail))))
-    error ("Too many arguments");
+  sym = XCAR (args);
+  tail = XCDR (args);
 
-  tem = Fdefault_boundp (sym);
-  if (!NILP (tail))
+  if (CONSP (tail))
     {
+      if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
+	error ("Too many arguments");
+
+      tem = Fdefault_boundp (sym);
+
       /* Do it before evaluating the initial value, for self-references.  */
       XSYMBOL (sym)->declared_special = 1;
 
       if (NILP (tem))
-	Fset_default (sym, eval_sub (Fcar (tail)));
+	Fset_default (sym, eval_sub (XCAR (tail)));
       else
 	{ /* Check if there is really a global binding rather than just a let
 	     binding that shadows the global unboundness of the var.  */
@@ -730,7 +740,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
 		}
 	    }
 	}
-      tail = Fcdr (tail);
+      tail = XCDR (tail);
       tem = Fcar (tail);
       if (!NILP (tem))
 	{
@@ -775,18 +785,18 @@ The optional DOCSTRING specifies the variable's documentation string.
 usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   (Lisp_Object args)
 {
-  register Lisp_Object sym, tem;
+  Lisp_Object sym, tem;
 
-  sym = Fcar (args);
-  if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+  sym = XCAR (args);
+  if (CONSP (Fcdr (XCDR (XCDR (args)))))
     error ("Too many arguments");
 
-  tem = eval_sub (Fcar (Fcdr (args)));
+  tem = eval_sub (Fcar (XCDR (args)));
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
   XSYMBOL (sym)->declared_special = 1;
-  tem = Fcar (Fcdr (Fcdr (args)));
+  tem = Fcar (XCDR (XCDR (args)));
   if (!NILP (tem))
     {
       if (!NILP (Vpurify_flag))
@@ -827,7 +837,7 @@ usage: (let* VARLIST BODY...)  */)
 
   lexenv = Vinternal_interpreter_environment;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
   while (CONSP (varlist))
     {
       QUIT;
@@ -868,7 +878,7 @@ usage: (let* VARLIST BODY...)  */)
       varlist = XCDR (varlist);
     }
   UNGCPRO;
-  val = Fprogn (Fcdr (args));
+  val = Fprogn (XCDR (args));
   return unbind_to (count, val);
 }
 
@@ -888,7 +898,7 @@ usage: (let VARLIST BODY...)  */)
   struct gcpro gcpro1, gcpro2;
   USE_SAFE_ALLOCA;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
 
   /* Make space to hold the values to give the bound variables.  */
   elt = Flength (varlist);
@@ -915,7 +925,7 @@ usage: (let VARLIST BODY...)  */)
 
   lexenv = Vinternal_interpreter_environment;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
   for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
     {
       Lisp_Object var;
@@ -938,7 +948,7 @@ usage: (let VARLIST BODY...)  */)
     /* Instantiate a new lexical environment.  */
     specbind (Qinternal_interpreter_environment, lexenv);
 
-  elt = Fprogn (Fcdr (args));
+  elt = Fprogn (XCDR (args));
   SAFE_FREE ();
   return unbind_to (count, elt);
 }
@@ -955,8 +965,8 @@ usage: (while TEST BODY...)  */)
 
   GCPRO2 (test, body);
 
-  test = Fcar (args);
-  body = Fcdr (args);
+  test = XCAR (args);
+  body = XCDR (args);
   while (!NILP (eval_sub (test)))
     {
       QUIT;
@@ -1053,9 +1063,9 @@ usage: (catch TAG BODY...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  tag = eval_sub (Fcar (args));
+  tag = eval_sub (XCAR (args));
   UNGCPRO;
-  return internal_catch (tag, Fprogn, Fcdr (args));
+  return internal_catch (tag, Fprogn, XCDR (args));
 }
 
 /* Set up a catch, then call C function FUNC on argument ARG.
@@ -1169,8 +1179,8 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   Lisp_Object val;
   ptrdiff_t count = SPECPDL_INDEX ();
 
-  record_unwind_protect (Fprogn, Fcdr (args));
-  val = eval_sub (Fcar (args));
+  record_unwind_protect (unwind_body, XCDR (args));
+  val = eval_sub (XCAR (args));
   return unbind_to (count, val);
 }
 
@@ -1202,9 +1212,9 @@ See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
 {
-  Lisp_Object var = Fcar (args);
-  Lisp_Object bodyform = Fcar (Fcdr (args));
-  Lisp_Object handlers = Fcdr (Fcdr (args));
+  Lisp_Object var = XCAR (args);
+  Lisp_Object bodyform = XCAR (XCDR (args));
+  Lisp_Object handlers = XCDR (XCDR (args));
 
   return internal_lisp_condition_case (var, bodyform, handlers);
 }
@@ -1631,7 +1641,7 @@ signal_error (const char *s, Lisp_Object arg)
     }
 
   if (!NILP (hare))
-    arg = Fcons (arg, Qnil);	/* Make it a list.  */
+    arg = list1 (arg);
 
   xsignal (Qerror, Fcons (build_string (s), arg));
 }
@@ -1723,7 +1733,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
       /* RMS: What's this for?  */
       && when_entered_debugger < num_nonmacro_input_events)
     {
-      call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
+      call_debugger (list2 (Qerror, combined_data));
       return 1;
     }
 
@@ -1910,10 +1920,10 @@ this does nothing and returns nil.  */)
 		    Qnil);
 }
 
-Lisp_Object
+void
 un_autoload (Lisp_Object oldqueue)
 {
-  register Lisp_Object queue, first, second;
+  Lisp_Object queue, first, second;
 
   /* Queue to unwind is current value of Vautoload_queue.
      oldqueue is the shadowed value to leave in Vautoload_queue.  */
@@ -1930,7 +1940,6 @@ un_autoload (Lisp_Object oldqueue)
 	Ffset (first, second);
       queue = XCDR (queue);
     }
-  return Qnil;
 }
 
 /* Load an autoloaded function.
@@ -2012,7 +2021,7 @@ If LEXICAL is t, evaluate using lexical scoping.  */)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
   specbind (Qinternal_interpreter_environment,
-	    CONSP (lexical) || NILP (lexical) ? lexical : Fcons (Qt, Qnil));
+	    CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
   return unbind_to (count, eval_sub (form));
 }
 
@@ -2277,7 +2286,7 @@ eval_sub (Lisp_Object form)
 
   lisp_eval_depth--;
   if (backtrace_debug_on_exit (specpdl_ptr - 1))
-    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
+    val = call_debugger (list2 (Qexit, val));
   specpdl_ptr--;
 
   return val;
@@ -2898,7 +2907,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   check_cons_list ();
   lisp_eval_depth--;
   if (backtrace_debug_on_exit (specpdl_ptr - 1))
-    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
+    val = call_debugger (list2 (Qexit, val));
   specpdl_ptr--;
   return val;
 }
@@ -2940,7 +2949,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
     {
       /* Don't do it again when we return to eval.  */
       set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
-      tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
+      tem = call_debugger (list2 (Qexit, tem));
     }
   SAFE_FREE ();
   return tem;
@@ -3255,8 +3264,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
     }
 }
 
+/* Push unwind-protect entries of various types.  */
+
 void
-record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
+record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
 {
   specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
   specpdl_ptr->unwind.func = function;
@@ -3265,6 +3276,32 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
 }
 
 void
+record_unwind_protect_ptr (void (*function) (void *), void *arg)
+{
+  specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+  specpdl_ptr->unwind_ptr.func = function;
+  specpdl_ptr->unwind_ptr.arg = arg;
+  grow_specpdl ();
+}
+
+void
+record_unwind_protect_int (void (*function) (int), int arg)
+{
+  specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
+  specpdl_ptr->unwind_int.func = function;
+  specpdl_ptr->unwind_int.arg = arg;
+  grow_specpdl ();
+}
+
+void
+record_unwind_protect_void (void (*function) (void))
+{
+  specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
+  specpdl_ptr->unwind_void.func = function;
+  grow_specpdl ();
+}
+
+void
 rebind_for_thread_switch (void)
 {
   union specbinding *bind;
@@ -3288,7 +3325,18 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
   switch (this_binding->kind)
     {
     case SPECPDL_UNWIND:
-      specpdl_func (this_binding) (specpdl_arg (this_binding));
+      specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
+      break;
+    case SPECPDL_UNWIND_PTR:
+      specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
+      break;
+    case SPECPDL_UNWIND_INT:
+      specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
+      break;
+    case SPECPDL_UNWIND_VOID:
+      specpdl_ptr->unwind_void.func ();
+      break;
+    case SPECPDL_BACKTRACE:
       break;
     case SPECPDL_LET:
       /* If variable has a trivial value (no forwarding), we can
@@ -3304,8 +3352,6 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
 	Fset_default (specpdl_symbol (this_binding),
 		      specpdl_old_value (this_binding));
       break;
-    case SPECPDL_BACKTRACE:
-      break;
     case SPECPDL_LET_LOCAL:
     case SPECPDL_LET_DEFAULT:
       { /* If the symbol is a list, it is really (SYMBOL WHERE
@@ -3331,6 +3377,46 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
     }
 }
 
+void
+do_nothing (void)
+{}
+
+/* Push an unwind-protect entry that does nothing, so that
+   set_unwind_protect_ptr can overwrite it later.  */
+
+void
+record_unwind_protect_nothing (void)
+{
+  record_unwind_protect_void (do_nothing);
+}
+
+/* Clear the unwind-protect entry COUNT, so that it does nothing.
+   It need not be at the top of the stack.  */
+
+void
+clear_unwind_protect (ptrdiff_t count)
+{
+  union specbinding *p = specpdl + count;
+  p->unwind_void.kind = SPECPDL_UNWIND_VOID;
+  p->unwind_void.func = do_nothing;
+}
+
+/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
+   It need not be at the top of the stack.  Discard the entry's
+   previous value without invoking it.  */
+
+void
+set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
+{
+  union specbinding *p = specpdl + count;
+  p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+  p->unwind_ptr.func = func;
+  p->unwind_ptr.arg = arg;
+}
+
+/* Pop and execute entries from the unwind-protect stack until the
+   depth COUNT is reached.  Return VALUE.  */
+
 Lisp_Object
 unbind_to (ptrdiff_t count, Lisp_Object value)
 {
@@ -3449,7 +3535,30 @@ Output stream used is value of `standard-output'.  */)
   return Qnil;
 }
 
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
+static union specbinding *
+get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
+{
+  union specbinding *pdl = backtrace_top ();
+  register EMACS_INT i;
+
+  CHECK_NATNUM (nframes);
+
+  if (!NILP (base))
+    { /* Skip up to `base'.  */
+      base = Findirect_function (base, Qt);
+      while (backtrace_p (pdl)
+	     && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+	pdl = backtrace_next (pdl);
+    }
+
+  /* Find the frame requested.  */
+  for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
+    pdl = backtrace_next (pdl);
+
+  return pdl;
+}
+
+DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
        doc: /* Return the function and arguments NFRAMES up from current execution point.
 If that frame has not evaluated the arguments yet (or is a special form),
 the value is (nil FUNCTION ARG-FORMS...).
@@ -3458,17 +3567,12 @@ the value is (t FUNCTION ARG-VALUES...).
 A &rest arg is represented as the tail of the list ARG-VALUES.
 FUNCTION is whatever was supplied as car of evaluated list,
 or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil.  */)
-  (Lisp_Object nframes)
+If NFRAMES is more than the number of frames, the value is nil.
+If BASE is non-nil, it should be a function and NFRAMES counts from its
+nearest activation frame.  */)
+  (Lisp_Object nframes, Lisp_Object base)
 {
-  union specbinding *pdl = backtrace_top ();
-  register EMACS_INT i;
-
-  CHECK_NATNUM (nframes);
-
-  /* Find the frame requested.  */
-  for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++)
-    pdl = backtrace_next (pdl);
+  union specbinding *pdl = get_backtrace_frame (nframes, base);
 
   if (!backtrace_p (pdl))
     return Qnil;
@@ -3483,6 +3587,109 @@ If NFRAMES is more than the number of frames, the value is nil.  */)
     }
 }
 
+/* For backtrace-eval, we want to temporarily unwind the last few elements of
+   the specpdl stack, and then rewind them.  We store the pre-unwind values
+   directly in the pre-existing specpdl elements (i.e. we swap the current
+   value and the old value stored in the specpdl), kind of like the inplace
+   pointer-reversal trick.  As it turns out, the rewind does the same as the
+   unwind, except it starts from the other end of the spepdl stack, so we use
+   the same function for both unwind and rewind.  */
+static void
+backtrace_eval_unrewind (int distance)
+{
+  union specbinding *tmp = specpdl_ptr;
+  int step = -1;
+  if (distance < 0)
+    { /* It's a rewind rather than unwind.  */
+      tmp += distance - 1;
+      step = 1;
+      distance = -distance;
+    }
+
+  for (; distance > 0; distance--)
+    {
+      tmp += step;
+      /*  */
+      switch (tmp->kind)
+	{
+	  /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
+	     unwind_protect, but the problem is that we don't know how to
+	     rewind them afterwards.  */
+	case SPECPDL_UNWIND:
+	case SPECPDL_UNWIND_PTR:
+	case SPECPDL_UNWIND_INT:
+	case SPECPDL_UNWIND_VOID:
+	case SPECPDL_BACKTRACE:
+	  break;
+	case SPECPDL_LET:
+	  /* If variable has a trivial value (no forwarding), we can
+	     just set it.  No need to check for constant symbols here,
+	     since that was already done by specbind.  */
+	  if (XSYMBOL (specpdl_symbol (tmp))->redirect
+	      == SYMBOL_PLAINVAL)
+	    {
+	      struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp));
+	      Lisp_Object old_value = specpdl_old_value (tmp);
+	      set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
+	      SET_SYMBOL_VAL (sym, old_value);
+	      break;
+	    }
+	  else
+	    {
+	      /* FALLTHROUGH!
+		 NOTE: we only ever come here if make_local_foo was used for
+		 the first time on this var within this let.  */
+	    }
+	case SPECPDL_LET_DEFAULT:
+	  {
+	    Lisp_Object sym = specpdl_symbol (tmp);
+	    Lisp_Object old_value = specpdl_old_value (tmp);
+	    set_specpdl_old_value (tmp, Fdefault_value (sym));
+	    Fset_default (sym, old_value);
+	  }
+	  break;
+	case SPECPDL_LET_LOCAL:
+	  {
+	    Lisp_Object symbol = specpdl_symbol (tmp);
+	    Lisp_Object where = specpdl_where (tmp);
+	    Lisp_Object old_value = specpdl_old_value (tmp);
+	    eassert (BUFFERP (where));
+
+	    /* If this was a local binding, reset the value in the appropriate
+	       buffer, but only if that buffer's binding still exists.  */
+	    if (!NILP (Flocal_variable_p (symbol, where)))
+	      {
+		set_specpdl_old_value
+		  (tmp, Fbuffer_local_value (symbol, where));
+		set_internal (symbol, old_value, where, 1);
+	      }
+	  }
+	  break;
+	}
+    }
+}
+
+DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
+       doc: /* Evaluate EXP in the context of some activation frame.
+NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.  */)
+     (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
+{
+  union specbinding *pdl = get_backtrace_frame (nframes, base);
+  ptrdiff_t count = SPECPDL_INDEX ();
+  ptrdiff_t distance = specpdl_ptr - pdl;
+  eassert (distance >= 0);
+
+  if (!backtrace_p (pdl))
+    error ("Activation frame not found!");
+
+  backtrace_eval_unrewind (distance);
+  record_unwind_protect_int (backtrace_eval_unrewind, -distance);
+
+  /* Use eval_sub rather than Feval since the main motivation behind
+     backtrace-eval is to be able to get/set the value of lexical variables
+     from the debugger.  */
+  return unbind_to (count, eval_sub (exp));
+}
 
 void
 mark_specpdl (union specbinding *first, union specbinding *ptr)
@@ -3729,6 +3936,7 @@ alist of active lexical bindings.  */);
   defsubr (&Sbacktrace_debug);
   defsubr (&Sbacktrace);
   defsubr (&Sbacktrace_frame);
+  defsubr (&Sbacktrace_eval);
   defsubr (&Sspecial_variable_p);
   defsubr (&Sfunctionp);
 }