(shrink_regexp_cache): Use xrealloc.

[gnu-emacs] / src / eval.c

diff --git a/src/eval.c b/src/eval.c
index 53272b9bd6813f38a6c7867407415140fc0e9675..5061cbc7667550cea1c9dda5bc9ed77d980cc140 100644 (file)
--- 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 ();
 
@@ -2161,7 +2162,7 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
   register Lisp_Object spread_arg;
   register Lisp_Object *funcall_args;
   Lisp_Object fun;
-  int nvars;
+  struct gcpro gcpro1;
 
   fun = args [0];
   funcall_args = 0;
@@ -2201,7 +2202,8 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
                                                 * sizeof (Lisp_Object));
          for (i = numargs; i < XSUBR (fun)->max_args;)
            funcall_args[++i] = Qnil;
-         nvars = 1 + XSUBR (fun)->max_args;
+         GCPRO1 (*funcall_args);
+         gcpro1.nvars = 1 + XSUBR (fun)->max_args;
        }
     }
  funcall:
@@ -2211,7 +2213,8 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
     {
       funcall_args = (Lisp_Object *) alloca ((1 + numargs)
                                             * sizeof (Lisp_Object));
-      nvars = 1 + numargs;
+      GCPRO1 (*funcall_args);
+      gcpro1.nvars = 1 + numargs;
     }
 
   bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
@@ -2224,7 +2227,8 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
       spread_arg = XCDR (spread_arg);
     }
 
-  return Ffuncall (nvars, funcall_args);
+  /* By convention, the caller needs to gcpro Ffuncall's args.  */
+  RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
 }
 \f
 /* Run hook variables in various ways.  */
@@ -3066,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
@@ -3081,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);
        }
     }