Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

[PATCH] The Return of the Priority DOD

18 views
Skip to first unread message

Luke Palmer

unread,
Jan 5, 2004, 8:47:53 AM1/5/04
to Internals List
After many months of lying dormant, I figured I'd get my act together
and adapt this patch to the few recent modifications. And this time,
I'm posting a benchmark!

My results get about 5% slowdown in the eager case, and the usual
10,000% speedup in the lazy case.

Luke

First, the benchmark (examples/benchmarks/dod_priority.imc):

#! /usr/bin/env parrot
# Call this program with an argument of 0 (or no arguments at all)
# to see the priority dod behavior. Call with an argument of 1 to
# see the full sweep.

.pcc_sub _main non_prototyped
.param pmc argv

.const int ntimes = 10000
.const int nestlevel = 1000

.sym int sweep_arg
$I0 = argv
if $I0 <= 1 goto set_zero
$P0 = argv[1]
sweep_arg = $P0
goto continue
set_zero:
sweep_arg = 0
continue:

$I0 = nestlevel
$P0 = new PerlString
$P0 = "Foo!"
needs_destroy $P0
makenest:
unless $I0 goto last
dec $I0
$P1 = new PerlArray
$P1[0] = $P0
$P0 = $P1
goto makenest
last:

# That concludes making the data structure, now let's run
# DOD a bunch of times (we're still in the root set in $P0)
$I0 = ntimes
again:
unless $I0 goto last2
dec $I0
if sweep_arg goto sweep_one
sweep 0
goto again
sweep_one:
sweep 1
goto again
last2:
end
.end

-----------
And the patch:

? vtable.dump
? examples/benchmarks/dod_priority.imc
Index: classes/timer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/timer.pmc,v
retrieving revision 1.7
diff -u -r1.7 timer.pmc
--- classes/timer.pmc 25 Aug 2003 09:46:23 -0000 1.7
+++ classes/timer.pmc 5 Jan 2004 13:30:45 -0000
@@ -253,7 +253,7 @@
t->self = SELF;
SELF->cache.struct_val = t;
PObj_active_destroy_SET(SELF);
- interpreter->has_early_DOD_PMCs = 1;
+ ++interpreter->num_early_DOD_PMCs;
}

void init_pmc(PMC *init) {
Index: include/parrot/dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.11
diff -u -r1.11 dod.h
--- include/parrot/dod.h 28 Jul 2003 13:38:00 -0000 1.11
+++ include/parrot/dod.h 5 Jan 2004 13:30:46 -0000
@@ -40,7 +40,12 @@
#define Parrot_is_blocked_GC(interpreter) \
((interpreter)->GC_block_level)

-void Parrot_do_dod_run(struct Parrot_Interp *, int trace_stack);
+enum {
+ DOD_trace_stack_FLAG = 1 << 0,
+ DOD_lazy_FLAG = 1 << 1
+};
+
+void Parrot_do_dod_run(struct Parrot_Interp *, UINTVAL flags);
void trace_system_areas(struct Parrot_Interp *);
void trace_mem_block(struct Parrot_Interp *, size_t, size_t);

Index: include/parrot/interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.114
diff -u -r1.114 interpreter.h
--- include/parrot/interpreter.h 2 Jan 2004 14:09:32 -0000 1.114
+++ include/parrot/interpreter.h 5 Jan 2004 13:30:46 -0000
@@ -247,7 +247,6 @@

/* per interpreter global vars */
INTVAL world_inited; /* Parrot_init is done */
- PMC *mark_ptr; /* last PMC marked used in DOD runs */
PMC *iglobals; /* SArray of PMCs, containing: */
/* 0: PMC *Parrot_base_classname_hash; hash containing name->base_type */
/* 1: PMC *Parrot_compreg_hash; hash containing assembler/compilers */
@@ -255,7 +254,12 @@
/* 3: PMC *Env; hash_like Env PMC */
/* 4: PMC *ParrotInterpreter that's me */
/* 5: PMC *Dyn_libs Array of dynamically loaded ParrotLibrary */
- int has_early_DOD_PMCs; /* Flag that some want immediate destruction */
+ UINTVAL num_early_DOD_PMCs; /* how many PMCs want immediate destruction */
+ UINTVAL num_early_PMCs_seen; /* how many such PMCs has DOD seen */
+ PMC* dod_mark_ptr; /* last PMC marked during a DOD run */
+ PMC* dod_trace_ptr; /* last PMC trace_children was called on */
+ int lazy_dod; /* flag that indicates whether we should stop
+ when we've seen all impatient PMCs */
PMC* DOD_registry; /* registered PMCs added to the root set */
struct MMD_table *binop_mmd_funcs; /* Table of MMD function pointers */
PMC** nci_method_table; /* Method table PMC for NCI stubs per class */
Index: include/parrot/pobj.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pobj.h,v
retrieving revision 1.31
diff -u -r1.31 pobj.h
--- include/parrot/pobj.h 24 Dec 2003 10:43:08 -0000 1.31
+++ include/parrot/pobj.h 5 Jan 2004 13:30:46 -0000
@@ -224,12 +224,14 @@
*/
b_PObj_is_special_PMC_FLAG = 1 << 26,

- b_PObj_needs_early_DOD_FLAG = 1 << 27,
+ /* true if this is connected by some route to a needs_early_DOD object */
+ PObj_high_priority_DOD_FLAG = 1 << 27,
+ PObj_needs_early_DOD_FLAG = (1 << 27 | 1 << 28),

/* True if the PMC is a class */
- PObj_is_class_FLAG = 1 << 28,
+ PObj_is_class_FLAG = 1 << 29,
/* True if the PMC is a parrot object */
- PObj_is_object_FLAG = 1 << 29
+ PObj_is_object_FLAG = 1 << 30

} PObj_flags;

