NAME ^

src/dod.c - Dead object destruction of the various headers

DESCRIPTION ^

This file implements dead object destruction. This is documented in PDD 9 with supplementary notes in docs/dev/dod.pod.

It's possible to turn on/off the checking of the system stack and processor registers. The actual checking is implemented in src/cpu_dep.c.

There's also a verbose mode for garbage collection.

FUNCTIONS ^

*/

#define DOD_C_SOURCE #include "parrot/parrot.h" #include "parrot/dod.h"

/* HEADERIZER HFILE: include/parrot/dod.h */

/* HEADERIZER BEGIN: static */

static void clear_live_bits( NOTNULL(Small_Object_Pool *pool) ) __attribute__nonnull__(1);

PARROT_CONST_FUNCTION static size_t find_common_mask( PARROT_INTERP, size_t val1, size_t val2 ) __attribute__nonnull__(1);

static void mark_special( PARROT_INTERP, NOTNULL(PMC *obj) ) __attribute__nonnull__(1) __attribute__nonnull__(2);

static int sweep_cb( PARROT_INTERP, NOTNULL(Small_Object_Pool *pool), int flag, NOTNULL(void *arg) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4);

static int trace_active_PMCs( PARROT_INTERP, int trace_stack ) __attribute__nonnull__(1);

/* HEADERIZER END: static */

/* Set this to 1 to see if unanchored objects are found in system areas. * Please note: these objects might be bogus */ #define GC_VERBOSE 0

#if ! DISABLE_GC_DEBUG /* Set when walking the system stack */ int CONSERVATIVE_POINTER_CHASING = 0; #endif

/*

FUNCDOC: mark_special

Mark a special PMC. If it has a PMC_EXT structure, append or prepend the next_for_GC pointer; otherwise, do the custom mark directly.

This should really be inline, so if inline isn't available, it would be better if it were a macro.

*/

static void mark_special(PARROT_INTERP, NOTNULL(PMC *obj)) { int hi_prio; Arenas *arena_base;

    /*
     * If the object is shared, we have to use the arena and dod
     * pointers of the originating interpreter.
     *
     * We are possibly changing another interpreter's data here, so
     * the mark phase of DOD must run only on one interpreter of a pool
     * at a time. However, freeing unused objects can occur in parallel.
     * And: to be sure that a shared object is dead, we have to finish
     * the mark phase of all interpreters in a pool that might reference
     * the object.
     */
    if (PObj_is_PMC_shared_TEST(obj)) {
        interp = PMC_sync(obj)->owner;
        PARROT_ASSERT(interp);
        /* XXX FIXME hack */
        if (!interp->arena_base->dod_mark_ptr)
            interp->arena_base->dod_mark_ptr = obj;
    }

    arena_base = interp->arena_base;

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

    if (PObj_high_priority_DOD_TEST(obj) && arena_base->dod_trace_ptr) {
        /* set obj's parent to high priority */
        PObj_high_priority_DOD_SET(arena_base->dod_trace_ptr);
        hi_prio = 1;
    }
    else
        hi_prio = 0;

    if (obj->pmc_ext) {
        PMC* const tptr = arena_base->dod_trace_ptr;

        ++arena_base->num_extended_PMCs;
        /*
         * XXX this basically invalidates the high-priority marking
         *     of PMCs by putting all PMCs onto the front of the list.
         *     The reason for this is the by far better cache locality
         *     when aggregates and their contents are marked "together".
         *
         *     To enable high priority marking again we should probably
         *     use a second pointer chain, which is, when not empty,
         *     processed first.
         */
        if (tptr || hi_prio) {
            if (PMC_next_for_GC(tptr) == tptr) {
                PMC_next_for_GC(obj) = obj;
            }
            else {
                /* put it at the head of the list */
                PMC_next_for_GC(obj) = PMC_next_for_GC(tptr);
            }

            PMC_next_for_GC(tptr)    = (PMC*)obj;
        }
        else {
            /* put it on the end of the list */
            PMC_next_for_GC(arena_base->dod_mark_ptr) = obj;

            /* Explicitly make the tail of the linked list be
             * self-referential */
            arena_base->dod_mark_ptr = PMC_next_for_GC(obj) = obj;
        }
    }
    else if (PObj_custom_mark_TEST(obj)) {
        PObj_get_FLAGS(obj) |= PObj_custom_GC_FLAG;
        VTABLE_mark(interp, obj);
    }
}

