SPECPDL_FRAME

* src/eval.c (unbind_once): New function.
  (unbind_to): Use unbind_once.

* src/lisp.h (SPECPDL_FRAME): New specbind_tag type.

  (dynwind_begin, dynwind_end): Add prototypes.

diff --git a/src/eval.c b/src/eval.c
index 0aad675..c44fa64 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -3259,6 +3259,68 @@ set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
   p->unwind_ptr.arg = arg;
 }
 
+void
+unbind_once (void)
+{
+  /* Decrement specpdl_ptr before we do the work to unbind it, so
+     that an error in unbinding won't try to unbind the same entry
+     again.  Take care to copy any parts of the binding needed
+     before invoking any code that can make more bindings.  */
+
+  specpdl_ptr--;
+
+  switch (specpdl_ptr->kind)
+    {
+    case SPECPDL_UNWIND:
+      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
+           just set it.  No need to check for constant symbols here,
+           since that was already done by specbind.  */
+        struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
+        if (sym->redirect == SYMBOL_PLAINVAL)
+          {
+            SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
+            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:
+      Fset_default (specpdl_symbol (specpdl_ptr),
+                    specpdl_old_value (specpdl_ptr));
+      break;
+    case SPECPDL_LET_LOCAL:
+      {
+        Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
+        Lisp_Object where = specpdl_where (specpdl_ptr);
+        Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
+        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_internal (symbol, old_value, where, 1);
+      }
+      break;
+    }
+}
+
 /* Pop and execute entries from the unwind-protect stack until the
    depth COUNT is reached.  Return VALUE.  */
 
@@ -3272,65 +3334,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
   Vquit_flag = Qnil;
 
   while (specpdl_ptr != specpdl + count)
-    {
-      /* Decrement specpdl_ptr before we do the work to unbind it, so
-        that an error in unbinding won't try to unbind the same entry
-        again.  Take care to copy any parts of the binding needed
-        before invoking any code that can make more bindings.  */
-
-      specpdl_ptr--;
-
-      switch (specpdl_ptr->kind)
-       {
-       case SPECPDL_UNWIND:
-         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
-              just set it.  No need to check for constant symbols here,
-              since that was already done by specbind.  */
-           struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
-           if (sym->redirect == SYMBOL_PLAINVAL)
-             {
-               SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
-               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:
-         Fset_default (specpdl_symbol (specpdl_ptr),
-                       specpdl_old_value (specpdl_ptr));
-         break;
-       case SPECPDL_LET_LOCAL:
-         {
-           Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
-           Lisp_Object where = specpdl_where (specpdl_ptr);
-           Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
-           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_internal (symbol, old_value, where, 1);
-         }
-         break;
-       }
-    }
+    unbind_once ();
 
   if (NILP (Vquit_flag) && !NILP (quitf))
     Vquit_flag = quitf;

diff --git a/src/lisp.h b/src/lisp.h
index a075e1c..5aad565 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2543,6 +2543,7 @@ typedef jmp_buf sys_jmp_buf;
    union specbinding.  But only eval.c should access it.  */
 
 enum specbind_tag {
+  SPECPDL_FRAME = 1,
   SPECPDL_UNWIND,              /* An unwind_protect function on Lisp_Object.  */
   SPECPDL_UNWIND_PTR,          /* Likewise, on void *.  */
   SPECPDL_UNWIND_INT,          /* Likewise, on int.  */
@@ -2557,6 +2558,9 @@ enum specbind_tag {
 union specbinding
   {
     ENUM_BF (specbind_tag) kind : CHAR_BIT;
+    struct {
+      ENUM_BF (specbind_tag) kind : CHAR_BIT;
+    } frame;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
       void (*func) (Lisp_Object);
@@ -3446,6 +3450,8 @@ extern void record_unwind_protect_nothing (void);
 extern void clear_unwind_protect (ptrdiff_t);
 extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
 extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
+extern void dynwind_begin (void);
+extern void dynwind_end (void);
 extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
 extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
 extern _Noreturn void verror (const char *, va_list)