X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=11f79116285002cb8642aafcfdba123bffeeb854;hb=87d802b905589544f8a96c760a33e89aafd53b0a;hp=0475e4653ea8ae303dbd84864007ef26a51c94e0;hpb=bc51f1af3c837d6c5cdac8374fad987773240202;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 0475e46..11f7911 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.110 2001/07/26 14:29:26 simonmar Exp $ + * $Id: GC.c,v 1.131 2002/03/07 17:53:05 keithw Exp $ * * (c) The GHC Team 1998-1999 * @@ -7,6 +7,7 @@ * * ---------------------------------------------------------------------------*/ +#include "PosixSource.h" #include "Rts.h" #include "RtsFlags.h" #include "RtsUtils.h" @@ -40,7 +41,9 @@ #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" #endif -#include + +#include "RetainerProfile.h" +#include "LdvProfile.h" /* STATIC OBJECT LIST. * @@ -132,7 +135,7 @@ static void zero_static_object_list ( StgClosure* first_static ); static void zero_mutable_list ( StgMutClosure *first ); static rtsBool traverse_weak_ptr_list ( void ); -static void cleanup_weak_ptr_list ( StgWeak **list ); +static void mark_weak_ptr_list ( StgWeak **list ); static void scavenge ( step * ); static void scavenge_mark_stack ( void ); @@ -142,7 +145,6 @@ static void scavenge_large ( step * ); static void scavenge_static ( void ); static void scavenge_mutable_list ( generation *g ); static void scavenge_mut_once_list ( generation *g ); -static void scavengeCAFs ( void ); #if 0 && defined(DEBUG) static void gcCAFs ( void ); @@ -216,6 +218,8 @@ pop_mark_stack(void) - free from-space in each step, and set from-space = to-space. + Locks held: sched_mutex + -------------------------------------------------------------------------- */ void @@ -462,7 +466,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } } - scavengeCAFs(); + /* follow roots from the CAF list (used by GHCi) + */ + evac_gen = 0; + markCAFs(mark_root); /* follow all the roots that the application knows about. */ @@ -487,6 +494,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) /* Mark the weak pointer list, and prepare to detect dead weak * pointers. */ + mark_weak_ptr_list(&weak_ptr_list); old_weak_ptr_list = weak_ptr_list; weak_ptr_list = NULL; weak_done = rtsFalse; @@ -579,11 +587,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } } - /* Final traversal of the weak pointer list (see comment by - * cleanUpWeakPtrList below). - */ - cleanup_weak_ptr_list(&weak_ptr_list); - #if defined(PAR) // Reconstruct the Global Address tables used in GUM rebuildGAtables(major_gc); @@ -604,9 +607,17 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } } +#ifdef PROFILING + // We call processHeapClosureForDead() on every closure destroyed during + // the current garbage collection, so we invoke LdvCensusForDead(). + if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV + || RtsFlags.ProfFlags.bioSelector != NULL) + LdvCensusForDead(N); +#endif + // NO MORE EVACUATION AFTER THIS POINT! // Finally: compaction of the oldest generation. - if (major_gc && RtsFlags.GcFlags.compact) { + if (major_gc && oldest_gen->steps[0].is_compacted) { // save number of blocks for stats oldgen_saved_blocks = oldest_gen->steps[0].n_blocks; compact(get_roots); @@ -699,24 +710,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) stp->large_objects = stp->scavenged_large_objects; stp->n_large_blocks = stp->n_scavenged_large_blocks; - /* Set the maximum blocks for this generation, interpolating - * between the maximum size of the oldest and youngest - * generations. - * - * max_blocks = oldgen_max_blocks * G - * ---------------------- - * oldest_gen - */ - if (g != 0) { -#if 0 - generations[g].max_blocks = (oldest_gen->max_blocks * g) - / (RtsFlags.GcFlags.generations-1); -#endif - generations[g].max_blocks = oldest_gen->max_blocks; - } - - // for older generations... } else { + // for older generations... /* For older generations, we need to append the * scavenged_large_object list (i.e. large objects that have been @@ -735,30 +730,83 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } } - /* Set the maximum blocks for the oldest generation, based on twice - * the amount of live data now, adjusted to fit the maximum heap - * size if necessary. + /* Reset the sizes of the older generations when we do a major + * collection. * - * This is an approximation, since in the worst case we'll need - * twice the amount of live data plus whatever space the other - * generations need. + * CURRENT STRATEGY: make all generations except zero the same size. + * We have to stay within the maximum heap size, and leave a certain + * percentage of the maximum heap size available to allocate into. */ if (major_gc && RtsFlags.GcFlags.generations > 1) { - oldest_gen->max_blocks = - stg_max(oldest_gen->steps[0].n_blocks * RtsFlags.GcFlags.oldGenFactor, - RtsFlags.GcFlags.minOldGenSize); - if (oldest_gen->max_blocks > RtsFlags.GcFlags.maxHeapSize / 2) { - oldest_gen->max_blocks = RtsFlags.GcFlags.maxHeapSize / 2; - if (((int)oldest_gen->max_blocks - - (int)oldest_gen->steps[0].n_blocks) < - (RtsFlags.GcFlags.pcFreeHeap * - RtsFlags.GcFlags.maxHeapSize / 200)) { - heapOverflow(); - } + nat live, size, min_alloc; + nat max = RtsFlags.GcFlags.maxHeapSize; + nat gens = RtsFlags.GcFlags.generations; + + // live in the oldest generations + live = oldest_gen->steps[0].n_blocks + + oldest_gen->steps[0].n_large_blocks; + + // default max size for all generations except zero + size = stg_max(live * RtsFlags.GcFlags.oldGenFactor, + RtsFlags.GcFlags.minOldGenSize); + + // minimum size for generation zero + min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200, + RtsFlags.GcFlags.minAllocAreaSize); + + // Auto-enable compaction when the residency reaches a + // certain percentage of the maximum heap size (default: 30%). + if (RtsFlags.GcFlags.generations > 1 && + (RtsFlags.GcFlags.compact || + (max > 0 && + oldest_gen->steps[0].n_blocks > + (RtsFlags.GcFlags.compactThreshold * max) / 100))) { + oldest_gen->steps[0].is_compacted = 1; +// fprintf(stderr,"compaction: on\n", live); + } else { + oldest_gen->steps[0].is_compacted = 0; +// fprintf(stderr,"compaction: off\n", live); + } + + // if we're going to go over the maximum heap size, reduce the + // size of the generations accordingly. The calculation is + // different if compaction is turned on, because we don't need + // to double the space required to collect the old generation. + if (max != 0) { + + // this test is necessary to ensure that the calculations + // below don't have any negative results - we're working + // with unsigned values here. + if (max < min_alloc) { + heapOverflow(); + } + + if (oldest_gen->steps[0].is_compacted) { + if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) { + size = (max - min_alloc) / ((gens - 1) * 2 - 1); + } + } else { + if ( (size * (gens - 1) * 2) + min_alloc > max ) { + size = (max - min_alloc) / ((gens - 1) * 2); + } + } + + if (size < live) { + heapOverflow(); + } + } + +#if 0 + fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live, + min_alloc, size, max); +#endif + + for (g = 0; g < gens; g++) { + generations[g].max_blocks = size; } } - // Guess the amount of live data for stats. + // Guess the amount of live data for stats. live = calcLive(); /* Free the small objects allocated via allocate(), since this will @@ -773,6 +821,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) alloc_HpLim = NULL; alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize; + // Start a new pinned_object_block + pinned_object_block = NULL; + /* Free the mark stack. */ if (mark_stack_bdescr != NULL) { @@ -806,9 +857,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) /* For a two-space collector, we need to resize the nursery. */ /* set up a new nursery. Allocate a nursery size based on a - * function of the amount of live data (currently a factor of 2, - * should be configurable (ToDo)). Use the blocks from the old - * nursery if possible, freeing up any left over blocks. + * function of the amount of live data (by default a factor of 2) + * Use the blocks from the old nursery if possible, freeing up any + * left over blocks. * * If we get near the maximum heap size, then adjust our nursery * size accordingly. If the nursery is the same size as the live @@ -817,12 +868,13 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) * * A normal 2-space collector would need 4L bytes to give the same * performance we get from 3L bytes, reducing to the same - * performance at 2L bytes. + * performance at 2L bytes. */ blocks = g0s0->n_to_blocks; - if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 > - RtsFlags.GcFlags.maxHeapSize ) { + if ( RtsFlags.GcFlags.maxHeapSize != 0 && + blocks * RtsFlags.GcFlags.oldGenFactor * 2 > + RtsFlags.GcFlags.maxHeapSize ) { long adjusted_blocks; // signed on purpose int pc_free; @@ -881,6 +933,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } resizeNursery((nat)blocks); + + } else { + // we might have added extra large blocks to the nursery, so + // resize back to minAllocAreaSize again. + resizeNursery(RtsFlags.GcFlags.minAllocAreaSize); } } @@ -889,21 +946,31 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) if (major_gc) { gcCAFs(); } #endif +#ifdef PROFILING + // resetStaticObjectForRetainerProfiling() must be called before + // zeroing below. + resetStaticObjectForRetainerProfiling(); +#endif + // zero the scavenged static object list if (major_gc) { zero_static_object_list(scavenged_static_objects); } - /* Reset the nursery - */ + // Reset the nursery resetNurseries(); + // let go of lock (so that it can be re-grabbed below). + RELEASE_LOCK(&sched_mutex); + // start any pending finalizers scheduleFinalizers(old_weak_ptr_list); // send exceptions to any threads which were about to die resurrectThreads(resurrected_threads); + ACQUIRE_LOCK(&sched_mutex); + // Update the stable pointer hash table. updateStablePtrTable(major_gc); @@ -920,7 +987,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // restore enclosing cost centre #ifdef PROFILING - heapCensus(); CCCS = prev_CCS; #endif @@ -977,14 +1043,6 @@ traverse_weak_ptr_list(void) last_w = &old_weak_ptr_list; for (w = old_weak_ptr_list; w != NULL; w = next_w) { - /* First, this weak pointer might have been evacuated. If so, - * remove the forwarding pointer from the weak_ptr_list. - */ - if (get_itbl(w)->type == EVACUATED) { - w = (StgWeak *)((StgEvacuated *)w)->evacuee; - *last_w = w; - } - /* There might be a DEAD_WEAK on the list if finalizeWeak# was * called on a live weak pointer object. Just remove it. */ @@ -998,7 +1056,8 @@ traverse_weak_ptr_list(void) /* Now, check whether the key is reachable. */ - if ((new = isAlive(w->key))) { + new = isAlive(w->key); + if (new != NULL) { w->key = new; // evacuate the value and finalizer w->value = evacuate(w->value); @@ -1059,7 +1118,6 @@ traverse_weak_ptr_list(void) // not alive (yet): leave this thread on the old_all_threads list. prev = &(t->global_link); next = t->global_link; - continue; } else { // alive: move this thread onto the all_threads list. @@ -1067,7 +1125,6 @@ traverse_weak_ptr_list(void) t->global_link = all_threads; all_threads = t; *prev = next; - break; } } } @@ -1077,7 +1134,6 @@ traverse_weak_ptr_list(void) * of pending finalizers later on. */ if (flag == rtsFalse) { - cleanup_weak_ptr_list(&old_weak_ptr_list); for (w = old_weak_ptr_list; w; w = w->link) { w->finalizer = evacuate(w->finalizer); } @@ -1114,23 +1170,15 @@ traverse_weak_ptr_list(void) static void -cleanup_weak_ptr_list ( StgWeak **list ) +mark_weak_ptr_list ( StgWeak **list ) { StgWeak *w, **last_w; last_w = list; for (w = *list; w; w = w->link) { - - if (get_itbl(w)->type == EVACUATED) { - w = (StgWeak *)((StgEvacuated *)w)->evacuee; - *last_w = w; - } - - if ((Bdescr((P_)w)->flags & BF_EVACUATED) == 0) { (StgClosure *)w = evacuate((StgClosure *)w); *last_w = w; - } - last_w = &(w->link); + last_w = &(w->link); } } @@ -1246,6 +1294,10 @@ static __inline__ StgClosure * copy(StgClosure *src, nat size, step *stp) { P_ to, from, dest; +#ifdef PROFILING + // @LDV profiling + nat size_org = size; +#endif TICK_GC_WORDS_COPIED(size); /* Find out where we're going, using the handy "to" pointer in @@ -1275,6 +1327,11 @@ copy(StgClosure *src, nat size, step *stp) dest = stp->hp; stp->hp = to; upd_evacuee(src,(StgClosure *)dest); +#ifdef PROFILING + // We store the size of the just evacuated object in the LDV word so that + // the profiler can guess the position of the next object later. + SET_EVACUAEE_FOR_LDV(src, size_org); +#endif return (StgClosure *)dest; } @@ -1284,10 +1341,14 @@ copy(StgClosure *src, nat size, step *stp) */ -static __inline__ StgClosure * +static StgClosure * copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) { P_ dest, to, from; +#ifdef PROFILING + // @LDV profiling + nat size_to_copy_org = size_to_copy; +#endif TICK_GC_WORDS_COPIED(size_to_copy); if (stp->gen_no < evac_gen) { @@ -1309,6 +1370,16 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) dest = stp->hp; stp->hp += size_to_reserve; upd_evacuee(src,(StgClosure *)dest); +#ifdef PROFILING + // We store the size of the just evacuated object in the LDV word so that + // the profiler can guess the position of the next object later. + // size_to_copy_org is wrong because the closure already occupies size_to_reserve + // words. + SET_EVACUAEE_FOR_LDV(src, size_to_reserve); + // fill the slop + if (size_to_reserve - size_to_copy_org > 0) + FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org)); +#endif return (StgClosure *)dest; } @@ -1331,9 +1402,10 @@ evacuate_large(StgPtr p) bdescr *bd = Bdescr(p); step *stp; - // should point to the beginning of the block - ASSERT(((W_)p & BLOCK_MASK) == 0); - + // object must be at the beginning of the block (or be a ByteArray) + ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS || + (((W_)p & BLOCK_MASK) == 0)); + // already evacuated? if (bd->flags & BF_EVACUATED) { /* Don't forget to set the failed_to_evac flag if we didn't get @@ -1446,6 +1518,9 @@ loop: if (HEAP_ALLOCED(q)) { bd = Bdescr((P_)q); + // not a group head: find the group head + if (bd->blocks == 0) { bd = bd->link; } + if (bd->gen_no > N) { /* Can't evacuate this object, because it's in a generation * older than the ones we're collecting. Let's hope that it's @@ -1584,6 +1659,7 @@ loop: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_STATIC: + case CONSTR_NOCAF_STATIC: { StgWord offset = info->layout.selector_offset; @@ -1594,6 +1670,7 @@ loop: // perform the selection! q = selectee->payload[offset]; + if (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();} /* if we're already in to-space, there's no need to continue * with the evacuation, just update the source address with @@ -1647,8 +1724,10 @@ loop: thunk_selector_depth--; goto selector_loop; } - } - // otherwise, fall through... + } else { + TICK_GC_SEL_ABANDONED(); + // and fall through... + } # endif case AP_UPD: @@ -2132,9 +2211,23 @@ scavenge(step *stp) } case IND_PERM: - if (stp->gen_no != 0) { - SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); - } + if (stp->gen->no != 0) { +#ifdef PROFILING + // @LDV profiling + // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an + // IND_OLDGEN_PERM closure is larger than an IND_PERM closure. + LDV_recordDead((StgClosure *)p, sizeofW(StgInd)); +#endif + // + // Todo: maybe use SET_HDR() and remove LDV_recordCreate()? + // + SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); +#ifdef PROFILING + // @LDV profiling + // We pretend that p has just been created. + LDV_recordCreate((StgClosure *)p); +#endif + } // fall through case IND_OLDGEN_PERM: ((StgIndOldGen *)p)->indirectee = @@ -3453,15 +3546,14 @@ revertCAFs( void ) } void -scavengeCAFs( void ) +markCAFs( evac_fn evac ) { StgIndStatic *c; - evac_gen = 0; for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) { - c->indirectee = evacuate(c->indirectee); + evac(&c->indirectee); } } @@ -3561,7 +3653,17 @@ threadLazyBlackHole(StgTSO *tso) #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) belch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif +#ifdef PROFILING + // @LDV profiling + // We pretend that bh is now dead. + LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh); +#endif SET_INFO(bh,&stg_BLACKHOLE_info); +#ifdef PROFILING + // @LDV profiling + // We pretend that bh has just been created. + LDV_recordCreate(bh); +#endif } update_frame = update_frame->link; @@ -3792,7 +3894,7 @@ threadSqueezeStack(StgTSO *tso) { StgInfoTable *info = get_itbl(bh); nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i; - /* don't zero out slop for a THUNK_SELECTOR, because it's layout + /* don't zero out slop for a THUNK_SELECTOR, because its layout * info is used for a different purpose, and it's exactly the * same size as a BLACKHOLE in any case. */ @@ -3803,7 +3905,20 @@ threadSqueezeStack(StgTSO *tso) } } #endif +#ifdef PROFILING + // @LDV profiling + // We pretend that bh is now dead. + LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh); +#endif + // + // Todo: maybe use SET_HDR() and remove LDV_recordCreate()? + // SET_INFO(bh,&stg_BLACKHOLE_info); +#ifdef PROFILING + // @LDV profiling + // We pretend that bh has just been created. + LDV_recordCreate(bh); +#endif } }