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

Reply via email to