cvsuser 04/01/10 05:21:35
Modified: classes timer.pmc
include/parrot dod.h interpreter.h pobj.h resources.h
io io.c
ops core.ops
src dod.c interpreter.c resources.c smallobject.c
string.c
t/op gc.t
t/pmc timer.t
Log:
The Return of the Priority DOD
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!
Courtesy of Luke Palmer with some cleanup by leo
Revision Changes Path
1.10 +2 -2 parrot/classes/timer.pmc
Index: timer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/timer.pmc,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- timer.pmc 9 Jan 2004 10:28:11 -0000 1.9
+++ timer.pmc 10 Jan 2004 13:21:21 -0000 1.10
@@ -1,7 +1,7 @@
/* timer.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: timer.pmc,v 1.9 2004/01/09 10:28:11 leo Exp $
+ * $Id: timer.pmc,v 1.10 2004/01/10 13:21:21 leo Exp $
* Overview:
* This is the Timer base class
* Data Structure and Algorithms:
@@ -90,7 +90,7 @@
mem_sys_allocate_zeroed(sizeof(parrot_timer_event));
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) {
1.12 +7 -2 parrot/include/parrot/dod.h
Index: dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- dod.h 28 Jul 2003 13:38:00 -0000 1.11
+++ dod.h 10 Jan 2004 13:21:24 -0000 1.12
@@ -1,7 +1,7 @@
/* dod.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.h,v 1.11 2003/07/28 13:38:00 leo Exp $
+ * $Id: dod.h,v 1.12 2004/01/10 13:21:24 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -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);
1.115 +7 -3 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -w -r1.114 -r1.115
--- interpreter.h 2 Jan 2004 14:09:32 -0000 1.114
+++ interpreter.h 10 Jan 2004 13:21:24 -0000 1.115
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.114 2004/01/02 14:09:32 leo Exp $
+ * $Id: interpreter.h,v 1.115 2004/01/10 13:21:24 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -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 */
1.32 +13 -10 parrot/include/parrot/pobj.h
Index: pobj.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pobj.h,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- pobj.h 24 Dec 2003 10:43:08 -0000 1.31
+++ pobj.h 10 Jan 2004 13:21:24 -0000 1.32
@@ -1,7 +1,7 @@
/* pobj.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pobj.h,v 1.31 2003/12/24 10:43:08 leo Exp $
+ * $Id: pobj.h,v 1.32 2004/01/10 13:21:24 leo Exp $
* Overview:
* Parrot Object data members and flags enum
* Data Structure and Algorithms:
@@ -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,9 +370,9 @@
#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); \
1.45 +2 -1 parrot/include/parrot/resources.h
Index: resources.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/resources.h,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -w -r1.44 -r1.45
--- resources.h 21 Jul 2003 18:00:42 -0000 1.44
+++ resources.h 10 Jan 2004 13:21:24 -0000 1.45
@@ -1,7 +1,7 @@
/* register.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: resources.h,v 1.44 2003/07/21 18:00:42 chromatic Exp $
+ * $Id: resources.h,v 1.45 2004/01/10 13:21:24 leo Exp $
* Overview:
* Defines the resource allocation API
* Data Structure and Algorithms:
@@ -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 */
1.77 +4 -4 parrot/io/io.c
Index: io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -w -r1.76 -r1.77
--- io.c 9 Dec 2003 17:44:55 -0000 1.76
+++ io.c 10 Jan 2004 13:21:26 -0000 1.77
@@ -1,7 +1,7 @@
/* io.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io.c,v 1.76 2003/12/09 17:44:55 boemmels Exp $
+ * $Id: io.c,v 1.77 2004/01/10 13:21:26 leo Exp $
* Overview:
* This is the Parrot IO subsystem API. Generic IO stuff
* goes here, each specific layer goes in its own file...
@@ -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]) {
1.346 +5 -2 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.345
retrieving revision 1.346
diff -u -w -r1.345 -r1.346
--- core.ops 9 Jan 2004 21:41:05 -0000 1.345
+++ core.ops 10 Jan 2004 13:21:28 -0000 1.346
@@ -879,8 +879,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();
}
@@ -948,7 +951,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();
}
1.79 +145 -66 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -w -r1.78 -r1.79
--- dod.c 2 Jan 2004 14:09:38 -0000 1.78
+++ dod.c 10 Jan 2004 13:21:30 -0000 1.79
@@ -1,7 +1,7 @@
/* dod.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.c,v 1.78 2004/01/02 14:09:38 leo Exp $
+ * $Id: dod.c,v 1.79 2004/01/10 13:21:30 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -31,7 +31,44 @@
#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);
+
+/*
+ * mark a special PMC
+ * - if it has a PMC_ECT structure append or prepend the
+ * next_for_GC pointer
+ * - else do custom mark directly
+ *
+ * this should really be inline, so if inline isn't available, it
+ * should better be a macro
+ */
+static PARROT_INLINE void
+mark_special(Parrot_Interp interpreter, PMC* obj)
+{
+ if (obj->pmc_ext) {
+ if (PObj_high_priority_DOD_TEST(obj) && interpreter->dod_trace_ptr) {
+ PMC* tptr = interpreter->dod_trace_ptr;
+ if (tptr->next_for_GC == tptr) {
+ obj->next_for_GC = obj;
+ }
+ else {
+ /* put it at the head of the list */
+ obj->next_for_GC = tptr->next_for_GC;
+ }
+ tptr->next_for_GC = (PMC*)obj;
+ }
+ else {
+ /* put it on the end of the list */
+ interpreter->dod_mark_ptr->next_for_GC = obj;
+
+ /* Explicitly make the tail of the linked list be
+ * self-referential */
+ interpreter->dod_mark_ptr = obj->next_for_GC = obj;
+ }
+ }
+ else if (PObj_custom_mark_TEST(obj))
+ VTABLE_mark(interpreter, obj);
+}
#if ARENA_DOD_FLAGS
@@ -45,21 +82,18 @@
UINTVAL *dod_flags = arena->dod_flags + ns;
if (*dod_flags & ((PObj_on_free_list_FLAG | PObj_live_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);
+
++arena->live_objects;
*dod_flags |= PObj_live_FLAG << nm;
- 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_needs_early_DOD_TEST(obj))
+ ++interpreter->num_early_PMCs_seen;
- /* Explicitly make the tail of the linked list be
- * self-referential */
- interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
- }
- else if (PObj_custom_mark_TEST(obj))
- VTABLE_mark(interpreter, (PMC *) obj);
- return;
+ if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
+ mark_special(interpreter, (PMC*) obj);
}
}
@@ -84,23 +118,18 @@
}
# 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 (PObj_needs_early_DOD_TEST(obj))
+ ++interpreter->num_early_PMCs_seen;
+
/* 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 (((PMC*)obj)->pmc_ext) {
- /* put it on the end of the list */
- interpreter->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;
- }
- else if (PObj_custom_mark_TEST(obj))
- VTABLE_mark(interpreter, (PMC *) obj);
- return;
+ mark_special(interpreter, (PMC*) obj);
}
#if GC_VERBOSE
/* buffer GC_DEBUG stuff */
@@ -117,8 +146,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 +165,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 +229,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 +241,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 +296,7 @@
prev = current;
}
+ return 1;
}
/* Scan any buffers in S registers and other non-PMC places and mark
@@ -452,9 +495,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 +536,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 +551,8 @@
if (PObj_is_PMC_TEST(b)) {
/* then destroy it here
*/
+ if (PObj_needs_early_DOD_TEST(b))
+ --interpreter->num_early_DOD_PMCs;
if (PObj_active_destroy_TEST(b))
VTABLE_destroy(interpreter, (PMC *)b);
@@ -695,6 +732,34 @@
}
#endif
+static void
+clear_live_bits(Parrot_Interp interpreter)
+{
+ struct Small_Object_Pool *pool;
+ struct Small_Object_Arena *arena;
+ UINTVAL i;
+ UINTVAL object_size = pool->object_size;
+
+ pool = interpreter->arena_base->pmc_pool;
+ /* Run through all the buffer header pools and mark */
+ for (arena = pool->last_Arena; arena; arena = arena->prev) {
+#if ARENA_DOD_FLAGS
+ UINTVAL * dod_flags = arena->dod_flags;
+ for (i = 0; i < arena->used; i += (ARENA_FLAG_MASK+1)) {
+ /* reset live bits for a bunch of objects */
+ *dod_flags &= ~ALL_LIVE_MASK;
+ ++dod_flags;
+ }
+#else
+ Buffer *b = arena->start_objects;
+ for (i = 0; i < cur_arena->used; i++) {
+ PObj_live_CLEAR(b);
+ b = (Buffer *)((char *)b + object_size);
+ }
+#endif
+ }
+}
+
static PARROT_INLINE void
profile_dod_start(Parrot_Interp interpreter)
{
@@ -718,7 +783,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 +794,11 @@
return;
}
Parrot_block_DOD(interpreter);
+
+ interpreter->lazy_dod = flags & DOD_lazy_FLAG;
+ interpreter->dod_trace_ptr = NULL;
+ interpreter->num_early_PMCs_seen = 0;
+
if (interpreter->profile)
profile_dod_start(interpreter);
@@ -741,8 +811,7 @@
}
#endif
/* Now go trace the PMCs */
- trace_active_PMCs(interpreter, trace_stack);
-
+ if (trace_active_PMCs(interpreter, flags & DOD_trace_stack_FLAG)) {
/* And the buffers */
trace_active_buffers(interpreter);
#if !TRACE_SYSTEM_AREAS
@@ -751,7 +820,7 @@
* marking everything, if something was missed
* not - these could also be stale objects
*/
- if (trace_stack) {
+ if (flags & DOD_trace_stack_FLAG) {
# if ! DISABLE_GC_DEBUG
CONSERVATIVE_POINTER_CHASING = 1;
# endif
@@ -782,8 +851,18 @@
#endif
}
}
+ }
+ else {
+ /* it was an aborted lazy dod run - we should clear
+ * the live bits, but e.g. t/pmc/timer_7 succeeds w/o this
+ */
+#if 1
+ clear_live_bits(interpreter);
+#endif
+ }
/* Note it */
interpreter->dod_runs++;
+ interpreter->dod_trace_ptr = NULL;
if (interpreter->profile)
profile_dod_end(interpreter);
Parrot_unblock_DOD(interpreter);
1.254 +4 -1 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.253
retrieving revision 1.254
diff -u -w -r1.253 -r1.254
--- interpreter.c 8 Jan 2004 12:12:44 -0000 1.253
+++ interpreter.c 10 Jan 2004 13:21:30 -0000 1.254
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.253 2004/01/08 12:12:44 leo Exp $
+ * $Id: interpreter.c,v 1.254 2004/01/10 13:21:30 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -1293,6 +1293,9 @@
break;
case TOTAL_COPIED:
ret = interpreter->memory_collected;
+ break;
+ case IMPATIENT_PMCS:
+ ret = interpreter->num_early_DOD_PMCs;
break;
}
return ret;
1.114 +3 -3 parrot/src/resources.c
Index: resources.c
===================================================================
RCS file: /cvs/public/parrot/src/resources.c,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -w -r1.113 -r1.114
--- resources.c 12 Nov 2003 11:02:34 -0000 1.113
+++ resources.c 10 Jan 2004 13:21:30 -0000 1.114
@@ -1,7 +1,7 @@
/* resources.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: resources.c,v 1.113 2003/11/12 11:02:34 leo Exp $
+ * $Id: resources.c,v 1.114 2004/01/10 13:21:30 leo Exp $
* Overview:
* Allocate and deallocate tracked resources
* Data Structure and Algorithms:
@@ -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 */
1.32 +2 -2 parrot/src/smallobject.c
Index: smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- smallobject.c 21 Dec 2003 10:15:19 -0000 1.31
+++ smallobject.c 10 Jan 2004 13:21:30 -0000 1.32
@@ -1,7 +1,7 @@
/* resources.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: smallobject.c,v 1.31 2003/12/21 10:15:19 leo Exp $
+ * $Id: smallobject.c,v 1.32 2004/01/10 13:21:30 leo Exp $
* Overview:
* Handles the accessing of small object pools (header pools)
* Data Structure and Algorithms:
@@ -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;
}
1.167 +6 -6 parrot/src/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.166
retrieving revision 1.167
diff -u -w -r1.166 -r1.167
--- string.c 8 Jan 2004 10:44:45 -0000 1.166
+++ string.c 10 Jan 2004 13:21:30 -0000 1.167
@@ -1,7 +1,7 @@
/* string.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string.c,v 1.166 2004/01/08 10:44:45 petergibbs Exp $
+ * $Id: string.c,v 1.167 2004/01/10 13:21:30 leo Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -947,7 +947,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) {
@@ -1054,7 +1054,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) {
@@ -1109,7 +1109,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,
@@ -1168,7 +1168,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) {
@@ -1247,7 +1247,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) {
1.6 +1 -1 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- gc.t 1 Jul 2003 23:08:14 -0000 1.5
+++ gc.t 10 Jan 2004 13:21:33 -0000 1.6
@@ -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
1.5 +68 -2 parrot/t/pmc/timer.t
Index: timer.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/timer.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- timer.t 9 Jan 2004 10:28:20 -0000 1.4
+++ timer.t 10 Jan 2004 13:21:35 -0000 1.5
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 7;
use Test::More;
output_is(<<'CODE', <<'OUT', "Timer setup");
@@ -64,7 +64,7 @@
OUT
SKIP: {
- skip("No thread config yet", 3) unless ($^O eq 'linux' or $^O eq 'darwin');
+ skip("No thread config yet", 5) unless ($^O eq 'linux' or $^O eq 'darwin');
output_is(<<'CODE', <<'OUT', "Timer setup - initializer/start");
.include "timer.pasm"
@@ -152,5 +152,71 @@
ok 3
OUT
+output_is(<<'CODE', <<'OUT', "Timer setup - initializer/start/destroy");
+.include "timer.pasm"
+ bounds 1 # cant run with JIT core yet
+ new P1, .SArray
+ set P1, 6
+ set P1[0], .PARROT_TIMER_NSEC
+ set P1[1], 0.5
+ set P1[2], .PARROT_TIMER_HANDLER
+ find_global P2, "_timer_sub"
+ set P1[3], P2
+ set P1[4], .PARROT_TIMER_RUNNING
+ set P1[5], 1
+
+ sweep 0
+ new P0, .Timer, P1
+ print "ok 1\n"
+ sweep 0
+ # destroy
+ null P0
+ # do a lazy DOD run
+ sweep 0
+ sleep 1
+ print "ok 2\n"
+ end
+.pcc_sub _timer_sub:
+ print "never\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+OUT
+
+output_is(<<'CODE', <<'OUT', "Timer setup - timer in array destroy");
+.include "timer.pasm"
+ bounds 1 # cant run with JIT core yet
+ new P1, .SArray
+ set P1, 6
+ set P1[0], .PARROT_TIMER_NSEC
+ set P1[1], 0.5
+ set P1[2], .PARROT_TIMER_HANDLER
+ find_global P2, "_timer_sub"
+ set P1[3], P2
+ set P1[4], .PARROT_TIMER_RUNNING
+ set P1[5], 1
+
+ new P0, .Timer, P1
+ print "ok 1\n"
+ sweep 0
+ # hide timer in array
+ set P1[0], P0
+ new P0, .PerlUndef
+ sweep 0
+ # un-anchor the array
+ new P1, .PerlUndef
+ # do a lazy DOD run
+ sweep 0
+ sleep 1
+ print "ok 2\n"
+ end
+.pcc_sub _timer_sub:
+ print "never\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+OUT
}