PARROT_API void pobject_lives(PARROT_INTERP, NOTNULL(PObj *obj)) { #if PARROT_GC_GMS do { if (!PObj_live_TEST(obj) && \ PObj_to_GMSH(obj)->gen->gen_no >= interp->gc_generation) \ parrot_gc_gms_pobject_lives(interp, obj); \ } while (0); #else /* not PARROT_GC_GMS */ /* if object is live or on free list return */ if (PObj_is_live_or_free_TESTALL(obj)) return;

# if ! DISABLE_GC_DEBUG # if GC_VERBOSE if (CONSERVATIVE_POINTER_CHASING) { fprintf(stderr, "GC Warning! Unanchored %s %p " " found in system areas \n", PObj_is_PMC_TEST(obj) ? "PMC" : "Buffer", obj); } # endif # endif /* mark it live */ PObj_live_SET(obj);

    /* if object is a PMC and it's real_self pointer points to another
     * PMC, we must mark that. */
    if (PObj_is_PMC_TEST(obj)) {
        PMC * const p = (PMC*)obj;
        if (p->real_self != p)
            pobject_lives(interp, (PObj *)p->real_self);
    }

    /* 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)) {
        mark_special(interp, (PMC*) obj);
    }
#  ifndef NDEBUG
    else {
        if (PObj_is_PMC_TEST(obj)) {
            PMC * const p = (PMC*)obj;

            if (p->pmc_ext && PMC_metadata(p)) {
                fprintf(stderr, "GC: error obj %p (%s) has properties\n",
                        (void *)p, (char*)p->vtable->whoami->strstart);
            }
        }
    }
#  endif
#  if GC_VERBOSE
    /* buffer GC_DEBUG stuff */
    if (! GC_DEBUG(interp))
        return;

    if (PObj_report_TEST(obj)) {
        fprintf(stderr, "GC: buffer %p pointing to %p marked live\n",
                obj, PObj_bufstart((Buffer*) obj));
    }
#  endif
#endif  /* PARROT_GC_GMS */
}

/*

FUNCDOC: Parrot_dod_trace_root

Trace the root set. Returns 0 if it's a lazy DOD run and all objects that need timely destruction were found.

trace_stack can have these values:

 0 ... trace normal roots, no system areas
 1 ... trace whole root set
 2 ... trace system areas only

*/

PARROT_API int Parrot_dod_trace_root(PARROT_INTERP, int trace_stack) { Arenas * const arena_base = interp->arena_base; parrot_context_t *ctx;

    /* note: adding locals here did cause increased DOD runs */
    unsigned int i = 0;

    if (trace_stack == 2) {
        trace_system_areas(interp);
        return 0;
    }

    if (interp->profile)
        Parrot_dod_profile_start(interp);

    /* We have to start somewhere; the interpreter globals is a good place */
    if (!arena_base->dod_mark_start) {
        arena_base->dod_mark_start
            = arena_base->dod_mark_ptr
            = interp->iglobals;
    }

    /* mark it as used  */
    pobject_lives(interp, (PObj *)interp->iglobals);

    /* mark the current context. */
    ctx = CONTEXT(interp->ctx);
    mark_context(interp, ctx);

    /* mark the dynamic environment. */
    mark_stack(interp, interp->dynamic_env);

    /*
     * mark vtable->data
     *
     * XXX these PMCs are constant and shouldn't get collected
     * but t/library/dumper* fails w/o this marking.
     *
     * It seems that the Class PMC gets DODed - these should
     * get created as constant PMCs.
     */
    for (i = 1; i < (unsigned int)interp->n_vtable_max; i++) {
        const VTABLE * const vtable = interp->vtables[i];
        /*
         * XXX dynpmc groups have empty slots for abstract objects
         */
        if (vtable) {
            if (vtable->mro)
                pobject_lives(interp, (PObj *)vtable->mro);

            pobject_lives(interp, (PObj *)vtable->_namespace);
        }
    }

    /* mark exception list */
    for (i = 0; i <= E_LAST_PYTHON_E; ++i)
        pobject_lives(interp, (PObj*)interp->exception_list[i]);

    /* mark the root_namespace */
    pobject_lives(interp, (PObj *)interp->root_namespace);

    /* s. packfile.c */
    mark_const_subs(interp);

    /* mark caches and freelists */
    mark_object_cache(interp);

    /* Now mark the class hash */
    pobject_lives(interp, (PObj *)interp->class_hash);

    /* Mark the PMC Proxy PMC array. */
    pobject_lives(interp, (PObj *)interp->pmc_proxies);

    /* Mark the registry if any */
    if (interp->DOD_registry)
        pobject_lives(interp, (PObj *)interp->DOD_registry);

    /* Mark the transaction log */
    /* XXX do this more generically? */
    if (interp->thread_data && interp->thread_data->stm_log)
        Parrot_STM_mark_transaction(interp);

    /* Walk the iodata */
    Parrot_IOData_mark(interp, interp->piodata);

    /* quick check if we can already bail out */
    if (arena_base->lazy_dod && arena_base->num_early_PMCs_seen >=
            arena_base->num_early_DOD_PMCs)
        return 0;

    /* Find important stuff on the system stack */
    if (trace_stack)
        trace_system_areas(interp);

    if (interp->profile)
        Parrot_dod_profile_end(interp, PARROT_PROF_DOD_p1);

    return 1;
}

