=== modified file 'src/alloc.c' --- src/alloc.c 2012-08-31 10:53:19 +0000 +++ src/alloc.c 2012-09-04 14:08:31 +0000 @@ -189,6 +189,26 @@ static EMACS_INT total_free_conses, total_free_markers, total_free_symbols; static EMACS_INT total_free_floats, total_floats; +/* New gengc variables. */ + +static EMACS_INT old_objects_reached, new_objects_reached; +static EMACS_INT old_objects_died, new_objects_died; +static EMACS_INT objects_promoted; + +/* Used to store inter-generational objects and pointers to them. */ + +#define GENGC_MAX_OBJECTS 500000 +static Lisp_Object gengc_objects[GENGC_MAX_OBJECTS]; +static int gengc_index; + +/* True means we've verbose. */ + +static bool gengc_verbose; + +/* True means we're performing generational collection. */ + +static bool gengc; + /* Points to memory space allocated as "spare", to be freed if we run out of memory. We keep one large block, four cons-blocks, and two string blocks. */ @@ -271,6 +291,7 @@ static Lisp_Object Qpost_gc_hook; static void mark_terminals (void); +static void mark_face_caches (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_glyph_matrix (struct glyph_matrix *); @@ -284,6 +305,7 @@ static void free_large_strings (void); static void sweep_strings (void); static void free_misc (Lisp_Object); +static void free_misc_internal (Lisp_Object); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; /* When scanning the C stack for live Lisp objects, Emacs keeps track @@ -449,8 +471,242 @@ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ & ~ ((ALIGNMENT) - 1))) - - +/* Initialize per-object GC information. */ + +void +gengc_init (struct gc_info *g, enum gc_obj_type objtype, enum gc_type gctype) +{ + if (gctype == GC_OLD) + abort (); + + if (gctype == GC_PURE || gctype == GC_FREE) + g->generation = -1; + else + g->generation = 0; + + g->gctype = gctype; + g->objtype = objtype; + g->account = 0; +} + +/* Called to promote an object to an old generation. */ + +void +gengc_promote (struct gc_info *g) +{ + eassert (g->objtype != GC_OBJ_FREE); + eassert (g->gctype == GC_NEW || g->gctype == GC_OLD); + g->account = 0; + g->gctype = GC_OLD; + g->generation++; + objects_promoted++; +} + +/* Called when an owner of G dies or when a free object is recycled as free + for next time. */ + +void +gengc_exit (struct gc_info *g) +{ + eassert (g != NULL); + + if (g->gctype == GC_OLD) + old_objects_died++; + else if (g->gctype == GC_NEW) + new_objects_died++; + else if (g->gctype == GC_FREE) + /* nothing */; + else + abort (); + + /* Reset for the sake of recycled objects. */ + g->gctype = GC_FREE; + g->objtype = GC_OBJ_FREE; + g->generation = -1; +} + +/* Collect some statistics about objects we're marking. */ + +void +gengc_collect (struct gc_info *g) +{ + eassert (g != NULL); + if (g->account == 0) + { + if (g->gctype == GC_OLD) + old_objects_reached++; + else if (g->gctype == GC_NEW) + new_objects_reached++; + else if (g->gctype == GC_FREE || g->gctype == GC_PURE) + { + Lisp_Object owner = get_gc_info_obj (g); + + if (INTEGERP (owner)) + fprintf (stderr, "*** marking object with gctype %d\n", g->gctype); + else + fprintf (stderr, "*** marking object %lx (type %d) with gctype %d\n", + XLI (owner), XTYPE (owner), g->gctype); + abort (); + } + g->account = 1; + } +} + +/* Show collected statistics and reset counters. */ + +static void +show_gc_info (void) +{ + if (gengc_verbose) + { + double newobjs, oldobjs, totalobjs; + + oldobjs = old_objects_reached; + newobjs = new_objects_reached; + totalobjs = oldobjs + newobjs; + fprintf (stderr, "%ld (%.2f%%) old + %ld (%.2f%%) new objects marked\n", + old_objects_reached, oldobjs / totalobjs * 100.0, + new_objects_reached, newobjs / totalobjs * 100.0); + + oldobjs = old_objects_died; + newobjs = new_objects_died; + totalobjs = oldobjs + newobjs; + fprintf (stderr, "%ld (%.2f%%) old + %ld (%.2f%%) new objects died\n", + old_objects_died, oldobjs / totalobjs * 100.0, + new_objects_died, newobjs / totalobjs * 100.0); + fprintf (stderr, "%ld objects promoted\n\n", objects_promoted); + } + + old_objects_reached = new_objects_reached = 0; + old_objects_died = new_objects_died = 0; + objects_promoted = 0; +} + +/* API for recording objects and pointers. */ + +static int +gengc_find_pointer (void *ptr) +{ + int i; + Lisp_Object test; + + for (i = 0; i < gengc_index; i++) + { + test = gengc_objects[i]; + if (SAVE_VALUEP (test) + && XSAVE_VALUE (test)->savetype > 0 + && XSAVE_VALUE (test)->pointer == ptr) + return 1; + } + return 0; +} + +static int +gengc_find_object (Lisp_Object obj) +{ + int i; + + for (i = 0; i < gengc_index; i++) + if (EQ (gengc_objects[i], obj)) + return 1; + return 0; +} + +void +gengc_record_interval (INTERVAL i) +{ + eassert (i != NULL); + if (!gengc_find_pointer (i)) + { + Lisp_Object obj; + + eassert (gengc_index < GENGC_MAX_OBJECTS); + obj = make_save_value (i, 0); + XSAVE_VALUE (obj)->savetype = 1; + gengc_objects[gengc_index++] = obj; + } +} + +void +gengc_record_object (Lisp_Object obj) +{ + eassert (valid_lisp_object_p (obj)); + + if (!gengc_find_object (obj)) + { + eassert (gengc_index < GENGC_MAX_OBJECTS); + gengc_objects[gengc_index++] = obj; + } +} + +void +gengc_record_address (Lisp_Object *objptr) +{ + eassert (objptr != NULL); + if (!gengc_find_pointer (objptr)) + { + Lisp_Object obj; + + eassert (gengc_index < GENGC_MAX_OBJECTS); + obj = make_save_value (objptr, 0); + XSAVE_VALUE (obj)->savetype = 2; + gengc_objects[gengc_index++] = obj; + } +} + +/* Write barrier routines. */ + +int +gengc_write_barrier (struct gc_info *p, struct gc_info *q) +{ + /* No free objects here. */ + if (p && p->gctype == GC_FREE) + abort (); + if (q && q->gctype == GC_FREE) + abort (); + /* Both P and Q belongs to collectable objects, + P is from old, and Q is from new. */ + return (p && p->gctype == GC_OLD && q && q->gctype == GC_NEW); +} + +void +gengc_object_write_barrier (Lisp_Object p, Lisp_Object q) +{ + if (gengc_write_barrier (get_gc_info (p), get_gc_info (q))) + gengc_record_object (q); +} + +/* Explicit free support. */ + +static void +gengc_notice_free (Lisp_Object obj) +{ + int i; + + for (i = 0; i < gengc_index; i++) + if (EQ (gengc_objects[i], obj)) + { + if (i == gengc_index - 1) + /* Discard last recorded object. */ + gengc_index--; + else + /* Rewrite with last recorded object. */ + gengc_objects[i] = gengc_objects[--gengc_index]; + break; + } +} + +/* True if an owner of G is a subject to sweep. */ + +bool +gengc_sweep (struct gc_info *g) +{ + eassert (g != NULL); + /* For full collection, always sweep everything. + For generational collection, sweep new objects only. */ + return !gengc || (gengc && g->gctype == GC_NEW); +} + /************************************************************************ Malloc ************************************************************************/ @@ -1534,6 +1790,7 @@ consing_since_gc += sizeof (struct interval); intervals_consed++; total_free_intervals--; + gengc_init (&val->gcinfo, GC_OBJ_NONLISP, GC_NEW); RESET_INTERVAL (val); val->gcmarkbit = 0; return val; @@ -1545,9 +1802,15 @@ static void mark_interval (register INTERVAL i, Lisp_Object dummy) { - /* Intervals should never be shared. So, if extra internal checking is - enabled, GC aborts if it seems to have visited an interval twice. */ - eassert (!i->gcmarkbit); + if (gengc && i->gcinfo.gctype != GC_NEW) + return; + + gengc_collect (&i->gcinfo); + /* Full GC: intervals should never be shared. So, if extra internal checking + is enabled, GC aborts if it seems to have visited an interval twice. + Gen GC: intervals may be marked in arbitrary order. */ + if (!gengc) + eassert (!i->gcmarkbit); i->gcmarkbit = 1; mark_object (i->plist); } @@ -1907,6 +2170,8 @@ for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i) { s = b->strings + i; + /* Allocated (but currently unused) object. */ + gengc_init (&s->gcinfo, GC_OBJ_STRING, GC_FREE); /* Every string on a free list should have NULL data pointer. */ s->data = NULL; NEXT_FREE_LISP_STRING (s) = string_free_list; @@ -1942,6 +2207,10 @@ } #endif /* GC_CHECK_STRING_BYTES */ + /* It comes from a free list and so should be GC_FREE. */ + eassert (s->gcinfo.gctype == GC_FREE); + + gengc_init (&s->gcinfo, GC_OBJ_STRING, GC_NEW); return s; } @@ -2080,6 +2349,9 @@ { struct Lisp_String *s = b->strings + i; + if (!gengc_sweep (&s->gcinfo)) + continue; + if (s->data) { /* String was not on free-list before. */ @@ -2088,6 +2360,9 @@ /* String is live; unmark it and its intervals. */ UNMARK_STRING (s); + /* Promote it to old generation. */ + gengc_promote (&s->gcinfo); + /* Do not use string_(set|get)_intervals here. */ s->intervals = balance_intervals (s->intervals); @@ -2099,6 +2374,9 @@ /* String is dead. Put it on the free-list. */ struct sdata *data = SDATA_OF_STRING (s); + /* Step 1: account S as dead. */ + gengc_exit (&s->gcinfo); + /* Save the size of S in its sdata so that we know how large that is. Reset the sdata's string back-pointer so that we know it's free. */ @@ -2114,6 +2392,9 @@ know it's free. */ s->data = NULL; + /* Step 2: initialize it for free list. */ + gengc_init (&s->gcinfo, GC_OBJ_STRING, GC_FREE); + /* Put the string on the free-list. */ NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = s; @@ -2122,6 +2403,8 @@ } else { + /* It should be GC_FREE since it comes from a free list. */ + eassert (s->gcinfo.gctype == GC_FREE); /* S was on the free-list before. Put it there again. */ NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = s; @@ -2614,6 +2897,7 @@ XFLOAT_INIT (val, float_value); eassert (!FLOAT_MARKED_P (XFLOAT (val))); + gengc_init (&XFLOAT (val)->gcinfo, GC_OBJ_FLOAT, GC_NEW); consing_since_gc += sizeof (struct Lisp_Float); floats_consed++; total_free_floats--; @@ -2677,6 +2961,10 @@ void free_cons (struct Lisp_Cons *ptr) { + { Lisp_Object tem; + XSETCONS (tem, ptr); + gengc_notice_free (tem); } + gengc_exit (&ptr->gcinfo); ptr->u.chain = cons_free_list; #if GC_MARK_STACK ptr->car = Vdead; @@ -2686,6 +2974,36 @@ total_free_conses++; } +Lisp_Object +xcar (Lisp_Object cell) +{ + eassert (XCONS (cell)->gcinfo.gctype != GC_FREE); + return XCONS (cell)->car; +} + +Lisp_Object +xcdr (Lisp_Object cell) +{ + eassert (XCONS (cell)->gcinfo.gctype != GC_FREE); + return XCONS (cell)->u.cdr; +} + +void +setcar (Lisp_Object cell, Lisp_Object car) +{ + eassert (CONSP (cell)); + PTR_BARRIER (XCONS (cell), car); + XCONS (cell)->car = car; +} + +void +setcdr (Lisp_Object cell, Lisp_Object cdr) +{ + eassert (CONSP (cell)); + PTR_BARRIER (XCONS (cell), cdr); + XCONS (cell)->u.cdr = cdr; +} + DEFUN ("cons", Fcons, Scons, 2, 2, 0, doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) (Lisp_Object car, Lisp_Object cdr) @@ -2721,9 +3039,10 @@ MALLOC_UNBLOCK_INPUT; - XSETCAR (val, car); - XSETCDR (val, cdr); + XCONS (val)->car = car; + XCONS (val)->u.cdr = cdr; eassert (!CONS_MARKED_P (XCONS (val))); + gengc_init (&XCONS (val)->gcinfo, GC_OBJ_CONS, GC_NEW); consing_since_gc += sizeof (struct Lisp_Cons); total_free_conses--; cons_cells_consed++; @@ -2940,6 +3259,8 @@ (index) = VINDEX (nbytes); \ eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ (v)->header.next.vector = vector_free_lists[index]; \ + /* Allocated (but currently unused) object. */ \ + gengc_init (&v->header.gcinfo, GC_OBJ_VECTOR, GC_FREE); \ vector_free_lists[index] = (v); \ total_free_vector_slots += (nbytes) / word_size; \ } while (0) @@ -3101,30 +3422,41 @@ for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) { + struct gc_info *g = &vector->header.gcinfo; + ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); + if (VECTOR_MARKED_P (vector)) { VECTOR_UNMARK (vector); + /* This vector is live, promote it to old generation. */ + gengc_promote (&vector->header.gcinfo); total_vectors++; total_vector_slots += vector->header.next.nbytes / word_size; next = ADVANCE (vector, vector->header.next.nbytes); } - else + else if (gengc_sweep (g)) { - ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); ptrdiff_t total_bytes = nbytes; + /* This vector is dead. */ + gengc_exit (&vector->header.gcinfo); + next = ADVANCE (vector, nbytes); + g = &next->header.gcinfo; /* While NEXT is not marked, try to coalesce with VECTOR, thus making VECTOR of the largest possible size. */ - while (VECTOR_IN_BLOCK (next, block)) + while (VECTOR_IN_BLOCK (next, block) && gengc_sweep (g)) { if (VECTOR_MARKED_P (next)) break; + /* NEXT is dead too. */ + gengc_exit (&next->header.gcinfo); nbytes = PSEUDOVECTOR_NBYTES (next); total_bytes += nbytes; next = ADVANCE (next, nbytes); + g = &next->header.gcinfo; } eassert (total_bytes % roundup_size == 0); @@ -3140,6 +3472,8 @@ SETUP_ON_FREE_LIST (vector, total_bytes, tmp); } } + else + next = ADVANCE (vector, nbytes); } if (free_this_block) @@ -3161,6 +3495,8 @@ if (VECTOR_MARKED_P (vector)) { VECTOR_UNMARK (vector); + /* VECTOR is live, promote it to old generation. */ + gengc_promote (&vector->header.gcinfo); total_vectors++; if (vector->header.size & PSEUDOVECTOR_FLAG) { @@ -3181,14 +3517,33 @@ += header_size / word_size + vector->header.size; vprev = &vector->header.next.vector; } - else + else if (gengc_sweep (&vector->header.gcinfo)) { *vprev = vector->header.next.vector; + /* This vector is dead. */ + gengc_exit (&vector->header.gcinfo); lisp_free (vector); } + else + vprev = &vector->header.next.vector; } } +Lisp_Object +aref (Lisp_Object array, ptrdiff_t index) +{ + eassert (XVECTOR (array)->header.gcinfo.gctype != GC_FREE); + return XVECTOR (array)->contents[index]; +} + +void +aset (Lisp_Object array, ptrdiff_t index, Lisp_Object val) +{ + eassert (XVECTOR (array)->header.gcinfo.gctype != GC_FREE); + VECTOR_BARRIER (XVECTOR (array), val); + XVECTOR (array)->contents[index] = val; +} + /* Value is a pointer to a newly allocated Lisp_Vector structure with room for LEN Lisp_Objects. */ @@ -3228,6 +3583,7 @@ /* Back to a reasonable maximum of mmap'ed areas. */ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); #endif + gengc_init (&p->header.gcinfo, GC_OBJ_VECTOR, GC_NEW); consing_since_gc += nbytes; vector_cells_consed += len; @@ -3276,6 +3632,7 @@ { struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); + gengc_init (&b->header.gcinfo, GC_OBJ_VECTOR, GC_NEW); XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text) - header_size) / word_size); /* Note that the fields of B are not initialized. */ @@ -3510,6 +3867,7 @@ MALLOC_UNBLOCK_INPUT; p = XSYMBOL (val); + gengc_init (&p->gcinfo, GC_OBJ_SYMBOL, GC_NEW); set_symbol_name (val, name); set_symbol_plist (val, Qnil); p->redirect = SYMBOL_PLAINVAL; @@ -3599,14 +3957,16 @@ misc_objects_consed++; XMISCTYPE (val) = type; XMISCANY (val)->gcmarkbit = 0; + gengc_init (&XMISCANY (val)->gcinfo, GC_OBJ_MISC, GC_NEW); return val; } /* Free a Lisp_Misc object */ static void -free_misc (Lisp_Object misc) +free_misc_internal (Lisp_Object misc) { + gengc_exit (&XMISCANY (misc)->gcinfo); XMISCTYPE (misc) = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); @@ -3614,6 +3974,13 @@ total_free_markers++; } +static void +free_misc (Lisp_Object misc) +{ + gengc_notice_free (misc); + free_misc_internal (misc); +} + /* Return a Lisp_Misc_Save_Value object containing POINTER and INTEGER. This is used to package C values to call record_unwind_protect. The unwind function can get the C values back using XSAVE_VALUE. */ @@ -3628,6 +3995,7 @@ p = XSAVE_VALUE (val); p->pointer = pointer; p->integer = integer; + p->savetype = 0; p->dogc = 0; return val; } @@ -5212,6 +5580,7 @@ s->size = nchars; s->size_byte = multibyte ? nbytes : -1; s->intervals = NULL; + gengc_init (&s->gcinfo, GC_OBJ_STRING, GC_PURE); XSETSTRING (string, s); return string; } @@ -5228,6 +5597,7 @@ s->size_byte = -1; s->data = (unsigned char *) data; s->intervals = NULL; + gengc_init (&s->gcinfo, GC_OBJ_STRING, GC_PURE); XSETSTRING (string, s); return string; } @@ -5243,6 +5613,7 @@ XSETCONS (new, p); XSETCAR (new, Fpurecopy (car)); XSETCDR (new, Fpurecopy (cdr)); + gengc_init (&p->gcinfo, GC_OBJ_CONS, GC_PURE); return new; } @@ -5256,6 +5627,7 @@ struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); XSETFLOAT (new, p); XFLOAT_INIT (new, num); + gengc_init (&p->gcinfo, GC_OBJ_FLOAT, GC_PURE); return new; } @@ -5271,6 +5643,7 @@ struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); XSETVECTOR (new, p); XVECTOR (new)->header.size = len; + gengc_init (&p->header.gcinfo, GC_OBJ_VECTOR, GC_PURE); return new; } @@ -5410,6 +5783,11 @@ if (pure_bytes_used_before_overflow) return Qnil; + gengc = !!(gcs_done & 1); + if (gengc_verbose) + fprintf (stderr, "GC%ld: perform %s collection, %d inter-generational objects\n", + gcs_done, (gengc ? "generational" : "full"), gengc_index); + check_cons_list (); /* Don't keep undo information around forever. @@ -5466,6 +5844,10 @@ /* Mark all the special slots that serve as the roots of accessibility. */ + if (gengc) + for (i = 0; i < gengc_index; i++) + mark_object (gengc_objects[i]); + for (i = 0; i < staticidx; i++) mark_object (*staticvec[i]); @@ -5521,6 +5903,10 @@ mark_stack (); #endif + /* FIXME: face caches are reachable from frame objects + but writes to lface vectors aren't barriered :-(... */ + mark_face_caches (); + /* Everything is now marked, except for the things that require special finalization, i.e. the undo_list. Look thru every buffer's undo list @@ -5569,7 +5955,9 @@ unmark_byte_stack (); VECTOR_UNMARK (&buffer_defaults); + gengc_promote (&buffer_defaults.header.gcinfo); VECTOR_UNMARK (&buffer_local_symbols); + gengc_promote (&buffer_local_symbols.header.gcinfo); #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0 dump_zombies (); @@ -5698,6 +6086,16 @@ + EMACS_TIME_TO_DOUBLE (since_start)); } + /* Dump generation statistics. */ + show_gc_info (); + + /* Reset gengc storage. */ + for (i = 0; i < gengc_index; i++) + if (SAVE_VALUEP (gengc_objects[i]) + && XSAVE_VALUE (gengc_objects[i])->savetype != 0) + free_misc_internal (gengc_objects[i]); + gengc_index = 0; + gcs_done++; return retval; @@ -5808,7 +6206,7 @@ if (SUB_CHAR_TABLE_P (val)) { if (! VECTOR_MARKED_P (XVECTOR (val))) - mark_char_table (XVECTOR (val)); + mark_object (val); } else mark_object (val); @@ -5822,6 +6220,8 @@ { for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) { + if (gengc && ptr->gcinfo.gctype != GC_NEW) + continue; ptr->gcmarkbit = 1; mark_object (ptr->start); mark_object (ptr->end); @@ -5850,7 +6250,11 @@ /* If this is an indirect buffer, mark its base buffer. */ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) - mark_buffer (buffer->base_buffer); + { + Lisp_Object tem; + XSETBUFFER (tem, buffer->base_buffer); + mark_object (tem); + } } /* Determine type of generic Lisp_Object and mark it accordingly. */ @@ -5864,6 +6268,7 @@ struct mem_node *m; #endif ptrdiff_t cdr_count = 0; + struct gc_info *g; loop: @@ -5874,6 +6279,27 @@ if (last_marked_index == LAST_MARKED_SIZE) last_marked_index = 0; + g = get_gc_info (obj); + if (g) + { + Lisp_Object tem; + + if (g->gctype == GC_FREE) + abort (); + + /* Mark only new objects now. */ + if (gengc && g->gctype != GC_NEW) + return; + + gengc_collect (g); + /* Check whether gcinfo matches an object. */ + tem = get_gc_info_obj (g); + if (INTEGERP (tem)) + eassert (XFASTINT (tem) == -1); + else + eassert (EQ (tem, obj)); + } + /* Perform some sanity checks on the objects marked here. Abort if we encounter an object we know is bogus. This increases GC time by ~80%, and requires compilation with GC_MARK_STACK != 0. */ @@ -5994,7 +6420,8 @@ case PVEC_FRAME: { mark_vectorlike (ptr); - mark_face_cache (((struct frame *) ptr)->face_cache); + /* FIXME: marked separately + mark_face_cache (((struct frame *) ptr)->face_cache); */ } break; @@ -6092,7 +6519,7 @@ default: abort (); } if (!PURE_POINTER_P (XSTRING (ptr->name))) - MARK_STRING (XSTRING (ptr->name)); + mark_object (ptr->name); MARK_INTERVAL_TREE (string_intervals (ptr->name)); ptr = ptr->next; @@ -6134,7 +6561,12 @@ for (nelt = ptr->integer; nelt > 0; nelt--, p++) mark_maybe_object (*p); } - } + /* Special save values comes from gengc_objects. */ + else if (ptr->savetype == 1) + MARK_INTERVAL_TREE (((INTERVAL) ptr->pointer)); + else if (ptr->savetype == 2) + mark_object (*(Lisp_Object *) ptr->pointer); + } #endif break; @@ -6191,7 +6623,9 @@ static void mark_terminals (void) { + Lisp_Object obj; struct terminal *t; + for (t = terminal_list; t; t = t->next_terminal) { eassert (t->name != NULL); @@ -6202,11 +6636,22 @@ mark_image_cache (t->image_cache); #endif /* HAVE_WINDOW_SYSTEM */ if (!VECTOR_MARKED_P (t)) - mark_vectorlike ((struct Lisp_Vector *)t); + { + XSETTERMINAL (obj, t); + mark_object (obj); + } } } +static void +mark_face_caches (void) +{ + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + if (FRAME_LIVE_P (XFRAME (frame))) + mark_face_cache (XFRAME (frame)->face_cache); +} /* 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. */ @@ -6250,6 +6695,14 @@ abort (); } + if (gengc) + { + struct gc_info *g = get_gc_info (obj); + /* Old objects will definitely survive. */ + if (g) + survives_p = survives_p || (g->gctype == GC_OLD); + } + return survives_p || PURE_POINTER_P ((void *) XPNTR (obj)); } @@ -6278,7 +6731,7 @@ for (cblk = cons_block; cblk; cblk = *cprev) { - register int i = 0; + register int i = 0, j; int this_free = 0; int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT; @@ -6290,6 +6743,10 @@ /* Fast path - all cons cells for this int are marked. */ cblk->gcmarkbits[i] = 0; num_used += BITS_PER_INT; + + /* Promote live conses to old generation. */ + for (j = 0; j < BITS_PER_INT; j++) + gengc_promote (&cblk->conses[i * BITS_PER_INT + j].gcinfo); } else { @@ -6305,6 +6762,8 @@ for (pos = start; pos < stop; pos++) { + if (!gengc_sweep (&cblk->conses[pos].gcinfo)) + continue; if (!CONS_MARKED_P (&cblk->conses[pos])) { this_free++; @@ -6313,11 +6772,15 @@ #if GC_MARK_STACK cons_free_list->car = Vdead; #endif + /* This cons is dead. */ + gengc_exit (&cblk->conses[pos].gcinfo); } else { num_used++; CONS_UNMARK (&cblk->conses[pos]); + /* This cons is live, promote it to old generation. */ + gengc_promote (&cblk->conses[pos].gcinfo); } } } @@ -6358,17 +6821,26 @@ register int i; int this_free = 0; for (i = 0; i < lim; i++) - if (!FLOAT_MARKED_P (&fblk->floats[i])) - { - this_free++; - fblk->floats[i].u.chain = float_free_list; - float_free_list = &fblk->floats[i]; - } - else - { - num_used++; - FLOAT_UNMARK (&fblk->floats[i]); - } + { + if (!gengc_sweep (&fblk->floats[i].gcinfo)) + continue; + + if (!FLOAT_MARKED_P (&fblk->floats[i])) + { + this_free++; + fblk->floats[i].u.chain = float_free_list; + float_free_list = &fblk->floats[i]; + /* This float is dead. */ + gengc_exit (&fblk->floats[i].gcinfo); + } + else + { + num_used++; + FLOAT_UNMARK (&fblk->floats[i]); + /* This float is live, promote it to old generation. */ + gengc_promote (&fblk->floats[i].gcinfo); + } + } lim = FLOAT_BLOCK_SIZE; /* If this block contains only free floats and we have already seen more than two blocks worth of free floats then deallocate @@ -6406,16 +6878,23 @@ for (i = 0; i < lim; i++) { + if (!gengc_sweep (&iblk->intervals[i].gcinfo)) + continue; if (!iblk->intervals[i].gcmarkbit) { - set_interval_parent (&iblk->intervals[i], interval_free_list); + iblk->intervals[i].up_obj = 0; + iblk->intervals[i].up.interval = interval_free_list; interval_free_list = &iblk->intervals[i]; + /* This interval is dead. */ + gengc_exit (&iblk->intervals[i].gcinfo); this_free++; } else { num_used++; iblk->intervals[i].gcmarkbit = 0; + /* This interval is live, promote it to old generation. */ + gengc_promote (&iblk->intervals[i].gcinfo); } } lim = INTERVAL_BLOCK_SIZE; @@ -6461,6 +6940,9 @@ so we conservatively assume that it is live. */ bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name)); + if (!gengc_sweep (&sym->s.gcinfo)) + continue; + if (!sym->s.gcmarkbit && !pure_p) { if (sym->s.redirect == SYMBOL_LOCALIZED) @@ -6470,6 +6952,8 @@ #if GC_MARK_STACK symbol_free_list->function = Vdead; #endif + /* This symbol is dead. */ + gengc_exit (&sym->s.gcinfo); ++this_free; } else @@ -6478,6 +6962,8 @@ if (!pure_p) UNMARK_STRING (XSTRING (sym->s.name)); sym->s.gcmarkbit = 0; + /* This symbol is live, promote it to old generation. */ + gengc_promote (&sym->s.gcinfo); } } @@ -6519,6 +7005,8 @@ for (i = 0; i < lim; i++) { + if (!gengc_sweep (&mblk->markers[i].m.u_any.gcinfo)) + continue; if (!mblk->markers[i].m.u_any.gcmarkbit) { if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker) @@ -6529,12 +7017,16 @@ mblk->markers[i].m.u_marker.type = Lisp_Misc_Free; mblk->markers[i].m.u_free.chain = marker_free_list; marker_free_list = &mblk->markers[i].m; + /* This misc is dead. */ + gengc_exit (&mblk->markers[i].m.u_any.gcinfo); this_free++; } else { num_used++; mblk->markers[i].m.u_any.gcmarkbit = 0; + /* This misc is live, promote it to old generation. */ + gengc_promote (&mblk->markers[i].m.u_any.gcinfo); } } lim = MARKER_BLOCK_SIZE; @@ -6565,13 +7057,16 @@ total_buffers = 0; while (buffer) - if (!VECTOR_MARKED_P (buffer)) + if (!VECTOR_MARKED_P (buffer) + && gengc_sweep (&buffer->header.gcinfo)) { if (prev) prev->header.next = buffer->header.next; else all_buffers = buffer->header.next.buffer; next = buffer->header.next.buffer; + /* This buffer is dead. */ + gengc_exit (&buffer->header.gcinfo); lisp_free (buffer); buffer = next; } @@ -6580,6 +7075,8 @@ VECTOR_UNMARK (buffer); /* Do not use buffer_(set|get)_intervals here. */ buffer->text->intervals = balance_intervals (buffer->text->intervals); + /* This buffer is live, promote it to old generation. */ + gengc_promote (&buffer->header.gcinfo); total_buffers++; prev = buffer, buffer = buffer->header.next.buffer; } @@ -6747,6 +7244,7 @@ #endif Vgc_elapsed = make_float (0.0); gcs_done = 0; + gengc_verbose = getenv ("EMACS_GENGC_VERBOSE"); } void === modified file 'src/buffer.c' --- src/buffer.c 2012-08-28 10:59:17 +0000 +++ src/buffer.c 2012-09-04 12:09:11 +0000 @@ -161,221 +161,265 @@ static inline void bset_abbrev_mode (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (abbrev_mode) = val; } static inline void bset_abbrev_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (abbrev_table) = val; } static inline void bset_auto_fill_function (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (auto_fill_function) = val; } static inline void bset_auto_save_file_format (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (auto_save_file_format) = val; } static inline void bset_auto_save_file_name (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (auto_save_file_name) = val; } static inline void bset_backed_up (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (backed_up) = val; } static inline void bset_begv_marker (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (begv_marker) = val; } static inline void bset_bidi_display_reordering (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (bidi_display_reordering) = val; } static inline void bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (buffer_file_coding_system) = val; } static inline void bset_cache_long_line_scans (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (cache_long_line_scans) = val; } static inline void bset_case_fold_search (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (case_fold_search) = val; } static inline void bset_ctl_arrow (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (ctl_arrow) = val; } static inline void bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val; } static inline void bset_cursor_type (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (cursor_type) = val; } static inline void bset_display_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (display_table) = val; } static inline void bset_extra_line_spacing (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (extra_line_spacing) = val; } static inline void bset_file_format (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (file_format) = val; } static inline void bset_file_truename (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (file_truename) = val; } static inline void bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (fringe_cursor_alist) = val; } static inline void bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (fringe_indicator_alist) = val; } static inline void bset_fringes_outside_margins (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (fringes_outside_margins) = val; } static inline void bset_header_line_format (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (header_line_format) = val; } static inline void bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (indicate_buffer_boundaries) = val; } static inline void bset_indicate_empty_lines (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (indicate_empty_lines) = val; } static inline void bset_invisibility_spec (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (invisibility_spec) = val; } static inline void bset_left_fringe_width (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (left_fringe_width) = val; } static inline void bset_major_mode (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (major_mode) = val; } static inline void bset_mark (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (mark) = val; } static inline void bset_minor_modes (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (minor_modes) = val; } static inline void bset_mode_line_format (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (mode_line_format) = val; } static inline void bset_mode_name (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (mode_name) = val; } static inline void bset_name (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (name) = val; } static inline void bset_overwrite_mode (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (overwrite_mode) = val; } static inline void bset_pt_marker (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (pt_marker) = val; } static inline void bset_right_fringe_width (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (right_fringe_width) = val; } static inline void bset_save_length (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (save_length) = val; } static inline void bset_scroll_bar_width (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (scroll_bar_width) = val; } static inline void bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (scroll_down_aggressively) = val; } static inline void bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (scroll_up_aggressively) = val; } static inline void bset_selective_display (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (selective_display) = val; } static inline void bset_selective_display_ellipses (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (selective_display_ellipses) = val; } static inline void bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (vertical_scroll_bar_type) = val; } static inline void bset_word_wrap (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (word_wrap) = val; } static inline void bset_zv_marker (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (zv_marker) = val; } @@ -1673,6 +1717,17 @@ void compact_buffer (struct buffer *buffer) { + struct Lisp_Marker *m; + + /* FIXME: hunting for the dead/broken markers... */ + for (m = BUF_MARKERS (buffer); m; m = m->next) + { + if (m->buffer != buffer) + abort (); + if (m->gcinfo.gctype == GC_FREE) + abort (); + } + /* Verify indirection counters. */ if (buffer->base_buffer) { @@ -5119,7 +5174,9 @@ reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ buffer_defaults.text = &buffer_defaults.own_text; + gengc_init (&buffer_defaults.header.gcinfo, GC_OBJ_VECTOR, GC_NEW); buffer_local_symbols.text = &buffer_local_symbols.own_text; + gengc_init (&buffer_local_symbols.header.gcinfo, GC_OBJ_VECTOR, GC_NEW); /* No one will share the text with these buffers, but let's play it safe. */ buffer_defaults.indirections = 0; buffer_local_symbols.indirections = 0; @@ -5380,6 +5437,9 @@ struct Lisp_Symbol *sym; int offset; + /* FIXME: do we need this? */ + gengc_record_address (address); + sym = XSYMBOL (intern (namestring)); offset = (char *)address - (char *)current_buffer; === modified file 'src/buffer.h' --- src/buffer.h 2012-08-28 06:20:08 +0000 +++ src/buffer.h 2012-09-03 10:00:48 +0000 @@ -866,96 +866,115 @@ BUFFER_INLINE void bset_bidi_paragraph_direction (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (bidi_paragraph_direction) = val; } BUFFER_INLINE void bset_case_canon_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (case_canon_table) = val; } BUFFER_INLINE void bset_case_eqv_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (case_eqv_table) = val; } BUFFER_INLINE void bset_directory (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (directory) = val; } BUFFER_INLINE void bset_display_count (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (display_count) = val; } BUFFER_INLINE void bset_display_time (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (display_time) = val; } BUFFER_INLINE void bset_downcase_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (downcase_table) = val; } BUFFER_INLINE void bset_enable_multibyte_characters (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (enable_multibyte_characters) = val; } BUFFER_INLINE void bset_filename (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (filename) = val; } BUFFER_INLINE void bset_keymap (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (keymap) = val; } BUFFER_INLINE void bset_last_selected_window (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (last_selected_window) = val; } BUFFER_INLINE void bset_local_var_alist (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (local_var_alist) = val; } BUFFER_INLINE void bset_mark_active (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (mark_active) = val; } BUFFER_INLINE void bset_point_before_scroll (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (point_before_scroll) = val; } BUFFER_INLINE void bset_read_only (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (read_only) = val; } BUFFER_INLINE void bset_truncate_lines (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (truncate_lines) = val; } BUFFER_INLINE void bset_undo_list (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (undo_list) = val; } BUFFER_INLINE void bset_upcase_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (upcase_table) = val; } BUFFER_INLINE void bset_width_table (struct buffer *b, Lisp_Object val) { + VECTOR_BARRIER (b, val); b->INTERNAL_FIELD (width_table) = val; } @@ -1085,6 +1104,8 @@ set_buffer_intervals (struct buffer *b, INTERVAL i) { eassert (b->text != NULL); + if (i && gengc_write_barrier (&b->header.gcinfo, interval_gc_info (i))) + gengc_record_interval (i); b->text->intervals = i; } @@ -1238,6 +1259,7 @@ BUFFER_INLINE void set_per_buffer_default (int offset, Lisp_Object value) { + VECTOR_BARRIER (&buffer_defaults, value); *(Lisp_Object *)(offset + (char *) &buffer_defaults) = value; } @@ -1253,6 +1275,7 @@ BUFFER_INLINE void set_per_buffer_value (struct buffer *b, int offset, Lisp_Object value) { + VECTOR_BARRIER (b, value); *(Lisp_Object *)(offset + (char *) b) = value; } === modified file 'src/data.c' --- src/data.c 2012-08-27 17:23:48 +0000 +++ src/data.c 2012-09-04 11:46:07 +0000 @@ -891,6 +891,8 @@ break; case Lisp_Fwd_Obj: + /* FIXME: do we need this? */ + gengc_record_address (XOBJFWD (valcontents)->objvar); *XOBJFWD (valcontents)->objvar = newval; /* If this variable is a default for something stored === modified file 'src/fns.c' --- src/fns.c 2012-09-01 01:04:26 +0000 +++ src/fns.c 2012-09-04 12:26:33 +0000 @@ -3824,6 +3824,7 @@ ptrdiff_t start_of_bucket, i; eassert ((hash & ~INTMASK) == 0); + eassert (h->header.gcinfo.gctype != GC_FREE); /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); @@ -4050,7 +4051,12 @@ { next = h->next_weak; - if (h->header.size & ARRAY_MARK_FLAG) + if (!gengc_sweep (&h->header.gcinfo)) + { + h->next_weak = used; + used = h; + } + else if (h->header.size & ARRAY_MARK_FLAG) { /* TABLE is marked as used. Sweep its contents. */ if (h->count > 0) === modified file 'src/frame.c' --- src/frame.c 2012-09-01 06:38:52 +0000 +++ src/frame.c 2012-09-03 03:49:39 +0000 @@ -124,11 +124,13 @@ static inline void fset_buffer_predicate (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->buffer_predicate = val; } static inline void fset_minibuffer_window (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->minibuffer_window = val; } === modified file 'src/frame.h' --- src/frame.h 2012-09-01 06:38:52 +0000 +++ src/frame.h 2012-09-03 03:49:39 +0000 @@ -505,101 +505,121 @@ FRAME_INLINE void fset_buffer_list (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->buffer_list = val; } FRAME_INLINE void fset_buried_buffer_list (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->buried_buffer_list = val; } FRAME_INLINE void fset_condemned_scroll_bars (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->condemned_scroll_bars = val; } FRAME_INLINE void fset_current_tool_bar_string (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->current_tool_bar_string = val; } FRAME_INLINE void fset_desired_tool_bar_string (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->desired_tool_bar_string = val; } FRAME_INLINE void fset_face_alist (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->face_alist = val; } FRAME_INLINE void fset_focus_frame (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->focus_frame = val; } FRAME_INLINE void fset_icon_name (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->icon_name = val; } FRAME_INLINE void fset_menu_bar_items (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->menu_bar_items = val; } FRAME_INLINE void fset_menu_bar_vector (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->menu_bar_vector = val; } FRAME_INLINE void fset_menu_bar_window (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->menu_bar_window = val; } FRAME_INLINE void fset_name (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->name = val; } FRAME_INLINE void fset_param_alist (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->param_alist = val; } FRAME_INLINE void fset_root_window (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->root_window = val; } FRAME_INLINE void fset_scroll_bars (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->scroll_bars = val; } FRAME_INLINE void fset_selected_window (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->selected_window = val; } FRAME_INLINE void fset_title (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->title = val; } FRAME_INLINE void fset_tool_bar_items (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->tool_bar_items = val; } FRAME_INLINE void fset_tool_bar_position (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->tool_bar_position = val; } FRAME_INLINE void fset_tool_bar_window (struct frame *f, Lisp_Object val) { + VECTOR_BARRIER (f, val); f->tool_bar_window = val; } === modified file 'src/intervals.c' --- src/intervals.c 2012-08-18 06:06:39 +0000 +++ src/intervals.c 2012-09-03 10:52:05 +0000 @@ -59,9 +59,15 @@ static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object); static INTERVAL merge_interval_right (INTERVAL); static INTERVAL reproduce_tree (INTERVAL, INTERVAL); - + /* Utility functions for intervals. */ +struct gc_info * ATTRIBUTE_CONST +interval_gc_info (INTERVAL i) +{ + return &i->gcinfo; +} + /* Use these functions to set Lisp_Object or pointer slots of struct interval. */ @@ -69,6 +75,7 @@ set_interval_object (INTERVAL i, Lisp_Object obj) { eassert (BUFFERP (obj) || STRINGP (obj)); + PTR_BARRIER (i, obj); i->up_obj = 1; i->up.obj = obj; } @@ -76,12 +83,14 @@ static inline void set_interval_left (INTERVAL i, INTERVAL left) { + INTERVAL_BARRIER (i, left); i->left = left; } static inline void set_interval_right (INTERVAL i, INTERVAL right) { + INTERVAL_BARRIER (i, right); i->right = right; } @@ -91,6 +100,10 @@ static inline void copy_interval_parent (INTERVAL d, INTERVAL s) { + if (s->up_obj) + PTR_BARRIER (d, s->up.obj); + else + INTERVAL_BARRIER (d, s->up.interval); d->up = s->up; d->up_obj = s->up_obj; } @@ -981,6 +994,8 @@ Lisp_Object pleft, pright; struct interval newi; + gengc_init (&newi.gcinfo, GC_OBJ_NONLISP, GC_NEW); + RESET_INTERVAL (&newi); pleft = prev ? prev->plist : Qnil; pright = i ? i->plist : Qnil; @@ -1002,6 +1017,7 @@ merge_interval_right (prev); } + gengc_exit (&newi.gcinfo); /* We will need to update the cache here later. */ } else if (! prev && ! NILP (i->plist)) === modified file 'src/intervals.h' --- src/intervals.h 2012-08-17 21:12:11 +0000 +++ src/intervals.h 2012-09-03 05:22:28 +0000 @@ -59,6 +59,7 @@ before this interval goes into it. */ unsigned int rear_sticky : 1; /* Likewise for just after it. */ Lisp_Object plist; /* Other properties. */ + struct gc_info gcinfo; /* Used by gengc. */ }; /* These are macros for dealing with the interval tree. */ @@ -133,12 +134,21 @@ #define GET_INTERVAL_OBJECT(d,s) (eassert ((s)->up_obj == 1), (d) = (s)->up.obj) +/* Special write barrier for interval objects. */ + +#define INTERVAL_BARRIER(ptr1, ptr2) \ + do { \ + if (ptr2 && gengc_write_barrier (&(ptr1)->gcinfo, &(ptr2)->gcinfo)) \ + gengc_record_interval (ptr2); \ + } while (0) + /* Use these functions to set Lisp_Object or pointer slots of struct interval. */ INTERVALS_INLINE void set_interval_parent (INTERVAL i, INTERVAL parent) { + INTERVAL_BARRIER (i, parent); i->up_obj = 0; i->up.interval = parent; } @@ -146,6 +156,7 @@ INTERVALS_INLINE void set_interval_plist (INTERVAL i, Lisp_Object plist) { + PTR_BARRIER (i, plist); i->plist = plist; } === modified file 'src/keyboard.c' --- src/keyboard.c 2012-09-01 06:38:52 +0000 +++ src/keyboard.c 2012-09-04 12:30:32 +0000 @@ -11296,6 +11296,7 @@ void init_kboard (KBOARD *kb) { + gengc_init (&kb->gcinfo, GC_OBJ_NONLISP, GC_NEW); kset_overriding_terminal_local_map (kb, Qnil); kset_last_command (kb, Qnil); kset_real_last_command (kb, Qnil); @@ -11330,6 +11331,7 @@ static void wipe_kboard (KBOARD *kb) { + gengc_exit (&kb->gcinfo); xfree (kb->kbd_macro_buffer); } @@ -12288,6 +12290,12 @@ Lisp_Object *p; for (kb = all_kboards; kb; kb = kb->next_kboard) { + /* Since there is no sweep for keyboards, account them here. */ + /* FIXME: consider gengc_collect (&kb->gcinfo) here! */ + + /* This keyboard is live, promote it to old generation. */ + gengc_promote (&kb->gcinfo); + if (kb->kbd_macro_buffer) for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) mark_object (*p); === modified file 'src/keyboard.h' --- src/keyboard.h 2012-09-01 06:38:52 +0000 +++ src/keyboard.h 2012-09-03 03:23:48 +0000 @@ -74,6 +74,9 @@ { KBOARD *next_kboard; + /* Used by gengc. */ + struct gc_info gcinfo; + /* If non-nil, a keymap that overrides all others but applies only to this KBOARD. Lisp code that uses this instead of calling read-char can effectively wait for input in the any-kboard state, and hence === modified file 'src/lisp.h' --- src/lisp.h 2012-09-01 01:04:26 +0000 +++ src/lisp.h 2012-09-04 12:35:51 +0000 @@ -603,12 +603,11 @@ #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) /* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -#define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) +extern Lisp_Object aref (Lisp_Object, ptrdiff_t); +extern void aset (Lisp_Object, ptrdiff_t, Lisp_Object); +#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size +#define AREF(ARRAY, IDX) aref ((ARRAY), (IDX)) +#define ASET(ARRAY, IDX, VAL) aset ((ARRAY), (IDX), (VAL)) /* Convenience macros for dealing with Lisp strings. */ @@ -636,6 +635,46 @@ #define INTERNAL_FIELD(field) field ## _ +/* Per-object GC type. */ + +enum gc_type + { + GC_PURE, + GC_FREE, + GC_OLD, + GC_NEW + }; + +/* Type of struct gc_info owner. */ + +enum gc_obj_type + { + GC_OBJ_FREE, + GC_OBJ_NONLISP, + GC_OBJ_SYMBOL, + GC_OBJ_MISC, + GC_OBJ_STRING, + GC_OBJ_VECTOR, + GC_OBJ_CONS, + GC_OBJ_FLOAT + }; + +struct gc_info +{ + /* Type, one from the above. Extra bits + are useful to catch invalid values. */ + ENUM_BF (gc_type) gctype : 5; + + /* Owner type. */ + ENUM_BF (gc_obj_type) objtype : 5; + + /* Used to obtain collection data just once per object. */ + unsigned account : 1; + + /* How many GCs this object survived. */ + int generation : 21; +}; + /* See the macros in intervals.h. */ typedef struct interval *INTERVAL; @@ -657,30 +696,22 @@ /* Used to chain conses on a free list. */ struct Lisp_Cons *chain; } u; + + /* Used by gengc. */ + struct gc_info gcinfo; }; /* Take the car or cdr of something known to be a cons cell. */ -/* The _AS_LVALUE macros shouldn't be used outside of the minimal set - of code that has to know what a cons cell looks like. Other code not - part of the basic lisp implementation should assume that the car and cdr - fields are not accessible as lvalues. (What if we want to switch to - a copying collector someday? Cached cons cell field addresses may be - invalidated at arbitrary points.) */ -#define XCAR_AS_LVALUE(c) (XCONS (c)->car) -#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) - -/* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) - -/* Use these to set the fields of a cons cell. - - Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) +extern Lisp_Object xcar (Lisp_Object); +extern Lisp_Object xcdr (Lisp_Object); +#define XCAR(c) xcar ((c)) +#define XCDR(c) xcdr ((c)) + +/* Use these to set the fields of a cons cell. */ +extern void setcar (Lisp_Object, Lisp_Object); +extern void setcdr (Lisp_Object, Lisp_Object); +#define XSETCAR(c,n) setcar ((c), (n)) +#define XSETCDR(c,n) setcdr ((c), (n)) /* Take the car or cdr of something whose type is not known. */ #define CAR(c) \ @@ -759,6 +790,8 @@ ptrdiff_t size_byte; INTERVAL intervals; /* Text properties in this string. */ unsigned char *data; + /* Used by gengc. */ + struct gc_info gcinfo; }; /* Header of vector-like objects. This documents the layout constraints on @@ -807,6 +840,9 @@ empty vector is handled specially anyway. */ struct Lisp_Vector *vector; } next; + + /* Used by gengc. */ + struct gc_info gcinfo; }; /* Regular vector is just a header plus array of Lisp_Objects. */ @@ -1095,6 +1131,9 @@ /* Next symbol in obarray bucket, if the symbol is interned. */ struct Lisp_Symbol *next; + + /* Used by gengc. */ + struct gc_info gcinfo; }; /* Value is name of symbol. */ @@ -1107,14 +1146,11 @@ (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) #define SYMBOL_FWD(sym) \ (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) + +#define SET_SYMBOL_VAL(sym, v) set_symbol_val (sym, v) +#define SET_SYMBOL_ALIAS(sym, a) set_symbol_alias (sym, a) +#define SET_SYMBOL_BLV(sym, b) set_symbol_blv (sym, b) +#define SET_SYMBOL_FWD(sym, f) set_symbol_fwd (sym, f) #define SYMBOL_NAME(sym) XSYMBOL (sym)->name @@ -1272,6 +1308,8 @@ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ unsigned gcmarkbit : 1; int spacer : 15; + /* Used by gengc. */ + struct gc_info gcinfo; }; struct Lisp_Marker @@ -1286,6 +1324,8 @@ /* 1 means normal insertion at the marker's position leaves the marker after the inserted text. */ unsigned int insertion_type : 1; + /* Used by gengc. */ + struct gc_info gcinfo; /* This is the buffer that the marker points into, or 0 if it points nowhere. Note: a chain of markers can contain markers pointing into different buffers (the chain is per buffer_text rather than per buffer, so it's @@ -1333,6 +1373,8 @@ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */ unsigned gcmarkbit : 1; int spacer : 15; + /* Used by gengc. */ + struct gc_info gcinfo; struct Lisp_Overlay *next; Lisp_Object start; Lisp_Object end; @@ -1345,10 +1387,15 @@ { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ unsigned gcmarkbit : 1; - int spacer : 14; + int spacer : 12; /* If DOGC is set, POINTER is the address of a memory area containing INTEGER potential Lisp_Objects. */ unsigned int dogc : 1; + /* (Ab)used by gengc: 1 means saved interval pointer, + 2 means saved Lisp_Object pointer. */ + unsigned int savetype : 2; + /* Used by gengc. */ + struct gc_info gcinfo; void *pointer; ptrdiff_t integer; }; @@ -1360,6 +1407,8 @@ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ unsigned gcmarkbit : 1; int spacer : 15; + /* Used by gengc. */ + struct gc_info gcinfo; union Lisp_Misc *chain; }; @@ -1462,6 +1511,8 @@ Also if the currently loaded binding is the default binding, then this is `eq'ual to defcell. */ Lisp_Object valcell; + /* Used by gengc. */ + struct gc_info gcinfo; }; /* Like Lisp_Objfwd except that value lives in a slot in the @@ -1489,6 +1540,8 @@ double data; struct Lisp_Float *chain; } u; + /* Used by gengc. */ + struct gc_info gcinfo; }; #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) @@ -2321,11 +2374,135 @@ struct window; struct frame; +/* New GC API. */ + +extern void gengc_init (struct gc_info *, enum gc_obj_type, enum gc_type); +extern void gengc_exit (struct gc_info *); +extern void gengc_collect (struct gc_info *); +extern void gengc_promote (struct gc_info *); +extern void gengc_record_interval (INTERVAL); +extern void gengc_record_object (Lisp_Object); +extern void gengc_interval_pointer (INTERVAL); +extern void gengc_record_address (Lisp_Object *); +extern int gengc_write_barrier (struct gc_info *, struct gc_info *); +extern void gengc_object_write_barrier (Lisp_Object, Lisp_Object); +extern bool gengc_sweep (struct gc_info *); + +/* Get GC info from object. */ + +LISP_INLINE struct gc_info * +get_gc_info (Lisp_Object obj) +{ + /* Omit uncollectable objects. */ + if (INTEGERP (obj) || SUBRP (obj)) + return NULL; + + /* Now get per-object GC info. */ + switch (XTYPE (obj)) + { + case Lisp_Cons: + return &(XCONS (obj)->gcinfo); + + case Lisp_String: + return &(XSTRING (obj)->gcinfo); + + case Lisp_Vectorlike: + return &(XVECTOR (obj)->header.gcinfo); + + case Lisp_Float: + return &(XFLOAT (obj)->gcinfo); + + case Lisp_Symbol: + return &(XSYMBOL (obj)->gcinfo); + + case Lisp_Misc: + return &(XMISCANY (obj)->gcinfo); + + default: + abort (); + } +} + +/* Get Lisp_Object this GC info belongs to. */ + +LISP_INLINE Lisp_Object +get_gc_info_obj (struct gc_info *g) +{ + Lisp_Object obj; + + eassert (g != NULL); + + switch (g->objtype) + { + case GC_OBJ_SYMBOL: + XSETSYMBOL (obj, (char *) g - offsetof (struct Lisp_Symbol, gcinfo)); + break; + + case GC_OBJ_MISC: + XSETMISC (obj, (char *) g - offsetof (struct Lisp_Misc_Any, gcinfo)); + break; + + case GC_OBJ_STRING: + XSETSTRING (obj, (char *) g - offsetof (struct Lisp_String, gcinfo)); + break; + + case GC_OBJ_VECTOR: + { + struct Lisp_Vector *v; + ptrdiff_t pvectype; + + v = (struct Lisp_Vector *) + ((char *) g - offsetof (struct Lisp_Vector, header.gcinfo)); + + if (v->header.size & PSEUDOVECTOR_FLAG) + pvectype = ((v->header.size & PVEC_TYPE_MASK) + >> PSEUDOVECTOR_SIZE_BITS); + else + pvectype = 0; + + if (pvectype == PVEC_FREE || pvectype == PVEC_SUBR) + XSETINT (obj, -1); + else if (pvectype) + XSETPSEUDOVECTOR (obj, v, pvectype); + else + XSETVECTOR (obj, v); + } + break; + + case GC_OBJ_CONS: + XSETCONS (obj, (char *) g - offsetof (struct Lisp_Cons, gcinfo)); + break; + + case GC_OBJ_FLOAT: + XSETFLOAT (obj, (char *) g - offsetof (struct Lisp_Float, gcinfo)); + break; + + default: + XSETINT (obj, -1); + break; + } + + return obj; +} + +#define PTR_BARRIER(ptr, obj) \ + do { \ + if (gengc_write_barrier (&(ptr)->gcinfo, get_gc_info (obj))) \ + gengc_record_object (obj); \ + } while (0) + +#define VECTOR_BARRIER(vec, obj) \ + do { \ + if (gengc_write_barrier (&(vec)->header.gcinfo, get_gc_info (obj))) \ + gengc_record_object (obj); \ + } while (0) + /* Simple access functions. */ LISP_INLINE Lisp_Object * aref_addr (Lisp_Object array, ptrdiff_t idx) { + gengc_record_address (XVECTOR (array)->contents + idx); return & XVECTOR (array)->contents[idx]; } @@ -2335,7 +2512,7 @@ /* Like ASET, but also can be used in the garbage collector: sweep_weak_table calls set_hash_key etc. while the table is marked. */ eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); - XVECTOR (array)->contents[idx] = val; + aset (array, idx, val); } /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ @@ -2343,8 +2520,11 @@ LISP_INLINE void vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count) { + ptrdiff_t i; + eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v)); - memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args); + for (i = 0; i < count; i++) + aset (v, offset + i, args[i]); } /* Functions to modify hash tables. */ @@ -2352,6 +2532,7 @@ LISP_INLINE void set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) { + VECTOR_BARRIER (h, key_and_value); h->key_and_value = key_and_value; } @@ -2370,6 +2551,7 @@ LISP_INLINE void set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) { + VECTOR_BARRIER (h, next); h->next = next; } @@ -2382,6 +2564,7 @@ LISP_INLINE void set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) { + VECTOR_BARRIER (h, hash); h->hash = hash; } @@ -2394,6 +2577,7 @@ LISP_INLINE void set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) { + VECTOR_BARRIER (h, index); h->index = index; } @@ -2409,27 +2593,77 @@ LISP_INLINE void set_symbol_name (Lisp_Object sym, Lisp_Object name) { + gengc_object_write_barrier (sym, name); XSYMBOL (sym)->name = name; } LISP_INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { + gengc_object_write_barrier (sym, function); XSYMBOL (sym)->function = function; } LISP_INLINE void set_symbol_plist (Lisp_Object sym, Lisp_Object plist) { + gengc_object_write_barrier (sym, plist); XSYMBOL (sym)->plist = plist; } LISP_INLINE void set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) { + if (next && gengc_write_barrier (&XSYMBOL (sym)->gcinfo, &next->gcinfo)) + { Lisp_Object tem; XSETSYMBOL (tem, next); gengc_record_object (tem); } + XSYMBOL (sym)->next = next; } +LISP_INLINE void +set_symbol_val (struct Lisp_Symbol *sym, Lisp_Object val) +{ + eassert (sym->redirect == SYMBOL_PLAINVAL); + PTR_BARRIER (sym, val); + sym->val.value = val; +} + +LISP_INLINE void +set_symbol_alias (struct Lisp_Symbol *sym, struct Lisp_Symbol *alias) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + + if (alias && gengc_write_barrier (&sym->gcinfo, &alias->gcinfo)) + { Lisp_Object tem; XSETSYMBOL (tem, alias); gengc_record_object (tem); } + + sym->val.alias = alias; +} + +LISP_INLINE void +set_symbol_blv (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *blv) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + + if (blv && sym->gcinfo.gctype == GC_OLD) + { + gengc_record_address (&blv->where); + gengc_record_address (&blv->valcell); + gengc_record_address (&blv->defcell); + } + sym->val.blv = blv; +} + +LISP_INLINE void +set_symbol_fwd (struct Lisp_Symbol *sym, union Lisp_Fwd *fwd) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + + if (fwd && sym->gcinfo.gctype == GC_OLD && XFWDTYPE (fwd) == Lisp_Fwd_Obj) + gengc_record_address (fwd->u_objfwd.objvar); + + sym->val.fwd = fwd; +} + /* Buffer-local (also frame-local) variable access functions. */ LISP_INLINE int @@ -2455,24 +2689,28 @@ LISP_INLINE void set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) { + /* FIXME: handled by cons cell write barrier? */ XSETCDR (blv->valcell, val); } LISP_INLINE void set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) { + gengc_record_address (&blv->where); blv->where = val; } LISP_INLINE void set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) { + gengc_record_address (&blv->defcell); blv->defcell = val; } LISP_INLINE void set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) { + gengc_record_address (&blv->valcell); blv->valcell = val; } @@ -2481,6 +2719,7 @@ LISP_INLINE void set_overlay_plist (Lisp_Object overlay, Lisp_Object plist) { + gengc_object_write_barrier (overlay, plist); XOVERLAY (overlay)->plist = plist; } @@ -2494,9 +2733,13 @@ /* Set text properties of S to I. */ +extern struct gc_info * interval_gc_info (INTERVAL); + LISP_INLINE void set_string_intervals (Lisp_Object s, INTERVAL i) { + if (i && gengc_write_barrier (&XSTRING (s)->gcinfo, interval_gc_info (i))) + gengc_record_interval (i); XSTRING (s)->intervals = i; } @@ -2506,21 +2749,25 @@ LISP_INLINE void set_char_table_ascii (Lisp_Object table, Lisp_Object val) { + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->ascii = val; } LISP_INLINE void set_char_table_defalt (Lisp_Object table, Lisp_Object val) { + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->defalt = val; } LISP_INLINE void set_char_table_parent (Lisp_Object table, Lisp_Object val) { + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->parent = val; } LISP_INLINE void set_char_table_purpose (Lisp_Object table, Lisp_Object val) { + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->purpose = val; } @@ -2530,6 +2777,7 @@ set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) { eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table))); + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->extras[idx] = val; } @@ -2537,12 +2785,14 @@ set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) { eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0)); + gengc_object_write_barrier (table, val); XCHAR_TABLE (table)->contents[idx] = val; } LISP_INLINE void set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) { + gengc_object_write_barrier (table, val); XSUB_CHAR_TABLE (table)->contents[idx] = val; } === modified file 'src/process.c' --- src/process.c 2012-09-01 06:38:52 +0000 +++ src/process.c 2012-09-03 03:49:39 +0000 @@ -342,81 +342,97 @@ static inline void pset_buffer (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->buffer = val; } static inline void pset_command (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->command = val; } static inline void pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->decode_coding_system = val; } static inline void pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->decoding_buf = val; } static inline void pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->encode_coding_system = val; } static inline void pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->encoding_buf = val; } static inline void pset_filter (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->filter = val; } static inline void pset_log (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->log = val; } static inline void pset_mark (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->mark = val; } static inline void pset_name (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->name = val; } static inline void pset_plist (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->plist = val; } static inline void pset_sentinel (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->sentinel = val; } static inline void pset_status (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->status = val; } static inline void pset_tty_name (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->tty_name = val; } static inline void pset_type (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->type = val; } static inline void pset_write_queue (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->write_queue = val; } === modified file 'src/process.h' --- src/process.h 2012-08-27 17:23:48 +0000 +++ src/process.h 2012-09-03 03:49:39 +0000 @@ -171,6 +171,7 @@ PROCESS_INLINE void pset_childp (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->childp = val; } @@ -178,6 +179,7 @@ PROCESS_INLINE void pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val) { + VECTOR_BARRIER (p, val); p->gnutls_cred_type = val; } #endif === modified file 'src/puresize.h' --- src/puresize.h 2012-06-27 21:15:13 +0000 +++ src/puresize.h 2012-09-03 03:28:05 +0000 @@ -40,7 +40,7 @@ #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1620000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (1920000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ === modified file 'src/termhooks.h' --- src/termhooks.h 2012-08-18 00:07:52 +0000 +++ src/termhooks.h 2012-09-03 09:05:56 +0000 @@ -637,11 +637,13 @@ TERMHOOKS_INLINE void tset_charset_list (struct terminal *t, Lisp_Object val) { + VECTOR_BARRIER (t, val); t->charset_list = val; } TERMHOOKS_INLINE void tset_selection_alist (struct terminal *t, Lisp_Object val) { + VECTOR_BARRIER (t, val); t->Vselection_alist = val; } === modified file 'src/terminal.c' --- src/terminal.c 2012-08-18 00:07:52 +0000 +++ src/terminal.c 2012-09-03 09:05:05 +0000 @@ -46,6 +46,7 @@ static inline void tset_param_alist (struct terminal *t, Lisp_Object val) { + VECTOR_BARRIER (t, val); t->param_alist = val; } === modified file 'src/window.c' --- src/window.c 2012-08-28 16:01:59 +0000 +++ src/window.c 2012-09-03 03:49:39 +0000 @@ -138,111 +138,133 @@ static inline void wset_combination_limit (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->combination_limit = val; } static inline void wset_dedicated (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->dedicated = val; } static inline void wset_display_table (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->display_table = val; } static inline void wset_hchild (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->hchild = val; } static inline void wset_left_fringe_width (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->left_fringe_width = val; } static inline void wset_left_margin_cols (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->left_margin_cols = val; } static inline void wset_new_normal (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->new_normal = val; } static inline void wset_new_total (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->new_total = val; } static inline void wset_next_buffers (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->next_buffers = val; } static inline void wset_normal_cols (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->normal_cols = val; } static inline void wset_normal_lines (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->normal_lines = val; } static inline void wset_parent (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->parent = val; } static inline void wset_pointm (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->pointm = val; } static inline void wset_prev_buffers (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->prev_buffers = val; } static inline void wset_right_fringe_width (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->right_fringe_width = val; } static inline void wset_right_margin_cols (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->right_margin_cols = val; } static inline void wset_scroll_bar_width (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->scroll_bar_width = val; } static inline void wset_start (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->start = val; } static inline void wset_temslot (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->temslot = val; } static inline void wset_vchild (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->vchild = val; } static inline void wset_vertical_scroll_bar_type (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->vertical_scroll_bar_type = val; } static inline void wset_window_parameters (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->window_parameters = val; } === modified file 'src/window.h' --- src/window.h 2012-08-26 10:04:27 +0000 +++ src/window.h 2012-09-03 03:49:39 +0000 @@ -354,66 +354,79 @@ WINDOW_INLINE void wset_buffer (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->buffer = val; } WINDOW_INLINE void wset_frame (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->frame = val; } WINDOW_INLINE void wset_left_col (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->left_col = val; } WINDOW_INLINE void wset_next (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->next = val; } WINDOW_INLINE void wset_prev (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->prev = val; } WINDOW_INLINE void wset_redisplay_end_trigger (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->redisplay_end_trigger = val; } WINDOW_INLINE void wset_top_line (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->top_line = val; } WINDOW_INLINE void wset_total_cols (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->total_cols = val; } WINDOW_INLINE void wset_total_lines (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->total_lines = val; } WINDOW_INLINE void wset_vertical_scroll_bar (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->vertical_scroll_bar = val; } WINDOW_INLINE void wset_window_end_pos (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->window_end_pos = val; } WINDOW_INLINE void wset_window_end_valid (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->window_end_valid = val; } WINDOW_INLINE void wset_window_end_vpos (struct window *w, Lisp_Object val) { + VECTOR_BARRIER (w, val); w->window_end_vpos = val; }