/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
*
* Generational garbage collector: scavenging functions
*
*
* ---------------------------------------------------------------------------*/
+#include "PosixSource.h"
#include "Rts.h"
-#include "RtsFlags.h"
+
#include "Storage.h"
-#include "MBlock.h"
#include "GC.h"
+#include "GCThread.h"
#include "GCUtils.h"
#include "Compact.h"
#include "Evac.h"
#include "Scav.h"
#include "Apply.h"
#include "Trace.h"
-#include "LdvProfile.h"
#include "Sanity.h"
+#include "Capability.h"
static void scavenge_stack (StgPtr p, StgPtr stack_end);
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(bd,g) scavenge_mutable_list1(bd,g)
+# define scavenge_capability_mut_lists(cap) scavenge_capability_mut_Lists1(cap)
#endif
- }
- p++;
- bitmap = bitmap >> 1;
- }
-}
+/* -----------------------------------------------------------------------------
+ Scavenge a TSO.
+ -------------------------------------------------------------------------- */
STATIC_INLINE void
-scavenge_thunk_srt(const StgInfoTable *info)
+scavenge_TSO_link (StgTSO *tso)
{
- 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);
+ // 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);
+ }
}
-STATIC_INLINE void
-scavenge_fun_srt(const StgInfoTable *info)
+static void
+scavengeTSO (StgTSO *tso)
{
- StgFunInfoTable *fun_info;
+ 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;
+ }
- if (!major_gc) return;
-
- fun_info = itbl_to_fun_itbl(info);
- scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
-}
+ debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id);
-/* -----------------------------------------------------------------------------
- Scavenge a TSO.
- -------------------------------------------------------------------------- */
+ saved_eager = gct->eager_promotion;
+ gct->eager_promotion = rtsFalse;
-static void
-scavengeTSO (StgTSO *tso)
-{
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnException
) {
- tso->block_info.closure = evacuate(tso->block_info.closure);
+ evacuate(&tso->block_info.closure);
}
- tso->blocked_exceptions =
- (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
+ 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);
+ 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;
}
/* -----------------------------------------------------------------------------
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
p++;
bitmap = bitmap >> 1;
return p;
}
-STATIC_INLINE StgPtr
+STATIC_INLINE GNUC_ATTR_HOT StgPtr
scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
{
StgPtr p;
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
p++;
bitmap = bitmap >> 1;
return p;
}
-STATIC_INLINE StgPtr
+STATIC_INLINE GNUC_ATTR_HOT StgPtr
scavenge_PAP (StgPAP *pap)
{
- pap->fun = evacuate(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);
+ evacuate(&ap->fun);
return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
}
/* -----------------------------------------------------------------------------
+ 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 GNUC_ATTR_HOT 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 GNUC_ATTR_HOT 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 GNUC_ATTR_HOT 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)
+static GNUC_ATTR_HOT void
+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(bd->link == NULL);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
info = get_itbl((StgClosure *)p);
case MVAR_CLEAN:
case MVAR_DIRTY:
{
- rtsBool saved_eager_promotion = gct->eager_promotion;
-
StgMVar *mvar = ((StgMVar *)p);
gct->eager_promotion = rtsFalse;
- mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
- mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
- mvar->value = evacuate((StgClosure *)mvar->value);
+ evacuate((StgClosure **)&mvar->head);
+ evacuate((StgClosure **)&mvar->tail);
+ evacuate((StgClosure **)&mvar->value);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
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]);
+ evacuate(&((StgClosure *)p)->payload[1]);
+ 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]);
+ evacuate(&((StgThunk *)p)->payload[1]);
+ 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]);
+ evacuate(&((StgClosure *)p)->payload[1]);
+ 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]);
+ 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]);
+ evacuate(&((StgClosure *)p)->payload[0]);
p += sizeofW(StgHeader) + 1;
break;
case THUNK_1_1:
scavenge_thunk_srt(info);
- ((StgThunk *)p)->payload[0] = evacuate(((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]);
+ evacuate(&((StgClosure *)p)->payload[0]);
p += sizeofW(StgHeader) + 2;
break;
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);
+ evacuate((StgClosure **)p);
}
p += info->layout.payload.nptrs;
break;
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ 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);
+ evacuate((StgClosure **)&bco->instrs);
+ evacuate((StgClosure **)&bco->literals);
+ evacuate((StgClosure **)&bco->ptrs);
p += bco_sizeW(bco);
break;
}
}
// fall through
case IND_OLDGEN_PERM:
- ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
+ evacuate(&((StgInd *)p)->indirectee);
p += sizeofW(StgInd);
break;
case MUT_VAR_CLEAN:
- case MUT_VAR_DIRTY: {
- rtsBool saved_eager_promotion = gct->eager_promotion;
-
+ case MUT_VAR_DIRTY:
gct->eager_promotion = rtsFalse;
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
+ evacuate(&((StgMutVar *)p)->var);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
}
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);
+ evacuate(&s->selectee);
p += THUNK_SELECTOR_sizeW();
break;
}
{
StgAP_STACK *ap = (StgAP_STACK *)p;
- ap->fun = evacuate(ap->fun);
+ evacuate(&ap->fun);
scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
p = (StgPtr)ap->payload + ap->size;
break;
// 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++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*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;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
// If we're going to put this object on the mutable list, then
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;
}
case TVAR_WATCH_QUEUE:
{
StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&wq->closure);
+ evacuate((StgClosure **)&wq->next_queue_entry);
+ evacuate((StgClosure **)&wq->prev_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgTVarWatchQueue);
break;
case TVAR:
{
StgTVar *tvar = ((StgTVar *) p);
- gct->evac_gen = 0;
- tvar->current_value = evacuate((StgClosure*)tvar->current_value);
- tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&tvar->current_value);
+ evacuate((StgClosure **)&tvar->first_watch_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgTVar);
break;
case TREC_HEADER:
{
StgTRecHeader *trec = ((StgTRecHeader *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&trec->enclosing_trec);
+ evacuate((StgClosure **)&trec->current_chunk);
+ evacuate((StgClosure **)&trec->invariants_to_check);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgTRecHeader);
break;
StgWord i;
StgTRecChunk *tc = ((StgTRecChunk *) p);
TRecEntry *e = &(tc -> entries[0]);
- gct->evac_gen = 0;
- tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ gct->evac_step = 0;
+ 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);
+ 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;
case ATOMIC_INVARIANT:
{
StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
- gct->evac_gen = 0;
- invariant->code = (StgClosure *)evacuate(invariant->code);
- invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate(&invariant->code);
+ evacuate((StgClosure **)&invariant->last_execution);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgAtomicInvariant);
break;
case INVARIANT_CHECK_QUEUE:
{
StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&queue->invariant);
+ evacuate((StgClosure **)&queue->my_execution);
+ evacuate((StgClosure **)&queue->next_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgInvariantCheckQueue);
break;
if (gct->failed_to_evac) {
gct->failed_to_evac = rtsFalse;
if (bd->gen_no > 0) {
- recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
+ recordMutableGen_GC((StgClosure *)q, bd->gen_no);
}
}
}
- 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.
{
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()) {
info = get_itbl((StgClosure *)p);
q = p;
- switch (info->type) {
+ switch (info->type) {
case MVAR_CLEAN:
case MVAR_DIRTY:
StgMVar *mvar = ((StgMVar *)p);
gct->eager_promotion = rtsFalse;
- mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
- mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
- mvar->value = evacuate((StgClosure *)mvar->value);
+ evacuate((StgClosure **)&mvar->head);
+ evacuate((StgClosure **)&mvar->tail);
+ evacuate((StgClosure **)&mvar->value);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
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]);
+ evacuate(&((StgClosure *)p)->payload[1]);
+ 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]);
+ evacuate(&((StgThunk *)p)->payload[1]);
+ 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]);
+ evacuate(&((StgClosure *)p)->payload[1]);
+ 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]);
+ 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]);
+ evacuate(&((StgThunk *)p)->payload[0]);
break;
case CONSTR_1_0:
case CONSTR_1_1:
- ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
+ evacuate(&((StgClosure *)p)->payload[0]);
break;
case FUN_0_1:
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);
+ evacuate((StgClosure **)p);
}
break;
}
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ 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);
+ evacuate((StgClosure **)&bco->instrs);
+ evacuate((StgClosure **)&bco->literals);
+ evacuate((StgClosure **)&bco->ptrs);
break;
}
case IND_OLDGEN:
case IND_OLDGEN_PERM:
- ((StgInd *)p)->indirectee =
- evacuate(((StgInd *)p)->indirectee);
+ evacuate(&((StgInd *)p)->indirectee);
break;
case MUT_VAR_CLEAN:
rtsBool saved_eager_promotion = gct->eager_promotion;
gct->eager_promotion = rtsFalse;
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
+ evacuate(&((StgMutVar *)p)->var);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
}
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);
+ evacuate(&s->selectee);
break;
}
{
StgAP_STACK *ap = (StgAP_STACK *)p;
- ap->fun = evacuate(ap->fun);
+ evacuate(&ap->fun);
scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
break;
}
gct->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);
+ evacuate((StgClosure **)p);
}
gct->eager_promotion = saved_eager;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
// If we're going to put this object on the mutable list, then
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;
- 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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&wq->closure);
+ evacuate((StgClosure **)&wq->next_queue_entry);
+ evacuate((StgClosure **)&wq->prev_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case TVAR:
{
StgTVar *tvar = ((StgTVar *) p);
- gct->evac_gen = 0;
- tvar->current_value = evacuate((StgClosure*)tvar->current_value);
- tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&tvar->current_value);
+ evacuate((StgClosure **)&tvar->first_watch_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
StgWord i;
StgTRecChunk *tc = ((StgTRecChunk *) p);
TRecEntry *e = &(tc -> entries[0]);
- gct->evac_gen = 0;
- tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ gct->evac_step = 0;
+ 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);
+ 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;
}
case TREC_HEADER:
{
StgTRecHeader *trec = ((StgTRecHeader *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&trec->enclosing_trec);
+ evacuate((StgClosure **)&trec->current_chunk);
+ evacuate((StgClosure **)&trec->invariants_to_check);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case ATOMIC_INVARIANT:
{
StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
- gct->evac_gen = 0;
- invariant->code = (StgClosure *)evacuate(invariant->code);
- invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate(&invariant->code);
+ evacuate((StgClosure **)&invariant->last_execution);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case INVARIANT_CHECK_QUEUE:
{
StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&queue->invariant);
+ evacuate((StgClosure **)&queue->my_execution);
+ evacuate((StgClosure **)&queue->next_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
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_no);
}
}
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));
StgMVar *mvar = ((StgMVar *)p);
gct->eager_promotion = rtsFalse;
- mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
- mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
- mvar->value = evacuate((StgClosure *)mvar->value);
+ evacuate((StgClosure **)&mvar->head);
+ evacuate((StgClosure **)&mvar->tail);
+ evacuate((StgClosure **)&mvar->value);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
- *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+ evacuate((StgClosure **)q);
}
break;
}
end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
- *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+ evacuate((StgClosure **)q);
}
break;
}
rtsBool saved_eager_promotion = gct->eager_promotion;
gct->eager_promotion = rtsFalse;
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
+ evacuate(&((StgMutVar *)p)->var);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
}
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);
+ evacuate(&s->selectee);
break;
}
{
StgAP_STACK *ap = (StgAP_STACK *)p;
- ap->fun = evacuate(ap->fun);
+ evacuate(&ap->fun);
scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
p = (StgPtr)ap->payload + ap->size;
break;
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);
+ evacuate((StgClosure **)p);
}
gct->eager_promotion = saved_eager;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
// If we're going to put this object on the mutable list, then
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;
- 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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&wq->closure);
+ evacuate((StgClosure **)&wq->next_queue_entry);
+ evacuate((StgClosure **)&wq->prev_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case TVAR:
{
StgTVar *tvar = ((StgTVar *) p);
- gct->evac_gen = 0;
- tvar->current_value = evacuate((StgClosure*)tvar->current_value);
- tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&tvar->current_value);
+ evacuate((StgClosure **)&tvar->first_watch_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case TREC_HEADER:
{
StgTRecHeader *trec = ((StgTRecHeader *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&trec->enclosing_trec);
+ evacuate((StgClosure **)&trec->current_chunk);
+ evacuate((StgClosure **)&trec->invariants_to_check);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
StgWord i;
StgTRecChunk *tc = ((StgTRecChunk *) p);
TRecEntry *e = &(tc -> entries[0]);
- gct->evac_gen = 0;
- tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ gct->evac_step = 0;
+ 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);
+ 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;
}
case ATOMIC_INVARIANT:
{
StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
- gct->evac_gen = 0;
- invariant->code = (StgClosure *)evacuate(invariant->code);
- invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate(&invariant->code);
+ evacuate((StgClosure **)&invariant->last_execution);
+ gct->evac_step = saved_evac_step;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case INVARIANT_CHECK_QUEUE:
{
StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
- gct->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);
- gct->evac_gen = saved_evac_gen;
+ gct->evac_step = 0;
+ evacuate((StgClosure **)&queue->invariant);
+ evacuate((StgClosure **)&queue->my_execution);
+ evacuate((StgClosure **)&queue->next_queue_entry);
+ gct->evac_step = saved_evac_step;
gct->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);
- }
+ evacuate(&((StgInd *)p)->indirectee);
#if 0 && defined(DEBUG)
if (RtsFlags.DebugFlags.gc)
-------------------------------------------------------------------------- */
void
-scavenge_mutable_list(generation *gen)
+scavenge_mutable_list(bdescr *bd, generation *gen)
{
- bdescr *bd;
StgPtr p, q;
- 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;
// 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.
+ // list at all; others, such as MUT_ARR_PTRS_CLEAN
+ // are always on the mutable list.
//
switch (get_itbl((StgClosure *)p)->type) {
case MUT_ARR_PTRS_CLEAN:
- recordMutableGen_GC((StgClosure *)p,gen);
+ recordMutableGen_GC((StgClosure *)p,gen->no);
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_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->no);
+ gct->failed_to_evac = rtsFalse;
+ } else {
+ tso->flags &= ~TSO_LINK_DIRTY;
+ }
continue;
}
}
if (scavenge_one(p)) {
// didn't manage to promote everything, so put the
// object back on the list.
- recordMutableGen_GC((StgClosure *)p,gen);
+ recordMutableGen_GC((StgClosure *)p,gen->no);
}
}
}
+}
+
+void
+scavenge_capability_mut_lists (Capability *cap)
+{
+ nat g;
- // free the old mut_list
- freeChain(gen->saved_mut_list);
- gen->saved_mut_list = NULL;
+ /* Mutable lists from each generation > N
+ * we want to *scavenge* these roots, not evacuate them: they're not
+ * going to move in this GC.
+ * Also do them in reverse generation order, for the usual reason:
+ * namely to reduce the likelihood of spurious old->new pointers.
+ */
+ for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
+ scavenge_mutable_list(cap->saved_mut_lists[g], &generations[g]);
+ freeChain_sync(cap->saved_mut_lists[g]);
+ cap->saved_mut_lists[g] = NULL;
+ }
}
/* -----------------------------------------------------------------------------
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;
}
/* 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) {
case IND_STATIC:
{
StgInd *ind = (StgInd *)p;
- ind->indirectee = evacuate(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
*/
if (gct->failed_to_evac) {
gct->failed_to_evac = rtsFalse;
- recordMutableGen_GC((StgClosure *)p,oldest_gen);
+ recordMutableGen_GC((StgClosure *)p,oldest_gen->no);
}
break;
}
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);
+ evacuate((StgClosure **)q);
}
break;
}
bitmap = large_bitmap->bitmap[b];
for (i = 0; i < size; ) {
if ((bitmap & 1) == 0) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
i++;
p++;
{
while (size > 0) {
if ((bitmap & 1) == 0) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
p++;
bitmap = bitmap >> 1;
// the indirection into an IND_PERM, so that evacuate will
// copy the indirection into the old generation instead of
// discarding it.
+ //
+ // Note [upd-black-hole]
+ // One slight hiccup is that the THUNK_SELECTOR machinery can
+ // overwrite the updatee with an IND. In parallel GC, this
+ // could even be happening concurrently, so we can't check for
+ // the IND. Fortunately if we assume that blackholing is
+ // happening (either lazy or eager), then we can be sure that
+ // the updatee is never a THUNK_SELECTOR and we're ok.
+ // NB. this is a new invariant: blackholing is not optional.
{
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;
- }
- ((StgUpdateFrame *)p)->updatee
- = evacuate(((StgUpdateFrame *)p)->updatee);
- p += sizeofW(StgUpdateFrame);
- continue;
+ const StgInfoTable *i;
+ StgClosure *updatee;
+
+ updatee = ((StgUpdateFrame *)p)->updatee;
+ i = updatee->header.info;
+ if (!IS_FORWARDING_PTR(i)) {
+ type = get_itbl(updatee)->type;
+ if (type == IND) {
+ updatee->header.info = &stg_IND_PERM_info;
+ } else if (type == IND_OLDGEN) {
+ updatee->header.info = &stg_IND_OLDGEN_PERM_info;
+ }
+ }
+ evacuate(&((StgUpdateFrame *)p)->updatee);
+ ASSERT(GET_CLOSURE_TAG(((StgUpdateFrame *)p)->updatee) == 0);
+ p += sizeofW(StgUpdateFrame);
+ continue;
}
// small bitmap (< 32 entries, or 64 on a 64-bit machine)
nat size;
p++;
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
bco = (StgBCO *)*p;
p++;
size = BCO_BITMAP_SIZE(bco);
// follow the ptr words
for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
p++;
}
continue;
StgRetFun *ret_fun = (StgRetFun *)p;
StgFunInfoTable *fun_info;
- ret_fun->fun = evacuate(ret_fun->fun);
+ evacuate(&ret_fun->fun);
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
p = scavenge_arg_block(fun_info, ret_fun->payload);
goto follow_srt;
/*-----------------------------------------------------------------------------
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.
--------------------------------------------------------------------------- */
bdescr *bd;
StgPtr p;
- gct->evac_gen = ws->stp->gen_no;
+ gct->evac_step = ws->step;
bd = ws->todo_large_objects;
// 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_no);
}
}
+
+ // 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;
-}
+ gct->scav_find_work++;
-/* ----------------------------------------------------------------------------
- Look for local work to do.
+ did_anything = rtsFalse;
- We can have outstanding scavenging to do if, for any of the workspaces,
+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;
+ }
- - the scan block is the same as the todo block, and new objects
- have been evacuated to the todo block.
+ // If we have any large objects to scavenge, do them now.
+ if (ws->todo_large_objects) {
+ scavenge_large(ws);
+ did_something = rtsTrue;
+ break;
+ }
- - the scan block *was* the same as the todo block, but the todo
- block filled up and a new one has been allocated.
- ------------------------------------------------------------------------- */
+ if ((bd = grab_local_todo_block(ws)) != NULL) {
+ scavenge_block(bd);
+ did_something = rtsTrue;
+ break;
+ }
+ }
-static rtsBool
-scavenge_find_local_work (void)
-{
- int g, s;
- step_workspace *ws;
- rtsBool flag;
+ if (did_something) {
+ did_anything = rtsTrue;
+ goto loop;
+ }
- 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;
- }
+#if defined(THREADED_RTS)
+ if (work_stealing) {
+ // look for work to steal
+ for (s = total_steps-1; s >= 0; s--) {
+ if (s == 0 && RtsFlags.GcFlags.generations > 1) {
+ continue;
+ }
+ if ((bd = steal_todo_block(s)) != NULL) {
+ scavenge_block(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 (did_something) {
+ did_anything = rtsTrue;
+ goto loop;
+ }
+ }
+#endif
- 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;
- }
+ // only return when there is no more work to do
- if (flag) return rtsTrue;
- }
- }
- return rtsFalse;
+ return did_anything;
}
/* ----------------------------------------------------------------------------
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();
}
// 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;
-}
projects / ghc-hetmet.git / blobdiff