/*

FUNCDOC: trace_active_PMCs

Do a full trace run and mark all the PMCs as active if they are. Returns whether the run completed, that is, whether it's safe to proceed with GC.

*/

static int trace_active_PMCs(PARROT_INTERP, int trace_stack) { if (!Parrot_dod_trace_root(interp, trace_stack)) return 0;

    /* Okay, we've marked the whole root set, and should have a good-sized
     * list of things to look at. Run through it */
    return Parrot_dod_trace_children(interp, (size_t) -1);
}

/*

FUNCDOC: Parrot_dod_trace_children

Returns whether the tracing process completed.

*/

PARROT_API int Parrot_dod_trace_children(PARROT_INTERP, size_t how_many) { Arenas * const arena_base = interp->arena_base; const int lazy_dod = arena_base->lazy_dod; PMC *current = arena_base->dod_mark_start; PMC *next = PMCNULL;

    const UINTVAL mask = PObj_data_is_PMC_array_FLAG | PObj_custom_mark_FLAG;

    /*
     * First phase of mark is finished. Now if we are the owner
     * of a shared pool, we must run the mark phase of other
     * interpreters in our pool, so that live shared PMCs in that
     * interpreter are appended to our mark_ptrs chain.
     *
     * If there is a count of shared PMCs and we have already seen
     * all these, we could skip that.
     */
    if (interp->profile)
        Parrot_dod_profile_start(interp);

    pt_DOD_mark_root_finished(interp);

    for (; ; current = next) {
        const UINTVAL bits = PObj_get_FLAGS(current) & mask;

        if (lazy_dod && arena_base->num_early_PMCs_seen >=
                arena_base->num_early_DOD_PMCs) {
            return 0;
        }

        arena_base->dod_trace_ptr = current;

        /* short-term hack to color objects black */
        PObj_get_FLAGS(current) |= PObj_custom_GC_FLAG;

        /* clearing the flag is much more expensive then testing */
        if (!PObj_needs_early_DOD_TEST(current))
            PObj_high_priority_DOD_CLEAR(current);

        /* mark properties */
        if (PMC_metadata(current))
            pobject_lives(interp, (PObj *)PMC_metadata(current));

        /* Start by checking if there's anything at all. This assumes that the
         * largest percentage of PMCs won't have anything in their data
         * pointer that we need to trace. */
        if (bits) {
            if (bits == PObj_data_is_PMC_array_FLAG) {
                /* malloced array of PMCs */
                PMC ** const data = PMC_data_typed(current, PMC **);

                if (data) {
                    int i;
                    for (i = 0; i < PMC_int_val(current); i++) {
                        if (data[i])
                            pobject_lives(interp, (PObj *)data[i]);
                    }
                }
            }
            else {
                /* All that's left is the custom */
                PARROT_ASSERT(!PObj_on_free_list_TEST(current));
                VTABLE_mark(interp, current);
            }
        }

        next = PMC_next_for_GC(current);

        if (!PMC_IS_NULL(next) && next == current)
            break;

        if (--how_many == 0) {
            current = next;
            break;
        }
    }

    arena_base->dod_mark_start = current;
    arena_base->dod_trace_ptr  = NULL;

    if (interp->profile)
        Parrot_dod_profile_end(interp, PARROT_PROF_DOD_p2);

    return 1;
}

