changeset 39572:715a67381594

(purebeg, pure_size, pure_bytes_used_before_overflow): New variables. (init_alloc_once): Initialize new variables. (PURE_POINTER_P): Use new variables. (pure_alloc): If pure storage overflows, allocate from the heap. (check_pure_size): New function. (Fgarbage_collect): Don't GC if pure storage has overflowed. (Vpost_gc_hook, Qpost_gc_hook): New variables. (syms_of_alloc): DEFVAR_LISP post-gc-hook, initialize Qpost_gc_hook. (Fgarbage_collect): Run post-gc-hook. (Fmake_symbol): Adapt to changes of struct Lisp_Symbol.

--- a/src/alloc.c	Fri Oct 05 09:38:43 2001 +0000
+++ b/src/alloc.c	Fri Oct 05 09:42:02 2001 +0000
@@ -191,29 +191,30 @@
 EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
 #define PUREBEG (char *) pure
 
-#else /* not HAVE_SHM */
+#else /* HAVE_SHM */
 
 #define pure PURE_SEG_BITS   /* Use shared memory segment */
 #define PUREBEG (char *)PURE_SEG_BITS
 
-/* This variable is used only by the XPNTR macro when HAVE_SHM is
-   defined.  If we used the PURESIZE macro directly there, that would
-   make most of Emacs dependent on puresize.h, which we don't want -
-   you should be able to change that without too much recompilation.
-   So map_in_data initializes pure_size, and the dependencies work
-   out.  */
-
-EMACS_INT pure_size;
-
-#endif /* not HAVE_SHM */
+#endif /* HAVE_SHM */
+
+/* Pointer to the pure area, and its size.  */
+
+static char *purebeg;
+static size_t pure_size;
+
+/* Number of bytes of pure storage used before pure storage overflowed.
+   If this is non-zero, this implies that an overflow occurred.  */
+
+static size_t pure_bytes_used_before_overflow;
 
 /* Value is non-zero if P points into pure space.  */
 
 #define PURE_POINTER_P(P)					\
      (((PNTR_COMPARISON_TYPE) (P)				\
-       < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE))	\
+       < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size))	\
       && ((PNTR_COMPARISON_TYPE) (P)				\
-	  >= (PNTR_COMPARISON_TYPE) pure))
+	  >= (PNTR_COMPARISON_TYPE) purebeg))
 
 /* Index in pure at which next pure object will be allocated.. */
 
@@ -246,6 +247,10 @@
 
 Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
 
+/* Hook run after GC has finished.  */
+
+Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
+
 static void mark_buffer P_ ((Lisp_Object));
 static void mark_kboards P_ ((void));
 static void gc_sweep P_ ((void));
@@ -2541,11 +2546,13 @@
   
   p = XSYMBOL (val);
   p->name = XSTRING (name);
-  p->obarray = Qnil;
   p->plist = Qnil;
   p->value = Qunbound;
   p->function = Qunbound;
-  p->next = 0;
+  p->next = NULL;
+  p->interned = SYMBOL_UNINTERNED;
+  p->constant = 0;
+  p->indirect_variable = 0;
   consing_since_gc += sizeof (struct Lisp_Symbol);
   symbols_consed++;
   return val;
@@ -3791,7 +3798,7 @@
 {
   size_t nbytes;
   POINTER_TYPE *result;
-  char *beg = PUREBEG;
+  char *beg = purebeg;
 
   /* Give Lisp_Floats an extra alignment.  */
   if (type == Lisp_Float)
@@ -3806,8 +3813,14 @@
     }
     
   nbytes = ALIGN (size, sizeof (EMACS_INT));
-  if (pure_bytes_used + nbytes > PURESIZE)
-    error ("Pure Lisp storage exhausted");
+  
+  if (pure_bytes_used + nbytes > pure_size)
+    {
+      beg = purebeg = (char *) xmalloc (PURESIZE);
+      pure_size = PURESIZE;
+      pure_bytes_used_before_overflow += pure_bytes_used;
+      pure_bytes_used = 0;
+    }
 
   result = (POINTER_TYPE *) (beg + pure_bytes_used);
   pure_bytes_used += nbytes;
@@ -3815,6 +3828,17 @@
 }
 
 
+/* Signal an error if PURESIZE is too small.  */
+
+void
+check_pure_size ()
+{
+  if (pure_bytes_used_before_overflow)
+    error ("Pure Lisp storage overflow (approx. %d bytes needed)",
+	   (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+}
+
+
 /* Return a string allocated in pure space.  DATA is a buffer holding
    NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE
    non-zero means make the result string multibyte.
@@ -4021,6 +4045,11 @@
   Lisp_Object total[8];
   int count = BINDING_STACK_SIZE ();
 
+  /* Can't GC if pure storage overflowed because we can't determine
+     if something is a pure object or not.  */
+  if (pure_bytes_used_before_overflow)
+    return Qnil;
+
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
@@ -4265,6 +4294,13 @@
     }
 #endif
 
+  if (!NILP (Vpost_gc_hook))
+    {
+      int count = inhibit_garbage_collection ();
+      safe_run_hooks (Qpost_gc_hook);
+      unbind_to (count, Qnil);
+    }
+  
   return Flist (sizeof total / sizeof *total, total);
 }
 
@@ -5357,14 +5393,16 @@
 init_alloc_once ()
 {
   /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
+  purebeg = PUREBEG;
+  pure_size = PURESIZE;
   pure_bytes_used = 0;
+  pure_bytes_used_before_overflow = 0;
+
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);
 #endif
-#ifdef HAVE_SHM
-  pure_size = PURESIZE;
-#endif
+
   all_vectors = 0;
   ignore_warnings = 1;
 #ifdef DOUG_LEA_MALLOC
@@ -5472,6 +5510,12 @@
     "Non-nil means display messages at start and end of garbage collection.");
   garbage_collection_messages = 0;
 
+  DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
+    "Hook run after garbage collection has finished.");
+  Vpost_gc_hook = Qnil;
+  Qpost_gc_hook = intern ("post-gc-hook");
+  staticpro (&Qpost_gc_hook);
+
   /* We build this in advance because if we wait until we need it, we might
      not be able to allocate the memory to hold it.  */
   memory_signal_data