@@ -246,7 +248,6 @@
# define d_PObj_live_FLAG 0x01
# define d_PObj_on_free_list_FLAG 0x02
# define d_PObj_is_special_PMC_FLAG 0x04
-# define d_PObj_needs_early_DOD_FLAG 0x08

/*
* arenas are constant sized ~32 byte object size, ~16K objects
@@ -303,14 +304,12 @@
# define PObj_live_FLAG d_PObj_live_FLAG
# define PObj_on_free_list_FLAG d_PObj_on_free_list_FLAG
# define PObj_is_special_PMC_FLAG d_PObj_is_special_PMC_FLAG
-# define PObj_needs_early_DOD_FLAG d_PObj_needs_early_DOD_FLAG

#else

# define PObj_live_FLAG b_PObj_live_FLAG
# define PObj_on_free_list_FLAG b_PObj_on_free_list_FLAG
# define PObj_is_special_PMC_FLAG b_PObj_is_special_PMC_FLAG
-# define PObj_needs_early_DOD_FLAG b_PObj_needs_early_DOD_FLAG

# define DOD_flag_TEST(flag, o) PObj_flag_TEST(flag, o)
# define DOD_flag_SET(flag, o) PObj_flag_SET(flag, o)
@@ -347,6 +346,10 @@
#define PObj_report_SET(o) PObj_flag_SET(report, o)
#define PObj_report_CLEAR(o) PObj_flag_CLEAR(report, o)

+#define PObj_high_priority_DOD_TEST(o) PObj_flag_TEST(high_priority_DOD, o)
+#define PObj_high_priority_DOD_SET(o) PObj_flag_SET(high_priority_DOD, o)
+#define PObj_high_priority_DOD_CLEAR(o) PObj_flag_CLEAR(high_priority_DOD, o)
+
#define PObj_on_free_list_TEST(o) DOD_flag_TEST(on_free_list, o)
#define PObj_on_free_list_SET(o) DOD_flag_SET(on_free_list, o)
#define PObj_on_free_list_CLEAR(o) DOD_flag_CLEAR(on_free_list, o)
@@ -367,10 +370,10 @@
#define PObj_sysmem_SET(o) PObj_flag_SET(sysmem, o)
#define PObj_sysmem_CLEAR(o) PObj_flag_CLEAR(sysmem, o)

-#define PObj_needs_early_DOD_TEST(o) DOD_flag_TEST(needs_early_DOD, o)
-#define PObj_needs_early_DOD_SET(o) DOD_flag_SET(needs_early_DOD, o)
-#define PObj_needs_early_DOD_CLEAR(o) DOD_flag_CLEAR(needs_early_DOD, o)
-
+#define PObj_needs_early_DOD_TEST(o) PObj_flag_TEST(needs_early_DOD, o)
+#define PObj_needs_early_DOD_SET(o) PObj_flag_SET(needs_early_DOD, o)
+#define PObj_needs_early_DOD_CLEAR(o) PObj_flag_CLEAR(needs_early_DOD, o)
+
#define PObj_special_SET(flag, o) do { \
PObj_flag_SET(flag, o); \
DOD_flag_SET(is_special_PMC, o); \
Index: include/parrot/resources.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/resources.h,v
retrieving revision 1.44
diff -u -r1.44 resources.h
--- include/parrot/resources.h 21 Jul 2003 18:00:42 -0000 1.44
+++ include/parrot/resources.h 5 Jan 2004 13:30:46 -0000
@@ -82,6 +82,7 @@
#define HEADER_ALLOCS_SINCE_COLLECT 8
#define MEM_ALLOCS_SINCE_COLLECT 9
#define TOTAL_COPIED 10
+#define IMPATIENT_PMCS 11

/* &end_gen */

Index: io/io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.76
diff -u -r1.76 io.c
--- io/io.c 9 Dec 2003 17:44:55 -0000 1.76
+++ io/io.c 5 Jan 2004 13:30:46 -0000
@@ -840,12 +840,12 @@
INTVAL i;
ParrotIOTable table = piodata->table;

- /* XXX boe: Parrot_really_destroy might call us with mark_ptr not
+ /* XXX boe: Parrot_really_destroy might call us with dod_mark_ptr not
* set. This is neccessary until destruction ordering prevents
* the premature destruction of the standardhandles
*/
- if (!interpreter->mark_ptr)
- interpreter->mark_ptr = table[0];
+ if (!interpreter->dod_mark_ptr)
+ interpreter->dod_mark_ptr = table[0];