#ifdef GC_IS_MALLOC

/*

FUNCDOC: clear_cow

Clear the COW ref count.

*/

void clear_cow(PARROT_INTERP, NOTNULL(Small_Object_Pool *pool), int cleanup) { const UINTVAL object_size = pool->object_size; Small_Object_Arena *cur_arena;

    /* clear refcount for COWable objects. */
    for (cur_arena = pool->last_Arena;
            NULL != cur_arena; cur_arena = cur_arena->prev) {
        UINTVAL i;
        Buffer *b = cur_arena->start_objects;

        for (i = 0; i < cur_arena->used; i++) {
            if (!PObj_on_free_list_TEST(b)) {
                if (cleanup) {
                    /* clear COWed external FLAG */
                    PObj_external_CLEAR(b);

                    /* if cleanup (Parrot_destroy) constants are dead too */
                    PObj_constant_CLEAR(b);
                    PObj_live_CLEAR(b);
                }

                if (PObj_COW_TEST(b) && PObj_bufstart(b) &&
                        !PObj_external_TEST(b)) {
                    INTVAL * const refcount = PObj_bufrefcountptr(b);
                    *refcount               = 0;
                }
            }

            b = (Buffer *)((char *)b + object_size);
        }
    }
}

/*

FUNCDOC: used_cow

Find other users of COW's bufstart.

*/

void used_cow(PARROT_INTERP, NOTNULL(Small_Object_Pool *pool), int cleanup) { UINTVAL object_size = pool->object_size; Small_Object_Arena *cur_arena;

    for (cur_arena = pool->last_Arena;
            NULL != cur_arena; cur_arena = cur_arena->prev) {
        const Buffer *b = cur_arena->start_objects;
        UINTVAL i;

        for (i = 0; i < cur_arena->used; i++) {
            if (!PObj_on_free_list_TEST(b) &&
                    PObj_COW_TEST(b) &&
                    PObj_bufstart(b) &&
                   !PObj_external_TEST(b)) {

                INTVAL * const refcount = PObj_bufrefcountptr(b);

                /* mark users of this bufstart by incrementing refcount */
                if (PObj_live_TEST(b))
                    *refcount = 1 << 29;        /* ~infinite usage */
                else
                    (*refcount)++;      /* dead usage */
            }

            b = (Buffer *)((char *)b + object_size);
        }
    }
}
#endif /* GC_IS_MALLOC */

/*

FUNCDOC: Parrot_dod_sweep

Put any buffers/PMCs that are now unused onto the pool's free list. If GC_IS_MALLOC, bufstart gets freed too, if possible. Avoid buffers that are immune from collection (i.e. constant).

*/

PARROT_API void Parrot_dod_sweep(PARROT_INTERP, NOTNULL(Small_Object_Pool *pool)) { Arenas * const arena_base = interp->arena_base;

    UINTVAL i;
    UINTVAL total_used    = 0;
    UINTVAL object_size   = pool->object_size;

    Small_Object_Arena *cur_arena;

#if GC_VERBOSE if (Interp_trace_TEST(interp, 1)) { Interp *tracer = interp->debugger; PMC *pio = PIO_STDERR(interp);

        PIO_flush(interp, pio);

        if (tracer) {
            pio = PIO_STDERR(tracer);
            PIO_flush(tracer, pio);
        }
    }
