* [RFC] proof-of-concept generational GC survives the bootstrap
@ 2012-09-04 15:03 Dmitry Antipov
2012-09-05 9:43 ` martin rudalics
0 siblings, 1 reply; 4+ messages in thread
From: Dmitry Antipov @ 2012-09-04 15:03 UTC (permalink / raw)
To: Emacs development discussions
[-- Attachment #1: Type: text/plain, Size: 1919 bytes --]
This is a patch against bzr trunk 109851, ant it passes the full
bootstrap for me. It's also alive with basic editing operations,
but most probably will crash quite soon. There isn't too much
comments yet, so I tried to write some notices below.
* Object life cycle
Each object contains 'struct gc_info' which is used to store
additional object information. Allocation routines should call
gengc_init to initialize 'gcinfo' slot of the object; it should
specify correct GC_OBJ_xxx type and one of GC_NEW (if object will
be immediately used) or GC_FREE (if the object will join a free
list). If an object survives the GC, gengc_promote should be
called to adjust object as GC_OLD; if an object dies, gengc_exit
should be called for it.
* Write barrier
The main routine is gengc_write_barrier; convenient wrappers
are gengc_object_write_barrier and PTR_BARRIER/VECTOR_BARRIER
macros. Inter-generational objects are stored in gengc_objects
without duplications; to record special values, Lisp_Misc_Save_Value
is (ab)used to hold either interval pointer or Lisp_Object address.
The last one (via gengc_record_address) is used when an Lisp_Object
slot's address is obtained; since we can't assume what object type
will be written to it (and whether something will be written at all),
we conservatively assume that GC_NEW object will be written to
this slot of GC_OLD object, and so the slot is a subject for marking
traversal during generational collection.
* Mark/sweep
Collection scheduling is fairly simple: each odd collection is
generational, and each even collection is full. During generational
collection, only GC_NEW objects are marked with mark_object; the
same applies to sweeping (gengc_sweep controls it); gengc_collect
tries to collect some statistics about objects (set EMACS_GENGC_VERBOSE
environment variable to see it).
Dmitry
[-- Attachment #2: gengc.patch --]
[-- Type: text/plain, Size: 75172 bytes --]
=== 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)))
-
-\f
+/* 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);
-\f
+
/* 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;
}
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [RFC] proof-of-concept generational GC survives the bootstrap
2012-09-04 15:03 [RFC] proof-of-concept generational GC survives the bootstrap Dmitry Antipov
@ 2012-09-05 9:43 ` martin rudalics
2012-09-05 16:29 ` Eli Zaretskii
0 siblings, 1 reply; 4+ messages in thread
From: martin rudalics @ 2012-09-05 9:43 UTC (permalink / raw)
To: Dmitry Antipov; +Cc: Emacs development discussions
> This is a patch against bzr trunk 109851, ant it passes the full
> bootstrap for me. It's also alive with basic editing operations,
> but most probably will crash quite soon. There isn't too much
> comments yet, so I tried to write some notices below.
As soon as you get a fairly reliable version ready, please make
it a branch. I will try it then for less critical work.
Thanks, martin
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [RFC] proof-of-concept generational GC survives the bootstrap
2012-09-05 9:43 ` martin rudalics
@ 2012-09-05 16:29 ` Eli Zaretskii
2012-09-05 17:59 ` martin rudalics
0 siblings, 1 reply; 4+ messages in thread
From: Eli Zaretskii @ 2012-09-05 16:29 UTC (permalink / raw)
To: martin rudalics; +Cc: dmantipov, emacs-devel
> Date: Wed, 05 Sep 2012 11:43:24 +0200
> From: martin rudalics <rudalics@gmx.at>
> Cc: Emacs development discussions <emacs-devel@gnu.org>
>
> > This is a patch against bzr trunk 109851, ant it passes the full
> > bootstrap for me. It's also alive with basic editing operations,
> > but most probably will crash quite soon. There isn't too much
> > comments yet, so I tried to write some notices below.
>
> As soon as you get a fairly reliable version ready, please make
> it a branch. I will try it then for less critical work.
You can always make that branch locally, and apply the diffs there.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [RFC] proof-of-concept generational GC survives the bootstrap
2012-09-05 16:29 ` Eli Zaretskii
@ 2012-09-05 17:59 ` martin rudalics
0 siblings, 0 replies; 4+ messages in thread
From: martin rudalics @ 2012-09-05 17:59 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: dmantipov, emacs-devel
> You can always make that branch locally, and apply the diffs there.
But I'd eventually want the most recent fixes and do not want to
apply any merges.
martin
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2012-09-05 17:59 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-09-04 15:03 [RFC] proof-of-concept generational GC survives the bootstrap Dmitry Antipov
2012-09-05 9:43 ` martin rudalics
2012-09-05 16:29 ` Eli Zaretskii
2012-09-05 17:59 ` martin rudalics
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.