for (i = 0; i < PIO_NR_OPEN; i++) {
if (table[i]) {
Index: ops/core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.344
diff -u -r1.344 core.ops
--- ops/core.ops 2 Jan 2004 16:25:37 -0000 1.344
+++ ops/core.ops 5 Jan 2004 13:30:46 -0000
@@ -878,8 +878,11 @@
=cut

op sweep(inconst INT) {
- if ($1 || interpreter->has_early_DOD_PMCs)
+ if ($1)
Parrot_do_dod_run(interpreter, 0);
+ else
+ if (interpreter->num_early_DOD_PMCs)
+ Parrot_do_dod_run(interpreter, DOD_lazy_FLAG);
goto NEXT();
}

@@ -947,7 +950,7 @@

op needs_destroy(in PMC) {
PObj_needs_early_DOD_SET($1);
- interpreter->has_early_DOD_PMCs = 1;
+ ++interpreter->num_early_DOD_PMCs;
goto NEXT();
}

Index: src/dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.78
diff -u -r1.78 dod.c
--- src/dod.c 2 Jan 2004 14:09:38 -0000 1.78
+++ src/dod.c 5 Jan 2004 13:30:46 -0000
@@ -31,7 +31,7 @@
#endif

static size_t find_common_mask(size_t val1, size_t val2);
-static void trace_children(struct Parrot_Interp *interpreter, PMC *current);
+static int trace_children(struct Parrot_Interp *interpreter, PMC *current);

#if ARENA_DOD_FLAGS

@@ -45,21 +45,45 @@
UINTVAL *dod_flags = arena->dod_flags + ns;
if (*dod_flags & ((PObj_on_free_list_FLAG | PObj_live_FLAG) << nm))
return;
+ if (*dod_flags & PObj_on_free_list_FLAG << nm)
+ return;
+ if (PObj_high_priority_DOD_TEST(obj) && interpreter->dod_trace_ptr)
+ /* set obj's parent to high priority */
+ PObj_high_priority_DOD_SET(interpreter->dod_trace_ptr);
+ if (*dod_flags & PObj_live_FLAG << nm)
+ return;
+
++arena->live_objects;
*dod_flags |= PObj_live_FLAG << nm;

+ if (PObj_needs_early_DOD_TEST(obj))
+ ++interpreter->num_early_PMCs_seen;
+
if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
if (((PMC*)obj)->pmc_ext) {
- /* put it on the end of the list */
- interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ if (PObj_high_priority_DOD_TEST(obj)
+ && interpreter->dod_trace_ptr) {
+ PMC* tptr = interpreter->dod_trace_ptr;
+ if (tptr->next_for_GC == tptr) {
+ ((PMC*)obj)->next_for_GC = (PMC*)obj;
+ }
+ else {
+ /* put it at the head of the list */
+ ((PMC*)obj)->next_for_GC = tptr->next_for_GC;
+ }
+ interpreter->dod_trace_ptr->next_for_GC = (PMC*)obj;
+ }
+ else {
+ /* put it on the end of the list */
+ interpreter->dod_mark_ptr->next_for_GC = (PMC *)obj;

- /* Explicitly make the tail of the linked list be
- * self-referential */
- interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+ /* Explicitly make the tail of the linked list be
+ * self-referential */
+ interpreter->dod_mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+ }
}
else if (PObj_custom_mark_TEST(obj))
VTABLE_mark(interpreter, (PMC *) obj);
- return;
}
}

@@ -84,23 +108,38 @@
}
# endif
#endif
+ if (PObj_high_priority_DOD_TEST(obj) && interpreter->dod_trace_ptr)
+ PObj_high_priority_DOD_SET(interpreter->dod_trace_ptr);
/* mark it live */
PObj_live_SET(obj);
/* if object is a PMC and contains buffers or PMCs, then attach
* the PMC to the chained mark list
*/
- if (PObj_is_special_PMC_TEST(obj)) {
+ if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
if (((PMC*)obj)->pmc_ext) {
- /* put it on the end of the list */
- interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ if (PObj_high_priority_DOD_TEST(obj)
+ && interpreter->dod_trace_ptr) {
+ PMC* tptr = interpreter->dod_trace_ptr;
+ if (tptr->next_for_GC == tptr) {
+ ((PMC*)obj)->next_for_GC = (PMC*)obj;
+ }
+ else {
+ /* put it at the head of the list */
+ ((PMC*)obj)->next_for_GC = tptr->next_for_GC;
+ }
+ interpreter->dod_trace_ptr->next_for_GC = (PMC*)obj;
+ }
+ else {
+ /* put it on the end of the list */
+ interpreter->dod_mark_ptr->next_for_GC = (PMC *)obj;

- /* Explicitly make the tail of the linked list be
- * self-referential */
- interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+ /* Explicitly make the tail of the linked list be
+ * self-referential */
+ interpreter->dod_mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+ }
}
else if (PObj_custom_mark_TEST(obj))
VTABLE_mark(interpreter, (PMC *) obj);
- return;
}
#if GC_VERBOSE
/* buffer GC_DEBUG stuff */
@@ -117,8 +156,10 @@
#endif


-/* Do a full trace run and mark all the PMCs as active if they are */
-static void
+/* Do a full trace run and mark all the PMCs as active if they are.
+ * Returns whether the run wasn't aborted; i.e. whether it's safe to
+ * proceed with GC */
+static int
trace_active_PMCs(struct Parrot_Interp *interpreter, int trace_stack)
{
PMC *current;
@@ -134,7 +175,7 @@
struct Stash *stash = 0;

/* We have to start somewhere, the interpreter globals is a good place */
- interpreter->mark_ptr = current = interpreter->iglobals;
+ interpreter->dod_mark_ptr = current = interpreter->iglobals;

/* mark it as used */
pobject_lives(interpreter, (PObj *)interpreter->iglobals);
@@ -198,10 +239,11 @@
#endif
/* Okay, we've marked the whole root set, and should have a good-sized
* list 'o things to look at. Run through it */
- trace_children(interpreter, current);
+ return trace_children(interpreter, current);
}