#endif

    /* Run through all the buffer header pools and mark */
    for (cur_arena = pool->last_Arena;
            NULL != cur_arena; cur_arena = cur_arena->prev) {
        Buffer *b = (Buffer *)cur_arena->start_objects;

        for (i = 0; i < cur_arena->total_objects; i++) {
            if (PObj_on_free_list_TEST(b))
                ; /* if it's on free list, do nothing */
            else if (PObj_live_TEST(b)) {
                total_used++;
                PObj_live_CLEAR(b);
                PObj_get_FLAGS(b) &= ~PObj_custom_GC_FLAG;
            }
            else {
                /* it must be dead */

#if GC_VERBOSE if (Interp_trace_TEST(interp, 1)) { fprintf(stderr, "Freeing pobject %p\n", b); if (PObj_is_PMC_TEST(b)) { fprintf(stderr, "\t = PMC type %s\n", (char*) ((PMC*)b)->vtable->whoami->strstart); } } #endif

                if (PObj_is_shared_TEST(b)) {
                    /* only mess with shared objects if we
                     * (and thus everyone) is suspended for
                     * a GC run.
                     * XXX wrong thing to do with "other" GCs
                     */
                    if (!(interp->thread_data &&
                            (interp->thread_data->state &
                            THREAD_STATE_SUSPENDED_GC))) {
                        ++total_used;
                        goto next;
                    }
                }

                /* if object is a PMC and needs destroying */
                if (PObj_is_PMC_TEST(b)) {
                    PMC * const p = (PMC *)b;

                    /* then destroy it here
                     *
                     * TODO collect objects with finalizers
                    */
                    if (PObj_needs_early_DOD_TEST(p))
                        --arena_base->num_early_DOD_PMCs;

                    if (PObj_active_destroy_TEST(p))
                        VTABLE_destroy(interp, p);

                    if (PObj_is_PMC_EXT_TEST(p) && p->pmc_ext != NULL) {
                        /* if the PMC has a PMC_EXT structure,
                         * return it to the pool/arena */
                        Small_Object_Pool * const ext_pool
                            = arena_base->pmc_ext_pool;

                        if (PObj_is_PMC_shared_TEST(p) && PMC_sync(p)) {
                            MUTEX_DESTROY(PMC_sync(p)->pmc_lock);
                            mem_internal_free(PMC_sync(p));
                            PMC_sync(p) = NULL;
                        }

                        ext_pool->add_free_object(interp, ext_pool, (PObj *)p->pmc_ext);
                    }
#ifndef NDEBUG
                    /*
                     * invalidate the PMC
                     */
                    p->pmc_ext     = (PMC_EXT *)0xdeadbeef;
                    p->vtable      = (VTABLE  *)0xdeadbeef;
                    PMC_pmc_val(p) = (PMC     *)0xdeadbeef;
#endif
                }
                /* else object is a buffer(like) */
                else if (PObj_sysmem_TEST(b) && PObj_bufstart(b)) {
                    /* has sysmem allocated, e.g. string_pin */
                    mem_sys_free(PObj_bufstart(b));
                    PObj_bufstart(b) = NULL;
                    PObj_buflen(b)   = 0;
                }
                else {
#ifdef GC_IS_MALLOC
                    /* free allocated space at (int*)bufstart - 1,
                     * but not if it used COW or is external
                     */
                    if (PObj_bufstart(b) &&
                            !PObj_is_external_or_free_TESTALL(b)) {
                        if (PObj_COW_TEST(b)) {
                            INTVAL *refcount = ((INTVAL *)PObj_bufstart(b) - 1);

                            if (!--(*refcount)) {
                                free(refcount); /* the actual bufstart */
                                refcount = NULL;
                            }
                        }
                        else
                            free((INTVAL*)PObj_bufstart(b) - 1);
                    }
#else
                    /*
                     * XXX Jarkko did report that on irix pool->mem_pool
                     *     was NULL, which really shouldn't happen
                     */
                    if (pool->mem_pool) {
                        if (!PObj_COW_TEST(b)) {
                            ((Memory_Pool *)
                             pool->mem_pool)->guaranteed_reclaimable +=
                                PObj_buflen(b);
                        }
                        ((Memory_Pool *)
                         pool->mem_pool)->possibly_reclaimable +=
                            PObj_buflen(b);
                    }
#endif
                    PObj_buflen(b) = 0;
                }
                PObj_flags_SETTO((PObj *)b, PObj_on_free_list_FLAG);
                pool->add_free_object(interp, pool, b);
            }
next:
            b = (Buffer *)((char *)b + object_size);
        }
    }
    pool->num_free_objects = pool->total_objects - total_used;
}

#ifndef PLATFORM_STACK_WALK

/*

FUNCDOC: find_common_mask

Find a mask covering the longest common bit-prefix of val1 and val2.

*/

PARROT_CONST_FUNCTION static size_t find_common_mask(PARROT_INTERP, size_t val1, size_t val2) { int i; const int bound = sizeof (size_t) * 8;

    /* Shifting a value by its size (in bits) or larger is undefined behaviour.
       So need an explicit check to return 0 if there is no prefix, rather than
       attempting to rely on (say) 0xFFFFFFFF << 32 being 0.  */
    for (i = 0; i < bound; i++) {
        if (val1 == val2)
            return ~(size_t)0 << i;

        val1 >>= 1;
        val2 >>= 1;
    }

    if (val1 == val2) {
        PARROT_ASSERT(i == bound);
        return 0;
    }

    real_exception(interp, NULL, INTERP_ERROR,
            "Unexpected condition in find_common_mask()!\n");
}

