(gc_sweep): Call sweep_weak_hash_tables.

(survives_gc_p): New.
(mark_object): Mark objects referenced from glyphs, hash tables,
toolbar date, toolbar window, face caches, menu bar window.
Mark windows specially.
(Fgarbage_collect): Use message3_nolog.
(mark_face_cache): New.
(NSTATICS): Increased to 1024.
(mark_glyph_matrix): New.

1 files changed, 287 insertions, 4 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 79e3278680b..1ae6cdd153a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -192,9 +192,17 @@ int ignore_warnings;
 
 Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
 
-static void mark_object (), mark_buffer (), mark_kboards ();
+static void mark_buffer (), mark_kboards ();
 static void clear_marks (), gc_sweep ();
 static void compact_strings ();
+static void mark_glyph_matrix P_ ((struct glyph_matrix *));
+static void mark_face_cache P_ ((struct face_cache *));
+
+#ifdef HAVE_WINDOW_SYSTEM
+static void mark_image P_ ((struct image *));
+static void mark_image_cache P_ ((struct frame *));
+#endif /* HAVE_WINDOW_SYSTEM */
+
 
 extern int message_enable_multibyte;
 
@@ -1667,7 +1675,7 @@ Does not copy symbols.")
 
 struct gcpro *gcprolist;
 
-#define NSTATICS 768
+#define NSTATICS 1024
 
 Lisp_Object *staticvec[NSTATICS] = {0};
 
@@ -1739,15 +1747,19 @@ Garbage collection happens automatically if you cons more than\n\
   register struct backtrace *backlist;
   register Lisp_Object tem;
   char *omessage = echo_area_glyphs;
+  Lisp_Object omessage_string = echo_area_message;
   int omessage_length = echo_area_glyphs_length;
   int oldmultibyte = message_enable_multibyte;
   char stack_top_variable;
   register int i;
+  struct gcpro gcpro1;
 
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
 
+  GCPRO1 (omessage_string);
+
   /* Save a copy of the contents of the stack, for debugging.  */
 #if MAX_SAVE_STACK > 0
   if (NILP (Vpurify_flag))
@@ -1930,12 +1942,15 @@ Garbage collection happens automatically if you cons more than\n\
 
   if (garbage_collection_messages)
     {
+      if (STRINGP (omessage_string))
+        message3_nolog (omessage_string, omessage_length, oldmultibyte);
       if (omessage || minibuf_level > 0)
         message2_nolog (omessage, omessage_length, oldmultibyte);
       else
         message1_nolog ("Garbage collecting...done");
     }
 