-static void
+/* Returns whether the tracing process wasn't aborted */
+static int
trace_children(struct Parrot_Interp *interpreter, PMC *current)
{
PMC *prev = NULL;
@@ -209,9 +251,19 @@
UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
| PObj_custom_mark_FLAG;

+ int lazy_dod = interpreter->lazy_dod;
+
for (; current != prev; current = current->next_for_GC) {
UINTVAL bits = PObj_get_FLAGS(current) & mask;

+ if (lazy_dod &&
+ interpreter->num_early_PMCs_seen >= interpreter->num_early_DOD_PMCs) {
+ return 0;
+ }
+ interpreter->dod_trace_ptr = current;
+ if (!PObj_needs_early_DOD_TEST(current))
+ PObj_high_priority_DOD_CLEAR(current);
+
/* mark properties */
if (current->metadata) {
pobject_lives(interpreter, (PObj *)current->metadata);
@@ -254,6 +306,7 @@

prev = current;
}
+ return 1;
}

/* Scan any buffers in S registers and other non-PMC places and mark
@@ -452,9 +505,6 @@
UINTVAL free_arenas = 0, old_total_used = 0;
#endif

- /* We have no impatient things. Yet. */
- interpreter->has_early_DOD_PMCs = 0;
-
/* Run through all the buffer header pools and mark */
for (cur_arena = pool->last_Arena;
NULL != cur_arena; cur_arena = cur_arena->prev) {
@@ -496,13 +546,8 @@
{
/* its live */
total_used++;
-#if ARENA_DOD_FLAGS
- if ((*dod_flags & (PObj_needs_early_DOD_FLAG << nm)))
- interpreter->has_early_DOD_PMCs = 1;
-#else
+#if !ARENA_DOD_FLAGS
PObj_live_CLEAR(b);
- if (PObj_needs_early_DOD_TEST(b))
- interpreter->has_early_DOD_PMCs = 1;
#endif
}
else {
@@ -516,6 +561,8 @@
if (PObj_is_PMC_TEST(b)) {
/* then destroy it here
*/
+ if (PObj_high_priority_DOD_TEST(b))
+ --interpreter->num_early_DOD_PMCs;
if (PObj_active_destroy_TEST(b))
VTABLE_destroy(interpreter, (PMC *)b);

@@ -718,7 +765,7 @@

/* See if we can find some unused headers */
void
-Parrot_do_dod_run(struct Parrot_Interp *interpreter, int trace_stack)
+Parrot_do_dod_run(struct Parrot_Interp *interpreter, UINTVAL flags)
{
struct Small_Object_Pool *header_pool;
int j;
@@ -729,6 +776,10 @@
return;
}
Parrot_block_DOD(interpreter);
+
+ interpreter->lazy_dod = flags & DOD_lazy_FLAG;
+ interpreter->dod_trace_ptr = NULL;
+
if (interpreter->profile)
profile_dod_start(interpreter);

@@ -741,49 +792,50 @@
}
#endif
/* Now go trace the PMCs */
- trace_active_PMCs(interpreter, trace_stack);
-
- /* And the buffers */
- trace_active_buffers(interpreter);
+ if (trace_active_PMCs(interpreter, flags & DOD_trace_stack_FLAG)) {
+ /* And the buffers */
+ trace_active_buffers(interpreter);
#if !TRACE_SYSTEM_AREAS
# if GC_VERBOSE
- /* whe, we don't trace stack and registers, we check after
- * marking everything, if something was missed
- * not - these could also be stale objects
- */
- if (trace_stack) {
+ /* whe, we don't trace stack and registers, we check after
+ * marking everything, if something was missed
+ * not - these could also be stale objects
+ */
+ if (flags & DOD_trace_stack_FLAG) {
# if ! DISABLE_GC_DEBUG
- CONSERVATIVE_POINTER_CHASING = 1;
+ CONSERVATIVE_POINTER_CHASING = 1;
# endif
- trace_system_areas(interpreter);
+ trace_system_areas(interpreter);
# if ! DISABLE_GC_DEBUG
- CONSERVATIVE_POINTER_CHASING = 0;
+ CONSERVATIVE_POINTER_CHASING = 0;
# endif
- }
+ }
# endif
#endif

- /* Now put unused PMCs on the free list */
- header_pool = interpreter->arena_base->pmc_pool;
- free_unused_pobjects(interpreter, header_pool);
- total_free += header_pool->num_free_objects;
-
- /* And unused buffers on the free list */
- for (j = 0; j < (INTVAL)interpreter->arena_base->num_sized; j++) {
- header_pool = interpreter->arena_base->sized_header_pools[j];
- if (header_pool) {
+ /* Now put unused PMCs on the free list */
+ header_pool = interpreter->arena_base->pmc_pool;
+ free_unused_pobjects(interpreter, header_pool);
+ total_free += header_pool->num_free_objects;
+
+ /* And unused buffers on the free list */
+ for (j = 0; j < (INTVAL)interpreter->arena_base->num_sized; j++) {
+ header_pool = interpreter->arena_base->sized_header_pools[j];
+ if (header_pool) {
#ifdef GC_IS_MALLOC
- used_cow(interpreter, header_pool, 0);
+ used_cow(interpreter, header_pool, 0);
#endif
- free_unused_pobjects(interpreter, header_pool);
- total_free += header_pool->num_free_objects;
+ free_unused_pobjects(interpreter, header_pool);
+ total_free += header_pool->num_free_objects;
#ifdef GC_IS_MALLOC
- clear_cow(interpreter, header_pool, 0);
+ clear_cow(interpreter, header_pool, 0);
#endif
+ }
}
}
/* Note it */
interpreter->dod_runs++;
+ interpreter->dod_trace_ptr = NULL;
if (interpreter->profile)
profile_dod_end(interpreter);
Parrot_unblock_DOD(interpreter);
Index: src/interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.252
diff -u -r1.252 interpreter.c
--- src/interpreter.c 2 Jan 2004 14:09:38 -0000 1.252
+++ src/interpreter.c 5 Jan 2004 13:30:46 -0000
@@ -1285,6 +1285,9 @@
case TOTAL_COPIED:
ret = interpreter->memory_collected;
break;
+ case IMPATIENT_PMCS:
+ ret = interpreter->num_early_DOD_PMCs;
+ break;
}
return ret;
}
Index: src/resources.c
===================================================================
RCS file: /cvs/public/parrot/src/resources.c,v
retrieving revision 1.113
diff -u -r1.113 resources.c
--- src/resources.c 12 Nov 2003 11:02:34 -0000 1.113
+++ src/resources.c 5 Jan 2004 13:30:46 -0000
@@ -106,13 +106,13 @@
interpreter->mem_allocs_since_last_collect++;
}
if (0 && GC_DEBUG(interpreter)) {
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
if (pool->compact) {
(*pool->compact) (interpreter, pool);
}
}
if (pool->top_block->free < size) {
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
/* Compact the pool if allowed and worthwhile */
if (pool->compact) {
/* don't bother reclaiming if it's just chicken feed */
Index: src/smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.31
diff -u -r1.31 smallobject.c
--- src/smallobject.c 21 Dec 2003 10:15:19 -0000 1.31
+++ src/smallobject.c 5 Jan 2004 13:30:46 -0000
@@ -68,7 +68,7 @@
if (pool->skip)
pool->skip = 0;
else {
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
if (pool->num_free_objects <= pool->replenish_level)
pool->skip = 1;
}
Index: src/string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.164
diff -u -r1.164 string.c
--- src/string.c 3 Jan 2004 09:44:13 -0000 1.164
+++ src/string.c 5 Jan 2004 13:30:46 -0000
@@ -957,7 +957,7 @@
# if ! DISABLE_GC_DEBUG
/* It's easy to forget that string comparison can trigger GC */
if (GC_DEBUG(interpreter))
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
# endif

if (s1->type != s2->type || s1->encoding != s2->encoding) {
@@ -1064,7 +1064,7 @@
# if ! DISABLE_GC_DEBUG
/* It's easy to forget that string comparison can trigger GC */
if (GC_DEBUG(interpreter))
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
# endif

if (s1->type != s2->type || s1->encoding != s2->encoding) {
@@ -1119,7 +1119,7 @@

/* trigger GC for debug */
if (interpreter && GC_DEBUG(interpreter))
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);

if (s1->type != s2->type || s1->encoding != s2->encoding) {
s1 = string_transcode(interpreter, s1, NULL, string_unicode_type,
@@ -1178,7 +1178,7 @@

/* trigger GC for debug */
if (interpreter && GC_DEBUG(interpreter))
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);

if (s1 && s2) {
if (s1->type != s2->type || s1->encoding != s2->encoding) {
@@ -1257,7 +1257,7 @@

/* trigger GC for debug */
if (interpreter && GC_DEBUG(interpreter))
- Parrot_do_dod_run(interpreter, 1);
+ Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);

if (s1 && s2) {
if (s1->type != s2->type || s1->encoding != s2->encoding) {
Index: t/op/gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.5
diff -u -r1.5 gc.t
--- t/op/gc.t 1 Jul 2003 23:08:14 -0000 1.5
+++ t/op/gc.t 5 Jan 2004 13:30:46 -0000
@@ -35,10 +35,10 @@
interpinfo I1, 2 # How many DOD runs have we done already?
new P0, .PerlUndef
needs_destroy P0
+ new P0, .PerlUndef # kill object
sweep 0
interpinfo I2, 2 # Should be one more now
sub I3, I2, I1
- new P0, .PerlUndef # kill 1st object
sweep 0
interpinfo I4, 2 # Should be same as last
sub I5, I4, I2

Leopold Toetsch

unread,
Jan 5, 2004, 9:43:13 AM1/5/04
to Luke Palmer, perl6-i...@perl.org
Luke Palmer <fibo...@babylonia.flatirons.org> wrote:
> After many months of lying dormant, I figured I'd get my act together
> and adapt this patch to the few recent modifications. And this time,
> I'm posting a benchmark!

Wow, thanks.

Some comments:

> - b_PObj_needs_early_DOD_FLAG = 1 << 27,
> + /* true if this is connected by some route to a needs_early_DOD object */
> + PObj_high_priority_DOD_FLAG = 1 << 27,
> + PObj_needs_early_DOD_FLAG = (1 << 27 | 1 << 28),

Moving the needs_early_DOD_FLAG out of the arena_flags is suboptimal
(and probably the reason for the 5% slowdown for the eager case). Now the
relevant flags is the high_priority_DOD_FLAG. If I get the patch right,
it gets set on the PMC itself and all its parents.

So it would be fine, if the high_priority_DOD_FLAG would be in the
arena_flags nibble. The tests in the fast path of pobject_lives can then
go away - PMCs that can contain other PMCs can't be the parent of PMCs
that need timely destruction, so that should work. And all PMCs, that
can contain other PMCs must have a PMC_EXT attached with the next_for_GC
pointer.

And if that helps, we can just say: If an object needs timely
destruction it must have the PMC_EXT struct attached, so that marking
is out of the fast path.

>@@ -45,21 +45,45 @@
> UINTVAL *dod_flags = arena->dod_flags + ns;
> if (*dod_flags & ((PObj_on_free_list_FLAG | PObj_live_FLAG) << nm))
> return;
> + if (*dod_flags & PObj_on_free_list_FLAG << nm)
> + return;

This seems bogus, if the flag is set, the first test has succeeded.

> + if (PObj_high_priority_DOD_TEST(obj) && interpreter->dod_trace_ptr)
> + /* set obj's parent to high priority */
> + PObj_high_priority_DOD_SET(interpreter->dod_trace_ptr);

That could go probably below, if the special_PMC_FLAG is set.

>@@ -84,23 +108,38 @@

> - if (PObj_is_special_PMC_TEST(obj)) {
> + if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {

This seems to be the non-ARENA_DOD_FLAGS case, so above doesn't work.

leo

Leopold Toetsch

unread,
Jan 5, 2004, 9:51:17 AM1/5/04
to Luke Palmer, perl6-i...@perl.org
Luke Palmer <fibo...@babylonia.flatirons.org> wrote:

One more remark:


>
> + if (PObj_needs_early_DOD_TEST(obj))
> + ++interpreter->num_early_PMCs_seen;

When is this counter reset?

leo

Jeff Clites

unread,
Jan 5, 2004, 11:36:34 AM1/5/04
to Luke Palmer, Internals List
On Jan 5, 2004, at 5:47 AM, Luke Palmer wrote:

> After many months of lying dormant, I figured I'd get my act together
> and adapt this patch to the few recent modifications. And this time,
> I'm posting a benchmark!
>
> My results get about 5% slowdown in the eager case, and the usual
> 10,000% speedup in the lazy case.

Sounds cool; do you have a quick high-level description of what it's
all about? (I had seen that needs_early_DOD flag in the source, and
didn't know what it was intended to do.)

Thanks!

JEff

Luke Palmer

unread,
Jan 5, 2004, 2:24:30 PM1/5/04
to Jeff Clites, Internals List

Okay, here I go, just before I get some sleep and then wake up to tie up
the rather insidious bugs in the patch.

We have a problem with several common constructs that Perl will likely
require of us. For instance, this one:

{
my $fh = open '> foo';
print $fh: "Hello!\n";
}
{
my $fh = open '< foo';
print <$fh>;
}

In Perl 5, this prints "Hello!" without the blink of an eye (well, if it
were valid Perl 5 syntax ;-). But now on Parrot with a opportunistic
DOD, this guarantee doesn't hold. If $fh isn't closed before it's
opened, the results here are undefined.

Performing a full sweep at every scope exit is not practical: there's
enough sub-call overhead as it is. So a new variant of C<sweep> was
added: C<sweep 0> would only sweep if there were no PMCs that had been
marked as neededing early (or impatient for) DOD.

I and several others quickly saw this as a makeshift solution. There
will commonly be at least one such object that will last the entire
lifetime of a program. So C<sweep 0>, in practice, was exactly
equivalent to C<sweep 1>.

Enter the scheme that this patch implements. It was batted around and
refined several times before I implemented it a few months ago. Here's
how it goes:

The common case is that none of the impatient objects go out of program
view, and moreover that the various paths to find them remain the same.
The algorithm takes heavy advantage of this, keeping state across
multiple DOD runs.

Each PMC has associated with it a "high priority" flag. First, only the
impatient objects have this flag set. But on each DOD run, it's
possible to efficiently tell all objects that hold a reference to this
high priority object. Those objects also get their high priority flag
set. And so on down the chain.

Then during the DOD main loop, if such a high priority object comes
along, it is prepended to the queue, temporarily switching the DOD to
depth first. This allows it to quickly navigate its way to the
impatient objects, and once they are all found, the lazy DOD is
terminated. And the more the lazy DOD is run, the faster it becomes.

When one of the impatient objects can't be found, the run is equivalent
to a C<sweep 1>, but that happens rarely. Also in this case, all high
priority flags are cleared, so that a wide-spreading circular data
structure doesn't end up making I<everything> high priority, thereby
nullifying the algorithm. This is one of those things I forgot to
implement ;-)

Hope this clarified things.

Luke

> JEff
>

Luke Palmer

unread,
Jan 7, 2004, 11:47:55 PM1/7/04
to Leopold Toetsch, perl6-i...@perl.org
Leopold Toetsch writes:
> Luke Palmer <fibo...@babylonia.flatirons.org> wrote:
> > After many months of lying dormant, I figured I'd get my act together
> > and adapt this patch to the few recent modifications. And this time,
> > I'm posting a benchmark!
>
> Wow, thanks.
>
> Some comments:
>
> > - b_PObj_needs_early_DOD_FLAG = 1 << 27,
> > + /* true if this is connected by some route to a needs_early_DOD object */
> > + PObj_high_priority_DOD_FLAG = 1 << 27,
> > + PObj_needs_early_DOD_FLAG = (1 << 27 | 1 << 28),
>
> Moving the needs_early_DOD_FLAG out of the arena_flags is suboptimal
> (and probably the reason for the 5% slowdown for the eager case). Now the
> relevant flags is the high_priority_DOD_FLAG. If I get the patch right,
> it gets set on the PMC itself and all its parents.

Hmm. Interesting that I did that, as I don't understand arena DOD flags :-)
I would appreciate a short explanation, thanks.

Just as a note, you can expect even more delays to the maintainence of
this patch. My job just picked up its pace, and I've got to have this
compiler cracking at full-featuredness in the next week. I'm not
against somebody else maintaining the patch in the meantime :-)

(But rest assured, I will get back to it)

Sorry,
Luke

Leopold Toetsch

unread,
Jan 8, 2004, 6:19:02 AM1/8/04
to Luke Palmer, perl6-i...@perl.org
Luke Palmer <fibo...@babylonia.flatirons.org> wrote:

> Leopold Toetsch writes:
>> Moving the needs_early_DOD_FLAG out of the arena_flags is suboptimal
>> (and probably the reason for the 5% slowdown for the eager case). Now the
>> relevant flags is the high_priority_DOD_FLAG. If I get the patch right,
>> it gets set on the PMC itself and all its parents.

> Hmm. Interesting that I did that, as I don't understand arena DOD flags :-)
> I would appreciate a short explanation, thanks.

Some additional information beyond docs/memory_internals.pod:

I expect by far more plain scalars being around then aggregates. Plain
scalars (w/o properties attached) don't have the PMC_EXT structure, so
they don't have the next_for_GC pointer either.

During DOD now only the relevant bits in the arena are touched (or
pulled into the processors caches) if such a plain scalar is marked
live. The PMCs memory itself isn't touched and not pulled into the
caches.

All non-plain scalars and aggregates have the is_special_PMC bit
set and are marked by chaining them with the next_for_GC pointer, so
that contained PMCs get marked too. This of course needs that the PMC
and the PMC_EXT structure is pulled into the caches.

This reduced cache misses during DOD to almost zero.

> Just as a note, you can expect even more delays to the maintainence of
> this patch. My job just picked up its pace, and I've got to have this
> compiler cracking at full-featuredness in the next week. I'm not
> against somebody else maintaining the patch in the meantime :-)

I'll go through it and apply it eventually.

> Luke

leo

Leopold Toetsch

unread,
Jan 8, 2004, 10:49:15 AM1/8/04
to Luke Palmer, perl6-i...@perl.org
Luke Palmer <fibo...@babylonia.flatirons.org> wrote:
> ... I'm not

> against somebody else maintaining the patch in the meantime :-)

I went again through the patch and the original one from Sept, 5th. But
it seems that one thing is missing in both:

*If* all PMCs which needs_early_DOD are seen live, the DOD run is
aborted. But completing the DOD run also resets live bits of non-dead
objects, which is missing now.

It seems, that in that case we still need to walk the PMC arenas and
reset all live bits. OTOH when ARENA_DOD_FLAGS is on, this isn't too
expensive because it can be done my masking a full word worth of 8 PMCs
at once. So its still a lot faster then the eager case - hopefully.

Or am I missing something?

> Luke

leo

Luke Palmer

unread,
Jan 9, 2004, 8:37:54 AM1/9/04
to Leopold Toetsch, perl6-i...@perl.org

I don't think you are. I would have thought that GC be the one to reset
the live bits, but there was a lot of DOD that I didn't completely
understand. I don't remember explicitly taking such a thing out, but I
could have inadvertently.

Thanks for looking through the patch.

Luke

Leopold Toetsch

unread,
Jan 10, 2004, 8:28:38 AM1/10/04
to Luke Palmer, perl6-i...@perl.org
Luke Palmer <fibo...@babylonia.flatirons.org> wrote:
> Leopold Toetsch writes:
>> It seems, that in that case we still need to walk the PMC arenas and
>> reset all live bits. OTOH when ARENA_DOD_FLAGS is on, this isn't too
>> expensive because it can be done my masking a full word worth of 8 PMCs
>> at once. So its still a lot faster then the eager case - hopefully.
>>
>> Or am I missing something?

> I don't think you are. I would have thought that GC be the one to reset
> the live bits, but there was a lot of DOD that I didn't completely
> understand.

GC is mostly independent of DOD and it doesn't look at PMCs. GC compacts
variable sized memory pools.

I have applied now your patch with some minor cleanup. Funnily clearing
the live bits after an aborted lazy DOD run seems not to be necessary.
Either the test (t/pmc/timer_7) is bogus or I'm still missing something.

> Luke

Thanks again for your patch,
leo

Nicholas Clark

unread,
Jan 10, 2004, 11:08:31 AM1/10/04
to Leopold Toetsch, Luke Palmer, perl6-i...@perl.org

I'm seeing compile failures on FreeBSD now:

src/dod.c: In function `clear_live_bits':
src/dod.c:755: `cur_arena' undeclared (first use in this function)
src/dod.c:755: (Each undeclared identifier is reported only once
src/dod.c:755: for each function it appears in.)
src/dod.c
*** Error code 1

The appended patch cures it (and all tests pass) but I'm not sure if it
is correct.

Nicholas Clark

Index: src/dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v

retrieving revision 1.80
diff -p -u -r1.80 dod.c
--- src/dod.c 10 Jan 2004 13:47:50 -0000 1.80
+++ src/dod.c 10 Jan 2004 16:05:52 -0000
@@ -752,7 +752,7 @@ clear_live_bits(Parrot_Interp interprete
}
#else
Buffer *b = arena->start_objects;
- for (i = 0; i < cur_arena->used; i++) {
+ for (i = 0; i < arena->used; i++) {
PObj_live_CLEAR(b);
b = (Buffer *)((char *)b + object_size);
}

Leopold Toetsch

unread,
Jan 10, 2004, 2:39:51 PM1/10/04
to Nicholas Clark, perl6-i...@perl.org
Nicholas Clark <ni...@ccl4.org> wrote:

> src/dod.c: In function `clear_live_bits':
> src/dod.c:755: `cur_arena' undeclared (first use in this function)

> The appended patch cures it (and all tests pass) but I'm not sure if it
> is correct.

Ah yep, thanks. I didn't test the patch with ARENA_DOD_FLAGS disabled
and finally diceded that "arena" is as meaningful and readable as
"cur_arena" and changed that before submitting - a policy which almost
always causes an error somewhere :)

Thanks, fixed.

> Nicholas Clark

leo

Nicholas Clark

unread,
Jan 10, 2004, 2:54:44 PM1/10/04
to Leopold Toetsch, perl6-i...@perl.org

How come most tinderboxes kept going without failing? What's making the
choice on the value of ARENA_DOD_FLAGS ?

Yes, I think arena makes as much sense as cur_arena, implying that the cur_
is redundant.


Nicholas Clark

Jeff Clites

unread,
Jan 10, 2004, 7:25:58 PM1/10/04
to Nicholas Clark, perl6-i...@perl.org, Leopold Toetsch

On Jan 10, 2004, at 11:54 AM, Nicholas Clark wrote:

> On Sat, Jan 10, 2004 at 08:39:51PM +0100, Leopold Toetsch wrote:
>> Nicholas Clark <ni...@ccl4.org> wrote:
>>
>>> src/dod.c: In function `clear_live_bits':
>>> src/dod.c:755: `cur_arena' undeclared (first use in this function)
>>
>>> The appended patch cures it (and all tests pass) but I'm not sure if
>>> it
>>> is correct.
>>
>> Ah yep, thanks. I didn't test the patch with ARENA_DOD_FLAGS disabled
>> and finally diceded that "arena" is as meaningful and readable as
>> "cur_arena" and changed that before submitting - a policy which almost
>> always causes an error somewhere :)
>
> How come most tinderboxes kept going without failing? What's making the
> choice on the value of ARENA_DOD_FLAGS ?

It gets set in include/parrot/pobj.h, and is basically set to true if
your platform has some flavor of memalign(), which allows you to
allocate chunks of memory with arbitrary power-of-2 alignment. So all
the platforms being tested on the tinders probably have this. (Of
course, you can manually set ARENA_DOD_FLAGS to false in the source,
for testing.)

JEff

Lars Balker Rasmussen

unread,
Jan 10, 2004, 7:44:29 PM1/10/04
to perl6-i...@perl.org
Jeff Clites <jcl...@mac.com> writes:
> It gets set in include/parrot/pobj.h, and is basically set to true if
> your platform has some flavor of memalign(), which allows you to
> allocate chunks of memory with arbitrary power-of-2 alignment. So all
> the platforms being tested on the tinders probably have this. (Of
> course, you can manually set ARENA_DOD_FLAGS to false in the source,
> for testing.)

Actually, at least FreeBSD doesn't have either of the memalign()'s
parrot looks for, which is what Nicholas (and I) ran into.

(If OpenBSD doesn't have one either, there's some clean-up to be done
in parrot/config/init/hints/openbsd.pl :-) )
--
Lars Balker Rasmussen Consult::Perl

Leopold Toetsch

unread,
Jan 10, 2004, 3:21:59 PM1/10/04
to Nicholas Clark, perl6-i...@perl.org
Nicholas Clark <ni...@ccl4.org> wrote:

> How come most tinderboxes kept going without failing? What's making the
> choice on the value of ARENA_DOD_FLAGS ?

ARENA_DOD_FLAGS is turned on by default. If there is no memalign or such
library function (which it depends on), this define is disabled.

> Nicholas Clark

leo

Nicholas Clark

unread,
Jan 11, 2004, 6:04:38 AM1/11/04
to Jeff Clites, perl6-i...@perl.org, Leopold Toetsch
On Sat, Jan 10, 2004 at 04:25:58PM -0800, Jeff Clites wrote:

> allocate chunks of memory with arbitrary power-of-2 alignment. So all
> the platforms being tested on the tinders probably have this. (Of
> course, you can manually set ARENA_DOD_FLAGS to false in the source,
> for testing.)

My tinderbox running on FreeBSD definitely didn't have it, and the OpenBSD
tinderbox returned from burning to success at the same time as mine.
(Not that I've checked the actual case of its failure, but I think only
one patch got committed around then)

Nicholas Clark

0 new messages