X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=64cfacdb4afa2da1fc3ba2ac05ea8b8426b99400;hb=1621421619df6f19dce3b8cb29471e5d3c731acb;hp=883058234e181881c39554078a6fc094406a7f24;hpb=a186d6f72aa221772ffeccb99c6c538c4505b0d7;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 8830582..64cfacd 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -11,6 +11,7 @@ #include "RtsFlags.h" #include "RtsUtils.h" #include "Apply.h" +#include "OSThreads.h" #include "Storage.h" #include "LdvProfile.h" #include "Updates.h" @@ -434,7 +435,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) bitmap_size = stp->n_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE); if (bitmap_size > 0) { - bitmap_bdescr = allocGroup((nat)BLOCK_ROUND_UP(bitmap_size) + bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) / BLOCK_SIZE); stp->bitmap = bitmap_bdescr; bitmap = bitmap_bdescr->start; @@ -1415,8 +1416,6 @@ mark_root(StgClosure **root) STATIC_INLINE void upd_evacuee(StgClosure *p, StgClosure *dest) { - // Source object must be in from-space: - ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0); // not true: (ToDo: perhaps it should be) // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED); SET_INFO(p, &stg_EVACUATED_info); @@ -1626,7 +1625,9 @@ evacuate_large(StgPtr p) REGPARM1 static StgClosure * evacuate(StgClosure *q) { +#if defined(PAR) StgClosure *to; +#endif bdescr *bd = NULL; step *stp; const StgInfoTable *info; @@ -1677,6 +1678,9 @@ loop: return q; } + /* Object is not already evacuated. */ + ASSERT((bd->flags & BF_EVACUATED) == 0); + stp = bd->step->to; } #ifdef DEBUG @@ -1754,10 +1758,6 @@ loop: case BLACKHOLE: return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp); - case BLACKHOLE_BQ: - to = copy(q,BLACKHOLE_sizeW(),stp); - return to; - case THUNK_SELECTOR: { StgClosure *p; @@ -1918,7 +1918,7 @@ loop: } #if defined(PAR) - case RBH: // cf. BLACKHOLE_BQ + case RBH: { //StgInfoTable *rip = get_closure_info(q, &size, &ptrs, &nonptrs, &vhs, str); to = copy(q,BLACKHOLE_sizeW(),stp); @@ -2166,7 +2166,6 @@ selector_loop: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: case BLACKHOLE: - case BLACKHOLE_BQ: #if defined(PAR) case RBH: case BLOCKED_FETCH: @@ -2351,8 +2350,8 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) p = (StgPtr)args; switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->f.bitmap); - size = BITMAP_SIZE(fun_info->f.bitmap); + bitmap = BITMAP_BITS(fun_info->f.b.bitmap); + size = BITMAP_SIZE(fun_info->f.b.bitmap); goto small_bitmap; case ARG_GEN_BIG: size = GET_FUN_LARGE_BITMAP(fun_info)->size; @@ -2392,7 +2391,7 @@ scavenge_PAP (StgPAP *pap) switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->f.bitmap); + bitmap = BITMAP_BITS(fun_info->f.b.bitmap); goto small_bitmap; case ARG_GEN_BIG: scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); @@ -2613,16 +2612,6 @@ scavenge(step *stp) p += BLACKHOLE_sizeW(); break; - case BLACKHOLE_BQ: - { - StgBlockingQueue *bh = (StgBlockingQueue *)p; - bh->blocking_queue = - (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); - failed_to_evac = rtsTrue; - p += BLACKHOLE_sizeW(); - break; - } - case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; @@ -2696,7 +2685,7 @@ scavenge(step *stp) } #if defined(PAR) - case RBH: // cf. BLACKHOLE_BQ + case RBH: { #if 0 nat size, ptrs, nonptrs, vhs; @@ -2739,7 +2728,7 @@ scavenge(step *stp) p += sizeofW(StgFetchMe); break; // nothing to do in this case - case FETCH_ME_BQ: // cf. BLACKHOLE_BQ + case FETCH_ME_BQ: { StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = @@ -2968,15 +2957,6 @@ linear_scan: case ARR_WORDS: break; - case BLACKHOLE_BQ: - { - StgBlockingQueue *bh = (StgBlockingQueue *)p; - bh->blocking_queue = - (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); - failed_to_evac = rtsTrue; - break; - } - case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; @@ -3038,7 +3018,7 @@ linear_scan: } #if defined(PAR) - case RBH: // cf. BLACKHOLE_BQ + case RBH: { #if 0 nat size, ptrs, nonptrs, vhs; @@ -3077,7 +3057,7 @@ linear_scan: case FETCH_ME: break; // nothing to do in this case - case FETCH_ME_BQ: // cf. BLACKHOLE_BQ + case FETCH_ME_BQ: { StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = @@ -3087,7 +3067,7 @@ linear_scan: p, info_type((StgClosure *)p))); break; } -#endif // PAR +#endif /* PAR */ case TVAR_WAIT_QUEUE: { @@ -3270,16 +3250,6 @@ scavenge_one(StgPtr p) case BLACKHOLE: break; - case BLACKHOLE_BQ: - { - StgBlockingQueue *bh = (StgBlockingQueue *)p; - evac_gen = 0; // repeatedly mutable - bh->blocking_queue = - (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); - failed_to_evac = rtsTrue; - break; - } - case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; @@ -3346,7 +3316,7 @@ scavenge_one(StgPtr p) } #if defined(PAR) - case RBH: // cf. BLACKHOLE_BQ + case RBH: { #if 0 nat size, ptrs, nonptrs, vhs; @@ -3386,7 +3356,7 @@ scavenge_one(StgPtr p) case FETCH_ME: break; // nothing to do in this case - case FETCH_ME_BQ: // cf. BLACKHOLE_BQ + case FETCH_ME_BQ: { StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = @@ -3452,11 +3422,21 @@ scavenge_one(StgPtr p) case IND_OLDGEN: case IND_OLDGEN_PERM: case IND_STATIC: - /* Try to pull the indirectee into this generation, so we can - * remove the indirection from the mutable list. - */ - ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee); - + { + /* Careful here: a THUNK can be on the mutable list because + * it contains pointers to young gen objects. If such a thunk + * is updated, the IND_OLDGEN will be added to the mutable + * list again, and we'll scavenge it twice. evacuate() + * doesn't check whether the object has already been + * evacuated, so we perform that check here. + */ + StgClosure *q = ((StgInd *)p)->indirectee; + if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) { + break; + } + ((StgInd *)p)->indirectee = evacuate(q); + } + #if 0 && defined(DEBUG) if (RtsFlags.DebugFlags.gc) /* Debugging code to print out the size of the thing we just @@ -3838,14 +3818,14 @@ revertCAFs( void ) { StgIndStatic *c; - for (c = (StgIndStatic *)caf_list; c != NULL; + for (c = (StgIndStatic *)revertible_caf_list; c != NULL; c = (StgIndStatic *)c->static_link) { SET_INFO(c, c->saved_info); c->saved_info = NULL; // could, but not necessary: c->static_link = NULL; } - caf_list = NULL; + revertible_caf_list = NULL; } void @@ -3858,6 +3838,11 @@ markCAFs( evac_fn evac ) { evac(&c->indirectee); } + for (c = (StgIndStatic *)revertible_caf_list; c != NULL; + c = (StgIndStatic *)c->static_link) + { + evac(&c->indirectee); + } } /* ----------------------------------------------------------------------------- @@ -3925,7 +3910,7 @@ threadLazyBlackHole(StgTSO *tso) { StgClosure *frame; StgRetInfoTable *info; - StgBlockingQueue *bh; + StgClosure *bh; StgPtr stack_end; stack_end = &tso->stack[tso->stack_size]; @@ -3938,7 +3923,7 @@ threadLazyBlackHole(StgTSO *tso) switch (info->i.type) { case UPDATE_FRAME: - bh = (StgBlockingQueue *)((StgUpdateFrame *)frame)->updatee; + bh = ((StgUpdateFrame *)frame)->updatee; /* if the thunk is already blackholed, it means we've also * already blackholed the rest of the thunks on this stack, @@ -3951,8 +3936,7 @@ threadLazyBlackHole(StgTSO *tso) return; } - if (bh->header.info != &stg_BLACKHOLE_BQ_info && - bh->header.info != &stg_CAF_BLACKHOLE_info) { + if (bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif @@ -4056,7 +4040,6 @@ threadSqueezeStack(StgTSO *tso) * screw us up if we don't check. */ if (upd->updatee != updatee && !closure_IND(upd->updatee)) { - // this wakes the threads up UPD_IND_NOLOCK(upd->updatee, updatee); } @@ -4074,11 +4057,10 @@ threadSqueezeStack(StgTSO *tso) // single update frame, or the topmost update frame in a series else { - StgBlockingQueue *bh = (StgBlockingQueue *)upd->updatee; + StgClosure *bh = upd->updatee; // Do lazy black-holing if (bh->header.info != &stg_BLACKHOLE_info && - bh->header.info != &stg_BLACKHOLE_BQ_info && bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); @@ -4239,4 +4221,4 @@ maybeLarge(StgClosure *closure) } -#endif // DEBUG +#endif /* DEBUG */