X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/96d44c649994bf28e5ddcb8d51515fbebb320960..b221615bc47647612a1a0999b5c9b7cfc699fce6:/src/eval.c

diff --git a/src/eval.c b/src/eval.c
index 80cc2f79dd..5061cbc766 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -117,7 +117,7 @@ struct specbinding *specpdl;
 
 /* Pointer to first unused element in specpdl.  */
 
-struct specbinding *specpdl_ptr;
+volatile struct specbinding *specpdl_ptr;
 
 /* Maximum size allowed for specpdl allocation */
 
@@ -1187,7 +1187,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   Lisp_Object val;
   int count = SPECPDL_INDEX ();
 
-  record_unwind_protect (0, Fcdr (args));
+  record_unwind_protect (Fprogn, Fcdr (args));
   val = Feval (Fcar (args));
   return unbind_to (count, val);
 }
@@ -1454,6 +1454,7 @@ See also the function `condition-case'.  */)
   struct backtrace *bp;
 
   immediate_quit = handling_signal = 0;
+  abort_on_gc = 0;
   if (gc_in_progress || waiting_for_input)
     abort ();
 
@@ -3069,14 +3070,17 @@ unbind_to (count, value)
 
   while (specpdl_ptr != specpdl + count)
     {
-      --specpdl_ptr;
-
-      if (specpdl_ptr->func != 0)
-	(*specpdl_ptr->func) (specpdl_ptr->old_value);
-      /* Note that a "binding" of nil is really an unwind protect,
-	 so in that case the "old value" is a list of forms to evaluate.  */
-      else if (NILP (specpdl_ptr->symbol))
-	Fprogn (specpdl_ptr->old_value);
+      /* Copy the binding, and decrement specpdl_ptr, before we do
+	 the work to unbind it.  We decrement first
+	 so that an error in unbinding won't try to unbind
+	 the same entry again, and we copy the binding first
+	 in case more bindings are made during some of the code we run.  */
+
+      struct specbinding this_binding;
+      this_binding = *--specpdl_ptr;
+
+      if (this_binding.func != 0)
+	(*this_binding.func) (this_binding.old_value);
       /* If the symbol is a list, it is really (SYMBOL WHERE
 	 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
 	 frame.  If WHERE is a buffer or frame, this indicates we
@@ -3084,29 +3088,29 @@ unbind_to (count, value)
 	 binding.  WHERE nil means that the variable had the default
 	 value when it was bound.  CURRENT-BUFFER is the buffer that
          was current when the variable was bound.  */
-      else if (CONSP (specpdl_ptr->symbol))
+      else if (CONSP (this_binding.symbol))
 	{
 	  Lisp_Object symbol, where;
 
-	  symbol = XCAR (specpdl_ptr->symbol);
-	  where = XCAR (XCDR (specpdl_ptr->symbol));
+	  symbol = XCAR (this_binding.symbol);
+	  where = XCAR (XCDR (this_binding.symbol));
 
 	  if (NILP (where))
-	    Fset_default (symbol, specpdl_ptr->old_value);
+	    Fset_default (symbol, this_binding.old_value);
 	  else if (BUFFERP (where))
-	    set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);
+	    set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
 	  else
-	    set_internal (symbol, specpdl_ptr->old_value, NULL, 1);
+	    set_internal (symbol, this_binding.old_value, NULL, 1);
 	}
       else
 	{
 	  /* 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 (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol)))
-	    SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value);
+	  if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
+	    SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
 	  else
-	    set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
+	    set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
 	}
     }