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().
}
/* -----------------------------------------------------------------------------
- Scavenge a block from the given scan pointer up to bd->free.
-
- 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_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)
-{
- StgPtr p, q;
- StgInfoTable *info;
- step *saved_evac_step;
-
- p = scan;
-
- debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
- bd->start, bd->gen_no, bd->step->no, scan);
-
- gct->evac_step = bd->step;
- saved_evac_step = gct->evac_step;
- gct->failed_to_evac = rtsFalse;
-
- // 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) {
-
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
- info = get_itbl((StgClosure *)p);
-
- ASSERT(gct->thunk_selector_depth == 0);
-
- q = p;
- switch (info->type) {
-
- 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;
- }
- p += sizeofW(StgMVar);
- break;
- }
-
- case FUN_2_0:
- scavenge_fun_srt(info);
- evacuate(&((StgClosure *)p)->payload[1]);
- evacuate(&((StgClosure *)p)->payload[0]);
- p += sizeofW(StgHeader) + 2;
- break;
-
- case THUNK_2_0:
- scavenge_thunk_srt(info);
- evacuate(&((StgThunk *)p)->payload[1]);
- evacuate(&((StgThunk *)p)->payload[0]);
- p += sizeofW(StgThunk) + 2;
- break;
-
- case CONSTR_2_0:
- evacuate(&((StgClosure *)p)->payload[1]);
- evacuate(&((StgClosure *)p)->payload[0]);
- p += sizeofW(StgHeader) + 2;
- break;
-
- case THUNK_1_0:
- scavenge_thunk_srt(info);
- evacuate(&((StgThunk *)p)->payload[0]);
- p += sizeofW(StgThunk) + 1;
- break;
-
- case FUN_1_0:
- scavenge_fun_srt(info);
- case CONSTR_1_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);
- evacuate(&((StgThunk *)p)->payload[0]);
- p += sizeofW(StgThunk) + 2;
- break;
-
- case FUN_1_1:
- scavenge_fun_srt(info);
- case CONSTR_1_1:
- 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++) {
- 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++) {
- evacuate((StgClosure **)p);
- }
- p += info->layout.payload.nptrs;
- break;
- }
-
- case BCO: {
- StgBCO *bco = (StgBCO *)p;
- evacuate((StgClosure **)&bco->instrs);
- evacuate((StgClosure **)&bco->literals);
- evacuate((StgClosure **)&bco->ptrs);
- p += bco_sizeW(bco);
- break;
- }
-
- case IND_PERM:
- if (bd->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:
- evacuate(&((StgInd *)p)->indirectee);
- p += sizeofW(StgInd);
- break;
-
- case MUT_VAR_CLEAN:
- case MUT_VAR_DIRTY: {
- rtsBool saved_eager_promotion = gct->eager_promotion;
-
- gct->eager_promotion = rtsFalse;
- evacuate(&((StgMutVar *)p)->var);
- gct->eager_promotion = saved_eager_promotion;
-
- if (gct->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;
- 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;
-
- 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 = gct->eager_promotion;
- gct->eager_promotion = rtsFalse;
- next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- evacuate((StgClosure **)p);
- }
- gct->eager_promotion = saved_eager;
-
- 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;
- }
-
- gct->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++) {
- 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 (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;
- }
- break;
- }
-
- 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
- p += tso_sizeW(tso);
- break;
- }
-
- case TVAR_WATCH_QUEUE:
- {
- StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
- 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_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_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;
- }
-
- case TREC_CHUNK:
- {
- StgWord i;
- StgTRecChunk *tc = ((StgTRecChunk *) p);
- TRecEntry *e = &(tc -> entries[0]);
- gct->evac_step = 0;
- evacuate((StgClosure **)&tc->prev_chunk);
- for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
- evacuate((StgClosure **)&e->tvar);
- evacuate((StgClosure **)&e->expected_value);
- evacuate((StgClosure **)&e->new_value);
- }
- gct->evac_step = saved_evac_step;
- gct->failed_to_evac = rtsTrue; // mutable
- p += sizeofW(StgTRecChunk);
- break;
- }
-
- case ATOMIC_INVARIANT:
- {
- StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
- 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_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;
- }
-
- 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 (gct->failed_to_evac) {
- gct->failed_to_evac = rtsFalse;
- if (bd->gen_no > 0) {
- recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
- }
- }
- }
-
- debugTrace(DEBUG_gc, " scavenged %ld bytes", (bd->free - scan) * sizeof(W_));
-}
-
-/* -----------------------------------------------------------------------------
Scavenge everything on the mark stack.
This is slightly different from scavenge():
}
/* ----------------------------------------------------------------------------
+ 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.
------------------------------------------------------------------------- */
// 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);
+ if (N == 0) {
+ scavenge_block0(bd, bd->start);
+ } else {
+ scavenge_block(bd, bd->start);
+ }
push_scan_block(bd, ws);
return rtsTrue;
}
// scavenge everything up to the free pointer.
if (ws->scan != NULL && ws->scan < ws->scan_bd->free)
{
- scavenge_block(ws->scan_bd, ws->scan);
+ 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;
}
projects / ghc-hetmet.git / blobdiff