cvsuser 04/08/18 05:53:32
Modified: classes fixedpmcarray.pmc resizablepmcarray.pmc
include/parrot dod.h
src dod.c gc_ims.c resources.c
t/op gc.t
Log:
gc subsystems 5 - fix lazy DOD; write barrier
* lazy DOD with async mutators isn't really simple :)
* start putting write barriers into mutator code
* more comments and fixes
* use custom_GC_FLAG as intermediate hack for denoting black objects
Revision Changes Path
1.19 +2 -1 parrot/classes/fixedpmcarray.pmc
Index: fixedpmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedpmcarray.pmc,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- fixedpmcarray.pmc 29 Jul 2004 06:56:15 -0000 1.18
+++ fixedpmcarray.pmc 18 Aug 2004 12:53:25 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedpmcarray.pmc,v 1.18 2004/07/29 06:56:15 leo Exp $
+$Id: fixedpmcarray.pmc,v 1.19 2004/08/18 12:53:25 leo Exp $
=head1 NAME
@@ -634,6 +634,7 @@
"FixedPMCArray: index out of bounds!\n");
data = (PMC**)PMC_data(SELF);
+ DOD_WRITE_BARRIER(INTERP, SELF, data[key], src);
data[key] = src;
}
1.13 +6 -2 parrot/classes/resizablepmcarray.pmc
Index: resizablepmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/resizablepmcarray.pmc,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- resizablepmcarray.pmc 23 Jul 2004 13:26:21 -0000 1.12
+++ resizablepmcarray.pmc 18 Aug 2004 12:53:25 -0000 1.13
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resizablepmcarray.pmc,v 1.12 2004/07/23 13:26:21 leo Exp $
+$Id: resizablepmcarray.pmc,v 1.13 2004/08/18 12:53:25 leo Exp $
=head1 NAME
@@ -24,6 +24,7 @@
#include "parrot/parrot.h"
+
pmclass ResizablePMCArray extends FixedPMCArray need_ext does array {
void class_init () {
/* this should be autmatically done - probably */
@@ -152,6 +153,7 @@
*/
void set_pmc_keyed_int (INTVAL key, PMC* src) {
+ PMC **data;
/*
* TODO in python mode, only .append is allowed
*/
@@ -162,7 +164,9 @@
"ResizablePMCArray: index out of bounds!\n");
if (key >= PMC_int_val(SELF))
DYNSELF.set_integer_native(key+1);
- ((PMC**)PMC_data(SELF))[key] = src;
+ data = (PMC**)PMC_data(SELF);
+ DOD_WRITE_BARRIER(INTERP, SELF, data[key], src);
+ data[key] = src;
}
void set_pmc_keyed (PMC* key, PMC* src) {
1.18 +23 -1 parrot/include/parrot/dod.h
Index: dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- dod.h 17 Aug 2004 08:21:29 -0000 1.17
+++ dod.h 18 Aug 2004 12:53:28 -0000 1.18
@@ -1,7 +1,7 @@
/* dod.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.h,v 1.17 2004/08/17 08:21:29 leo Exp $
+ * $Id: dod.h,v 1.18 2004/08/18 12:53:28 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -71,6 +71,7 @@
int Parrot_dod_trace_children(Interp *, size_t how_many);
void Parrot_dod_sweep(Interp *, struct Small_Object_Pool *pool);
void Parrot_dod_ms_run_init(Interp *interpreter);
+void Parrot_dod_clear_live_bits(Interp*);
/* GC subsystem init functions */
void Parrot_gc_ms_init(Interp* interpreter);
@@ -78,6 +79,27 @@
/* synchron entry point, mainly for lazy sweeps */
void Parrot_dod_ims_run(Interp *interpreter, UINTVAL flags);
+void Parrot_dod_ims_wb(Interp*, PMC *, PMC *);
+/*
+ * write barrier
+ */
+#if PARROT_GC_IMS
+# define DOD_WRITE_BARRIER(interp, agg, old, new) \
+ do { \
+ if ( \
+ PObj_live_TEST(agg) && \
+ (PObj_get_FLAGS(agg) & PObj_custom_GC_FLAG) && \
+ !PObj_live_TEST(new)) { \
+ Parrot_dod_ims_wb(interp, agg, new); \
+ } \
+ } while (0)
+
+#endif
+
+#if PARROT_GC_MS
+# define DOD_WRITE_BARRIER(interp, agg, old, new)
+#endif
+
#endif /* PARROT_DOD_H_GUARD */
/*
1.127 +26 -14 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -w -r1.126 -r1.127
--- dod.c 17 Aug 2004 11:03:38 -0000 1.126
+++ dod.c 18 Aug 2004 12:53:29 -0000 1.127
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.126 2004/08/17 11:03:38 leo Exp $
+$Id: dod.c,v 1.127 2004/08/18 12:53:29 leo Exp $
=head1 NAME
@@ -279,8 +279,10 @@
if (interpreter->profile)
profile_dod_start(interpreter);
/* We have to start somewhere, the interpreter globals is a good place */
+ if (!arena_base->dod_mark_start) {
arena_base->dod_mark_start = arena_base->dod_mark_ptr =
interpreter->iglobals;
+ }
/* mark it as used */
pobject_lives(interpreter, (PObj *)interpreter->iglobals);
@@ -379,7 +381,7 @@
int
Parrot_dod_trace_children(Interp *interpreter, size_t how_many)
{
- PMC *prev = NULL, *next;
+ PMC *next;
struct Arenas *arena_base = interpreter->arena_base;
INTVAL i = 0;
UINTVAL mask = PObj_data_is_PMC_array_FLAG | PObj_custom_mark_FLAG;
@@ -400,7 +402,7 @@
profile_dod_start(interpreter);
pt_DOD_mark_root_finished(interpreter);
- for (; current != prev; current = PMC_next_for_GC(current)) {
+ for (; ; current = next) {
UINTVAL bits = PObj_get_FLAGS(current) & mask;
if (lazy_dod && arena_base->num_early_PMCs_seen >=
@@ -409,6 +411,10 @@
}
arena_base->dod_trace_ptr = current;
/*
+ * short-term hack to color objects black
+ */
+ PObj_get_FLAGS(current) |= PObj_custom_GC_FLAG;
+ /*
* clearing the flag is much more expensive then testing
*/
if (!PObj_needs_early_DOD_TEST(current)
@@ -444,14 +450,16 @@
}
}
+ next = PMC_next_for_GC(current);
+ if (next == current)
+ break;
if (--how_many == 0) {
- if (current != PMC_next_for_GC(current))
- current = PMC_next_for_GC(current);
+ current = next;
break;
}
- prev = current;
}
arena_base->dod_mark_start = current;
+ arena_base->dod_trace_ptr = NULL;
if (interpreter->profile)
profile_dod_end(interpreter, PARROT_PROF_DOD_p2);
return 1;
@@ -762,6 +770,7 @@
total_used++;
#if !ARENA_DOD_FLAGS
PObj_live_CLEAR(b);
+ PObj_get_FLAGS(b) &= ~PObj_custom_GC_FLAG;
#endif
}
else {
@@ -989,7 +998,7 @@
/*
-=item C<static void clear_live_bits(Parrot_Interp interpreter)>
+=item C<static void Parrot_dod_clear_live_bits(Parrot_Interp interpreter)>
Run through all PMC arenas and clear live bits.
@@ -997,8 +1006,9 @@
*/
-static void
-clear_live_bits(Parrot_Interp interpreter)
+void Parrot_dod_clear_live_bits(Parrot_Interp interpreter);
+void
+Parrot_dod_clear_live_bits(Parrot_Interp interpreter)
{
struct Small_Object_Pool *pool = interpreter->arena_base->pmc_pool;
struct Small_Object_Arena *arena;
@@ -1098,6 +1108,7 @@
int j;
arena_base->dod_trace_ptr = NULL;
+ arena_base->dod_mark_start = NULL;
arena_base->num_early_PMCs_seen = 0;
arena_base->num_extended_PMCs = 0;
#if ARENA_DOD_FLAGS
@@ -1139,6 +1150,8 @@
/* Now go trace the PMCs */
if (trace_active_PMCs(interpreter, flags & DOD_trace_stack_FLAG)) {
+ arena_base->dod_trace_ptr = NULL;
+ arena_base->dod_mark_ptr = NULL;
/*
* mark is now finished
*/
@@ -1176,7 +1189,7 @@
* the live bits, but e.g. t/pmc/timer_7 succeeds w/o this
*/
#if 1
- clear_live_bits(interpreter);
+ Parrot_dod_clear_live_bits(interpreter);
#endif
if (interpreter->profile)
profile_dod_end(interpreter, PARROT_PROF_DOD_p2);
@@ -1184,7 +1197,6 @@
pt_DOD_stop_mark(interpreter);
/* Note it */
arena_base->dod_runs++;
- arena_base->dod_trace_ptr = NULL;
--arena_base->DOD_block_level;
return;
}
1.5 +133 -21 parrot/src/gc_ims.c
Index: gc_ims.c
===================================================================
RCS file: /cvs/public/parrot/src/gc_ims.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- gc_ims.c 17 Aug 2004 11:03:38 -0000 1.4
+++ gc_ims.c 18 Aug 2004 12:53:29 -0000 1.5
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: gc_ims.c,v 1.4 2004/08/17 11:03:38 leo Exp $
+$Id: gc_ims.c,v 1.5 2004/08/18 12:53:29 leo Exp $
=head1 NAME
@@ -337,6 +337,7 @@
*/
#include "parrot/parrot.h"
+#include <assert.h>
/*
* size of one arena
@@ -360,11 +361,18 @@
*/
#define REFILL_FACTOR 0.5
+#if 0
+# define IMS_DEBUG(x) fprintf x
+#else
+# define IMS_DEBUG(x)
+#endif
+
typedef enum { /* these states have to be in execution order */
GC_IMS_INITIAL, /* memory subsystem setup */
GC_IMS_STARTING, /* wait for DOD_block to clear */
GC_IMS_RE_INIT, /* start of normal operation - mark root */
GC_IMS_MARKING, /* mark children */
+ GC_IMS_START_SWEEP, /* mark finished, start sweep buffers */
GC_IMS_SWEEP, /* sweep buffers */
GC_IMS_COLLECT, /* collect buffer memory */
GC_IMS_FINISHED, /* update statistics */
@@ -385,12 +393,42 @@
static void parrot_gc_ims_run_increment(Interp*);
+/*
+
+=item C<static void gc_ims_add_free_object(Interp *interpreter,
+ struct Small_Object_Pool *pool, void *to_add)>
+
+Add object C<to_add> to the free_list in the given pool.
+C<pool->num_free_objects> has to be updated by the caller.
+
+=item C<static void *
+gc_ims_get_free_object(Interp *, struct Small_Object_Pool *pool)>
+
+Get a new object off the free_list in the given pool.
+
+=item C<static void
+gc_ims_alloc_objects(Interp *, struct Small_Object_Pool *pool)>
+
+Allocate new objects for the given pool.
+
+=cut
+
+*/
+
static void
gc_ims_add_free_object(Interp *interpreter,
struct Small_Object_Pool *pool, void *to_add)
{
*(void **)to_add = pool->free_list;
pool->free_list = to_add;
+#if ! DISABLE_GC_DEBUG
+ if (GC_DEBUG(interpreter)) {
+ if (pool == interpreter->arena_base->pmc_pool) {
+ PMC *p = to_add;
+ p->vtable = Parrot_base_vtables[enum_class_Null];
+ }
+ }
+#endif
}
@@ -407,6 +445,7 @@
ptr = pool->free_list;
pool->free_list = *(void **)ptr;
PObj_on_free_list_CLEAR((PObj*) ptr);
+ PObj_get_FLAGS((PObj*)ptr) &= ~PObj_custom_GC_FLAG;
--pool->num_free_objects;
#if ! DISABLE_GC_DEBUG
if (GC_DEBUG(interpreter))
@@ -490,7 +529,11 @@
arena_base->lazy_dod = 0;
g_ims = arena_base->gc_private;
Parrot_dod_ms_run_init(interpreter);
+ /*
+ * trace root set w/o system areas
+ */
Parrot_dod_trace_root(interpreter, 0);
+ g_ims->state = GC_IMS_MARKING;
}
@@ -500,9 +543,8 @@
Mark a bunch of children.
-TODO gather stats of items with and without a next_for_GC field.
+The work depends on item counts with and without a next_for_GC field.
The former are marked immediately, only the latter need real work here.
-Then adjust throttle on this data, so that we don't work too fast.
=cut
@@ -515,19 +557,28 @@
size_t todo;
struct Arenas *arena_base;
double work_factor;
+ PMC *next;
arena_base = interpreter->arena_base;
g_ims = arena_base->gc_private;
+ /*
+ * use statistics from the previous run
+ */
if (g_ims->n_objects) {
work_factor = (double)g_ims->n_extended_PMCs / g_ims->n_objects;
}
else
work_factor = 1.0;
todo = (double)g_ims->alloc_trigger * g_ims->throttle * work_factor;
+ assert(arena_base->lazy_dod == 0);
Parrot_dod_trace_children(interpreter, todo);
- if (arena_base->dod_trace_ptr ==
- PMC_next_for_GC(arena_base->dod_trace_ptr)) {
- g_ims->state = GC_IMS_SWEEP;
+ /*
+ * check if we are finished with marking - the end is
+ * self-referential
+ */
+ next = arena_base->dod_mark_start;
+ if (next == PMC_next_for_GC(next)) {
+ g_ims->state = GC_IMS_START_SWEEP;
}
}
@@ -551,16 +602,15 @@
int j;
size_t n_objects;
+ IMS_DEBUG((stderr, "\nSWEEP\n"));
g_ims = arena_base->gc_private;
/*
* as we are now gonna kill objects, make sure that we
* have traced the current stack
* except for a lazy run, which is invoked from the run loop
*/
- if (!g_ims->lazy) {
- /* no BARRIER yet - ark all roots */
- Parrot_dod_trace_root(interpreter, 1);
- }
+ /* no BARRIER yet - mark all roots */
+ Parrot_dod_trace_root(interpreter, g_ims->lazy ? 0 : 1);
/*
* mark (again) rest of children
*/
@@ -636,6 +686,7 @@
g_ims = arena_base->gc_private;
g_ims->allocations = 0;
++g_ims->increments;
+ IMS_DEBUG((stderr, "state = %d => ", g_ims->state));
switch (g_ims->state) {
case GC_IMS_INITIAL:
@@ -649,12 +700,15 @@
/* else fall through and start */
case GC_IMS_RE_INIT:
parrot_gc_ims_reinit(interpreter);
- g_ims->state = GC_IMS_MARKING;
break;
case GC_IMS_MARKING:
parrot_gc_ims_mark(interpreter);
break;
+
+ case GC_IMS_START_SWEEP:
+ g_ims->state = GC_IMS_SWEEP;
+ /* fall through */
case GC_IMS_SWEEP:
parrot_gc_ims_sweep(interpreter);
break;
@@ -666,14 +720,25 @@
g_ims->state = GC_IMS_CONSUMING;
/* fall through */
case GC_IMS_CONSUMING:
+ /*
+ * This currently looks only at PMCs and string_headers.
+ * There shouldn't be other pools that could run out of
+ * headers independent of PMCs
+ */
if (arena_base->pmc_pool->num_free_objects <
arena_base->pmc_pool->total_objects * REFILL_FACTOR) {
- g_ims->state = GC_IMS_RE_INIT;
+ g_ims->state = GC_IMS_STARTING;
+ }
+ else if (arena_base->string_header_pool->num_free_objects <
+ arena_base->string_header_pool->total_objects *
+ REFILL_FACTOR) {
+ g_ims->state = GC_IMS_STARTING;
}
break;
default:
PANIC("Unknown state in gc_ims");
}
+ IMS_DEBUG((stderr, "%d\n", g_ims->state));
}
/*
@@ -704,13 +769,17 @@
if (flags & DOD_finish_FLAG) {
/*
- * run until live flags are clear
+ * called from really_destroy. This interpreter is gonna die.
+ * The destruction includes a sweep over PMCs, so that
+ * destructors/finalizers are called.
+ *
+ * Be sure live bits are clear.
*/
- if (g_ims->state < GC_IMS_MARKING)
+ if (g_ims->state < GC_IMS_RE_INIT)
return;
- while (g_ims->state <= GC_IMS_COLLECT) {
- parrot_gc_ims_run_increment(interpreter);
- }
+ if (g_ims->state >= GC_IMS_FINISHED)
+ return;
+ Parrot_dod_clear_live_bits(interpreter);
return;
}
/* make the test happy that checks the count ;) */
@@ -720,17 +789,32 @@
parrot_gc_ims_run_increment(interpreter);
return;
}
+ /*
+ * lazy DOD handling
+ */
+ IMS_DEBUG((stderr, "\nLAZY state = %d\n", g_ims->state));
g_ims->lazy = lazy;
+ if (g_ims->state >= GC_IMS_COLLECT) {
+ /* we are beyond sweep, timely destruction is done */
+ if (arena_base->num_early_PMCs_seen >= arena_base->num_early_DOD_PMCs)
+ return;
+ /* when not all seen, start a fresh cycle */
+ g_ims->state = GC_IMS_RE_INIT;
+ /* run init, which clears lazy seen counter */
+ parrot_gc_ims_run_increment(interpreter);
+ }
/*
- * XXX this a short-term hack
- * num_early_DOD_PMCs can change any time during operation
- * need a high-prio queue that is always marked first
+ * run through all steps until we see enough PMCs that need timely
+ * destruction or we finished sweeping
*/
while (arena_base->num_early_PMCs_seen < arena_base->num_early_DOD_PMCs) {
parrot_gc_ims_run_increment(interpreter);
if (g_ims->state >= GC_IMS_COLLECT)
break;
}
+ /*
+ * if we stopped early, the lazy run was successful
+ */
if (g_ims->state < GC_IMS_COLLECT)
++arena_base->lazy_dod_runs;
g_ims->lazy = 0;
@@ -738,6 +822,34 @@
/*
+=item C<void Parrot_dod_ims_wb(Interp*, PMC *agg, PMC *new)>
+
+Write barriere called by the DOD_WRITE_BARRIER macro. Always when a
+white object gets store into a black aggregate, either the object must
+be greyed or the aggregate must be rescanned - by greying it.
+
+=cut
+
+*/
+
+#define DOD_IMS_GREY_NEW 1
+
+
+void
+Parrot_dod_ims_wb(Interp* interpreter, PMC *agg, PMC *new)
+{
+#if DOD_IMS_GREY_NEW
+ IMS_DEBUG((stderr, "%d ", ((Gc_ims_private *)interpreter->arena_base->
+ gc_private)->state));
+ pobject_lives(interpreter, (PObj*)new);
+#else
+ PObj_get_FLAGS(agg) &= ~ (PObj_live_FLAG|PObj_custom_GC_FLAG);
+ pobject_lives(interpreter, (PObj*)agg);
+#endif
+}
+
+/*
+
=back
=head1 SEE ALSO
1.128 +3 -7 parrot/src/resources.c
Index: resources.c
===================================================================
RCS file: /cvs/public/parrot/src/resources.c,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -w -r1.127 -r1.128
--- resources.c 15 Aug 2004 04:39:23 -0000 1.127
+++ resources.c 18 Aug 2004 12:53:29 -0000 1.128
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resources.c,v 1.127 2004/08/15 04:39:23 chromatic Exp $
+$Id: resources.c,v 1.128 2004/08/18 12:53:29 leo Exp $
=head1 NAME
@@ -132,13 +132,8 @@
alloc_new_block(interpreter, size, pool);
interpreter->arena_base->mem_allocs_since_last_collect++;
}
- if (0 && GC_DEBUG(interpreter)) {
- Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
- if (pool->compact) {
- (*pool->compact) (interpreter, pool);
- }
- }
if (pool->top_block->free < size) {
+#if PARROT_GC_MS
Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
/* Compact the pool if allowed and worthwhile */
if (pool->compact) {
@@ -152,6 +147,7 @@
}
}
+#endif
if (pool->top_block->free < size) {
if (pool->minimum_block_size < 65536*16)
pool->minimum_block_size *= 2;
1.15 +54 -2 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- gc.t 24 Jun 2004 10:12:19 -0000 1.14
+++ gc.t 18 Aug 2004 12:53:31 -0000 1.15
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: gc.t,v 1.14 2004/06/24 10:12:19 leo Exp $
+# $Id: gc.t,v 1.15 2004/08/18 12:53:31 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 14;
+use Parrot::Test tests => 15;
output_is( <<'CODE', '1', "sweep 1" );
interpinfo I1, 2 # How many DOD runs have we done already?
@@ -474,3 +474,55 @@
ok 1
10
OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "write barrier 1");
+ null I2
+ set I3, 100
+lp3:
+ null I0
+ set I1, 1000
+ new P1, .ResizablePMCArray
+lp1:
+ new P2, .ResizablePMCArray
+ new P0, .Integer
+ set P0, I0
+ set P2[0], P0
+ set P1[I0], P2
+ if I0, not_0
+ needs_destroy P0
+ # force marking past P2[0]
+ sweep 0
+not_0:
+ new P3, .Undef
+ new P4, .Undef
+ inc I0
+ lt I0, I1, lp1
+
+ null I0
+ # trace 1
+lp2:
+ set P2, P1[I0]
+ set P2, P2[0]
+ eq P2, I0, ok
+ print "nok\n"
+ print "I0: "
+ print I0
+ print " P2: "
+ print P2
+ print " type: "
+ typeof S0, P2
+ print S0
+ print " I2: "
+ print I2
+ print "\n"
+ exit 1
+ok:
+ inc I0
+ lt I0, I1, lp2
+ inc I2
+ lt I2, I3, lp3
+ print "ok\n"
+ end
+CODE
+ok
+OUTPUT
