# HG changeset patch # User Gerd Moellmann # Date 932593432 0 # Node ID 3bb745067f0e5b38ddf5bec1f8ca3b50f4b35686 # Parent 6e3de2f657042231326ed8d6109e8cf082e8717e (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. diff -r 6e3de2f65704 -r 3bb745067f0e src/alloc.c --- a/src/alloc.c Wed Jul 21 21:43:52 1999 +0000 +++ b/src/alloc.c Wed Jul 21 21:43:52 1999 +0000 @@ -192,9 +192,17 @@ 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 @@ struct gcpro *gcprolist; -#define NSTATICS 768 +#define NSTATICS 1024 Lisp_Object *staticvec[NSTATICS] = {0}; @@ -1739,15 +1747,19 @@ 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 @@ 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 @@ } } #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 @@ 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 (&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 @@ 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 @@ 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 (&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_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 @@ 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 @@ lisp_free (vector); n_vectors--; vector = next; + } else {