/*

FUNCDOC: trace_mem_block

Traces the memory block between lo_var_ptr and hi_var_ptr.

*/

void trace_mem_block(PARROT_INTERP, size_t lo_var_ptr, size_t hi_var_ptr) { size_t prefix; ptrdiff_t cur_var_ptr;

    const size_t buffer_min = get_min_buffer_address(interp);
    const size_t buffer_max = get_max_buffer_address(interp);
    const size_t pmc_min    = get_min_pmc_address(interp);
    const size_t pmc_max    = get_max_pmc_address(interp);

    const size_t mask       =
        find_common_mask(interp,
                         buffer_min < pmc_min ? buffer_min : pmc_min,
                         buffer_max > pmc_max ? buffer_max : pmc_max);

    if (!lo_var_ptr || !hi_var_ptr)
        return;

    if (lo_var_ptr < hi_var_ptr) {
        const size_t tmp_ptr = hi_var_ptr;
        hi_var_ptr           = lo_var_ptr;
        lo_var_ptr           = tmp_ptr;
    }

    /* Get the expected prefix */
    prefix = mask & buffer_min;

    for (cur_var_ptr = hi_var_ptr;
            (ptrdiff_t)cur_var_ptr < (ptrdiff_t)lo_var_ptr;
            cur_var_ptr = (size_t)((ptrdiff_t)cur_var_ptr + sizeof (void *))) {
        const size_t ptr = *(size_t *)cur_var_ptr;

        /* Do a quick approximate range check by bit-masking */
        if ((ptr & mask) == prefix || !prefix) {
            /* Note that what we find via the stack or registers are not
             * guaranteed to be live pmcs/buffers, and could very well have
             * had their bufstart/vtable destroyed due to the linked list of
             * free headers... */
            if (pmc_min <= ptr && ptr < pmc_max &&
                    is_pmc_ptr(interp, (void *)ptr)) {
                /* ...so ensure that pobject_lives checks PObj_on_free_list_FLAG
                 * before adding it to the next_for_GC list, to have
                 * vtable->mark() called. */
                pobject_lives(interp, (PObj *)ptr);
            }
            else if (buffer_min <= ptr && ptr < buffer_max &&
                    is_buffer_ptr(interp, (void *)ptr)) {
                /* ...and since pobject_lives doesn't care about bufstart, it
                 * doesn't really matter if it sets a flag */
                pobject_lives(interp, (PObj *)ptr);
            }
        }
    }

    return;
}
#endif

/*

FUNCDOC: Run through all PMC arenas and clear live bits.

*/

static void clear_live_bits(NOTNULL(Small_Object_Pool *pool)) { Small_Object_Arena *arena; const UINTVAL object_size = pool->object_size;

    for (arena = pool->last_Arena; arena; arena = arena->prev) {
        Buffer *b = (Buffer *)arena->start_objects;
        UINTVAL i;

        for (i = 0; i < arena->used; i++) {
            PObj_live_CLEAR(b);
            b = (Buffer *)((char *)b + object_size);
        }
    }

}

PARROT_API void Parrot_dod_clear_live_bits(PARROT_INTERP) { Small_Object_Pool * const pool = interp->arena_base->pmc_pool; clear_live_bits(pool); }

/*

FUNCDOC: Parrot_dod_profile_start

Records the start time of a DOD run when profiling is enabled.

*/

PARROT_API void Parrot_dod_profile_start(PARROT_INTERP) { if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) interp->profile->dod_time = Parrot_floatval_time(); }

/*

FUNCDOC: Parrot_dod_profile_end

Records the end time of the DOD part what run when profiling is enabled. Also record start time of next part.

*/

PARROT_API void Parrot_dod_profile_end(PARROT_INTERP, int what) { if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) { RunProfile * const profile = interp->profile; const FLOATVAL now = Parrot_floatval_time();

        profile->data[what].numcalls++;
        profile->data[what].time += now - profile->dod_time;

        /*
         * we've recorded the time of a DOD/GC piece from
         * dod_time until now, so add this to the start of the
         * currently executing opcode, which hasn't run this
         * interval.
         */
        profile->starttime += now - profile->dod_time;

        /* prepare start for next step */
        profile->dod_time   = now;
    }
}

