cvsuser 04/08/21 04:08:26
Modified: src gc_ims.c resources.c
Log:
gc subsystems 10 - run the memory compaction too
* fix typo, or cut'n'pasto - GC was blocked after first run
* run the memory compaction collector too in incremental MS
Revision Changes Path
1.7 +69 -6 parrot/src/gc_ims.c
Index: gc_ims.c
===================================================================
RCS file: /cvs/public/parrot/src/gc_ims.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- gc_ims.c 19 Aug 2004 11:48:18 -0000 1.6
+++ gc_ims.c 21 Aug 2004 11:08:25 -0000 1.7
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: gc_ims.c,v 1.6 2004/08/19 11:48:18 leo Exp $
+$Id: gc_ims.c,v 1.7 2004/08/21 11:08:25 leo Exp $
=head1 NAME
@@ -361,6 +361,16 @@
*/
#define REFILL_FACTOR 0.5
+/*
+ * we run the copying collector, if memory pool statistics indicate
+ * that this amount of the total size could be freed
+ *
+ * This factor also depends on the allocatio color of buffer headers,
+ * which is set to black now. So we are always one DOD cycle behind
+ * and the statistics are rather wrong.
+ */
+#define MEM_POOL_RECLAIM 0.2
+
#if 0
# define IMS_DEBUG(x) fprintf x
#else
@@ -615,7 +625,7 @@
* have traced the current stack
* except for a lazy run, which is invoked from the run loop
*/
- /* no BARRIER yet - mark all roots */
+ /* TODO mark volatile roots */
Parrot_dod_trace_root(interpreter, g_ims->lazy ? 0 : 1);
/*
* mark (again) rest of children
@@ -644,7 +654,7 @@
header_pool->num_free_objects;
}
}
- g_ims->state = GC_IMS_FINISHED; /* TODO collect */
+ g_ims->state = GC_IMS_COLLECT;
g_ims->n_objects = n_objects;
g_ims->n_extended_PMCs = arena_base->num_extended_PMCs;
}
@@ -659,18 +669,58 @@
=cut
*/
+#if GC_IS_MALLOC
+static void
+parrot_gc_ims_collect(Interp* interpreter)
+{
+}
+
+#else
static void
parrot_gc_ims_collect(Interp* interpreter)
{
struct Arenas *arena_base = interpreter->arena_base;
struct Small_Object_Pool *header_pool;
+ struct Memory_Pool *mem_pool;
+ struct Memory_Block *block;
Gc_ims_private *g_ims;
int j;
g_ims = arena_base->gc_private;
- /* TODO */
+ for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
+ header_pool = arena_base->sized_header_pools[j];
+ /*
+ * go through header pools check if there is an
+ * associate memory pool
+ */
+ if (header_pool && header_pool->mem_pool) {
+ mem_pool = header_pool->mem_pool;
+ /*
+ * and if the memory pool supports compaction
+ */
+ if (!mem_pool->compact)
+ continue;
+ /*
+ * several header pools can share one memory pool
+ * if that pool is already compacted, the following is zero
+ */
+ if (!mem_pool->guaranteed_reclaimable)
+ continue;
+ /*
+ * check used size
+ */
+ if ((mem_pool->possibly_reclaimable * mem_pool->reclaim_factor +
+ mem_pool->guaranteed_reclaimable) >=
+ mem_pool->total_allocated * MEM_POOL_RECLAIM) {
+ IMS_DEBUG((stderr, "COMPACT\n"));
+ mem_pool->compact(interpreter, mem_pool);
}
+ }
+ }
+ g_ims->state = GC_IMS_FINISHED;
+}
+#endif
/*
@@ -717,7 +767,7 @@
/* fall through */
case GC_IMS_SWEEP:
parrot_gc_ims_sweep(interpreter);
- break;
+ /* fall through */
case GC_IMS_COLLECT:
parrot_gc_ims_collect(interpreter);
break;
@@ -792,7 +842,20 @@
arena_base->dod_runs++;
lazy = flags & DOD_lazy_FLAG;
if (!lazy) {
+ /* run a full cycle
+ * TODO if we are called from mem_allocate() in src/resources.c:
+ * * pass needed size
+ * * check first, if it could be reasonable to run a full
+ * cycle
+ * * test examples/benchmarks/gc_header_new.pasm
+ */
+ if (g_ims->state >= GC_IMS_FINISHED)
+ g_ims->state = GC_IMS_STARTING;
+ while (1) {
parrot_gc_ims_run_increment(interpreter);
+ if (g_ims->state > GC_IMS_COLLECT)
+ break;
+ }
return;
}
/*
1.129 +8 -3 parrot/src/resources.c
Index: resources.c
===================================================================
RCS file: /cvs/public/parrot/src/resources.c,v
retrieving revision 1.128
retrieving revision 1.129
diff -u -w -r1.128 -r1.129
--- resources.c 18 Aug 2004 12:53:29 -0000 1.128
+++ resources.c 21 Aug 2004 11:08:25 -0000 1.129
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resources.c,v 1.128 2004/08/18 12:53:29 leo Exp $
+$Id: resources.c,v 1.129 2004/08/21 11:08:25 leo Exp $
=head1 NAME
@@ -133,8 +133,14 @@
interpreter->arena_base->mem_allocs_since_last_collect++;
}
if (pool->top_block->free < size) {
-#if PARROT_GC_MS
+ /*
+ * force a DOD run to get live flags set
+ * for incremental M&S collection is run from there
+ * TODO pass required allocation size to the DOD system,
+ * so that collection can be skipped if needed
+ */
Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
+#if PARROT_GC_MS
/* Compact the pool if allowed and worthwhile */
if (pool->compact) {
/* don't bother reclaiming if it's just chicken feed */
@@ -249,7 +255,6 @@
return;
}
++arena_base->GC_block_level;
- Parrot_block_GC(interpreter);
if (interpreter->profile)
profile_gc_start(interpreter);
