X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=680c8e5b22c8c0611901bb1197314586889f02ac;hb=2349db9a983bba49acbb5c059d095158459666bc;hp=82860ce0ee820f0cf4df73af59a0b86675265ce0;hpb=63015c7f7264be54d527e309de2647fa41f3f4c6;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 82860ce..680c8e5 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.30 1999/02/11 17:40:26 simonm Exp $ + * $Id: GC.c,v 1.52 1999/03/15 16:53:11 simonm Exp $ * * (c) The GHC Team 1998-1999 * @@ -91,25 +91,32 @@ static rtsBool failed_to_evac; */ bdescr *old_to_space; +/* Data used for allocation area sizing. + */ +lnat new_blocks; /* blocks allocated during this GC */ +lnat g0s0_pcnt_kept = 30; /* percentage of g0s0 live at last minor GC */ + /* ----------------------------------------------------------------------------- Static function declarations -------------------------------------------------------------------------- */ -static StgClosure *evacuate(StgClosure *q); -static void zeroStaticObjectList(StgClosure* first_static); -static rtsBool traverse_weak_ptr_list(void); -static void zeroMutableList(StgMutClosure *first); -static void revertDeadCAFs(void); +static StgClosure * evacuate ( StgClosure *q ); +static void zero_static_object_list ( StgClosure* first_static ); +static void zero_mutable_list ( StgMutClosure *first ); +static void revert_dead_CAFs ( void ); + +static rtsBool traverse_weak_ptr_list ( void ); +static void cleanup_weak_ptr_list ( StgWeak **list ); -static void scavenge_stack(StgPtr p, StgPtr stack_end); -static void scavenge_large(step *step); -static void scavenge(step *step); -static void scavenge_static(void); -static void scavenge_mutable_list(generation *g); -static void scavenge_mut_once_list(generation *g); +static void scavenge_stack ( StgPtr p, StgPtr stack_end ); +static void scavenge_large ( step *step ); +static void scavenge ( step *step ); +static void scavenge_static ( void ); +static void scavenge_mutable_list ( generation *g ); +static void scavenge_mut_once_list ( generation *g ); #ifdef DEBUG -static void gcCAFs(void); +static void gcCAFs ( void ); #endif /* ----------------------------------------------------------------------------- @@ -139,7 +146,7 @@ void GarbageCollect(void (*get_roots)(void)) { bdescr *bd; step *step; - lnat live, allocated, collected = 0; + lnat live, allocated, collected = 0, copied = 0; nat g, s; #ifdef PROFILING @@ -170,6 +177,10 @@ void GarbageCollect(void (*get_roots)(void)) for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) { allocated -= BLOCK_SIZE_W; } + if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) { + allocated -= (current_nursery->start + BLOCK_SIZE_W) + - current_nursery->free; + } /* Figure out which generation to collect */ @@ -191,10 +202,10 @@ void GarbageCollect(void (*get_roots)(void)) scavenged_static_objects = END_OF_STATIC_LIST; /* zero the mutable list for the oldest generation (see comment by - * zeroMutableList below). + * zero_mutable_list below). */ if (major_gc) { - zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_once_list); + zero_mutable_list(generations[RtsFlags.GcFlags.generations-1].mut_once_list); } /* Save the old to-space if we're doing a two-space collection @@ -204,6 +215,11 @@ void GarbageCollect(void (*get_roots)(void)) g0s0->to_space = NULL; } + /* Keep a count of how many new blocks we allocated during this GC + * (used for resizing the allocation area, later). + */ + new_blocks = 0; + /* Initialise to-space in all the generations/steps that we're * collecting. */ @@ -233,11 +249,12 @@ void GarbageCollect(void (*get_roots)(void)) step->hpLim = step->hp + BLOCK_SIZE_W; step->hp_bd = bd; step->to_space = bd; - step->to_blocks = 1; /* ???? */ + step->to_blocks = 1; step->scan = bd->start; step->scan_bd = bd; step->new_large_objects = NULL; step->scavenged_large_objects = NULL; + new_blocks++; /* mark the large objects as not evacuated yet */ for (bd = step->large_objects; bd; bd = bd->link) { bd->evacuated = 0; @@ -262,6 +279,7 @@ void GarbageCollect(void (*get_roots)(void)) step->hp_bd = bd; step->blocks = bd; step->n_blocks = 1; + new_blocks++; } /* Set the scan pointer for older generations: remember we * still have to scavenge objects that have been promoted. */ @@ -325,7 +343,6 @@ void GarbageCollect(void (*get_roots)(void)) /* Mark the weak pointer list, and prepare to detect dead weak * pointers. */ - markWeakList(); old_weak_ptr_list = weak_ptr_list; weak_ptr_list = NULL; weak_done = rtsFalse; @@ -341,22 +358,7 @@ void GarbageCollect(void (*get_roots)(void)) * the CAF document. */ extern void markHugsObjects(void); -#if 0 - /* ToDo: This (undefined) function should contain the scavenge - * loop immediately below this block of code - but I'm not sure - * enough of the details to do this myself. - */ - scavengeEverything(); - /* revert dead CAFs and update enteredCAFs list */ - revertDeadCAFs(); -#endif markHugsObjects(); -#if 0 - /* This will keep the CAFs and the attached BCOs alive - * but the values will have been reverted - */ - scavengeEverything(); -#endif } #endif @@ -389,6 +391,9 @@ void GarbageCollect(void (*get_roots)(void)) loop2: for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) { for (st = generations[gen].n_steps-1; st >= 0 ; st--) { + if (gen == 0 && st == 0 && RtsFlags.GcFlags.generations > 1) { + continue; + } step = &generations[gen].steps[st]; evac_gen = gen; if (step->hp_bd != step->scan_bd || step->scan < step->hp) { @@ -412,10 +417,18 @@ void GarbageCollect(void (*get_roots)(void)) } } - /* Now see which stable names are still alive + /* Final traversal of the weak pointer list (see comment by + * cleanUpWeakPtrList below). + */ + cleanup_weak_ptr_list(&weak_ptr_list); + + /* Now see which stable names are still alive. */ gcStablePtrTable(major_gc); + /* revert dead CAFs and update enteredCAFs list */ + revert_dead_CAFs(); + /* 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. @@ -443,6 +456,7 @@ void GarbageCollect(void (*get_roots)(void)) /* run through all the generations/steps and tidy up */ + copied = new_blocks * BLOCK_SIZE_W; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { if (g <= N) { @@ -457,6 +471,11 @@ void GarbageCollect(void (*get_roots)(void)) /* Tidy the end of the to-space chains */ step->hp_bd->free = step->hp; step->hp_bd->link = NULL; + /* stats information: how much we copied */ + if (g <= N) { + copied -= step->hp_bd->start + BLOCK_SIZE_W - + step->hp_bd->free; + } } /* for generations we collected... */ @@ -503,8 +522,11 @@ void GarbageCollect(void (*get_roots)(void)) * 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... */ @@ -529,6 +551,18 @@ void GarbageCollect(void (*get_roots)(void)) /* Guess the amount of live data for stats. */ live = calcLive(); + /* Free the small objects allocated via allocate(), since this will + * all have been copied into G0S1 now. + */ + if (small_alloc_list != NULL) { + freeChain(small_alloc_list); + } + small_alloc_list = NULL; + alloc_blocks = 0; + alloc_Hp = NULL; + alloc_HpLim = NULL; + alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize; + /* Two-space collector: * Free the old to-space, and estimate the amount of live data. */ @@ -592,25 +626,28 @@ void GarbageCollect(void (*get_roots)(void)) nat needed = calcNeeded(); /* approx blocks needed at next GC */ /* Guess how much will be live in generation 0 step 0 next time. - * A good approximation is the amount of data that was live this - * time: this assumes (1) that the size of G0S0 will be roughly - * the same as last time, and (2) that the promotion rate will be - * constant. - * - * If we don't know how much was live in G0S0 (because there's no - * step 1), then assume 30% (which is usually an overestimate). + * A good approximation is the obtained by finding the + * percentage of g0s0 that was live at the last minor GC. */ - if (g0->n_steps == 1) { - needed += (g0s0->n_blocks * 30) / 100; - } else { - needed += g0->steps[1].n_blocks; + if (N == 0) { + g0s0_pcnt_kept = (new_blocks * 100) / g0s0->n_blocks; } - /* Now we have a rough guess at the number of blocks needed for - * the next GC, subtract this from the user's suggested heap size - * and use the rest for the allocation area. + /* Estimate a size for the allocation area based on the + * information available. We might end up going slightly under + * or over the suggested heap size, but we should be pretty + * close on average. + * + * Formula: suggested - needed + * ---------------------------- + * 1 + g0s0_pcnt_kept/100 + * + * where 'needed' is the amount of memory needed at the next + * collection for collecting all steps except g0s0. */ - blocks = (int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed; + blocks = + (((int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed) * 100) / + (100 + (int)g0s0_pcnt_kept); if (blocks < (int)RtsFlags.GcFlags.minAllocAreaSize) { blocks = RtsFlags.GcFlags.minAllocAreaSize; @@ -620,17 +657,14 @@ void GarbageCollect(void (*get_roots)(void)) } } - /* revert dead CAFs and update enteredCAFs list */ - revertDeadCAFs(); - - /* mark the garbage collected CAFs as dead */ + /* mark the garbage collected CAFs as dead */ #ifdef DEBUG if (major_gc) { gcCAFs(); } #endif /* zero the scavenged static object list */ if (major_gc) { - zeroStaticObjectList(scavenged_static_objects); + zero_static_object_list(scavenged_static_objects); } /* Reset the nursery @@ -639,19 +673,10 @@ void GarbageCollect(void (*get_roots)(void)) bd->free = bd->start; ASSERT(bd->gen == g0); ASSERT(bd->step == g0s0); + IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE)); } current_nursery = g0s0->blocks; - /* Free the small objects allocated via allocate(), since this will - * all have been copied into G0S1 now. - */ - if (small_alloc_list != NULL) { - freeChain(small_alloc_list); - } - small_alloc_list = NULL; - alloc_blocks = 0; - alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize; - /* start any pending finalizers */ scheduleFinalizers(old_weak_ptr_list); @@ -675,7 +700,7 @@ void GarbageCollect(void (*get_roots)(void)) IF_DEBUG(sanity, memInventory()); /* ok, GC over: tell the stats department what happened. */ - stat_endGC(allocated, collected, live, N); + stat_endGC(allocated, collected, live, copied, N); } /* ----------------------------------------------------------------------------- @@ -715,6 +740,27 @@ traverse_weak_ptr_list(void) last_w = &old_weak_ptr_list; for (w = old_weak_ptr_list; w; 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. + */ + if (w->header.info == &DEAD_WEAK_info) { + next_w = ((StgDeadWeak *)w)->link; + *last_w = next_w; + continue; + } + + ASSERT(get_itbl(w)->type == WEAK); + + /* Now, check whether the key is reachable. + */ if ((new = isAlive(w->key))) { w->key = new; /* evacuate the value and finalizer */ @@ -742,8 +788,8 @@ 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->value = evacuate(w->value); w->finalizer = evacuate(w->finalizer); } weak_done = rtsTrue; @@ -753,6 +799,39 @@ traverse_weak_ptr_list(void) } /* ----------------------------------------------------------------------------- + After GC, the live weak pointer list may have forwarding pointers + on it, because a weak pointer object was evacuated after being + moved to the live weak pointer list. We remove those forwarding + pointers here. + + Also, we don't consider weak pointer objects to be reachable, but + we must nevertheless consider them to be "live" and retain them. + Therefore any weak pointer objects which haven't as yet been + evacuated need to be evacuated now. + -------------------------------------------------------------------------- */ + +static void +cleanup_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)->evacuated == 0) { + (StgClosure *)w = evacuate((StgClosure *)w); + *last_w = w; + } + last_w = &(w->link); + } +} + +/* ----------------------------------------------------------------------------- isAlive determines whether the given closure is still alive (after a garbage collection) or not. It returns the new address of the closure if it is alive, or NULL otherwise. @@ -823,6 +902,14 @@ static void addBlock(step *step) step->hpLim = step->hp + BLOCK_SIZE_W; step->hp_bd = bd; step->to_blocks++; + new_blocks++; +} + +static __inline__ void +upd_evacuee(StgClosure *p, StgClosure *dest) +{ + p->header.info = &EVACUATED_info; + ((StgEvacuated *)p)->evacuee = dest; } static __inline__ StgClosure * @@ -837,7 +924,11 @@ copy(StgClosure *src, nat size, step *step) * by evacuate()). */ if (step->gen->no < evac_gen) { +#ifdef NO_EAGER_PROMOTION + failed_to_evac = rtsTrue; +#else step = &generations[evac_gen].steps[0]; +#endif } /* chain a new block onto the to-space for the destination step if @@ -853,6 +944,7 @@ copy(StgClosure *src, nat size, step *step) dest = step->hp; step->hp = to; + upd_evacuee(src,(StgClosure *)dest); return (StgClosure *)dest; } @@ -868,7 +960,11 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step) TICK_GC_WORDS_COPIED(size_to_copy); if (step->gen->no < evac_gen) { +#ifdef NO_EAGER_PROMOTION + failed_to_evac = rtsTrue; +#else step = &generations[evac_gen].steps[0]; +#endif } if (step->hp + size_to_reserve >= step->hpLim) { @@ -881,18 +977,10 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step) dest = step->hp; step->hp += size_to_reserve; + upd_evacuee(src,(StgClosure *)dest); return (StgClosure *)dest; } -static __inline__ void -upd_evacuee(StgClosure *p, StgClosure *dest) -{ - StgEvacuated *q = (StgEvacuated *)p; - - SET_INFO(q,&EVACUATED_info); - q->evacuee = dest; -} - /* ----------------------------------------------------------------------------- Evacuate a large object @@ -940,7 +1028,11 @@ evacuate_large(StgPtr p, rtsBool mutable) */ step = bd->step->to; if (step->gen->no < evac_gen) { +#ifdef NO_EAGER_PROMOTION + failed_to_evac = rtsTrue; +#else step = &generations[evac_gen].steps[0]; +#endif } bd->step = step; @@ -1022,7 +1114,7 @@ evacuate(StgClosure *q) const StgInfoTable *info; loop: - if (!LOOKS_LIKE_STATIC(q)) { + if (HEAP_ALLOCED(q)) { bd = Bdescr((P_)q); if (bd->gen->no > N) { /* Can't evacuate this object, because it's in a generation @@ -1047,46 +1139,42 @@ loop: switch (info -> type) { case BCO: - to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step); - upd_evacuee(q,to); - return to; + return copy(q,bco_sizeW(stgCast(StgBCO*,q)),step); case MUT_VAR: ASSERT(q->header.info != &MUT_CONS_info); case MVAR: to = copy(q,sizeW_fromITBL(info),step); - upd_evacuee(q,to); recordMutable((StgMutClosure *)to); return to; - case STABLE_NAME: - stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue; - to = copy(q,sizeofW(StgStableName),step); - upd_evacuee(q,to); - return to; - case FUN_1_0: case FUN_0_1: case CONSTR_1_0: case CONSTR_0_1: - to = copy(q,sizeofW(StgHeader)+1,step); - upd_evacuee(q,to); - return to; + return copy(q,sizeofW(StgHeader)+1,step); case THUNK_1_0: /* here because of MIN_UPD_SIZE */ case THUNK_0_1: - case FUN_1_1: - case FUN_0_2: - case FUN_2_0: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: +#ifdef NO_PROMOTE_THUNKS + if (bd->gen->no == 0 && + bd->step->no != 0 && + bd->step->no == bd->gen->n_steps-1) { + step = bd->step; + } +#endif + return copy(q,sizeofW(StgHeader)+2,step); + + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: - to = copy(q,sizeofW(StgHeader)+2,step); - upd_evacuee(q,to); - return to; + return copy(q,sizeofW(StgHeader)+2,step); case FUN: case THUNK: @@ -1097,19 +1185,15 @@ loop: case CAF_ENTERED: case WEAK: case FOREIGN: - to = copy(q,sizeW_fromITBL(info),step); - upd_evacuee(q,to); - return to; + case STABLE_NAME: + return copy(q,sizeW_fromITBL(info),step); case CAF_BLACKHOLE: case BLACKHOLE: - to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step); - upd_evacuee(q,to); - return to; + return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step); case BLACKHOLE_BQ: to = copy(q,BLACKHOLE_sizeW(),step); - upd_evacuee(q,to); recordMutable((StgMutClosure *)to); return to; @@ -1129,11 +1213,11 @@ loop: case CONSTR_0_2: case CONSTR_STATIC: { - StgNat32 offset = info->layout.selector_offset; + StgWord32 offset = info->layout.selector_offset; /* check that the size is in range */ ASSERT(offset < - (StgNat32)(selectee_info->layout.payload.ptrs + + (StgWord32)(selectee_info->layout.payload.ptrs + selectee_info->layout.payload.nptrs)); /* perform the selection! */ @@ -1143,7 +1227,7 @@ loop: * with the evacuation, just update the source address with * a pointer to the (evacuated) constructor field. */ - if (IS_USER_PTR(q)) { + if (HEAP_ALLOCED(q)) { bdescr *bd = Bdescr((P_)q); if (bd->evacuated) { if (bd->gen->no < evac_gen) { @@ -1196,9 +1280,7 @@ loop: barf("evacuate: THUNK_SELECTOR: strange selectee"); } } - to = copy(q,THUNK_SELECTOR_sizeW(),step); - upd_evacuee(q,to); - return to; + return copy(q,THUNK_SELECTOR_sizeW(),step); case IND: case IND_OLDGEN: @@ -1206,30 +1288,35 @@ loop: q = ((StgInd*)q)->indirectee; goto loop; - /* ToDo: optimise STATIC_LINK for known cases. - - FUN_STATIC : payload[0] - - THUNK_STATIC : payload[1] - - IND_STATIC : payload[1] - */ case THUNK_STATIC: + if (info->srt_len > 0 && major_gc && + THUNK_STATIC_LINK((StgClosure *)q) == NULL) { + THUNK_STATIC_LINK((StgClosure *)q) = static_objects; + static_objects = (StgClosure *)q; + } + return q; + case FUN_STATIC: - if (info->srt_len == 0) { /* small optimisation */ - return q; + if (info->srt_len > 0 && major_gc && + FUN_STATIC_LINK((StgClosure *)q) == NULL) { + FUN_STATIC_LINK((StgClosure *)q) = static_objects; + static_objects = (StgClosure *)q; } - /* fall through */ - case CONSTR_STATIC: + return q; + case IND_STATIC: - /* don't want to evacuate these, but we do want to follow pointers - * from SRTs - see scavenge_static. - */ + if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) { + IND_STATIC_LINK((StgClosure *)q) = static_objects; + static_objects = (StgClosure *)q; + } + return q; - /* put the object on the static list, if necessary. - */ + case CONSTR_STATIC: if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) { STATIC_LINK(info,(StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; } - /* fall through */ + return q; case CONSTR_INTLIKE: case CONSTR_CHARLIKE: @@ -1256,9 +1343,7 @@ loop: case PAP: /* these are special - the payload is a copy of a chunk of stack, tagging and all. */ - to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),step); - upd_evacuee(q,to); - return to; + return copy(q,pap_sizeW(stgCast(StgPAP*,q)),step); case EVACUATED: /* Already evacuated, just return the forwarding address. @@ -1287,9 +1372,7 @@ loop: return q; } else { /* just copy the block */ - to = copy(q,size,step); - upd_evacuee(q,to); - return to; + return copy(q,size,step); } } @@ -1304,7 +1387,6 @@ loop: } else { /* just copy the block */ to = copy(q,size,step); - upd_evacuee(q,to); if (info->type == MUT_ARR_PTRS) { recordMutable((StgMutClosure *)to); } @@ -1338,7 +1420,6 @@ loop: new_tso->splim = (StgPtr)new_tso->splim + diff; relocate_TSO(tso, new_tso); - upd_evacuee(q,(StgClosure *)new_tso); recordMutable((StgMutClosure *)new_tso); return (StgClosure *)new_tso; @@ -1421,7 +1502,24 @@ scavenge_srt(const StgInfoTable *info) srt = stgCast(StgClosure **,info->srt); srt_end = srt + info->srt_len; for (; srt < srt_end; srt++) { - evacuate(*srt); + /* 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) + reference to the DLL closure in the table by first adding one to it. + We check for this here, and undo the addition before evacuating it. + + 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. + */ +#ifdef HAVE_WIN32_DLL_SUPPORT + if ( stgCast(unsigned long,*srt) & 0x1 ) { + evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1))); + } else { + evacuate(*srt); + } +#else + evacuate(*srt); +#endif } } @@ -1559,7 +1657,6 @@ scavenge(step *step) case IND_PERM: case IND_OLDGEN_PERM: case CAF_UNENTERED: - case CAF_ENTERED: { StgPtr end; @@ -1571,6 +1668,20 @@ scavenge(step *step) break; } + case CAF_ENTERED: + { + StgCAF *caf = (StgCAF *)p; + + caf->body = evacuate(caf->body); + caf->value = evacuate(caf->value); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + recordOldToNewPtrs((StgMutClosure *)p); + } + p += sizeofW(StgCAF); + break; + } + case MUT_VAR: /* ignore MUT_CONSs */ if (((StgMutVar *)p)->header.info != &MUT_CONS_info) { @@ -1765,7 +1876,6 @@ scavenge_one(StgClosure *p) case IND_PERM: case IND_OLDGEN_PERM: case CAF_UNENTERED: - case CAF_ENTERED: { StgPtr q, end; @@ -1857,7 +1967,7 @@ scavenge_mut_once_list(generation *gen) ((StgIndOldGen *)p)->indirectee = evacuate(((StgIndOldGen *)p)->indirectee); -#if 0 +#if 0 /* Debugging code to print out the size of the thing we just * promoted */ @@ -1918,6 +2028,31 @@ scavenge_mut_once_list(generation *gen) } continue; + case CAF_ENTERED: + { + StgCAF *caf = (StgCAF *)p; + caf->body = evacuate(caf->body); + caf->value = evacuate(caf->value); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + p->mut_link = new_list; + new_list = p; + } + } + continue; + + case CAF_UNENTERED: + { + StgCAF *caf = (StgCAF *)p; + caf->body = evacuate(caf->body); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + p->mut_link = new_list; + new_list = p; + } + } + continue; + default: /* shouldn't have anything else on the mutables list */ barf("scavenge_mut_once_list: strange object?"); @@ -1932,10 +2067,9 @@ static void scavenge_mutable_list(generation *gen) { StgInfoTable *info; - StgMutClosure *p, *next, *new_list; + StgMutClosure *p, *next; p = gen->saved_mut_list; - new_list = gen->mut_list; next = p->mut_link; evac_gen = 0; @@ -1966,16 +2100,16 @@ scavenge_mutable_list(generation *gen) if (failed_to_evac) { failed_to_evac = rtsFalse; - p->mut_link = new_list; - new_list = p; + p->mut_link = gen->mut_list; + gen->mut_list = p; } continue; } case MUT_ARR_PTRS: /* follow everything */ - p->mut_link = new_list; - new_list = p; + p->mut_link = gen->mut_list; + gen->mut_list = p; { StgPtr end, q; @@ -1993,8 +2127,8 @@ scavenge_mutable_list(generation *gen) */ ASSERT(p->header.info != &MUT_CONS_info); ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - p->mut_link = new_list; - new_list = p; + p->mut_link = gen->mut_list; + gen->mut_list = p; continue; case MVAR: @@ -2003,8 +2137,8 @@ scavenge_mutable_list(generation *gen) (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); - p->mut_link = new_list; - new_list = p; + p->mut_link = gen->mut_list; + gen->mut_list = p; continue; } @@ -2027,8 +2161,8 @@ scavenge_mutable_list(generation *gen) * point to some younger objects (because we set evac_gen to 0 * above). */ - tso->mut_link = new_list; - new_list = (StgMutClosure *)tso; + tso->mut_link = gen->mut_list; + gen->mut_list = (StgMutClosure *)tso; continue; } @@ -2037,8 +2171,8 @@ scavenge_mutable_list(generation *gen) StgBlockingQueue *bh = (StgBlockingQueue *)p; (StgClosure *)bh->blocking_queue = evacuate((StgClosure *)bh->blocking_queue); - p->mut_link = new_list; - new_list = p; + p->mut_link = gen->mut_list; + gen->mut_list = p; continue; } @@ -2047,8 +2181,6 @@ scavenge_mutable_list(generation *gen) barf("scavenge_mut_list: strange object?"); } } - - gen->mut_list = new_list; } static void @@ -2141,7 +2273,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) { StgPtr q; const StgInfoTable* info; - StgNat32 bitmap; + StgWord32 bitmap; /* * Each time around this loop, we are looking at a chunk of stack @@ -2160,14 +2292,13 @@ scavenge_stack(StgPtr p, StgPtr stack_end) /* Is q a pointer to a closure? */ - if (! LOOKS_LIKE_GHC_INFO(q)) { + if (! LOOKS_LIKE_GHC_INFO(q)) { #ifdef DEBUG - if (LOOKS_LIKE_STATIC(q)) { /* Is it a static closure? */ + if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) { /* Is it a static closure? */ ASSERT(closure_STATIC(stgCast(StgClosure*,q))); - } - /* otherwise, must be a pointer into the allocation space. - */ + } + /* otherwise, must be a pointer into the allocation space. */ #endif (StgClosure *)*p = evacuate((StgClosure *)q); @@ -2204,7 +2335,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) { StgUpdateFrame *frame = (StgUpdateFrame *)p; StgClosure *to; - StgClosureType type = get_itbl(frame->updatee)->type; + nat type = get_itbl(frame->updatee)->type; p += sizeofW(StgUpdateFrame); if (type == EVACUATED) { @@ -2219,18 +2350,24 @@ scavenge_stack(StgPtr p, StgPtr stack_end) } continue; } - step = bd->step->to; + + /* Don't promote blackholes */ + step = bd->step; + if (!(step->gen->no == 0 && + step->no != 0 && + step->no == step->gen->n_steps-1)) { + step = step->to; + } + switch (type) { case BLACKHOLE: case CAF_BLACKHOLE: to = copyPart(frame->updatee, BLACKHOLE_sizeW(), sizeofW(StgHeader), step); - upd_evacuee(frame->updatee,to); frame->updatee = to; continue; case BLACKHOLE_BQ: to = copy(frame->updatee, BLACKHOLE_sizeW(), step); - upd_evacuee(frame->updatee,to); frame->updatee = to; recordMutable((StgMutClosure *)to); continue; @@ -2402,7 +2539,7 @@ scavenge_large(step *step) } static void -zeroStaticObjectList(StgClosure* first_static) +zero_static_object_list(StgClosure* first_static) { StgClosure* p; StgClosure* link; @@ -2424,7 +2561,7 @@ zeroStaticObjectList(StgClosure* first_static) * mutable list. */ static void -zeroMutableList(StgMutClosure *first) +zero_mutable_list( StgMutClosure *first ) { StgMutClosure *next, *c; @@ -2449,35 +2586,27 @@ void RevertCAFs(void) caf->value = stgCast(StgClosure*,0xdeadbeef); caf->link = stgCast(StgCAF*,0xdeadbeef); } + enteredCAFs = END_CAF_LIST; } -void revertDeadCAFs(void) +void revert_dead_CAFs(void) { StgCAF* caf = enteredCAFs; enteredCAFs = END_CAF_LIST; while (caf != END_CAF_LIST) { - StgCAF* next = caf->link; - - switch(GET_INFO(caf)->type) { - case EVACUATED: - { - /* This object has been evacuated, it must be live. */ - StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee); - new->link = enteredCAFs; - enteredCAFs = new; - break; - } - case CAF_ENTERED: - { - SET_INFO(caf,&CAF_UNENTERED_info); - caf->value = stgCast(StgClosure*,0xdeadbeef); - caf->link = stgCast(StgCAF*,0xdeadbeef); - break; - } - default: - barf("revertDeadCAFs: enteredCAFs list corrupted"); - } - caf = next; + StgCAF *next, *new; + next = caf->link; + new = (StgCAF*)isAlive((StgClosure*)caf); + if (new) { + new->link = enteredCAFs; + enteredCAFs = new; + } else { + ASSERT(0); + SET_INFO(caf,&CAF_UNENTERED_info); + caf->value = (StgClosure*)0xdeadbeef; + caf->link = (StgCAF*)0xdeadbeef; + } + caf = next; } }