/*

FUNCDOC: Parrot_dod_ms_run_init

Prepare for a mark & sweep DOD run.

*/

PARROT_API void Parrot_dod_ms_run_init(PARROT_INTERP) { Arenas * const arena_base = interp->arena_base;

    arena_base->dod_trace_ptr       = NULL;
    arena_base->dod_mark_start      = NULL;
    arena_base->num_early_PMCs_seen = 0;
    arena_base->num_extended_PMCs   = 0;
}

static int sweep_cb(PARROT_INTERP, NOTNULL(Small_Object_Pool *pool), int flag, NOTNULL(void *arg)) { int * const total_free = (int *) arg;

#ifdef GC_IS_MALLOC if (flag & POOL_BUFFER) used_cow(interp, pool, 0); #endif

    Parrot_dod_sweep(interp, pool);

#ifdef GC_IS_MALLOC if (flag & POOL_BUFFER) clear_cow(interp, pool, 0); #endif

    if (interp->profile && (flag & POOL_PMC))
        Parrot_dod_profile_end(interp, PARROT_PROF_DOD_cp);

    *total_free += pool->num_free_objects;

    return 0;
}

/*

FUNCDOC: Parrot_dod_ms_run

Run the stop-the-world mark & sweep collector.

*/

PARROT_API void Parrot_dod_ms_run(PARROT_INTERP, int flags) { Arenas * const arena_base = interp->arena_base;

    /* XXX these should go into the interpreter */
    int total_free     = 0;

    if (arena_base->DOD_block_level)
        return;

    if (interp->debugger) {
        /*
         * if the other interpreter did a DOD run, it can set
         * live bits of shared objects, but these aren't reset, because
         * they are in a different arena. When now such a PMC points to
         * other non-shared object, these wouldn't be marked and hence
         * collected.
         */
        Parrot_dod_clear_live_bits(interp);
    }

    /*
     * the sync sweep is always at the end, so that
     * the live bits are cleared
     */
    if (flags & DOD_finish_FLAG) {
        /* XXX */
        Parrot_dod_clear_live_bits(interp);
        clear_live_bits(interp->arena_base->constant_pmc_pool);

        Parrot_dod_sweep(interp, interp->arena_base->pmc_pool);
        Parrot_dod_sweep(interp, interp->arena_base->constant_pmc_pool);

        return;
    }

    ++arena_base->DOD_block_level;
    arena_base->lazy_dod = flags & DOD_lazy_FLAG;

    /* tell the threading system that we're doing DOD mark */
    pt_DOD_start_mark(interp);
    Parrot_dod_ms_run_init(interp);

    /* Now go trace the PMCs */
    if (trace_active_PMCs(interp, flags & DOD_trace_stack_FLAG)) {
        int ignored;

        arena_base->dod_trace_ptr = NULL;
        arena_base->dod_mark_ptr  = NULL;

        /* mark is now finished */
        pt_DOD_stop_mark(interp);

        /* Now put unused PMCs and Buffers on the free list */
        ignored = Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_PMC,
            (void*)&total_free, sweep_cb);

        if (interp->profile)
            Parrot_dod_profile_end(interp, PARROT_PROF_DOD_cb);
    }
    else {
        pt_DOD_stop_mark(interp); /* XXX */

        /* successful lazy DOD count */
        ++arena_base->lazy_dod_runs;

        Parrot_dod_clear_live_bits(interp);
        if (interp->profile)
            Parrot_dod_profile_end(interp, PARROT_PROF_DOD_p2);
    }

    /* Note it */
    arena_base->dod_runs++;
    --arena_base->DOD_block_level;

    return;
}

/*

FUNCDOC: Parrot_do_dod_run

Call the configured garbage collector to reclaim unused headers.

*/

PARROT_API void Parrot_do_dod_run(PARROT_INTERP, UINTVAL flags) { interp->arena_base->do_dod_run(interp, flags); parrot_gc_context(interp); }

/*

SEE ALSO ^

include/parrot/dod.h, src/cpu_dep.c, docs/dev/dod.dev and docs/pdds/pdd09_gc.pod.

HISTORY ^

Initial version by Mike Lambert on 2002.05.27.

*/

/* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */


parrot