X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=bf5d612549e8b65f9409a30ab014795ebd3ea991;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=513d14a20c21527dfd995847427211a4a0ce9308;hpb=afd08a9c06ae4b15e33e26e5a2818801c7fee429;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 513d14a..bf5d612 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -104,6 +104,10 @@ static rtsBool major_gc; */ static nat evac_gen; +/* Whether to do eager promotion or not. + */ +static rtsBool eager_promotion; + /* Weak pointers */ StgWeak *old_weak_ptr_list; // also pending finaliser list @@ -140,6 +144,14 @@ static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC static lnat thunk_selector_depth = 0; #define MAX_THUNK_SELECTOR_DEPTH 8 +/* Mut-list stats */ +#ifdef DEBUG +static nat + mutlist_MUTVARS, + mutlist_MUTARRS, + mutlist_OTHERS; +#endif + /* ----------------------------------------------------------------------------- Static function declarations -------------------------------------------------------------------------- */ @@ -332,7 +344,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) { bdescr *bd; step *stp; - lnat live, allocated, collected = 0, copied = 0, scavd_copied = 0; + lnat live, allocated, copied = 0, scavd_copied = 0; lnat oldgen_saved_blocks = 0; nat g, s, i; @@ -363,6 +375,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) memInventory(); #endif +#ifdef DEBUG + mutlist_MUTVARS = 0; + mutlist_MUTARRS = 0; + mutlist_OTHERS = 0; +#endif + // Init stats and print par specific (timing) info PAR_TICKY_PAR_START(); @@ -571,6 +589,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) mark_stack_bdescr = NULL; } + eager_promotion = rtsTrue; // for now + /* ----------------------------------------------------------------------- * follow all the roots that we know about: * - mutable lists from each generation > N @@ -792,9 +812,13 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // Count the mutable list as bytes "copied" for the purposes of // stats. Every mutable list is copied during every GC. if (g > 0) { + nat mut_list_size = 0; for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { - copied += (bd->free - bd->start) * sizeof(StgWord); + mut_list_size += bd->free - bd->start; } + copied += mut_list_size; + + IF_DEBUG(gc, debugBelch("mut_list_size: %d (%d vars, %d arrays, %d others)\n", mut_list_size * sizeof(W_), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS)); } for (s = 0; s < generations[g].n_steps; s++) { @@ -813,18 +837,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // for generations we collected... if (g <= N) { - // rough calculation of garbage collected, for stats output - if (stp->is_compacted) { - collected += (oldgen_saved_blocks - stp->n_old_blocks) * BLOCK_SIZE_W; - } else { - if (g == 0 && s == 0) { - collected += countNurseryBlocks() * BLOCK_SIZE_W; - collected += alloc_blocks; - } else { - collected += stp->n_old_blocks * BLOCK_SIZE_W; - } - } - /* free old memory and shift to-space into from-space for all * the collected steps (except the allocation area). These * freed blocks will probaby be quickly recycled. @@ -1175,7 +1187,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) #endif // ok, GC over: tell the stats department what happened. - stat_endGC(allocated, collected, live, copied, scavd_copied, N); + stat_endGC(allocated, live, copied, scavd_copied, N); #if defined(RTS_USER_SIGNALS) // unblock signals again @@ -1561,11 +1573,11 @@ copy(StgClosure *src, nat size, step *stp) * by evacuate()). */ if (stp->gen_no < evac_gen) { -#ifdef NO_EAGER_PROMOTION - failed_to_evac = rtsTrue; -#else - stp = &generations[evac_gen].steps[0]; -#endif + if (eager_promotion) { + stp = &generations[evac_gen].steps[0]; + } else { + failed_to_evac = rtsTrue; + } } /* chain a new block onto the to-space for the destination step if @@ -1611,11 +1623,11 @@ copy_noscav(StgClosure *src, nat size, step *stp) * by evacuate()). */ if (stp->gen_no < evac_gen) { -#ifdef NO_EAGER_PROMOTION - failed_to_evac = rtsTrue; -#else - stp = &generations[evac_gen].steps[0]; -#endif + if (eager_promotion) { + stp = &generations[evac_gen].steps[0]; + } else { + failed_to_evac = rtsTrue; + } } /* chain a new block onto the to-space for the destination step if @@ -1658,11 +1670,11 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) TICK_GC_WORDS_COPIED(size_to_copy); if (stp->gen_no < evac_gen) { -#ifdef NO_EAGER_PROMOTION - failed_to_evac = rtsTrue; -#else - stp = &generations[evac_gen].steps[0]; -#endif + if (eager_promotion) { + stp = &generations[evac_gen].steps[0]; + } else { + failed_to_evac = rtsTrue; + } } if (stp->hp + size_to_reserve >= stp->hpLim) { @@ -1739,11 +1751,11 @@ evacuate_large(StgPtr p) */ stp = bd->step->to; if (stp->gen_no < evac_gen) { -#ifdef NO_EAGER_PROMOTION - failed_to_evac = rtsTrue; -#else - stp = &generations[evac_gen].steps[0]; -#endif + if (eager_promotion) { + stp = &generations[evac_gen].steps[0]; + } else { + failed_to_evac = rtsTrue; + } } bd->step = stp; @@ -1929,7 +1941,8 @@ loop: switch (info->type) { - case MUT_VAR: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: case MVAR: return copy(q,sizeW_fromITBL(info),stp); @@ -2099,7 +2112,8 @@ loop: // just copy the block return copy_noscav(q,arr_words_sizeW((StgArrWords *)q),stp); - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: // just copy the block @@ -2881,13 +2895,22 @@ scavenge(step *stp) p += sizeofW(StgInd); break; - case MUT_VAR: - evac_gen = 0; + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - evac_gen = saved_evac_gen; - failed_to_evac = rtsTrue; // mutable anyhow + 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: @@ -2928,18 +2951,32 @@ scavenge(step *stp) p += arr_words_sizeW((StgArrWords *)p); break; - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: // follow everything { StgPtr next; - - evac_gen = 0; // repeatedly mutable + 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); } - evac_gen = saved_evac_gen; - failed_to_evac = rtsTrue; // mutable anyhow. + 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; } @@ -3250,12 +3287,21 @@ linear_scan: evacuate(((StgInd *)p)->indirectee); break; - case MUT_VAR: - evac_gen = 0; + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - evac_gen = saved_evac_gen; - failed_to_evac = rtsTrue; + 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; + } break; + } case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: @@ -3289,17 +3335,31 @@ linear_scan: scavenge_AP((StgAP *)p); break; - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: // follow everything { StgPtr next; - - evac_gen = 0; // repeatedly mutable + 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); } - evac_gen = saved_evac_gen; + 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; // mutable anyhow. break; } @@ -3566,12 +3626,22 @@ scavenge_one(StgPtr p) break; } - case MUT_VAR: - evac_gen = 0; + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: { + StgPtr q = p; + rtsBool saved_eager_promotion = eager_promotion; + + eager_promotion = rtsFalse; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - evac_gen = saved_evac_gen; - failed_to_evac = rtsTrue; // mutable anyhow + 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; + } break; + } case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: @@ -3608,17 +3678,31 @@ scavenge_one(StgPtr p) // nothing to follow break; - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: { - // follow everything - StgPtr next; - - evac_gen = 0; // repeatedly mutable + 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 = eager_promotion; + 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); } - evac_gen = saved_evac_gen; + 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; break; } @@ -3834,6 +3918,30 @@ scavenge_mutable_list(generation *gen) for (q = bd->start; q < bd->free; q++) { p = (StgPtr)*q; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + +#ifdef DEBUG + switch (get_itbl((StgClosure *)p)->type) { + case MUT_VAR_CLEAN: + barf("MUT_VAR_CLEAN on mutable list"); + case MUT_VAR_DIRTY: + mutlist_MUTVARS++; break; + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + mutlist_MUTARRS++; break; + default: + mutlist_OTHERS++; break; + } +#endif + + // We don't need to scavenge clean arrays. This is the + // Whole Point of MUT_ARR_PTRS_CLEAN. + if (get_itbl((StgClosure *)p)->type == MUT_ARR_PTRS_CLEAN) { + recordMutableGen((StgClosure *)p,gen); + continue; + } + if (scavenge_one(p)) { /* didn't manage to promote everything, so put the * object back on the list. @@ -3999,6 +4107,32 @@ scavenge_stack(StgPtr p, StgPtr stack_end) switch (info->i.type) { case UPDATE_FRAME: + // In SMP, we can get update frames that point to indirections + // when two threads evaluate the same thunk. We do attempt to + // discover this situation in threadPaused(), but it's + // possible that the following sequence occurs: + // + // A B + // enter T + // enter T + // blackhole T + // update T + // GC + // + // Now T is an indirection, and the update frame is already + // marked on A's stack, so we won't traverse it again in + // threadPaused(). We could traverse the whole stack again + // 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. + if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_PERM_info; + } ((StgUpdateFrame *)p)->updatee = evacuate(((StgUpdateFrame *)p)->updatee); p += sizeofW(StgUpdateFrame); @@ -4430,7 +4564,7 @@ threadPaused(Capability *cap, StgTSO *tso) bh = ((StgUpdateFrame *)frame)->updatee; if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) { - IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %d words of stack\n", (StgPtr)frame - tso->sp)); + IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %ld words of stack\n", (StgPtr)frame - tso->sp)); // If this closure is already an indirection, then // suspend the computation up to this point: