X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=f61d6b7a61d8bd35c6bef2fa41e5b1e5ffe4940a;hb=b339c8b1d0f239031802555b454062e9430ec8bb;hp=080c75014e647acfb8db1d41ce52491cc55604f2;hpb=bf1197b67163d9f5b6509cf836e07ff83cc0a063;p=ghc-hetmet.git diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 080c750..f61d6b7 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team 1998-2006 + * (c) The GHC Team 1998-2008 * * Generational garbage collector: scavenging functions * @@ -16,6 +16,7 @@ #include "Storage.h" #include "MBlock.h" #include "GC.h" +#include "GCThread.h" #include "GCUtils.h" #include "Compact.h" #include "Evac.h" @@ -31,111 +32,44 @@ static void scavenge_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size ); -static void scavenge_block (bdescr *bd, StgPtr scan); - - -/* 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) { -#if defined(__PIC__) && defined(mingw32_TARGET_OS) - // 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); +#if defined(THREADED_RTS) && !defined(PARALLEL_GC) +# define evacuate(a) evacuate1(a) +# define recordMutableGen_GC(a,b) recordMutableGen(a,b) +# define scavenge_loop(a) scavenge_loop1(a) +# define scavenge_mutable_list(g) scavenge_mutable_list1(g) #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); -} +/* ----------------------------------------------------------------------------- + Scavenge a TSO. + -------------------------------------------------------------------------- */ STATIC_INLINE void -scavenge_fun_srt(const StgInfoTable *info) +scavenge_TSO_link (StgTSO *tso) { - 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); + // 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) { + evacuate((StgClosure **)&tso->_link); + } } -/* ----------------------------------------------------------------------------- - Scavenge a TSO. - -------------------------------------------------------------------------- */ - static void scavengeTSO (StgTSO *tso) { + rtsBool saved_eager; + + if (tso->what_next == ThreadRelocated) { + // the only way this can happen is if the old TSO was on the + // mutable list. We might have other links to this defunct + // TSO, so we must update its link field. + evacuate((StgClosure**)&tso->_link); + return; + } + + saved_eager = gct->eager_promotion; + gct->eager_promotion = rtsFalse; + if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnBlackHole || tso->why_blocked == BlockedOnException @@ -144,18 +78,26 @@ scavengeTSO (StgTSO *tso) } 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) { - evacuate((StgClosure **)&tso->link); - } - // scavange current transaction record evacuate((StgClosure **)&tso->trec); // scavenge this thread's stack scavenge_stack(tso->sp, &(tso->stack[tso->stack_size])); + + if (gct->failed_to_evac) { + tso->flags |= TSO_DIRTY; + scavenge_TSO_link(tso); + } else { + tso->flags &= ~TSO_DIRTY; + scavenge_TSO_link(tso); + if (gct->failed_to_evac) { + tso->flags |= TSO_LINK_DIRTY; + } else { + tso->flags &= ~TSO_LINK_DIRTY; + } + } + + gct->eager_promotion = saved_eager; } /* ----------------------------------------------------------------------------- @@ -252,37 +194,142 @@ scavenge_AP (StgAP *ap) } /* ----------------------------------------------------------------------------- + Scavenge SRTs + -------------------------------------------------------------------------- */ + +/* 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) { +#if defined(__PIC__) && defined(mingw32_TARGET_OS) + // 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 block from the given scan pointer up to bd->free. - evac_gen is set by the caller to be either zero (for a step in a + evac_step 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 + We sometimes temporarily change evac_step back to zero if we're scavenging a mutable object where eager promotion isn't such a good idea. -------------------------------------------------------------------------- */ static void -scavenge_block (bdescr *bd, StgPtr scan) +scavenge_block (bdescr *bd) { StgPtr p, q; StgInfoTable *info; - nat saved_evac_gen; + step *saved_evac_step; + rtsBool saved_eager_promotion; + step_workspace *ws; - p = scan; - debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p", - bd->start, bd->gen_no, bd->step->no, scan); + bd->start, bd->gen_no, bd->step->no, bd->u.scan); - gct->evac_gen = bd->gen_no; - saved_evac_gen = gct->evac_gen; + gct->scan_bd = bd; + gct->evac_step = bd->step; + saved_evac_step = gct->evac_step; + saved_eager_promotion = gct->eager_promotion; gct->failed_to_evac = rtsFalse; + ws = &gct->steps[bd->step->abs_no]; + + p = bd->u.scan; + // we might be evacuating into the very object that we're // scavenging, so we have to check the real bd->free pointer each // time around the loop. - while (p < bd->free) { + while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); @@ -295,8 +342,6 @@ scavenge_block (bdescr *bd, StgPtr scan) case MVAR_CLEAN: case MVAR_DIRTY: { - rtsBool saved_eager_promotion = gct->eager_promotion; - StgMVar *mvar = ((StgMVar *)p); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&mvar->head); @@ -445,9 +490,7 @@ scavenge_block (bdescr *bd, StgPtr scan) break; case MUT_VAR_CLEAN: - case MUT_VAR_DIRTY: { - rtsBool saved_eager_promotion = gct->eager_promotion; - + case MUT_VAR_DIRTY: gct->eager_promotion = rtsFalse; evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; @@ -459,7 +502,6 @@ scavenge_block (bdescr *bd, StgPtr scan) } p += sizeofW(StgMutVar); break; - } case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: @@ -505,19 +547,17 @@ scavenge_block (bdescr *bd, StgPtr scan) // 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 = gct->eager_promotion; gct->eager_promotion = rtsFalse; next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { evacuate((StgClosure **)p); } - gct->eager_promotion = saved_eager; + gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; @@ -553,19 +593,7 @@ scavenge_block (bdescr *bd, StgPtr scan) case TSO: { StgTSO *tso = (StgTSO *)p; - rtsBool saved_eager = gct->eager_promotion; - - gct->eager_promotion = rtsFalse; - scavengeTSO(tso); - gct->eager_promotion = saved_eager; - - if (gct->failed_to_evac) { - tso->flags |= TSO_DIRTY; - } else { - tso->flags &= ~TSO_DIRTY; - } - - gct->failed_to_evac = rtsTrue; // always on the mutable list + scavengeTSO(tso); p += tso_sizeW(tso); break; } @@ -573,11 +601,11 @@ scavenge_block (bdescr *bd, StgPtr scan) case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&wq->closure); evacuate((StgClosure **)&wq->next_queue_entry); evacuate((StgClosure **)&wq->prev_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTVarWatchQueue); break; @@ -586,10 +614,10 @@ scavenge_block (bdescr *bd, StgPtr scan) case TVAR: { StgTVar *tvar = ((StgTVar *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tvar->current_value); evacuate((StgClosure **)&tvar->first_watch_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTVar); break; @@ -598,11 +626,11 @@ scavenge_block (bdescr *bd, StgPtr scan) case TREC_HEADER: { StgTRecHeader *trec = ((StgTRecHeader *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&trec->enclosing_trec); evacuate((StgClosure **)&trec->current_chunk); evacuate((StgClosure **)&trec->invariants_to_check); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecHeader); break; @@ -613,14 +641,14 @@ scavenge_block (bdescr *bd, StgPtr scan) StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecChunk); break; @@ -629,10 +657,10 @@ scavenge_block (bdescr *bd, StgPtr scan) case ATOMIC_INVARIANT: { StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate(&invariant->code); evacuate((StgClosure **)&invariant->last_execution); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgAtomicInvariant); break; @@ -641,11 +669,11 @@ scavenge_block (bdescr *bd, StgPtr scan) case INVARIANT_CHECK_QUEUE: { StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&queue->invariant); evacuate((StgClosure **)&queue->my_execution); evacuate((StgClosure **)&queue->next_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgInvariantCheckQueue); break; @@ -671,9 +699,26 @@ scavenge_block (bdescr *bd, StgPtr scan) } } - debugTrace(DEBUG_gc, " scavenged %ld bytes", (bd->free - scan) * sizeof(W_)); -} + if (p > bd->free) { + gct->copied += ws->todo_free - bd->free; + bd->free = p; + } + + debugTrace(DEBUG_gc, " scavenged %ld bytes", + (unsigned long)((bd->free - bd->u.scan) * sizeof(W_))); + // update stats: this is a block that has been scavenged + gct->scanned += bd->free - bd->u.scan; + bd->u.scan = bd->free; + + if (bd != ws->todo_bd) { + // we're not going to evac any more objects into + // this block, so push it now. + push_scanned_block(bd, ws); + } + + gct->scan_bd = NULL; +} /* ----------------------------------------------------------------------------- Scavenge everything on the mark stack. @@ -687,10 +732,10 @@ scavenge_mark_stack(void) { StgPtr p, q; StgInfoTable *info; - nat saved_evac_gen; + step *saved_evac_step; - gct->evac_gen = oldest_gen->no; - saved_evac_gen = gct->evac_gen; + gct->evac_step = &oldest_gen->steps[0]; + saved_evac_step = gct->evac_step; linear_scan: while (!mark_stack_empty()) { @@ -700,7 +745,7 @@ linear_scan: info = get_itbl((StgClosure *)p); q = p; - switch (info->type) { + switch (((volatile StgWord *)info)[1] & 0xffff) { case MVAR_CLEAN: case MVAR_DIRTY: @@ -919,31 +964,18 @@ linear_scan: case TSO: { - StgTSO *tso = (StgTSO *)p; - rtsBool saved_eager = gct->eager_promotion; - - gct->eager_promotion = rtsFalse; - scavengeTSO(tso); - gct->eager_promotion = saved_eager; - - if (gct->failed_to_evac) { - tso->flags |= TSO_DIRTY; - } else { - tso->flags &= ~TSO_DIRTY; - } - - gct->failed_to_evac = rtsTrue; // always on the mutable list + scavengeTSO((StgTSO*)p); break; } case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&wq->closure); evacuate((StgClosure **)&wq->next_queue_entry); evacuate((StgClosure **)&wq->prev_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -951,10 +983,10 @@ linear_scan: case TVAR: { StgTVar *tvar = ((StgTVar *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tvar->current_value); evacuate((StgClosure **)&tvar->first_watch_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -964,14 +996,14 @@ linear_scan: StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -979,11 +1011,11 @@ linear_scan: case TREC_HEADER: { StgTRecHeader *trec = ((StgTRecHeader *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&trec->enclosing_trec); evacuate((StgClosure **)&trec->current_chunk); evacuate((StgClosure **)&trec->invariants_to_check); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -991,10 +1023,10 @@ linear_scan: case ATOMIC_INVARIANT: { StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate(&invariant->code); evacuate((StgClosure **)&invariant->last_execution); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1002,11 +1034,11 @@ linear_scan: case INVARIANT_CHECK_QUEUE: { StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&queue->invariant); evacuate((StgClosure **)&queue->my_execution); evacuate((StgClosure **)&queue->next_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1018,8 +1050,8 @@ linear_scan: if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; - if (gct->evac_gen > 0) { - recordMutableGen_GC((StgClosure *)q, &generations[gct->evac_gen]); + if (gct->evac_step) { + recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen); } } @@ -1079,7 +1111,7 @@ static rtsBool scavenge_one(StgPtr p) { const StgInfoTable *info; - nat saved_evac_gen = gct->evac_gen; + step *saved_evac_step = gct->evac_step; rtsBool no_luck; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); @@ -1251,31 +1283,18 @@ scavenge_one(StgPtr p) case TSO: { - StgTSO *tso = (StgTSO *)p; - rtsBool saved_eager = gct->eager_promotion; - - gct->eager_promotion = rtsFalse; - scavengeTSO(tso); - gct->eager_promotion = saved_eager; - - if (gct->failed_to_evac) { - tso->flags |= TSO_DIRTY; - } else { - tso->flags &= ~TSO_DIRTY; - } - - gct->failed_to_evac = rtsTrue; // always on the mutable list + scavengeTSO((StgTSO*)p); break; } case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&wq->closure); evacuate((StgClosure **)&wq->next_queue_entry); evacuate((StgClosure **)&wq->prev_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1283,10 +1302,10 @@ scavenge_one(StgPtr p) case TVAR: { StgTVar *tvar = ((StgTVar *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tvar->current_value); evacuate((StgClosure **)&tvar->first_watch_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1294,11 +1313,11 @@ scavenge_one(StgPtr p) case TREC_HEADER: { StgTRecHeader *trec = ((StgTRecHeader *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&trec->enclosing_trec); evacuate((StgClosure **)&trec->current_chunk); evacuate((StgClosure **)&trec->invariants_to_check); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1308,14 +1327,14 @@ scavenge_one(StgPtr p) StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1323,10 +1342,10 @@ scavenge_one(StgPtr p) case ATOMIC_INVARIANT: { StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate(&invariant->code); evacuate((StgClosure **)&invariant->last_execution); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1334,11 +1353,11 @@ scavenge_one(StgPtr p) case INVARIANT_CHECK_QUEUE: { StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); - gct->evac_gen = 0; + gct->evac_step = 0; evacuate((StgClosure **)&queue->invariant); evacuate((StgClosure **)&queue->my_execution); evacuate((StgClosure **)&queue->next_queue_entry); - gct->evac_gen = saved_evac_gen; + gct->evac_step = saved_evac_step; gct->failed_to_evac = rtsTrue; // mutable break; } @@ -1413,7 +1432,7 @@ scavenge_mutable_list(generation *gen) bd = gen->saved_mut_list; - gct->evac_gen = gen->no; + gct->evac_step = &gen->steps[0]; for (; bd != NULL; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { p = (StgPtr)*q; @@ -1453,14 +1472,17 @@ scavenge_mutable_list(generation *gen) 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) { - evacuate((StgClosure **)&tso->link); - } - recordMutableGen_GC((StgClosure *)p,gen); + // Must be on the mutable list because its link + // field is dirty. + ASSERT(tso->flags & TSO_LINK_DIRTY); + + scavenge_TSO_link(tso); + if (gct->failed_to_evac) { + recordMutableGen_GC((StgClosure *)p,gen); + gct->failed_to_evac = rtsFalse; + } else { + tso->flags &= ~TSO_LINK_DIRTY; + } continue; } } @@ -1477,7 +1499,7 @@ scavenge_mutable_list(generation *gen) } // free the old mut_list - freeChain(gen->saved_mut_list); + freeChain_sync(gen->saved_mut_list); gen->saved_mut_list = NULL; } @@ -1495,24 +1517,23 @@ scavenge_static(void) StgClosure* p; const StgInfoTable *info; + debugTrace(DEBUG_gc, "scavenging static objects"); + /* Always evacuate straight to the oldest generation for static * objects */ - gct->evac_gen = oldest_gen->no; + gct->evac_step = &oldest_gen->steps[0]; /* keep going until we've scavenged all the objects on the linked list... */ while (1) { - ACQUIRE_SPIN_LOCK(&static_objects_sync); - /* get the next static object from the list. Remember, there might * be more stuff on this list after each evacuation... * (static_objects is a global) */ - p = static_objects; + p = gct->static_objects; if (p == END_OF_STATIC_LIST) { - RELEASE_SPIN_LOCK(&static_objects_sync); break; } @@ -1527,11 +1548,9 @@ scavenge_static(void) /* 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; - - RELEASE_SPIN_LOCK(&static_objects_sync); + gct->static_objects = *STATIC_LINK(info,p); + *STATIC_LINK(info,p) = gct->scavenged_static_objects; + gct->scavenged_static_objects = p; switch (info -> type) { @@ -1669,17 +1688,22 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // discarding it. { nat type; - type = get_itbl(((StgUpdateFrame *)p)->updatee)->type; - if (type == IND) { - ((StgUpdateFrame *)p)->updatee->header.info = - (StgInfoTable *)&stg_IND_PERM_info; - } else if (type == IND_OLDGEN) { - ((StgUpdateFrame *)p)->updatee->header.info = - (StgInfoTable *)&stg_IND_OLDGEN_PERM_info; - } - evacuate(&((StgUpdateFrame *)p)->updatee); - p += sizeofW(StgUpdateFrame); - continue; + const StgInfoTable *i; + + i = ((StgUpdateFrame *)p)->updatee->header.info; + if (!IS_FORWARDING_PTR(i)) { + type = get_itbl(((StgUpdateFrame *)p)->updatee)->type; + if (type == IND) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_PERM_info; + } else if (type == IND_OLDGEN) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_OLDGEN_PERM_info; + } + evacuate(&((StgUpdateFrame *)p)->updatee); + p += sizeofW(StgUpdateFrame); + continue; + } } // small bitmap (< 32 entries, or 64 on a 64-bit machine) @@ -1774,9 +1798,9 @@ scavenge_stack(StgPtr p, StgPtr stack_end) /*----------------------------------------------------------------------------- scavenge the large object list. - evac_gen set by caller; similar games played with evac_gen as with + evac_step set by caller; similar games played with evac_step as with scavenge() - see comment at the top of scavenge(). Most large - objects are (repeatedly) mutable, so most of the time evac_gen will + objects are (repeatedly) mutable, so most of the time evac_step will be zero. --------------------------------------------------------------------------- */ @@ -1786,7 +1810,7 @@ scavenge_large (step_workspace *ws) bdescr *bd; StgPtr p; - gct->evac_gen = ws->stp->gen_no; + gct->evac_step = ws->step; bd = ws->todo_large_objects; @@ -1798,124 +1822,94 @@ scavenge_large (step_workspace *ws) // the front when evacuating. ws->todo_large_objects = bd->link; - ACQUIRE_SPIN_LOCK(&ws->stp->sync_large_objects); - dbl_link_onto(bd, &ws->stp->scavenged_large_objects); - ws->stp->n_scavenged_large_blocks += bd->blocks; - RELEASE_SPIN_LOCK(&ws->stp->sync_large_objects); + ACQUIRE_SPIN_LOCK(&ws->step->sync_large_objects); + dbl_link_onto(bd, &ws->step->scavenged_large_objects); + ws->step->n_scavenged_large_blocks += bd->blocks; + RELEASE_SPIN_LOCK(&ws->step->sync_large_objects); p = bd->start; if (scavenge_one(p)) { - if (ws->stp->gen_no > 0) { - recordMutableGen_GC((StgClosure *)p, ws->stp->gen); + if (ws->step->gen_no > 0) { + recordMutableGen_GC((StgClosure *)p, ws->step->gen); } } + + // stats + gct->scanned += closure_sizeW((StgClosure*)p); } } /* ---------------------------------------------------------------------------- - Find the oldest full block to scavenge, and scavenge it. + Look for work to do. + + We look for the oldest step that has either a todo block that can + be scanned, or a block of work on the global queue that we can + scan. + + It is important to take work from the *oldest* generation that we + has work available, because that minimizes the likelihood of + evacuating objects into a young generation when they should have + been eagerly promoted. This really does make a difference (the + cacheprof benchmark is one that is affected). + + We also want to scan the todo block if possible before grabbing + work from the global queue, the reason being that we don't want to + steal work from the global queue and starve other threads if there + is other work we can usefully be doing. ------------------------------------------------------------------------- */ static rtsBool -scavenge_find_global_work (void) +scavenge_find_work (void) { - bdescr *bd; - int g, s; - rtsBool flag; + int s; step_workspace *ws; + rtsBool did_something, did_anything; + bdescr *bd; - flag = rtsFalse; - for (g = RtsFlags.GcFlags.generations; --g >= 0; ) { - for (s = generations[g].n_steps; --s >= 0; ) { - if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - ws = &gct->steps[g][s]; - - // If we have any large objects to scavenge, do them now. - if (ws->todo_large_objects) { - scavenge_large(ws); - flag = rtsTrue; - } - - if ((bd = grab_todo_block(ws)) != NULL) { - // no need to assign this to ws->scan_bd, we're going - // to scavenge the whole thing and then push it on - // our scavd list. This saves pushing out the - // scan_bd block, which might be partial. - scavenge_block(bd, bd->start); - push_scan_block(bd, ws); - return rtsTrue; - } - - if (flag) return rtsTrue; - } - } - return rtsFalse; -} - -/* ---------------------------------------------------------------------------- - Look for local work to do. - - We can have outstanding scavenging to do if, for any of the workspaces, - - - the scan block is the same as the todo block, and new objects - have been evacuated to the todo block. - - - the scan block *was* the same as the todo block, but the todo - block filled up and a new one has been allocated. - ------------------------------------------------------------------------- */ + gct->scav_find_work++; -static rtsBool -scavenge_find_local_work (void) -{ - int g, s; - step_workspace *ws; - rtsBool flag; + did_anything = rtsFalse; - flag = rtsFalse; - for (g = RtsFlags.GcFlags.generations; --g >= 0; ) { - for (s = generations[g].n_steps; --s >= 0; ) { - if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - ws = &gct->steps[g][s]; - - // If we have a todo block and no scan block, start - // scanning the todo block. - if (ws->scan_bd == NULL && ws->todo_bd != NULL) - { - ws->scan_bd = ws->todo_bd; - ws->scan = ws->scan_bd->start; - } +loop: + did_something = rtsFalse; + for (s = total_steps-1; s >= 0; s--) { + if (s == 0 && RtsFlags.GcFlags.generations > 1) { + continue; + } + ws = &gct->steps[s]; + + gct->scan_bd = NULL; + + // If we have a scan block with some work to do, + // scavenge everything up to the free pointer. + if (ws->todo_bd->u.scan < ws->todo_free) + { + scavenge_block(ws->todo_bd); + did_something = rtsTrue; + break; + } - // If we have a scan block with some work to do, - // scavenge everything up to the free pointer. - if (ws->scan != NULL && ws->scan < ws->scan_bd->free) - { - scavenge_block(ws->scan_bd, ws->scan); - ws->scan = ws->scan_bd->free; - flag = rtsTrue; - } + // If we have any large objects to scavenge, do them now. + if (ws->todo_large_objects) { + scavenge_large(ws); + did_something = rtsTrue; + break; + } - if (ws->scan_bd != NULL && ws->scan == ws->scan_bd->free - && ws->scan_bd != ws->todo_bd) - { - // we're not going to evac any more objects into - // this block, so push it now. - push_scan_block(ws->scan_bd, ws); - ws->scan_bd = NULL; - ws->scan = NULL; - // we might be able to scan the todo block now. But - // don't do it right away: there might be full blocks - // waiting to be scanned as a result of scavenge_block above. - flag = rtsTrue; - } + if ((bd = grab_todo_block(ws)) != NULL) { + scavenge_block(bd); + did_something = rtsTrue; + break; + } + } - if (flag) return rtsTrue; - } + if (did_something) { + did_anything = rtsTrue; + goto loop; } - return rtsFalse; + // only return when there is no more work to do + + return did_anything; } /* ---------------------------------------------------------------------------- @@ -1931,8 +1925,8 @@ loop: work_to_do = rtsFalse; // scavenge static objects - if (major_gc && static_objects != END_OF_STATIC_LIST) { - IF_DEBUG(sanity, checkStaticObjects(static_objects)); + if (major_gc && gct->static_objects != END_OF_STATIC_LIST) { + IF_DEBUG(sanity, checkStaticObjects(gct->static_objects)); scavenge_static(); } @@ -1948,44 +1942,8 @@ loop: // local work. Only if all the global work has been exhausted // do we start scavenging the fragments of blocks in the local // workspaces. - if (scavenge_find_global_work()) goto loop; - if (scavenge_find_local_work()) goto loop; + if (scavenge_find_work()) goto loop; if (work_to_do) goto loop; } -rtsBool -any_work (void) -{ - int g, s; - step_workspace *ws; - - write_barrier(); - - // scavenge static objects - if (major_gc && static_objects != END_OF_STATIC_LIST) { - return rtsTrue; - } - - // scavenge objects in compacted generation - if (mark_stack_overflowed || oldgen_scan_bd != NULL || - (mark_stack_bdescr != NULL && !mark_stack_empty())) { - return rtsTrue; - } - - // Check for global work in any step. We don't need to check for - // local work, because we have already exited scavenge_loop(), - // which means there is no local work for this thread. - for (g = RtsFlags.GcFlags.generations; --g >= 0; ) { - for (s = generations[g].n_steps; --s >= 0; ) { - if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - ws = &gct->steps[g][s]; - if (ws->todo_large_objects) return rtsTrue; - if (ws->stp->todos) return rtsTrue; - } - } - - return rtsFalse; -}