diff options
Diffstat (limited to 'rts/sm/Scav.c')
| -rw-r--r-- | rts/sm/Scav.c | 1929 |
1 files changed, 1929 insertions, 0 deletions
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c new file mode 100644 index 0000000000..26b33f479e --- /dev/null +++ b/rts/sm/Scav.c @@ -0,0 +1,1929 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2006 + * + * Generational garbage collector: scavenging functions + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "Storage.h" +#include "MBlock.h" +#include "GC.h" +#include "Compact.h" +#include "Evac.h" +#include "Scav.h" +#include "Apply.h" +#include "Trace.h" +#include "LdvProfile.h" + +static void scavenge_stack (StgPtr p, StgPtr stack_end); + +static void scavenge_large_bitmap (StgPtr p, + StgLargeBitmap *large_bitmap, + nat size ); + +/* Similar to scavenge_large_bitmap(), but we don't write back the + * pointers we get back from evacuate(). + */ +static void +scavenge_large_srt_bitmap( StgLargeSRT *large_srt ) +{ + nat i, b, size; + StgWord bitmap; + StgClosure **p; + + b = 0; + bitmap = large_srt->l.bitmap[b]; + size = (nat)large_srt->l.size; + p = (StgClosure **)large_srt->srt; + for (i = 0; i < size; ) { + if ((bitmap & 1) != 0) { + evacuate(*p); + } + i++; + p++; + if (i % BITS_IN(W_) == 0) { + b++; + bitmap = large_srt->l.bitmap[b]; + } else { + bitmap = bitmap >> 1; + } + } +} + +/* evacuate the SRT. If srt_bitmap is zero, then there isn't an + * srt field in the info table. That's ok, because we'll + * never dereference it. + */ +STATIC_INLINE void +scavenge_srt (StgClosure **srt, nat srt_bitmap) +{ + nat bitmap; + StgClosure **p; + + bitmap = srt_bitmap; + p = srt; + + if (bitmap == (StgHalfWord)(-1)) { + scavenge_large_srt_bitmap( (StgLargeSRT *)srt ); + return; + } + + while (bitmap != 0) { + if ((bitmap & 1) != 0) { +#ifdef ENABLE_WIN32_DLL_SUPPORT + // Special-case to handle references to closures hiding out in DLLs, since + // double indirections required to get at those. The code generator knows + // which is which when generating the SRT, so it stores the (indirect) + // reference to the DLL closure in the table by first adding one to it. + // We check for this here, and undo the addition before evacuating it. + // + // If the SRT entry hasn't got bit 0 set, the SRT entry points to a + // closure that's fixed at link-time, and no extra magic is required. + if ( (unsigned long)(*srt) & 0x1 ) { + evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1))); + } else { + evacuate(*p); + } +#else + evacuate(*p); +#endif + } + p++; + bitmap = bitmap >> 1; + } +} + + +STATIC_INLINE void +scavenge_thunk_srt(const StgInfoTable *info) +{ + StgThunkInfoTable *thunk_info; + + if (!major_gc) return; + + thunk_info = itbl_to_thunk_itbl(info); + scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap); +} + +STATIC_INLINE void +scavenge_fun_srt(const StgInfoTable *info) +{ + StgFunInfoTable *fun_info; + + if (!major_gc) return; + + fun_info = itbl_to_fun_itbl(info); + scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap); +} + +/* ----------------------------------------------------------------------------- + Scavenge a TSO. + -------------------------------------------------------------------------- */ + +static void +scavengeTSO (StgTSO *tso) +{ + if ( tso->why_blocked == BlockedOnMVar + || tso->why_blocked == BlockedOnBlackHole + || tso->why_blocked == BlockedOnException +#if defined(PAR) + || tso->why_blocked == BlockedOnGA + || tso->why_blocked == BlockedOnGA_NoSend +#endif + ) { + tso->block_info.closure = evacuate(tso->block_info.closure); + } + tso->blocked_exceptions = + (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions); + + // We don't always chase the link field: TSOs on the blackhole + // queue are not automatically alive, so the link field is a + // "weak" pointer in that case. + if (tso->why_blocked != BlockedOnBlackHole) { + tso->link = (StgTSO *)evacuate((StgClosure *)tso->link); + } + + // scavange current transaction record + tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec); + + // scavenge this thread's stack + scavenge_stack(tso->sp, &(tso->stack[tso->stack_size])); +} + +/* ----------------------------------------------------------------------------- + Blocks of function args occur on the stack (at the top) and + in PAPs. + -------------------------------------------------------------------------- */ + +STATIC_INLINE StgPtr +scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) +{ + StgPtr p; + StgWord bitmap; + nat size; + + p = (StgPtr)args; + switch (fun_info->f.fun_type) { + case ARG_GEN: + bitmap = BITMAP_BITS(fun_info->f.b.bitmap); + size = BITMAP_SIZE(fun_info->f.b.bitmap); + goto small_bitmap; + case ARG_GEN_BIG: + size = GET_FUN_LARGE_BITMAP(fun_info)->size; + scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); + p += size; + break; + default: + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + small_bitmap: + while (size > 0) { + if ((bitmap & 1) == 0) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p++; + bitmap = bitmap >> 1; + size--; + } + break; + } + return p; +} + +STATIC_INLINE StgPtr +scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) +{ + StgPtr p; + StgWord bitmap; + StgFunInfoTable *fun_info; + + fun_info = get_fun_itbl(fun); + ASSERT(fun_info->i.type != PAP); + p = (StgPtr)payload; + + switch (fun_info->f.fun_type) { + case ARG_GEN: + bitmap = BITMAP_BITS(fun_info->f.b.bitmap); + goto small_bitmap; + case ARG_GEN_BIG: + scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); + p += size; + break; + case ARG_BCO: + scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size); + p += size; + break; + default: + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + small_bitmap: + while (size > 0) { + if ((bitmap & 1) == 0) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p++; + bitmap = bitmap >> 1; + size--; + } + break; + } + return p; +} + +STATIC_INLINE StgPtr +scavenge_PAP (StgPAP *pap) +{ + pap->fun = evacuate(pap->fun); + return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args); +} + +STATIC_INLINE StgPtr +scavenge_AP (StgAP *ap) +{ + ap->fun = evacuate(ap->fun); + return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args); +} + +/* ----------------------------------------------------------------------------- + Scavenge a given step until there are no more objects in this step + to scavenge. + + evac_gen is set by the caller to be either zero (for a step in a + generation < N) or G where G is the generation of the step being + scavenged. + + We sometimes temporarily change evac_gen back to zero if we're + scavenging a mutable object where early promotion isn't such a good + idea. + -------------------------------------------------------------------------- */ + +void +scavenge(step *stp) +{ + StgPtr p, q; + StgInfoTable *info; + bdescr *bd; + nat saved_evac_gen = evac_gen; + + p = stp->scan; + bd = stp->scan_bd; + + failed_to_evac = rtsFalse; + + /* scavenge phase - standard breadth-first scavenging of the + * evacuated objects + */ + + while (bd != stp->hp_bd || p < stp->hp) { + + // If we're at the end of this block, move on to the next block + if (bd != stp->hp_bd && p == bd->free) { + bd = bd->link; + p = bd->start; + continue; + } + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = get_itbl((StgClosure *)p); + + ASSERT(thunk_selector_depth == 0); + + q = p; + switch (info->type) { + + case MVAR: + { + StgMVar *mvar = ((StgMVar *)p); + evac_gen = 0; + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable. + p += sizeofW(StgMVar); + break; + } + + case FUN_2_0: + scavenge_fun_srt(info); + ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_2_0: + scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; + break; + + case CONSTR_2_0: + ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_0: + scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 1; + break; + + case FUN_1_0: + scavenge_fun_srt(info); + case CONSTR_1_0: + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_1: + scavenge_thunk_srt(info); + p += sizeofW(StgThunk) + 1; + break; + + case FUN_0_1: + scavenge_fun_srt(info); + case CONSTR_0_1: + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_2: + scavenge_thunk_srt(info); + p += sizeofW(StgThunk) + 2; + break; + + case FUN_0_2: + scavenge_fun_srt(info); + case CONSTR_0_2: + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_1: + scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; + break; + + case FUN_1_1: + scavenge_fun_srt(info); + case CONSTR_1_1: + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case FUN: + scavenge_fun_srt(info); + goto gen_obj; + + case THUNK: + { + StgPtr end; + + scavenge_thunk_srt(info); + end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p += info->layout.payload.nptrs; + break; + } + + gen_obj: + case CONSTR: + case WEAK: + case STABLE_NAME: + { + StgPtr end; + + end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p += info->layout.payload.nptrs; + break; + } + + case BCO: { + StgBCO *bco = (StgBCO *)p; + bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); + bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); + bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); + bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); + p += bco_sizeW(bco); + break; + } + + case IND_PERM: + if (stp->gen->no != 0) { +#ifdef PROFILING + // @LDV profiling + // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an + // IND_OLDGEN_PERM closure is larger than an IND_PERM closure. + LDV_recordDead((StgClosure *)p, sizeofW(StgInd)); +#endif + // + // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()? + // + SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); + + // We pretend that p has just been created. + LDV_RECORD_CREATE((StgClosure *)p); + } + // fall through + case IND_OLDGEN_PERM: + ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee); + p += sizeofW(StgInd); + break; + + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; + ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); + eager_promotion = saved_eager_promotion; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; + } + p += sizeofW(StgMutVar); + break; + } + + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + p += BLACKHOLE_sizeW(); + break; + + case THUNK_SELECTOR: + { + StgSelector *s = (StgSelector *)p; + s->selectee = evacuate(s->selectee); + p += THUNK_SELECTOR_sizeW(); + break; + } + + // A chunk of stack saved in a heap object + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + + ap->fun = evacuate(ap->fun); + scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + p = (StgPtr)ap->payload + ap->size; + break; + } + + case PAP: + p = scavenge_PAP((StgPAP *)p); + break; + + case AP: + p = scavenge_AP((StgAP *)p); + break; + + case ARR_WORDS: + // nothing to follow + p += arr_words_sizeW((StgArrWords *)p); + break; + + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + // follow everything + { + StgPtr next; + rtsBool saved_eager; + + // We don't eagerly promote objects pointed to by a mutable + // array, but if we find the array only points to objects in + // the same or an older generation, we mark it "clean" and + // avoid traversing it during minor GCs. + saved_eager = eager_promotion; + eager_promotion = rtsFalse; + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + eager_promotion = saved_eager; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + } + + failed_to_evac = rtsTrue; // always put it on the mutable list. + break; + } + + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + // follow everything + { + StgPtr next; + + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + + // If we're going to put this object on the mutable list, then + // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; + } + break; + } + + case TSO: + { + StgTSO *tso = (StgTSO *)p; + rtsBool saved_eager = eager_promotion; + + eager_promotion = rtsFalse; + scavengeTSO(tso); + eager_promotion = saved_eager; + + if (failed_to_evac) { + tso->flags |= TSO_DIRTY; + } else { + tso->flags &= ~TSO_DIRTY; + } + + failed_to_evac = rtsTrue; // always on the mutable list + p += tso_sizeW(tso); + break; + } + +#if defined(PAR) + case RBH: + { +#if 0 + nat size, ptrs, nonptrs, vhs; + char str[80]; + StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); +#endif + StgRBH *rbh = (StgRBH *)p; + (StgClosure *)rbh->blocking_queue = + evacuate((StgClosure *)rbh->blocking_queue); + failed_to_evac = rtsTrue; // mutable anyhow. + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue); + // ToDo: use size of reverted closure here! + p += BLACKHOLE_sizeW(); + break; + } + + case BLOCKED_FETCH: + { + StgBlockedFetch *bf = (StgBlockedFetch *)p; + // follow the pointer to the node which is being demanded + (StgClosure *)bf->node = + evacuate((StgClosure *)bf->node); + // follow the link to the rest of the blocking queue + (StgClosure *)bf->link = + evacuate((StgClosure *)bf->link); + debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); + p += sizeofW(StgBlockedFetch); + break; + } + +#ifdef DIST + case REMOTE_REF: +#endif + case FETCH_ME: + p += sizeofW(StgFetchMe); + break; // nothing to do in this case + + case FETCH_ME_BQ: + { + StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; + (StgClosure *)fmbq->blocking_queue = + evacuate((StgClosure *)fmbq->blocking_queue); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); + p += sizeofW(StgFetchMeBlockingQueue); + break; + } +#endif + + case TVAR_WATCH_QUEUE: + { + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); + evac_gen = 0; + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTVarWatchQueue); + break; + } + + case TVAR: + { + StgTVar *tvar = ((StgTVar *) p); + evac_gen = 0; + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTVar); + break; + } + + case TREC_HEADER: + { + StgTRecHeader *trec = ((StgTRecHeader *) p); + evac_gen = 0; + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTRecHeader); + break; + } + + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = ((StgTRecChunk *) p); + TRecEntry *e = &(tc -> entries[0]); + evac_gen = 0; + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); + } + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTRecChunk); + break; + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgAtomicInvariant); + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgInvariantCheckQueue); + break; + } + + default: + barf("scavenge: unimplemented/strange closure type %d @ %p", + info->type, p); + } + + /* + * We need to record the current object on the mutable list if + * (a) It is actually mutable, or + * (b) It contains pointers to a younger generation. + * Case (b) arises if we didn't manage to promote everything that + * the current object points to into the current generation. + */ + if (failed_to_evac) { + failed_to_evac = rtsFalse; + if (stp->gen_no > 0) { + recordMutableGen((StgClosure *)q, stp->gen); + } + } + } + + stp->scan_bd = bd; + stp->scan = p; +} + +/* ----------------------------------------------------------------------------- + Scavenge everything on the mark stack. + + This is slightly different from scavenge(): + - we don't walk linearly through the objects, so the scavenger + doesn't need to advance the pointer on to the next object. + -------------------------------------------------------------------------- */ + +void +scavenge_mark_stack(void) +{ + StgPtr p, q; + StgInfoTable *info; + nat saved_evac_gen; + + evac_gen = oldest_gen->no; + saved_evac_gen = evac_gen; + +linear_scan: + while (!mark_stack_empty()) { + p = pop_mark_stack(); + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = get_itbl((StgClosure *)p); + + q = p; + switch (info->type) { + + case MVAR: + { + StgMVar *mvar = ((StgMVar *)p); + evac_gen = 0; + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable. + break; + } + + case FUN_2_0: + scavenge_fun_srt(info); + ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + break; + + case THUNK_2_0: + scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + break; + + case CONSTR_2_0: + ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + break; + + case FUN_1_0: + case FUN_1_1: + scavenge_fun_srt(info); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + break; + + case THUNK_1_0: + case THUNK_1_1: + scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + break; + + case CONSTR_1_0: + case CONSTR_1_1: + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + break; + + case FUN_0_1: + case FUN_0_2: + scavenge_fun_srt(info); + break; + + case THUNK_0_1: + case THUNK_0_2: + scavenge_thunk_srt(info); + break; + + case CONSTR_0_1: + case CONSTR_0_2: + break; + + case FUN: + scavenge_fun_srt(info); + goto gen_obj; + + case THUNK: + { + StgPtr end; + + scavenge_thunk_srt(info); + end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + break; + } + + gen_obj: + case CONSTR: + case WEAK: + case STABLE_NAME: + { + StgPtr end; + + end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + break; + } + + case BCO: { + StgBCO *bco = (StgBCO *)p; + bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); + bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); + bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); + bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); + break; + } + + case IND_PERM: + // don't need to do anything here: the only possible case + // is that we're in a 1-space compacting collector, with + // no "old" generation. + break; + + case IND_OLDGEN: + case IND_OLDGEN_PERM: + ((StgInd *)p)->indirectee = + evacuate(((StgInd *)p)->indirectee); + break; + + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; + ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); + eager_promotion = saved_eager_promotion; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; + } + break; + } + + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + case ARR_WORDS: + break; + + case THUNK_SELECTOR: + { + StgSelector *s = (StgSelector *)p; + s->selectee = evacuate(s->selectee); + break; + } + + // A chunk of stack saved in a heap object + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + + ap->fun = evacuate(ap->fun); + scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + break; + } + + case PAP: + scavenge_PAP((StgPAP *)p); + break; + + case AP: + scavenge_AP((StgAP *)p); + break; + + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + // follow everything + { + StgPtr next; + rtsBool saved_eager; + + // We don't eagerly promote objects pointed to by a mutable + // array, but if we find the array only points to objects in + // the same or an older generation, we mark it "clean" and + // avoid traversing it during minor GCs. + saved_eager = eager_promotion; + eager_promotion = rtsFalse; + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + eager_promotion = saved_eager; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + } + + failed_to_evac = rtsTrue; // mutable anyhow. + break; + } + + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + // follow everything + { + StgPtr next, q = p; + + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + + // If we're going to put this object on the mutable list, then + // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; + } + break; + } + + case TSO: + { + StgTSO *tso = (StgTSO *)p; + rtsBool saved_eager = eager_promotion; + + eager_promotion = rtsFalse; + scavengeTSO(tso); + eager_promotion = saved_eager; + + if (failed_to_evac) { + tso->flags |= TSO_DIRTY; + } else { + tso->flags &= ~TSO_DIRTY; + } + + failed_to_evac = rtsTrue; // always on the mutable list + break; + } + +#if defined(PAR) + case RBH: + { +#if 0 + nat size, ptrs, nonptrs, vhs; + char str[80]; + StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); +#endif + StgRBH *rbh = (StgRBH *)p; + bh->blocking_queue = + (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); + failed_to_evac = rtsTrue; // mutable anyhow. + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue)); + break; + } + + case BLOCKED_FETCH: + { + StgBlockedFetch *bf = (StgBlockedFetch *)p; + // follow the pointer to the node which is being demanded + (StgClosure *)bf->node = + evacuate((StgClosure *)bf->node); + // follow the link to the rest of the blocking queue + (StgClosure *)bf->link = + evacuate((StgClosure *)bf->link); + debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); + break; + } + +#ifdef DIST + case REMOTE_REF: +#endif + case FETCH_ME: + break; // nothing to do in this case + + case FETCH_ME_BQ: + { + StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; + (StgClosure *)fmbq->blocking_queue = + evacuate((StgClosure *)fmbq->blocking_queue); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); + break; + } +#endif /* PAR */ + + case TVAR_WATCH_QUEUE: + { + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); + evac_gen = 0; + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TVAR: + { + StgTVar *tvar = ((StgTVar *) p); + evac_gen = 0; + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = ((StgTRecChunk *) p); + TRecEntry *e = &(tc -> entries[0]); + evac_gen = 0; + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); + } + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TREC_HEADER: + { + StgTRecHeader *trec = ((StgTRecHeader *) p); + evac_gen = 0; + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + default: + barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", + info->type, p); + } + + if (failed_to_evac) { + failed_to_evac = rtsFalse; + if (evac_gen > 0) { + recordMutableGen((StgClosure *)q, &generations[evac_gen]); + } + } + + // mark the next bit to indicate "scavenged" + mark(q+1, Bdescr(q)); + + } // while (!mark_stack_empty()) + + // start a new linear scan if the mark stack overflowed at some point + if (mark_stack_overflowed && oldgen_scan_bd == NULL) { + debugTrace(DEBUG_gc, "scavenge_mark_stack: starting linear scan"); + mark_stack_overflowed = rtsFalse; + oldgen_scan_bd = oldest_gen->steps[0].old_blocks; + oldgen_scan = oldgen_scan_bd->start; + } + + if (oldgen_scan_bd) { + // push a new thing on the mark stack + loop: + // find a closure that is marked but not scavenged, and start + // from there. + while (oldgen_scan < oldgen_scan_bd->free + && !is_marked(oldgen_scan,oldgen_scan_bd)) { + oldgen_scan++; + } + + if (oldgen_scan < oldgen_scan_bd->free) { + + // already scavenged? + if (is_marked(oldgen_scan+1,oldgen_scan_bd)) { + oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE; + goto loop; + } + push_mark_stack(oldgen_scan); + // ToDo: bump the linear scan by the actual size of the object + oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE; + goto linear_scan; + } + + oldgen_scan_bd = oldgen_scan_bd->link; + if (oldgen_scan_bd != NULL) { + oldgen_scan = oldgen_scan_bd->start; + goto loop; + } + } +} + +/* ----------------------------------------------------------------------------- + Scavenge one object. + + This is used for objects that are temporarily marked as mutable + because they contain old-to-new generation pointers. Only certain + objects can have this property. + -------------------------------------------------------------------------- */ + +static rtsBool +scavenge_one(StgPtr p) +{ + const StgInfoTable *info; + nat saved_evac_gen = evac_gen; + rtsBool no_luck; + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = get_itbl((StgClosure *)p); + + switch (info->type) { + + case MVAR: + { + StgMVar *mvar = ((StgMVar *)p); + evac_gen = 0; + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable. + break; + } + + case THUNK: + case THUNK_1_0: + case THUNK_0_1: + case THUNK_1_1: + case THUNK_0_2: + case THUNK_2_0: + { + StgPtr q, end; + + end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) { + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); + } + break; + } + + case FUN: + case FUN_1_0: // hardly worth specialising these guys + case FUN_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: + case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: + case WEAK: + case IND_PERM: + { + StgPtr q, end; + + end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) { + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); + } + break; + } + + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + StgPtr q = p; + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; + ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); + eager_promotion = saved_eager_promotion; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; + } + break; + } + + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + break; + + case THUNK_SELECTOR: + { + StgSelector *s = (StgSelector *)p; + s->selectee = evacuate(s->selectee); + break; + } + + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + + ap->fun = evacuate(ap->fun); + scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + p = (StgPtr)ap->payload + ap->size; + break; + } + + case PAP: + p = scavenge_PAP((StgPAP *)p); + break; + + case AP: + p = scavenge_AP((StgAP *)p); + break; + + case ARR_WORDS: + // nothing to follow + break; + + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + { + StgPtr next, q; + rtsBool saved_eager; + + // We don't eagerly promote objects pointed to by a mutable + // array, but if we find the array only points to objects in + // the same or an older generation, we mark it "clean" and + // avoid traversing it during minor GCs. + saved_eager = eager_promotion; + eager_promotion = rtsFalse; + q = p; + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + eager_promotion = saved_eager; + + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + } + + failed_to_evac = rtsTrue; + break; + } + + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + { + // follow everything + StgPtr next, q=p; + + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + + // If we're going to put this object on the mutable list, then + // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. + if (failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; + } + break; + } + + case TSO: + { + StgTSO *tso = (StgTSO *)p; + rtsBool saved_eager = eager_promotion; + + eager_promotion = rtsFalse; + scavengeTSO(tso); + eager_promotion = saved_eager; + + if (failed_to_evac) { + tso->flags |= TSO_DIRTY; + } else { + tso->flags &= ~TSO_DIRTY; + } + + failed_to_evac = rtsTrue; // always on the mutable list + break; + } + +#if defined(PAR) + case RBH: + { +#if 0 + nat size, ptrs, nonptrs, vhs; + char str[80]; + StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); +#endif + StgRBH *rbh = (StgRBH *)p; + (StgClosure *)rbh->blocking_queue = + evacuate((StgClosure *)rbh->blocking_queue); + failed_to_evac = rtsTrue; // mutable anyhow. + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue)); + // ToDo: use size of reverted closure here! + break; + } + + case BLOCKED_FETCH: + { + StgBlockedFetch *bf = (StgBlockedFetch *)p; + // follow the pointer to the node which is being demanded + (StgClosure *)bf->node = + evacuate((StgClosure *)bf->node); + // follow the link to the rest of the blocking queue + (StgClosure *)bf->link = + evacuate((StgClosure *)bf->link); + debugTrace(DEBUG_gc, + "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); + break; + } + +#ifdef DIST + case REMOTE_REF: +#endif + case FETCH_ME: + break; // nothing to do in this case + + case FETCH_ME_BQ: + { + StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; + (StgClosure *)fmbq->blocking_queue = + evacuate((StgClosure *)fmbq->blocking_queue); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); + break; + } +#endif + + case TVAR_WATCH_QUEUE: + { + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); + evac_gen = 0; + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TVAR: + { + StgTVar *tvar = ((StgTVar *) p); + evac_gen = 0; + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TREC_HEADER: + { + StgTRecHeader *trec = ((StgTRecHeader *) p); + evac_gen = 0; + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = ((StgTRecChunk *) p); + TRecEntry *e = &(tc -> entries[0]); + evac_gen = 0; + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); + } + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case IND_OLDGEN: + case IND_OLDGEN_PERM: + case IND_STATIC: + { + /* Careful here: a THUNK can be on the mutable list because + * it contains pointers to young gen objects. If such a thunk + * is updated, the IND_OLDGEN will be added to the mutable + * list again, and we'll scavenge it twice. evacuate() + * doesn't check whether the object has already been + * evacuated, so we perform that check here. + */ + StgClosure *q = ((StgInd *)p)->indirectee; + if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) { + break; + } + ((StgInd *)p)->indirectee = evacuate(q); + } + +#if 0 && defined(DEBUG) + if (RtsFlags.DebugFlags.gc) + /* Debugging code to print out the size of the thing we just + * promoted + */ + { + StgPtr start = gen->steps[0].scan; + bdescr *start_bd = gen->steps[0].scan_bd; + nat size = 0; + scavenge(&gen->steps[0]); + if (start_bd != gen->steps[0].scan_bd) { + size += (P_)BLOCK_ROUND_UP(start) - start; + start_bd = start_bd->link; + while (start_bd != gen->steps[0].scan_bd) { + size += BLOCK_SIZE_W; + start_bd = start_bd->link; + } + size += gen->steps[0].scan - + (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan); + } else { + size = gen->steps[0].scan - start; + } + debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); + } +#endif + break; + + default: + barf("scavenge_one: strange object %d", (int)(info->type)); + } + + no_luck = failed_to_evac; + failed_to_evac = rtsFalse; + return (no_luck); +} + +/* ----------------------------------------------------------------------------- + Scavenging mutable lists. + + We treat the mutable list of each generation > N (i.e. all the + generations older than the one being collected) as roots. We also + remove non-mutable objects from the mutable list at this point. + -------------------------------------------------------------------------- */ + +void +scavenge_mutable_list(generation *gen) +{ + bdescr *bd; + StgPtr p, q; + + bd = gen->saved_mut_list; + + evac_gen = gen->no; + for (; bd != NULL; bd = bd->link) { + for (q = bd->start; q < bd->free; q++) { + p = (StgPtr)*q; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + +#ifdef DEBUG + switch (get_itbl((StgClosure *)p)->type) { + case MUT_VAR_CLEAN: + barf("MUT_VAR_CLEAN on mutable list"); + case MUT_VAR_DIRTY: + mutlist_MUTVARS++; break; + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + mutlist_MUTARRS++; break; + default: + mutlist_OTHERS++; break; + } +#endif + + // Check whether this object is "clean", that is it + // definitely doesn't point into a young generation. + // Clean objects don't need to be scavenged. Some clean + // objects (MUT_VAR_CLEAN) are not kept on the mutable + // list at all; others, such as MUT_ARR_PTRS_CLEAN and + // TSO, are always on the mutable list. + // + switch (get_itbl((StgClosure *)p)->type) { + case MUT_ARR_PTRS_CLEAN: + recordMutableGen((StgClosure *)p,gen); + continue; + case TSO: { + StgTSO *tso = (StgTSO *)p; + if ((tso->flags & TSO_DIRTY) == 0) { + // A clean TSO: we don't have to traverse its + // stack. However, we *do* follow the link field: + // we don't want to have to mark a TSO dirty just + // because we put it on a different queue. + if (tso->why_blocked != BlockedOnBlackHole) { + tso->link = (StgTSO *)evacuate((StgClosure *)tso->link); + } + recordMutableGen((StgClosure *)p,gen); + continue; + } + } + default: + ; + } + + if (scavenge_one(p)) { + // didn't manage to promote everything, so put the + // object back on the list. + recordMutableGen((StgClosure *)p,gen); + } + } + } + + // free the old mut_list + freeChain(gen->saved_mut_list); + gen->saved_mut_list = NULL; +} + +/* ----------------------------------------------------------------------------- + Scavenging the static objects. + + We treat the mutable list of each generation > N (i.e. all the + generations older than the one being collected) as roots. We also + remove non-mutable objects from the mutable list at this point. + -------------------------------------------------------------------------- */ + +void +scavenge_static(void) +{ + StgClosure* p = static_objects; + const StgInfoTable *info; + + /* Always evacuate straight to the oldest generation for static + * objects */ + evac_gen = oldest_gen->no; + + /* keep going until we've scavenged all the objects on the linked + list... */ + while (p != END_OF_STATIC_LIST) { + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = get_itbl(p); + /* + if (info->type==RBH) + info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure + */ + // make sure the info pointer is into text space + + /* Take this object *off* the static_objects list, + * and put it on the scavenged_static_objects list. + */ + static_objects = *STATIC_LINK(info,p); + *STATIC_LINK(info,p) = scavenged_static_objects; + scavenged_static_objects = p; + + switch (info -> type) { + + case IND_STATIC: + { + StgInd *ind = (StgInd *)p; + ind->indirectee = evacuate(ind->indirectee); + + /* might fail to evacuate it, in which case we have to pop it + * back on the mutable list of the oldest generation. We + * leave it *on* the scavenged_static_objects list, though, + * in case we visit this object again. + */ + if (failed_to_evac) { + failed_to_evac = rtsFalse; + recordMutableGen((StgClosure *)p,oldest_gen); + } + break; + } + + case THUNK_STATIC: + scavenge_thunk_srt(info); + break; + + case FUN_STATIC: + scavenge_fun_srt(info); + break; + + case CONSTR_STATIC: + { + StgPtr q, next; + + next = (P_)p->payload + info->layout.payload.ptrs; + // evacuate the pointers + for (q = (P_)p->payload; q < next; q++) { + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); + } + break; + } + + default: + barf("scavenge_static: strange closure %d", (int)(info->type)); + } + + ASSERT(failed_to_evac == rtsFalse); + + /* get the next static object from the list. Remember, there might + * be more stuff on this list now that we've done some evacuating! + * (static_objects is a global) + */ + p = static_objects; + } +} + +/* ----------------------------------------------------------------------------- + scavenge a chunk of memory described by a bitmap + -------------------------------------------------------------------------- */ + +static void +scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) +{ + nat i, b; + StgWord bitmap; + + b = 0; + bitmap = large_bitmap->bitmap[b]; + for (i = 0; i < size; ) { + if ((bitmap & 1) == 0) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + i++; + p++; + if (i % BITS_IN(W_) == 0) { + b++; + bitmap = large_bitmap->bitmap[b]; + } else { + bitmap = bitmap >> 1; + } + } +} + +STATIC_INLINE StgPtr +scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap) +{ + while (size > 0) { + if ((bitmap & 1) == 0) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p++; + bitmap = bitmap >> 1; + size--; + } + return p; +} + +/* ----------------------------------------------------------------------------- + scavenge_stack walks over a section of stack and evacuates all the + objects pointed to by it. We can use the same code for walking + AP_STACK_UPDs, since these are just sections of copied stack. + -------------------------------------------------------------------------- */ + +static void +scavenge_stack(StgPtr p, StgPtr stack_end) +{ + const StgRetInfoTable* info; + StgWord bitmap; + nat size; + + /* + * Each time around this loop, we are looking at a chunk of stack + * that starts with an activation record. + */ + + while (p < stack_end) { + info = get_ret_itbl((StgClosure *)p); + + switch (info->i.type) { + + case UPDATE_FRAME: + // In SMP, we can get update frames that point to indirections + // when two threads evaluate the same thunk. We do attempt to + // discover this situation in threadPaused(), but it's + // possible that the following sequence occurs: + // + // A B + // enter T + // enter T + // blackhole T + // update T + // GC + // + // Now T is an indirection, and the update frame is already + // marked on A's stack, so we won't traverse it again in + // threadPaused(). We could traverse the whole stack again + // before GC, but that seems like overkill. + // + // Scavenging this update frame as normal would be disastrous; + // the updatee would end up pointing to the value. So we turn + // the indirection into an IND_PERM, so that evacuate will + // copy the indirection into the old generation instead of + // discarding it. + if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_PERM_info; + } + ((StgUpdateFrame *)p)->updatee + = evacuate(((StgUpdateFrame *)p)->updatee); + p += sizeofW(StgUpdateFrame); + continue; + + // small bitmap (< 32 entries, or 64 on a 64-bit machine) + case CATCH_STM_FRAME: + case CATCH_RETRY_FRAME: + case ATOMICALLY_FRAME: + case STOP_FRAME: + case CATCH_FRAME: + case RET_SMALL: + case RET_VEC_SMALL: + bitmap = BITMAP_BITS(info->i.layout.bitmap); + size = BITMAP_SIZE(info->i.layout.bitmap); + // NOTE: the payload starts immediately after the info-ptr, we + // don't have an StgHeader in the same sense as a heap closure. + p++; + p = scavenge_small_bitmap(p, size, bitmap); + + follow_srt: + if (major_gc) + scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap); + continue; + + case RET_BCO: { + StgBCO *bco; + nat size; + + p++; + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + bco = (StgBCO *)*p; + p++; + size = BCO_BITMAP_SIZE(bco); + scavenge_large_bitmap(p, BCO_BITMAP(bco), size); + p += size; + continue; + } + + // large bitmap (> 32 entries, or > 64 on a 64-bit machine) + case RET_BIG: + case RET_VEC_BIG: + { + nat size; + + size = GET_LARGE_BITMAP(&info->i)->size; + p++; + scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size); + p += size; + // and don't forget to follow the SRT + goto follow_srt; + } + + // Dynamic bitmap: the mask is stored on the stack, and + // there are a number of non-pointers followed by a number + // of pointers above the bitmapped area. (see StgMacros.h, + // HEAP_CHK_GEN). + case RET_DYN: + { + StgWord dyn; + dyn = ((StgRetDyn *)p)->liveness; + + // traverse the bitmap first + bitmap = RET_DYN_LIVENESS(dyn); + p = (P_)&((StgRetDyn *)p)->payload[0]; + size = RET_DYN_BITMAP_SIZE; + p = scavenge_small_bitmap(p, size, bitmap); + + // skip over the non-ptr words + p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; + + // follow the ptr words + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + p++; + } + continue; + } + + case RET_FUN: + { + StgRetFun *ret_fun = (StgRetFun *)p; + StgFunInfoTable *fun_info; + + ret_fun->fun = evacuate(ret_fun->fun); + fun_info = get_fun_itbl(ret_fun->fun); + p = scavenge_arg_block(fun_info, ret_fun->payload); + goto follow_srt; + } + + default: + barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type)); + } + } +} + +/*----------------------------------------------------------------------------- + scavenge the large object list. + + evac_gen set by caller; similar games played with evac_gen as with + scavenge() - see comment at the top of scavenge(). Most large + objects are (repeatedly) mutable, so most of the time evac_gen will + be zero. + --------------------------------------------------------------------------- */ + +void +scavenge_large(step *stp) +{ + bdescr *bd; + StgPtr p; + + bd = stp->new_large_objects; + + for (; bd != NULL; bd = stp->new_large_objects) { + + /* take this object *off* the large objects list and put it on + * the scavenged large objects list. This is so that we can + * treat new_large_objects as a stack and push new objects on + * the front when evacuating. + */ + stp->new_large_objects = bd->link; + dbl_link_onto(bd, &stp->scavenged_large_objects); + + // update the block count in this step. + stp->n_scavenged_large_blocks += bd->blocks; + + p = bd->start; + if (scavenge_one(p)) { + if (stp->gen_no > 0) { + recordMutableGen((StgClosure *)p, stp->gen); + } + } + } +} + |