X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=adb36cc21538f1e833e5004467ac58d67c06ee75;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=210f15cfa69ab38a728ec5e662ce311a10d528e6;hpb=70b3bd34ceead69761c7ec26e76feb2037c0bac5;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 210f15c..adb36cc 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.165 2004/05/07 21:19:21 panne Exp $ + * $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $ * * (c) The GHC Team 1998-2003 * @@ -13,7 +13,8 @@ #include "RtsUtils.h" #include "Apply.h" #include "Storage.h" -#include "StoragePriv.h" +#include "LdvProfile.h" +#include "Updates.h" #include "Stats.h" #include "Schedule.h" #include "SchedAPI.h" // for ReverCAFs prototype @@ -23,7 +24,6 @@ #include "ProfHeap.h" #include "SchedAPI.h" #include "Weak.h" -#include "StablePriv.h" #include "Prelude.h" #include "ParTicky.h" // ToDo: move into Rts.h #include "GCCompact.h" @@ -44,7 +44,6 @@ #endif #include "RetainerProfile.h" -#include "LdvProfile.h" #include @@ -447,11 +446,18 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // don't forget to fill it with zeros! memset(bitmap, 0, bitmap_size); - // for each block in this step, point to its bitmap from the + // For each block in this step, point to its bitmap from the // block descriptor. for (bd=stp->blocks; bd != NULL; bd = bd->link) { bd->u.bitmap = bitmap; bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE); + + // Also at this point we set the BF_COMPACTED flag + // for this block. The invariant is that + // BF_COMPACTED is always unset, except during GC + // when it is set on those blocks which will be + // compacted. + bd->flags |= BF_COMPACTED; } } } @@ -578,17 +584,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) */ markStablePtrTable(mark_root); -#ifdef INTERPRETER - { - /* ToDo: To fix the caf leak, we need to make the commented out - * parts of this code do something sensible - as described in - * the CAF document. - */ - extern void markHugsObjects(void); - markHugsObjects(); - } -#endif - /* ------------------------------------------------------------------------- * Repeatedly scavenge all the areas we know about until there's no * more scavenging to be done. @@ -753,8 +748,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // for a compacted step, just shift the new to-space // onto the front of the now-compacted existing blocks. for (bd = stp->to_blocks; bd != NULL; bd = bd->link) { - bd->flags &= ~BF_EVACUATED; // now from-space - bd->flags |= BF_COMPACTED; // compacted next time + bd->flags &= ~BF_EVACUATED; // now from-space } // tack the new blocks on the end of the existing blocks if (stp->blocks == NULL) { @@ -765,6 +759,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) if (next == NULL) { bd->link = stp->to_blocks; } + // NB. this step might not be compacted next + // time, so reset the BF_COMPACTED flags. + // They are set before GC if we're going to + // compact. (search for BF_COMPACTED above). + bd->flags &= ~BF_COMPACTED; } } // add the new blocks to the block tally @@ -774,7 +773,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) stp->blocks = stp->to_blocks; stp->n_blocks = stp->n_to_blocks; for (bd = stp->blocks; bd != NULL; bd = bd->link) { - bd->flags &= ~BF_EVACUATED; // now from-space + bd->flags &= ~BF_EVACUATED; // now from-space } } stp->to_blocks = NULL; @@ -1424,7 +1423,7 @@ upd_evacuee(StgClosure *p, StgClosure *dest) ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0); // not true: (ToDo: perhaps it should be) // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED); - p->header.info = &stg_EVACUATED_info; + SET_INFO(p, &stg_EVACUATED_info); ((StgEvacuated *)p)->evacuee = dest; } @@ -2014,13 +2013,28 @@ loop: thunk is unchanged. -------------------------------------------------------------------------- */ +static inline rtsBool +is_to_space ( StgClosure *p ) +{ + bdescr *bd; + + bd = Bdescr((StgPtr)p); + if (HEAP_ALLOCED(p) && + ((bd->flags & BF_EVACUATED) + || ((bd->flags & BF_COMPACTED) && + is_marked((P_)p,bd)))) { + return rtsTrue; + } else { + return rtsFalse; + } +} + static StgClosure * eval_thunk_selector( nat field, StgSelector * p ) { StgInfoTable *info; const StgInfoTable *info_ptr; StgClosure *selectee; - bdescr *bd; selectee = p->selectee; @@ -2067,12 +2081,10 @@ selector_loop: // point to to-space objects, because that happens when // scavenging. // - bd = Bdescr((StgPtr)selectee); - if (HEAP_ALLOCED(selectee) && - ((bd->flags & BF_EVACUATED) - || ((bd->flags & BF_COMPACTED) && - bd->gen_no <= N && - is_marked((P_)selectee,bd)))) { + // The to-space test is now embodied in the in_to_space() inline + // function, as it is re-used below. + // + if (is_to_space(selectee)) { goto bale_out; } @@ -2090,9 +2102,21 @@ selector_loop: ASSERT(field < (StgWord32)(info->layout.payload.ptrs + info->layout.payload.nptrs)); - // ToDo: shouldn't we test whether this pointer is in - // to-space? - return selectee->payload[field]; + // Select the right field from the constructor, and check + // that the result isn't in to-space. It might be in + // to-space if, for example, this constructor contains + // pointers to younger-gen objects (and is on the mut-once + // list). + // + { + StgClosure *q; + q = selectee->payload[field]; + if (is_to_space(q)) { + goto bale_out; + } else { + return q; + } + } case IND: case IND_PERM: @@ -2136,15 +2160,15 @@ selector_loop: // For the purposes of LDV profiling, we have destroyed // the original selector thunk. SET_INFO(p, info_ptr); - LDV_recordDead_FILL_SLOP_DYNAMIC(selectee); + LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(selectee); #endif ((StgInd *)selectee)->indirectee = val; SET_INFO(selectee,&stg_IND_info); -#ifdef PROFILING + // For the purposes of LDV profiling, we have created an // indirection. - LDV_recordCreate(selectee); -#endif + LDV_RECORD_CREATE(selectee); + selectee = val; goto selector_loop; } @@ -2290,7 +2314,7 @@ scavenge_fun_srt(const StgInfoTable *info) StgFunInfoTable *fun_info; fun_info = itbl_to_fun_itbl(info); - scavenge_srt((StgClosure **)fun_info->srt, fun_info->i.srt_bitmap); + scavenge_srt((StgClosure **)fun_info->f.srt, fun_info->i.srt_bitmap); } STATIC_INLINE void @@ -2343,19 +2367,19 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) nat size; p = (StgPtr)args; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->bitmap); - size = BITMAP_SIZE(fun_info->bitmap); + bitmap = BITMAP_BITS(fun_info->f.bitmap); + size = BITMAP_SIZE(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - size = ((StgLargeBitmap *)fun_info->bitmap)->size; - scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size); + size = ((StgLargeBitmap *)fun_info->f.bitmap)->size; + scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size); p += size; break; default: - bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]); - size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); small_bitmap: while (size > 0) { if ((bitmap & 1) == 0) { @@ -2384,12 +2408,12 @@ scavenge_PAP (StgPAP *pap) p = (StgPtr)pap->payload; size = pap->n_args; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->bitmap); + bitmap = BITMAP_BITS(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size); + scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size); p += size; break; case ARG_BCO: @@ -2397,7 +2421,7 @@ scavenge_PAP (StgPAP *pap) p += size; break; default: - bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); small_bitmap: size = pap->n_args; while (size > 0) { @@ -2583,14 +2607,12 @@ scavenge(step *stp) LDV_recordDead((StgClosure *)p, sizeofW(StgInd)); #endif // - // Todo: maybe use SET_HDR() and remove LDV_recordCreate()? + // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()? // 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 + LDV_RECORD_CREATE((StgClosure *)p); } // fall through case IND_OLDGEN_PERM: @@ -3793,16 +3815,16 @@ scavenge_stack(StgPtr p, StgPtr stack_end) dyn = ((StgRetDyn *)p)->liveness; // traverse the bitmap first - bitmap = GET_LIVENESS(dyn); + bitmap = RET_DYN_LIVENESS(dyn); p = (P_)&((StgRetDyn *)p)->payload[0]; size = RET_DYN_BITMAP_SIZE; p = scavenge_small_bitmap(p, size, bitmap); // skip over the non-ptr words - p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; + p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; // follow the ptr words - for (size = GET_PTRS(dyn); size > 0; size--) { + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { (StgClosure *)*p = evacuate((StgClosure *)*p); p++; } @@ -3913,7 +3935,7 @@ revertCAFs( void ) for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) { - c->header.info = c->saved_info; + SET_INFO(c, c->saved_info); c->saved_info = NULL; // could, but not necessary: c->static_link = NULL; } @@ -4034,11 +4056,9 @@ threadLazyBlackHole(StgTSO *tso) 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 + LDV_RECORD_CREATE(bh); } frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); @@ -4181,12 +4201,11 @@ threadSqueezeStack(StgTSO *tso) // We pretend that bh is now dead. LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh); #endif - // Todo: maybe use SET_HDR() and remove LDV_recordCreate()? + // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()? SET_INFO(bh,&stg_BLACKHOLE_info); -#ifdef PROFILING + // We pretend that bh has just been created. - LDV_recordCreate(bh); -#endif + LDV_RECORD_CREATE(bh); } prev_was_update_frame = rtsTrue;