X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=d01442b34ed8101f31be5bac883d3cf19e33b7e7;hb=4a05e6139d756c0473df7a6dcb257074201f843d;hp=5e38777795429cc4d25cdfd5fa3cdfe06742f4d5;hpb=754e039a8a15d5774fe73872ff9ac593b46370e0;p=ghc-hetmet.git diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 5e38777..d01442b 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -36,8 +36,8 @@ static void scavenge_large_bitmap (StgPtr p, #if defined(THREADED_RTS) && !defined(PARALLEL_GC) # define evacuate(a) evacuate1(a) -# define recordMutableGen_GC(a,b) recordMutableGen(a,b) # define scavenge_loop(a) scavenge_loop1(a) +# define scavenge_block(a) scavenge_block1(a) # define scavenge_mutable_list(bd,g) scavenge_mutable_list1(bd,g) # define scavenge_capability_mut_lists(cap) scavenge_capability_mut_Lists1(cap) #endif @@ -46,17 +46,6 @@ static void scavenge_large_bitmap (StgPtr p, Scavenge a TSO. -------------------------------------------------------------------------- */ -STATIC_INLINE void -scavenge_TSO_link (StgTSO *tso) -{ - // We don't always chase the link field: TSOs on the blackhole - // queue are not automatically alive, so the link field is a - // "weak" pointer in that case. - if (tso->why_blocked != BlockedOnBlackHole) { - evacuate((StgClosure **)&tso->_link); - } -} - static void scavengeTSO (StgTSO *tso) { @@ -72,16 +61,17 @@ scavengeTSO (StgTSO *tso) debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id); + // update the pointer from the Task. + if (tso->bound != NULL) { + tso->bound->tso = tso; + } + saved_eager = gct->eager_promotion; gct->eager_promotion = rtsFalse; - if ( tso->why_blocked == BlockedOnMVar - || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnException - ) { - evacuate(&tso->block_info.closure); - } + evacuate((StgClosure **)&tso->blocked_exceptions); + evacuate((StgClosure **)&tso->bq); // scavange current transaction record evacuate((StgClosure **)&tso->trec); @@ -89,20 +79,108 @@ scavengeTSO (StgTSO *tso) // scavenge this thread's stack scavenge_stack(tso->sp, &(tso->stack[tso->stack_size])); - if (gct->failed_to_evac) { - tso->dirty = 1; - scavenge_TSO_link(tso); + tso->dirty = gct->failed_to_evac; + + evacuate((StgClosure **)&tso->_link); + if ( tso->why_blocked == BlockedOnMVar + || tso->why_blocked == BlockedOnBlackHole + || tso->why_blocked == BlockedOnMsgThrowTo + || tso->why_blocked == NotBlocked + ) { + evacuate(&tso->block_info.closure); + } +#ifdef THREADED_RTS + // in the THREADED_RTS, block_info.closure must always point to a + // valid closure, because we assume this in throwTo(). In the + // non-threaded RTS it might be a FD (for + // BlockedOnRead/BlockedOnWrite) or a time value (BlockedOnDelay) + else { + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + } +#endif + + if (tso->dirty == 0 && gct->failed_to_evac) { + tso->flags |= TSO_LINK_DIRTY; } else { - tso->dirty = 0; - scavenge_TSO_link(tso); + tso->flags &= ~TSO_LINK_DIRTY; + } + + gct->eager_promotion = saved_eager; +} + +/* ----------------------------------------------------------------------------- + Mutable arrays of pointers + -------------------------------------------------------------------------- */ + +static StgPtr scavenge_mut_arr_ptrs (StgMutArrPtrs *a) +{ + lnat m; + rtsBool any_failed; + StgPtr p, q; + + any_failed = rtsFalse; + p = (StgPtr)&a->payload[0]; + for (m = 0; (int)m < (int)mutArrPtrsCards(a->ptrs) - 1; m++) + { + q = p + (1 << MUT_ARR_PTRS_CARD_BITS); + for (; p < q; p++) { + evacuate((StgClosure**)p); + } if (gct->failed_to_evac) { - tso->flags |= TSO_LINK_DIRTY; + any_failed = rtsTrue; + *mutArrPtrsCard(a,m) = 1; + gct->failed_to_evac = rtsFalse; } else { - tso->flags &= ~TSO_LINK_DIRTY; + *mutArrPtrsCard(a,m) = 0; } } - gct->eager_promotion = saved_eager; + q = (StgPtr)&a->payload[a->ptrs]; + if (p < q) { + for (; p < q; p++) { + evacuate((StgClosure**)p); + } + if (gct->failed_to_evac) { + any_failed = rtsTrue; + *mutArrPtrsCard(a,m) = 1; + gct->failed_to_evac = rtsFalse; + } else { + *mutArrPtrsCard(a,m) = 0; + } + } + + gct->failed_to_evac = any_failed; + return (StgPtr)a + mut_arr_ptrs_sizeW(a); +} + +// scavenge only the marked areas of a MUT_ARR_PTRS +static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a) +{ + lnat m; + StgPtr p, q; + rtsBool any_failed; + + any_failed = rtsFalse; + for (m = 0; m < mutArrPtrsCards(a->ptrs); m++) + { + if (*mutArrPtrsCard(a,m) != 0) { + p = (StgPtr)&a->payload[m << MUT_ARR_PTRS_CARD_BITS]; + q = stg_min(p + (1 << MUT_ARR_PTRS_CARD_BITS), + (StgPtr)&a->payload[a->ptrs]); + for (; p < q; p++) { + evacuate((StgClosure**)p); + } + if (gct->failed_to_evac) { + any_failed = rtsTrue; + gct->failed_to_evac = rtsFalse; + } else { + *mutArrPtrsCard(a,m) = 0; + } + } + } + + gct->failed_to_evac = any_failed; + return (StgPtr)a + mut_arr_ptrs_sizeW(a); } /* ----------------------------------------------------------------------------- @@ -251,7 +329,7 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap) while (bitmap != 0) { if ((bitmap & 1) != 0) { -#if defined(__PIC__) && defined(mingw32_TARGET_OS) +#if defined(__PIC__) && defined(mingw32_HOST_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) @@ -261,7 +339,7 @@ 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( (StgClosure**) ((unsigned long) (*srt) & ~0x1)); } else { evacuate(p); } @@ -300,11 +378,11 @@ scavenge_fun_srt(const StgInfoTable *info) /* ----------------------------------------------------------------------------- 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 + 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_step back to zero if we're + 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. -------------------------------------------------------------------------- */ @@ -314,20 +392,18 @@ scavenge_block (bdescr *bd) { StgPtr p, q; StgInfoTable *info; - step *saved_evac_step; rtsBool saved_eager_promotion; - step_workspace *ws; + gen_workspace *ws; - debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p", - bd->start, bd->gen_no, bd->step->no, bd->u.scan); + debugTrace(DEBUG_gc, "scavenging block %p (gen %d) @ %p", + bd->start, bd->gen_no, bd->u.scan); gct->scan_bd = bd; - gct->evac_step = bd->step; - saved_evac_step = gct->evac_step; + gct->evac_gen = bd->gen; saved_eager_promotion = gct->eager_promotion; gct->failed_to_evac = rtsFalse; - ws = &gct->steps[bd->step->abs_no]; + ws = &gct->gens[bd->gen->no]; p = bd->u.scan; @@ -452,7 +528,7 @@ scavenge_block (bdescr *bd) gen_obj: case CONSTR: case WEAK: - case STABLE_NAME: + case PRIM: { StgPtr end; @@ -474,23 +550,7 @@ scavenge_block (bdescr *bd) } 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: + case BLACKHOLE: evacuate(&((StgInd *)p)->indirectee); p += sizeofW(StgInd); break; @@ -509,10 +569,25 @@ scavenge_block (bdescr *bd) p += sizeofW(StgMutVar); break; - case CAF_BLACKHOLE: - case BLACKHOLE: - p += BLACKHOLE_sizeW(); - break; + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *)p; + + gct->eager_promotion = rtsFalse; + evacuate(&bq->bh); + evacuate((StgClosure**)&bq->owner); + evacuate((StgClosure**)&bq->queue); + evacuate((StgClosure**)&bq->link); + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; + } else { + bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; + } + p += sizeofW(StgBlockingQueue); + break; + } case THUNK_SELECTOR: { @@ -548,20 +623,14 @@ scavenge_block (bdescr *bd) case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: - // follow everything { - StgPtr next; + // 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. + gct->eager_promotion = rtsFalse; - // 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. - 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_promotion; + p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; @@ -569,6 +638,7 @@ scavenge_block (bdescr *bd) ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } + gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // always put it on the mutable list. break; } @@ -577,17 +647,12 @@ scavenge_block (bdescr *bd) 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); - } + p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)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; + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; } @@ -602,42 +667,21 @@ scavenge_block (bdescr *bd) break; } - case TVAR_WATCH_QUEUE: + case MUT_PRIM: { - 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; - } + StgPtr end; - 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; - } + gct->eager_promotion = rtsFalse; - 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; + 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; + + gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTRecHeader); - break; + break; } case TREC_CHUNK: @@ -645,44 +689,19 @@ scavenge_block (bdescr *bd) StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_step = 0; + gct->eager_promotion = rtsFalse; 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->eager_promotion = saved_eager_promotion; 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); @@ -736,10 +755,10 @@ scavenge_mark_stack(void) { StgPtr p, q; StgInfoTable *info; - step *saved_evac_step; + rtsBool saved_eager_promotion; - gct->evac_step = &oldest_gen->steps[0]; - saved_evac_step = gct->evac_step; + gct->evac_gen = oldest_gen; + saved_eager_promotion = gct->eager_promotion; while ((p = pop_mark_stack())) { @@ -752,8 +771,6 @@ scavenge_mark_stack(void) 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); @@ -836,7 +853,7 @@ scavenge_mark_stack(void) gen_obj: case CONSTR: case WEAK: - case STABLE_NAME: + case PRIM: { StgPtr end; @@ -861,15 +878,13 @@ scavenge_mark_stack(void) // no "old" generation. break; - case IND_OLDGEN: - case IND_OLDGEN_PERM: + case IND: + case BLACKHOLE: evacuate(&((StgInd *)p)->indirectee); 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; @@ -882,8 +897,25 @@ scavenge_mark_stack(void) break; } - case CAF_BLACKHOLE: - case BLACKHOLE: + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *)p; + + gct->eager_promotion = rtsFalse; + evacuate(&bq->bh); + evacuate((StgClosure**)&bq->owner); + evacuate((StgClosure**)&bq->queue); + evacuate((StgClosure**)&bq->link); + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; + } else { + bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; + } + break; + } + case ARR_WORDS: break; @@ -916,27 +948,21 @@ scavenge_mark_stack(void) 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; - } + scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); + + 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->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable anyhow. break; } @@ -945,12 +971,9 @@ scavenge_mark_stack(void) case MUT_ARR_PTRS_FROZEN0: // follow everything { - StgPtr next, q = p; + StgPtr q = p; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - evacuate((StgClosure **)p); - } + scavenge_mut_arr_ptrs((StgMutArrPtrs *)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. @@ -968,81 +991,39 @@ scavenge_mark_stack(void) 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 - 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 - break; - } - + case MUT_PRIM: + { + StgPtr end; + + gct->eager_promotion = rtsFalse; + + end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { + evacuate((StgClosure **)p); + } + + gct->eager_promotion = saved_eager_promotion; + gct->failed_to_evac = rtsTrue; // mutable + break; + } + case TREC_CHUNK: { StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_step = 0; + gct->eager_promotion = rtsFalse; 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 - 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->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable 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 - 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 - break; - } - default: barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", info->type, p); @@ -1050,8 +1031,8 @@ scavenge_mark_stack(void) if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; - if (gct->evac_step) { - recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen_no); + if (gct->evac_gen) { + recordMutableGen_GC((StgClosure *)q, gct->evac_gen->no); } } } // while (p = pop_mark_stack()) @@ -1069,9 +1050,11 @@ static rtsBool scavenge_one(StgPtr p) { const StgInfoTable *info; - step *saved_evac_step = gct->evac_step; rtsBool no_luck; + rtsBool saved_eager_promotion; + saved_eager_promotion = gct->eager_promotion; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); @@ -1080,8 +1063,6 @@ scavenge_one(StgPtr p) 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); @@ -1126,6 +1107,7 @@ scavenge_one(StgPtr p) case CONSTR_0_2: case CONSTR_2_0: case WEAK: + case PRIM: case IND_PERM: { StgPtr q, end; @@ -1140,7 +1122,6 @@ scavenge_one(StgPtr p) case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: { StgPtr q = p; - rtsBool saved_eager_promotion = gct->eager_promotion; gct->eager_promotion = rtsFalse; evacuate(&((StgMutVar *)p)->var); @@ -1154,10 +1135,25 @@ scavenge_one(StgPtr p) break; } - case CAF_BLACKHOLE: - case BLACKHOLE: - break; - + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *)p; + + gct->eager_promotion = rtsFalse; + evacuate(&bq->bh); + evacuate((StgClosure**)&bq->owner); + evacuate((StgClosure**)&bq->queue); + evacuate((StgClosure**)&bq->link); + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; + } else { + bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; + } + break; + } + case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; @@ -1190,28 +1186,21 @@ scavenge_one(StgPtr p) case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: { - StgPtr next, q; - 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; - q = p; - 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; + + scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); if (gct->failed_to_evac) { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } + gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; break; } @@ -1220,19 +1209,14 @@ scavenge_one(StgPtr p) case MUT_ARR_PTRS_FROZEN0: { // follow everything - StgPtr next, q=p; - - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - evacuate((StgClosure **)p); - } - + scavenge_mut_arr_ptrs((StgMutArrPtrs *)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; + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; } else { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; } break; } @@ -1243,87 +1227,45 @@ scavenge_one(StgPtr p) 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 - break; - } + case MUT_PRIM: + { + StgPtr end; + + gct->eager_promotion = rtsFalse; + + end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { + evacuate((StgClosure **)p); + } - 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->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable 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 - break; - } + } case TREC_CHUNK: { StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); - gct->evac_step = 0; + gct->eager_promotion = rtsFalse; 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->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable 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 - 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 - break; - } - case IND: // IND can happen, for example, when the interpreter allocates // a gigantic AP closure (more than one block), which ends up // on the large-object list and then gets updated. See #3424. - case IND_OLDGEN: - case IND_OLDGEN_PERM: + case BLACKHOLE: case IND_STATIC: evacuate(&((StgInd *)p)->indirectee); @@ -1333,21 +1275,21 @@ scavenge_one(StgPtr p) * promoted */ { - StgPtr start = gen->steps[0].scan; - bdescr *start_bd = gen->steps[0].scan_bd; + StgPtr start = gen->scan; + bdescr *start_bd = gen->scan_bd; nat size = 0; - scavenge(&gen->steps[0]); - if (start_bd != gen->steps[0].scan_bd) { + scavenge(&gen); + if (start_bd != gen->scan_bd) { size += (P_)BLOCK_ROUND_UP(start) - start; start_bd = start_bd->link; - while (start_bd != gen->steps[0].scan_bd) { + while (start_bd != gen->scan_bd) { size += BLOCK_SIZE_W; start_bd = start_bd->link; } - size += gen->steps[0].scan - - (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan); + size += gen->scan - + (P_)BLOCK_ROUND_DOWN(gen->scan); } else { - size = gen->steps[0].scan - start; + size = gen->scan - start; } debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); } @@ -1376,7 +1318,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen) { StgPtr p, q; - gct->evac_step = &gen->steps[0]; + gct->evac_gen = gen; for (; bd != NULL; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { p = (StgPtr)*q; @@ -1385,7 +1327,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen) #ifdef DEBUG switch (get_itbl((StgClosure *)p)->type) { case MUT_VAR_CLEAN: - barf("MUT_VAR_CLEAN on mutable list"); + // can happen due to concurrent writeMutVars case MUT_VAR_DIRTY: mutlist_MUTVARS++; break; case MUT_ARR_PTRS_CLEAN: @@ -1406,21 +1348,49 @@ scavenge_mutable_list(bdescr *bd, generation *gen) // definitely doesn't point into a young generation. // Clean objects don't need to be scavenged. Some clean // objects (MUT_VAR_CLEAN) are not kept on the mutable - // list at all; others, such as MUT_ARR_PTRS_CLEAN + // list at all; others, such as TSO // are always on the mutable list. // switch (get_itbl((StgClosure *)p)->type) { case MUT_ARR_PTRS_CLEAN: recordMutableGen_GC((StgClosure *)p,gen->no); continue; + case MUT_ARR_PTRS_DIRTY: + { + rtsBool saved_eager_promotion; + saved_eager_promotion = gct->eager_promotion; + gct->eager_promotion = rtsFalse; + + scavenge_mut_arr_ptrs_marked((StgMutArrPtrs *)p); + + if (gct->failed_to_evac) { + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + } else { + ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + } + + gct->eager_promotion = saved_eager_promotion; + gct->failed_to_evac = rtsFalse; + recordMutableGen_GC((StgClosure *)p,gen->no); + continue; + } case TSO: { StgTSO *tso = (StgTSO *)p; if (tso->dirty == 0) { - // Must be on the mutable list because its link - // field is dirty. - ASSERT(tso->flags & TSO_LINK_DIRTY); - - scavenge_TSO_link(tso); + // Should be on the mutable list because its link + // field is dirty. However, in parallel GC we may + // have a thread on multiple mutable lists, so + // this assertion would be invalid: + // ASSERT(tso->flags & TSO_LINK_DIRTY); + + evacuate((StgClosure **)&tso->_link); + if ( tso->why_blocked == BlockedOnMVar + || tso->why_blocked == BlockedOnBlackHole + || tso->why_blocked == BlockedOnMsgThrowTo + || tso->why_blocked == NotBlocked + ) { + evacuate((StgClosure **)&tso->block_info.prev); + } if (gct->failed_to_evac) { recordMutableGen_GC((StgClosure *)p,gen->no); gct->failed_to_evac = rtsFalse; @@ -1479,7 +1449,7 @@ scavenge_static(void) /* Always evacuate straight to the oldest generation for static * objects */ - gct->evac_step = &oldest_gen->steps[0]; + gct->evac_gen = oldest_gen; /* keep going until we've scavenged all the objects on the linked list... */ @@ -1564,23 +1534,21 @@ scavenge_static(void) static void scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) { - nat i, b; + nat i, j, b; StgWord bitmap; b = 0; - bitmap = large_bitmap->bitmap[b]; - for (i = 0; i < size; ) { - if ((bitmap & 1) == 0) { - evacuate((StgClosure **)p); - } - i++; - p++; - if (i % BITS_IN(W_) == 0) { - b++; - bitmap = large_bitmap->bitmap[b]; - } else { + + for (i = 0; i < size; b++) { + bitmap = large_bitmap->bitmap[b]; + j = stg_min(size-i, BITS_IN(W_)); + i += j; + for (; j > 0; j--, p++) { + if ((bitmap & 1) == 0) { + evacuate((StgClosure **)p); + } bitmap = bitmap >> 1; - } + } } } @@ -1640,10 +1608,12 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // before GC, but that seems like overkill. // // Scavenging this update frame as normal would be disastrous; - // the updatee would end up pointing to the value. So we turn - // the indirection into an IND_PERM, so that evacuate will - // copy the indirection into the old generation instead of - // discarding it. + // the updatee would end up pointing to the value. So we + // check whether the value after evacuation is a BLACKHOLE, + // and if not, we change the update frame to an stg_enter + // frame that simply returns the value. Hence, blackholing is + // compulsory (otherwise we would have to check for thunks + // too). // // Note [upd-black-hole] // One slight hiccup is that the THUNK_SELECTOR machinery can @@ -1654,22 +1624,17 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // the updatee is never a THUNK_SELECTOR and we're ok. // NB. this is a new invariant: blackholing is not optional. { - nat type; - const StgInfoTable *i; - StgClosure *updatee; - - updatee = ((StgUpdateFrame *)p)->updatee; - i = updatee->header.info; - if (!IS_FORWARDING_PTR(i)) { - type = get_itbl(updatee)->type; - if (type == IND) { - updatee->header.info = &stg_IND_PERM_info; - } else if (type == IND_OLDGEN) { - updatee->header.info = &stg_IND_OLDGEN_PERM_info; - } + StgUpdateFrame *frame = (StgUpdateFrame *)p; + StgClosure *v; + + evacuate(&frame->updatee); + v = frame->updatee; + if (GET_CLOSURE_TAG(v) != 0 || + (get_itbl(v)->type != BLACKHOLE)) { + // blackholing is compulsory, see above. + frame->header.info = (const StgInfoTable*)&stg_enter_checkbh_info; } - evacuate(&((StgUpdateFrame *)p)->updatee); - ASSERT(GET_CLOSURE_TAG(((StgUpdateFrame *)p)->updatee) == 0); + ASSERT(v->header.info != &stg_TSO_info); p += sizeofW(StgUpdateFrame); continue; } @@ -1766,19 +1731,19 @@ scavenge_stack(StgPtr p, StgPtr stack_end) /*----------------------------------------------------------------------------- scavenge the large object list. - evac_step set by caller; similar games played with evac_step as with + evac_gen set by caller; similar games played with evac_gen as with scavenge() - see comment at the top of scavenge(). Most large - objects are (repeatedly) mutable, so most of the time evac_step will + objects are (repeatedly) mutable, so most of the time evac_gen will be zero. --------------------------------------------------------------------------- */ static void -scavenge_large (step_workspace *ws) +scavenge_large (gen_workspace *ws) { bdescr *bd; StgPtr p; - gct->evac_step = ws->step; + gct->evac_gen = ws->gen; bd = ws->todo_large_objects; @@ -1790,15 +1755,15 @@ scavenge_large (step_workspace *ws) // the front when evacuating. ws->todo_large_objects = bd->link; - ACQUIRE_SPIN_LOCK(&ws->step->sync_large_objects); - dbl_link_onto(bd, &ws->step->scavenged_large_objects); - ws->step->n_scavenged_large_blocks += bd->blocks; - RELEASE_SPIN_LOCK(&ws->step->sync_large_objects); + ACQUIRE_SPIN_LOCK(&ws->gen->sync_large_objects); + dbl_link_onto(bd, &ws->gen->scavenged_large_objects); + ws->gen->n_scavenged_large_blocks += bd->blocks; + RELEASE_SPIN_LOCK(&ws->gen->sync_large_objects); p = bd->start; if (scavenge_one(p)) { - if (ws->step->gen_no > 0) { - recordMutableGen_GC((StgClosure *)p, ws->step->gen_no); + if (ws->gen->no > 0) { + recordMutableGen_GC((StgClosure *)p, ws->gen->no); } } @@ -1810,7 +1775,7 @@ scavenge_large (step_workspace *ws) /* ---------------------------------------------------------------------------- Look for work to do. - We look for the oldest step that has either a todo block that can + We look for the oldest gen that has either a todo block that can be scanned, or a block of work on the global queue that we can scan. @@ -1829,8 +1794,8 @@ scavenge_large (step_workspace *ws) static rtsBool scavenge_find_work (void) { - int s; - step_workspace *ws; + int g; + gen_workspace *ws; rtsBool did_something, did_anything; bdescr *bd; @@ -1840,11 +1805,8 @@ scavenge_find_work (void) loop: did_something = rtsFalse; - for (s = total_steps-1; s >= 0; s--) { - if (s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - ws = &gct->steps[s]; + for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) { + ws = &gct->gens[g]; gct->scan_bd = NULL; @@ -1879,11 +1841,8 @@ loop: #if defined(THREADED_RTS) if (work_stealing) { // look for work to steal - for (s = total_steps-1; s >= 0; s--) { - if (s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - if ((bd = steal_todo_block(s)) != NULL) { + for (g = RtsFlags.GcFlags.generations-1; g >= 0; g--) { + if ((bd = steal_todo_block(g)) != NULL) { scavenge_block(bd); did_something = rtsTrue; break;