*
* Generational garbage collector: scavenging functions
*
+ * Documentation on the architecture of the Garbage Collector can be
+ * found in the online commentary:
+ *
+ * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *
* ---------------------------------------------------------------------------*/
#include "Rts.h"
+#include "RtsFlags.h"
#include "Storage.h"
#include "MBlock.h"
#include "GC.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"
static void scavenge_stack (StgPtr p, StgPtr stack_end);
StgLargeBitmap *large_bitmap,
nat size );
+
/* Similar to scavenge_large_bitmap(), but we don't write back the
* pointers we get back from evacuate().
*/
p = (StgClosure **)large_srt->srt;
for (i = 0; i < size; ) {
if ((bitmap & 1) != 0) {
- evacuate(*p);
+ evacuate(p);
}
i++;
p++;
while (bitmap != 0) {
if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#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)
// 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)));
+ evacuate(stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
} else {
- evacuate(*p);
+ evacuate(p);
}
#else
- evacuate(*p);
+ evacuate(p);
#endif
}
p++;
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
-#if defined(PAR)
- || tso->why_blocked == BlockedOnGA
- || tso->why_blocked == BlockedOnGA_NoSend
-#endif
) {
- 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);
+ 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;
+ } else {
+ tso->flags &= ~TSO_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;
StgWord bitmap;
StgFunInfoTable *fun_info;
- fun_info = get_fun_itbl(fun);
+ fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
ASSERT(fun_info->i.type != PAP);
p = (StgPtr)payload;
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
}
p++;
bitmap = bitmap >> 1;
STATIC_INLINE 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 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():
doesn't need to advance the pointer on to the next object.
-------------------------------------------------------------------------- */
-void
+static void
scavenge_mark_stack(void)
{
StgPtr p, q;
StgInfoTable *info;
- nat saved_evac_gen;
+ step *saved_evac_step;
- evac_gen = oldest_gen->no;
- saved_evac_gen = 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 (((volatile StgWord *)info)[1] & 0xffff) {
- 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 MVAR_CLEAN:
+ case MVAR_DIRTY:
+ {
+ rtsBool saved_eager_promotion = gct->eager_promotion;
+
+ StgMVar *mvar = ((StgMVar *)p);
+ gct->eager_promotion = rtsFalse;
+ evacuate((StgClosure **)&mvar->head);
+ evacuate((StgClosure **)&mvar->tail);
+ evacuate((StgClosure **)&mvar->value);
+ gct->eager_promotion = saved_eager_promotion;
+
+ if (gct->failed_to_evac) {
+ mvar->header.info = &stg_MVAR_DIRTY_info;
+ } else {
+ mvar->header.info = &stg_MVAR_CLEAN_info;
+ }
+ 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]);
+ 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);
- bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
+ 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:
case MUT_VAR_DIRTY: {
- rtsBool saved_eager_promotion = eager_promotion;
+ rtsBool saved_eager_promotion = gct->eager_promotion;
- eager_promotion = rtsFalse;
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- eager_promotion = saved_eager_promotion;
+ gct->eager_promotion = rtsFalse;
+ evacuate(&((StgMutVar *)p)->var);
+ gct->eager_promotion = saved_eager_promotion;
- if (failed_to_evac) {
+ if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
} else {
((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
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;
}
// 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;
+ 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);
}
- eager_promotion = saved_eager;
+ gct->eager_promotion = saved_eager;
- if (failed_to_evac) {
+ if (gct->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.
+ gct->failed_to_evac = rtsTrue; // mutable anyhow.
break;
}
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
// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
- if (failed_to_evac) {
+ if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
} else {
((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
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
+ scavengeTSO((StgTSO*)p);
+ gct->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
+ 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);
- 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
+ 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]);
- 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);
}
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable
+ gct->evac_step = saved_evac_step;
+ gct->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
+ 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);
- 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
+ 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);
- 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
+ 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;
}
info->type, p);
}
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- if (evac_gen > 0) {
- recordMutableGen((StgClosure *)q, &generations[evac_gen]);
+ if (gct->failed_to_evac) {
+ gct->failed_to_evac = rtsFalse;
+ if (gct->evac_step) {
+ recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen);
}
}
scavenge_one(StgPtr p)
{
const StgInfoTable *info;
- nat saved_evac_gen = evac_gen;
+ step *saved_evac_step = gct->evac_step;
rtsBool no_luck;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
switch (info->type) {
- case MVAR:
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
{
+ rtsBool saved_eager_promotion = gct->eager_promotion;
+
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.
+ gct->eager_promotion = rtsFalse;
+ evacuate((StgClosure **)&mvar->head);
+ evacuate((StgClosure **)&mvar->tail);
+ evacuate((StgClosure **)&mvar->value);
+ gct->eager_promotion = saved_eager_promotion;
+
+ if (gct->failed_to_evac) {
+ mvar->header.info = &stg_MVAR_DIRTY_info;
+ } else {
+ mvar->header.info = &stg_MVAR_CLEAN_info;
+ }
break;
}
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;
}
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY: {
StgPtr q = p;
- rtsBool saved_eager_promotion = eager_promotion;
+ rtsBool saved_eager_promotion = gct->eager_promotion;
- eager_promotion = rtsFalse;
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- eager_promotion = saved_eager_promotion;
+ gct->eager_promotion = rtsFalse;
+ evacuate(&((StgMutVar *)p)->var);
+ gct->eager_promotion = saved_eager_promotion;
- if (failed_to_evac) {
+ if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
} else {
((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
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;
// 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;
+ saved_eager = gct->eager_promotion;
+ gct->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);
+ evacuate((StgClosure **)p);
}
- eager_promotion = saved_eager;
+ gct->eager_promotion = saved_eager;
- if (failed_to_evac) {
+ if (gct->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;
+ gct->failed_to_evac = rtsTrue;
break;
}
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
// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
- if (failed_to_evac) {
+ if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
} else {
((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
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
+ scavengeTSO((StgTSO*)p);
+ gct->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
+ 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);
- 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
+ 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);
- 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
+ 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]);
- 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);
}
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable
+ gct->evac_step = saved_evac_step;
+ gct->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
+ 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);
- 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
+ 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 (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
break;
}
- ((StgInd *)p)->indirectee = evacuate(q);
+ evacuate(&((StgInd *)p)->indirectee);
}
#if 0 && defined(DEBUG)
barf("scavenge_one: strange object %d", (int)(info->type));
}
- no_luck = failed_to_evac;
- failed_to_evac = rtsFalse;
+ no_luck = gct->failed_to_evac;
+ gct->failed_to_evac = rtsFalse;
return (no_luck);
}
bd = gen->saved_mut_list;
- 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;
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
mutlist_MUTARRS++; break;
+ case MVAR_CLEAN:
+ barf("MVAR_CLEAN on mutable list");
+ case MVAR_DIRTY:
+ mutlist_MVARS++; break;
default:
mutlist_OTHERS++; break;
}
//
switch (get_itbl((StgClosure *)p)->type) {
case MUT_ARR_PTRS_CLEAN:
- recordMutableGen((StgClosure *)p,gen);
+ recordMutableGen_GC((StgClosure *)p,gen);
continue;
case TSO: {
StgTSO *tso = (StgTSO *)p;
// 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);
+ evacuate((StgClosure **)&tso->link);
}
- recordMutableGen((StgClosure *)p,gen);
+ recordMutableGen_GC((StgClosure *)p,gen);
continue;
}
}
if (scavenge_one(p)) {
// didn't manage to promote everything, so put the
// object back on the list.
- recordMutableGen((StgClosure *)p,gen);
+ recordMutableGen_GC((StgClosure *)p,gen);
}
}
}
// free the old mut_list
- freeChain(gen->saved_mut_list);
+ freeChain_sync(gen->saved_mut_list);
gen->saved_mut_list = NULL;
}
remove non-mutable objects from the mutable list at this point.
-------------------------------------------------------------------------- */
-void
+static void
scavenge_static(void)
{
- StgClosure* p = static_objects;
+ StgClosure* p;
const StgInfoTable *info;
/* Always evacuate straight to the oldest generation for static
* objects */
- 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 (p != END_OF_STATIC_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;
+ if (p == END_OF_STATIC_LIST) {
+ RELEASE_SPIN_LOCK(&static_objects_sync);
+ break;
+ }
+
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
+ 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
*STATIC_LINK(info,p) = scavenged_static_objects;
scavenged_static_objects = p;
+ RELEASE_SPIN_LOCK(&static_objects_sync);
+
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
* 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);
+ if (gct->failed_to_evac) {
+ gct->failed_to_evac = rtsFalse;
+ recordMutableGen_GC((StgClosure *)p,oldest_gen);
}
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;
}
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;
+ ASSERT(gct->failed_to_evac == rtsFalse);
}
}
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.
- if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) {
+ {
+ nat type;
+ type = get_itbl(((StgUpdateFrame *)p)->updatee)->type;
+ if (type == IND) {
((StgUpdateFrame *)p)->updatee->header.info =
(StgInfoTable *)&stg_IND_PERM_info;
- }
- ((StgUpdateFrame *)p)->updatee
- = evacuate(((StgUpdateFrame *)p)->updatee);
+ } 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)
case CATCH_STM_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
nat size;
p++;
- *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ evacuate((StgClosure **)p);
bco = (StgBCO *)*p;
p++;
size = BCO_BITMAP_SIZE(bco);
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
- case RET_VEC_BIG:
{
nat size;
// 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);
- fun_info = get_fun_itbl(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.
--------------------------------------------------------------------------- */
-void
-scavenge_large(step *stp)
+static void
+scavenge_large (step_workspace *ws)
+{
+ bdescr *bd;
+ StgPtr p;
+
+ gct->evac_step = ws->stp;
+
+ bd = ws->todo_large_objects;
+
+ for (; bd != NULL; bd = ws->todo_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.
+ 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);
+
+ p = bd->start;
+ if (scavenge_one(p)) {
+ if (ws->stp->gen_no > 0) {
+ recordMutableGen_GC((StgClosure *)p, ws->stp->gen);
+ }
+ }
+ }
+}
+
+/* ----------------------------------------------------------------------------
+ Scavenge a block
+ ------------------------------------------------------------------------- */
+
+#define MINOR_GC
+#include "Scav.c-inc"
+#undef MINOR_GC
+#include "Scav.c-inc"
+
+/* ----------------------------------------------------------------------------
+ Find the oldest full block to scavenge, and scavenge it.
+ ------------------------------------------------------------------------- */
+
+static rtsBool
+scavenge_find_global_work (void)
{
- bdescr *bd;
- StgPtr p;
+ bdescr *bd;
+ int s;
+ rtsBool flag;
+ step_workspace *ws;
+
+ flag = rtsFalse;
+ for (s = total_steps-1; s>=0; s--)
+ {
+ if (s == 0 && RtsFlags.GcFlags.generations > 1) {
+ continue;
+ }
+ ws = &gct->steps[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.
+ if (N == 0) {
+ scavenge_block0(bd, bd->start);
+ } else {
+ scavenge_block(bd, bd->start);
+ }
+ push_scan_block(bd, ws);
+ return rtsTrue;
+ }
+
+ if (flag) return rtsTrue;
+ }
+ return rtsFalse;
+}
- bd = stp->new_large_objects;
+/* ----------------------------------------------------------------------------
+ Look for local work to do.
- for (; bd != NULL; bd = stp->new_large_objects) {
+ We can have outstanding scavenging to do if, for any of the workspaces,
- /* 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);
+ - the scan block is the same as the todo block, and new objects
+ have been evacuated to the todo block.
- // update the block count in this step.
- stp->n_scavenged_large_blocks += bd->blocks;
+ - the scan block *was* the same as the todo block, but the todo
+ block filled up and a new one has been allocated.
+ ------------------------------------------------------------------------- */
- p = bd->start;
- if (scavenge_one(p)) {
- if (stp->gen_no > 0) {
- recordMutableGen((StgClosure *)p, stp->gen);
- }
+static rtsBool
+scavenge_find_local_work (void)
+{
+ int s;
+ step_workspace *ws;
+ rtsBool flag;
+
+ flag = rtsFalse;
+ for (s = total_steps-1; s >= 0; s--) {
+ if (s == 0 && RtsFlags.GcFlags.generations > 1) {
+ continue;
+ }
+ ws = &gct->steps[s];
+
+ if (ws->todo_bd != NULL)
+ {
+ ws->todo_bd->free = ws->todo_free;
+ }
+
+ // 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 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)
+ {
+ if (N == 0) {
+ scavenge_block0(ws->scan_bd, ws->scan);
+ } else {
+ scavenge_block(ws->scan_bd, ws->scan);
+ }
+ ws->scan = ws->scan_bd->free;
+ flag = rtsTrue;
+ }
+
+ 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 (flag) return rtsTrue;
}
- }
+ return rtsFalse;
}
+/* ----------------------------------------------------------------------------
+ Scavenge until we can't find anything more to scavenge.
+ ------------------------------------------------------------------------- */
+
+void
+scavenge_loop(void)
+{
+ rtsBool work_to_do;
+
+loop:
+ work_to_do = rtsFalse;
+
+ // scavenge static objects
+ if (major_gc && static_objects != END_OF_STATIC_LIST) {
+ IF_DEBUG(sanity, checkStaticObjects(static_objects));
+ scavenge_static();
+ }
+
+ // scavenge objects in compacted generation
+ if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
+ (mark_stack_bdescr != NULL && !mark_stack_empty())) {
+ scavenge_mark_stack();
+ work_to_do = rtsTrue;
+ }
+
+ // Order is important here: we want to deal in full blocks as
+ // much as possible, so go for global work in preference to
+ // 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 (work_to_do) goto loop;
+}
+
+rtsBool
+any_work (void)
+{
+ int 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 (s = total_steps-1; s >= 0; s--) {
+ if (s == 0 && RtsFlags.GcFlags.generations > 1) {
+ continue;
+ }
+ ws = &gct->steps[s];
+ if (ws->todo_large_objects) return rtsTrue;
+ if (ws->stp->todos) return rtsTrue;
+ }
+
+ return rtsFalse;
+}
projects / ghc-hetmet.git / blobdiff