X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=0f06ee95ab6c38bdd04c7d13baffac34de17a643;hb=d07d5ed880e6f4529c2331a5d5a963505d884dd9;hp=2a6ea389e64ecfc27e77f53bfb46715eac80e99f;hpb=d5bd3e829c47c03157cf41cad581d2df44dfd81b;p=ghc-hetmet.git diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 2a6ea38..0f06ee9 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -31,8 +31,6 @@ static void scavenge_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size ); -static void scavenge_block (bdescr *bd, StgPtr scan); - /* Similar to scavenge_large_bitmap(), but we don't write back the * pointers we get back from evacuate(). @@ -50,7 +48,7 @@ scavenge_large_srt_bitmap( StgLargeSRT *large_srt ) p = (StgClosure **)large_srt->srt; for (i = 0; i < size; ) { if ((bitmap & 1) != 0) { - evacuate(*p); + evacuate(p); } i++; p++; @@ -93,12 +91,12 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap) // 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++; @@ -140,20 +138,19 @@ scavengeTSO (StgTSO *tso) || 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); + 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])); @@ -188,7 +185,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) small_bitmap: while (size > 0) { if ((bitmap & 1) == 0) { - *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + evacuate((StgClosure **)p); } p++; bitmap = bitmap >> 1; @@ -227,7 +224,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) small_bitmap: while (size > 0) { if ((bitmap & 1) == 0) { - *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + evacuate((StgClosure **)p); } p++; bitmap = bitmap >> 1; @@ -241,441 +238,18 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) 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 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 - 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 eager promotion isn't such a good - idea. - -------------------------------------------------------------------------- */ - -static void -scavenge_block (bdescr *bd, StgPtr scan) -{ - StgPtr p, q; - StgInfoTable *info; - nat saved_evac_gen; - - p = scan; - - debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p", - bd->start, bd->gen_no, bd->step->no, scan); - - gct->evac_gen = bd->gen_no; - saved_evac_gen = gct->evac_gen; - 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; - mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); - mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); - mvar->value = 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); - ((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); - 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: - ((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; - - gct->eager_promotion = rtsFalse; - ((StgMutVar *)p)->var = 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; - 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 = 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); - } - 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++) { - *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 (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_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->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->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->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_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); - } - gct->evac_gen = saved_evac_gen; - 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->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->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(): @@ -688,10 +262,10 @@ scavenge_mark_stack(void) { StgPtr p, q; StgInfoTable *info; - nat saved_evac_gen; + step *saved_evac_step; - gct->evac_gen = oldest_gen->no; - saved_evac_gen = gct->evac_gen; + gct->evac_step = &oldest_gen->steps[0]; + saved_evac_step = gct->evac_step; linear_scan: while (!mark_stack_empty()) { @@ -701,7 +275,7 @@ linear_scan: info = get_itbl((StgClosure *)p); q = p; - switch (info->type) { + switch (((volatile StgWord *)info)[1] & 0xffff) { case MVAR_CLEAN: case MVAR_DIRTY: @@ -710,9 +284,9 @@ linear_scan: 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) { @@ -725,36 +299,36 @@ linear_scan: 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: @@ -782,7 +356,7 @@ linear_scan: 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; } @@ -796,16 +370,16 @@ linear_scan: 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; } @@ -817,8 +391,7 @@ linear_scan: case IND_OLDGEN: case IND_OLDGEN_PERM: - ((StgInd *)p)->indirectee = - evacuate(((StgInd *)p)->indirectee); + evacuate(&((StgInd *)p)->indirectee); break; case MUT_VAR_CLEAN: @@ -826,7 +399,7 @@ linear_scan: 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) { @@ -847,7 +420,7 @@ linear_scan: case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; - s->selectee = evacuate(s->selectee); + evacuate(&s->selectee); break; } @@ -856,7 +429,7 @@ linear_scan: { 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; } @@ -884,7 +457,7 @@ linear_scan: 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; @@ -906,7 +479,7 @@ linear_scan: 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 @@ -941,11 +514,11 @@ linear_scan: 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; } @@ -953,10 +526,10 @@ linear_scan: 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; } @@ -966,14 +539,14 @@ linear_scan: 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; } @@ -981,11 +554,11 @@ linear_scan: 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; } @@ -993,10 +566,10 @@ linear_scan: 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; } @@ -1004,11 +577,11 @@ linear_scan: 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; } @@ -1020,8 +593,8 @@ linear_scan: if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; - if (gct->evac_gen > 0) { - recordMutableGen_GC((StgClosure *)q, &generations[gct->evac_gen]); + if (gct->evac_step) { + recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen); } } @@ -1081,7 +654,7 @@ static rtsBool scavenge_one(StgPtr p) { const StgInfoTable *info; - nat saved_evac_gen = gct->evac_gen; + step *saved_evac_step = gct->evac_step; rtsBool no_luck; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); @@ -1096,9 +669,9 @@ scavenge_one(StgPtr 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) { @@ -1120,7 +693,7 @@ scavenge_one(StgPtr p) 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; } @@ -1144,7 +717,7 @@ scavenge_one(StgPtr p) 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; } @@ -1155,7 +728,7 @@ scavenge_one(StgPtr p) 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) { @@ -1175,7 +748,7 @@ scavenge_one(StgPtr p) case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; - s->selectee = evacuate(s->selectee); + evacuate(&s->selectee); break; } @@ -1183,7 +756,7 @@ scavenge_one(StgPtr p) { 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; @@ -1216,7 +789,7 @@ scavenge_one(StgPtr p) 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; @@ -1238,7 +811,7 @@ scavenge_one(StgPtr 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); } // If we're going to put this object on the mutable list, then @@ -1273,11 +846,11 @@ scavenge_one(StgPtr p) 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; } @@ -1285,10 +858,10 @@ scavenge_one(StgPtr p) 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; } @@ -1296,11 +869,11 @@ scavenge_one(StgPtr p) 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; } @@ -1310,14 +883,14 @@ scavenge_one(StgPtr p) 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; } @@ -1325,10 +898,10 @@ scavenge_one(StgPtr p) 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; } @@ -1336,11 +909,11 @@ scavenge_one(StgPtr p) 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; } @@ -1360,7 +933,7 @@ scavenge_one(StgPtr p) if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) { break; } - ((StgInd *)p)->indirectee = evacuate(q); + evacuate(&((StgInd *)p)->indirectee); } #if 0 && defined(DEBUG) @@ -1415,7 +988,7 @@ scavenge_mutable_list(generation *gen) bd = gen->saved_mut_list; - gct->evac_gen = gen->no; + gct->evac_step = &gen->steps[0]; for (; bd != NULL; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { p = (StgPtr)*q; @@ -1460,7 +1033,7 @@ scavenge_mutable_list(generation *gen) // 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_GC((StgClosure *)p,gen); continue; @@ -1479,7 +1052,7 @@ scavenge_mutable_list(generation *gen) } // free the old mut_list - freeChain(gen->saved_mut_list); + freeChain_sync(gen->saved_mut_list); gen->saved_mut_list = NULL; } @@ -1494,22 +1067,35 @@ scavenge_mutable_list(generation *gen) static void scavenge_static(void) { - StgClosure* p = static_objects; + StgClosure* p; const StgInfoTable *info; /* 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 (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 @@ -1520,12 +1106,14 @@ scavenge_static(void) *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 @@ -1554,7 +1142,7 @@ scavenge_static(void) 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; } @@ -1564,12 +1152,6 @@ scavenge_static(void) } ASSERT(gct->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; } } @@ -1587,7 +1169,7 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) 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++; @@ -1605,7 +1187,7 @@ scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap) { while (size > 0) { if ((bitmap & 1) == 0) { - *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + evacuate((StgClosure **)p); } p++; bitmap = bitmap >> 1; @@ -1670,8 +1252,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) ((StgUpdateFrame *)p)->updatee->header.info = (StgInfoTable *)&stg_IND_OLDGEN_PERM_info; } - ((StgUpdateFrame *)p)->updatee - = evacuate(((StgUpdateFrame *)p)->updatee); + evacuate(&((StgUpdateFrame *)p)->updatee); p += sizeofW(StgUpdateFrame); continue; } @@ -1700,7 +1281,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) nat size; p++; - *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + evacuate((StgClosure **)p); bco = (StgBCO *)*p; p++; size = BCO_BITMAP_SIZE(bco); @@ -1742,7 +1323,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // follow the ptr words for (size = RET_DYN_PTRS(dyn); size > 0; size--) { - *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + evacuate((StgClosure **)p); p++; } continue; @@ -1753,7 +1334,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) 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; @@ -1768,9 +1349,9 @@ scavenge_stack(StgPtr p, StgPtr stack_end) /*----------------------------------------------------------------------------- scavenge the large object list. - evac_gen set by caller; similar games played with evac_gen as with + evac_step set by caller; similar games played with evac_step as with scavenge() - see comment at the top of scavenge(). Most large - objects are (repeatedly) mutable, so most of the time evac_gen will + objects are (repeatedly) mutable, so most of the time evac_step will be zero. --------------------------------------------------------------------------- */ @@ -1780,7 +1361,7 @@ scavenge_large (step_workspace *ws) bdescr *bd; StgPtr p; - gct->evac_gen = ws->stp->gen_no; + gct->evac_step = ws->stp; bd = ws->todo_large_objects; @@ -1807,6 +1388,15 @@ scavenge_large (step_workspace *ws) } /* ---------------------------------------------------------------------------- + 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. ------------------------------------------------------------------------- */ @@ -1819,8 +1409,8 @@ scavenge_find_global_work (void) step_workspace *ws; flag = rtsFalse; - for (g = RtsFlags.GcFlags.generations; --g >= 0; ) { - for (s = generations[g].n_steps; --s >= 0; ) { + for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) { + for (s = generations[g].n_steps-1; s >= 0; s--) { if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { continue; } @@ -1837,7 +1427,11 @@ scavenge_find_global_work (void) // 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; } @@ -1875,6 +1469,11 @@ scavenge_find_local_work (void) } ws = &gct->steps[g][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) @@ -1887,7 +1486,11 @@ scavenge_find_local_work (void) // 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; } @@ -1947,3 +1550,39 @@ 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-1; g >= 0; g--) { + for (s = generations[g].n_steps-1; s >= 0; s--) { + 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; +}