+  UNGCPRO;
   return Fcons (Fcons (make_number (total_conses),
                        make_number (total_free_conses)),
                 Fcons (Fcons (make_number (total_symbols),
@@ -2019,6 +2034,95 @@ clear_marks ()
   }
 }
 #endif
+
+/* Mark Lisp objects in glyph matrix MATRIX.  */
+
+static void
+mark_glyph_matrix (matrix)
+     struct glyph_matrix *matrix;
+{
+  struct glyph_row *row = matrix->rows;
+  struct glyph_row *end = row + matrix->nrows;
+
+  while (row < end)
+    {
+      if (row->enabled_p)
+        {
+          int area;
+          for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
+            {
+              struct glyph *glyph = row->glyphs[area];
+              struct glyph *end_glyph = glyph + row->used[area];
+              
+              while (glyph < end_glyph)
+                {
+                  if (/* OBJECT Is zero for face extending glyphs, padding
+                         spaces and such.  */
+                      glyph->object
+                      /* Marking the buffer itself should not be necessary.  */
+                      && !BUFFERP (glyph->object))
+                    mark_object (&glyph->object);
+                  ++glyph;
+                }
+            }
+        }
+      
+      ++row;
+    }
+}
+
+/* Mark Lisp faces in the face cache C.  */
+
+static void
+mark_face_cache (c)
+     struct face_cache *c;
+{
+  if (c)
+    {
+      int i, j;
+      for (i = 0; i < c->used; ++i)
+        {
+          struct face *face = FACE_FROM_ID (c->f, i);
+
+          if (face)
+            {
+              for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
+                mark_object (&face->lface[j]);
+              mark_object (&face->registry);
+            }
+        }
+    }
+}
+
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Mark Lisp objects in image IMG.  */
+
+static void
+mark_image (img)
+     struct image *img;
+{
+  mark_object (&img->spec);
+  
+  if (!NILP (img->data.lisp_val))
+    mark_object (&img->data.lisp_val);
+}
+
+
+/* Mark Lisp objects in image cache of frame F.  It's done this way so
+   that we don't have to include xterm.h here.  */
+
+static void
+mark_image_cache (f)
+     struct frame *f;
+{
+  forall_images_in_image_cache (f, mark_image);
+}
+
+#endif /* HAVE_X_WINDOWS */
+
+
 
 /* Mark reference to a Lisp_Object.
   If the object referred to has not been seen yet, recursively mark
@@ -2034,7 +2138,7 @@ clear_marks ()
 Lisp_Object *last_marked[LAST_MARKED_SIZE];
 int last_marked_index;
 
-static void
+void
 mark_object (argptr)
      Lisp_Object *argptr;
 {
@@ -2144,6 +2248,16 @@ mark_object (argptr)
           mark_object (&ptr->menu_bar_vector);
           mark_object (&ptr->buffer_predicate);
           mark_object (&ptr->buffer_list);
+          mark_object (&ptr->menu_bar_window);
+          mark_object (&ptr->toolbar_window);
+          mark_face_cache (ptr->face_cache);
+#ifdef HAVE_WINDOW_SYSTEM
+          mark_image_cache (ptr);
+          mark_object (&ptr->desired_toolbar_items);
+          mark_object (&ptr->current_toolbar_items);
+          mark_object (&ptr->desired_toolbar_string);
+          mark_object (&ptr->current_toolbar_string);
+#endif /* HAVE_WINDOW_SYSTEM */
         }
       else if (GC_BOOL_VECTOR_P (obj))
         {
@@ -2153,6 +2267,76 @@ mark_object (argptr)
             break;   /* Already marked */
           ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
         }
+      else if (GC_WINDOWP (obj))
+        {
+          register struct Lisp_Vector *ptr = XVECTOR (obj);
+          struct window *w = XWINDOW (obj);
+          register EMACS_INT size = ptr->size;
+          /* The reason we use ptr1 is to avoid an apparent hardware bug
+             that happens occasionally on the FSF's HP 300s.
+             The bug is that a2 gets clobbered by recursive calls to mark_object.
+             The clobberage seems to happen during function entry,
+             perhaps in the moveml instruction.
+             Yes, this is a crock, but we have to do it.  */
+          struct Lisp_Vector *volatile ptr1 = ptr;
+          register int i;
+
+          /* Stop if already marked.  */
+          if (size & ARRAY_MARK_FLAG)
+            break;
+
+          /* Mark it.  */
+          ptr->size |= ARRAY_MARK_FLAG;
+
+          /* There is no Lisp data above The member CURRENT_MATRIX in
+             struct WINDOW.  Stop marking when that slot is reached.  */
+          for (i = 0;
+               (char *) &ptr1->contents[i] < (char *) &w->current_matrix;
+               i++)
+            mark_object (&ptr1->contents[i]);
+
+          /* Mark glyphs for leaf windows.  Marking window matrices is
+             sufficient because frame matrices use the same glyph
+             memory.  */
+          if (NILP (w->hchild)
+              && NILP (w->vchild)
+              && w->current_matrix)
+            {
+              mark_glyph_matrix (w->current_matrix);
+              mark_glyph_matrix (w->desired_matrix);
+            }
+        }
+      else if (GC_HASH_TABLE_P (obj))
+        {
+          struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+          EMACS_INT size = h->size;
+          
+          /* Stop if already marked.  */
+          if (size & ARRAY_MARK_FLAG)
+            break;
+
+          /* Mark it.  */
+          h->size |= ARRAY_MARK_FLAG;
+
+          /* Mark contents.  */
+          mark_object (&h->test);
+          mark_object (&h->weak);
+          mark_object (&h->rehash_size);
+          mark_object (&h->rehash_threshold);
+          mark_object (&h->hash);
+          mark_object (&h->next);
+          mark_object (&h->index);
+          mark_object (&h->user_hash_function);
+          mark_object (&h->user_cmp_function);
+
+          /* If hash table is not weak, mark all keys and values.
+             For weak tables, mark only the vector.  */
+          if (GC_NILP (h->weak))
+            mark_object (&h->key_and_value);
+          else
+            XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
+            
+        }
       else
         {
           register struct Lisp_Vector *ptr = XVECTOR (obj);
@@ -2170,6 +2354,7 @@ mark_object (argptr)
           ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
           if (size & PSEUDOVECTOR_FLAG)
             size &= PSEUDOVECTOR_SIZE_MASK;
+
           for (i = 0; i < size; i++) /* and then mark its elements */
             mark_object (&ptr1->contents[i]);
         }
@@ -2187,7 +2372,7 @@ mark_object (argptr)
         mark_object (&ptr->function);
         mark_object (&ptr->plist);
         XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String);
-        mark_object (&ptr->name);
+        mark_object ((Lisp_Object *) &ptr->name);
         /* Note that we do not mark the obarray of the symbol.
            It is safe not to do so because nothing accesses that
            slot except to check whether it is nil.  */
@@ -2403,12 +2588,104 @@ mark_kboards ()
       mark_object (&kb->Vdefault_minibuffer_frame);
     }
 }
+
+
+/* Value is non-zero if OBJ will survive the current GC because it's
+   either marked or does not need to be marked to survive.  */
+
+int
+survives_gc_p (obj)
+     Lisp_Object obj;
+{
+  int survives_p;
+  
+  switch (XGCTYPE (obj))
+    {
+    case Lisp_Int:
+      survives_p = 1;
+      break;
+
+    case Lisp_Symbol:
+      survives_p = XMARKBIT (XSYMBOL (obj)->plist);
+      break;
+
+    case Lisp_Misc:
+      switch (XMISCTYPE (obj))
+        {
+        case Lisp_Misc_Marker:
+          survives_p = XMARKBIT (obj);
+          break;
+          
+        case Lisp_Misc_Buffer_Local_Value:
+        case Lisp_Misc_Some_Buffer_Local_Value:
+          survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
+          break;
+          
+        case Lisp_Misc_Intfwd:
+        case Lisp_Misc_Boolfwd:
+        case Lisp_Misc_Objfwd:
+        case Lisp_Misc_Buffer_Objfwd:
+        case Lisp_Misc_Kboard_Objfwd:
+          survives_p = 1;
+          break;
+          
+        case Lisp_Misc_Overlay:
+          survives_p = XMARKBIT (XOVERLAY (obj)->plist);
+          break;
+
+        default:
+          abort ();
+        }
+      break;
+
+    case Lisp_String:
+      {
+        struct Lisp_String *s = XSTRING (obj);
+
+        if (s->size & MARKBIT)
+          survives_p = s->size & ARRAY_MARK_FLAG;
+        else
+          survives_p = (s->size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE;
+      }
+      break;
+
+    case Lisp_Vectorlike:
+      if (GC_BUFFERP (obj))
+        survives_p = XMARKBIT (XBUFFER (obj)->name);
+      else if (GC_SUBRP (obj))
+        survives_p = 1;
+      else
+        survives_p = XVECTOR (obj)->size & ARRAY_MARK_FLAG;
+      break;
+
+    case Lisp_Cons:
+      survives_p = XMARKBIT (XCAR (obj));
+      break;
+
+#ifdef LISP_FLOAT_TYPE
+    case Lisp_Float:
+      survives_p = XMARKBIT (XFLOAT (obj)->type);
+      break;
+#endif /* LISP_FLOAT_TYPE */
+
+    default:
+      abort ();
+    }
+
+  return survives_p;
+}
+
+
 
 /* Sweep: find all structures not marked, and free them. */
 
 static void
 gc_sweep ()
 {
+  /* Remove or mark entries in weak hash tables.
+     This must be done before any object is unmarked.  */
+  sweep_weak_hash_tables ();
+
   total_string_size = 0;
   compact_strings ();
 
@@ -2746,6 +3023,11 @@ gc_sweep ()
     while (vector)
       if (!(vector->size & ARRAY_MARK_FLAG))
         {
+#if 0
+          if ((vector->size & (PSEUDOVECTOR_FLAG | PVEC_HASH_TABLE))
+              == (PSEUDOVECTOR_FLAG | PVEC_HASH_TABLE))
+            fprintf (stderr, "Freeing hash table %p\n", vector);
+#endif
           if (prev)
             prev->next = vector->next;
           else
@@ -2754,6 +3036,7 @@ gc_sweep ()
           lisp_free (vector);
           n_vectors--;
           vector = next;
+
         }
       else
         {