X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=5d156ed64c761eda4e09139b3c2ef36bfd9d0a19;hb=4e79709df545c16812b85f2c27ab3411f5a7b54f;hp=83890cbabe6e98a5aaac7c0f4666b82cf813aa62;hpb=509b3987c361fef9715b646c8ac738ef8d2279cf;p=ghc-hetmet.git diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 83890cb..5d156ed 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team 1998-2006 + * (c) The GHC Team 1998-2008 * * Generational garbage collector: scavenging functions * @@ -16,6 +16,7 @@ #include "Storage.h" #include "MBlock.h" #include "GC.h" +#include "GCThread.h" #include "GCUtils.h" #include "Compact.h" #include "Evac.h" @@ -131,6 +132,17 @@ scavenge_fun_srt(const StgInfoTable *info) Scavenge a TSO. -------------------------------------------------------------------------- */ +STATIC_INLINE void +scavenge_TSO_link (StgTSO *tso) +{ + // We don't always chase the link field: TSOs on the blackhole + // queue are not automatically alive, so the link field is a + // "weak" pointer in that case. + if (tso->why_blocked != BlockedOnBlackHole) { + evacuate((StgClosure **)&tso->_link); + } +} + static void scavengeTSO (StgTSO *tso) { @@ -155,13 +167,6 @@ scavengeTSO (StgTSO *tso) } evacuate((StgClosure **)&tso->blocked_exceptions); - // We don't always chase the link field: TSOs on the blackhole - // queue are not automatically alive, so the link field is a - // "weak" pointer in that case. - if (tso->why_blocked != BlockedOnBlackHole) { - evacuate((StgClosure **)&tso->link); - } - // scavange current transaction record evacuate((StgClosure **)&tso->trec); @@ -170,8 +175,15 @@ scavengeTSO (StgTSO *tso) if (gct->failed_to_evac) { tso->flags |= TSO_DIRTY; + scavenge_TSO_link(tso); } else { tso->flags &= ~TSO_DIRTY; + scavenge_TSO_link(tso); + if (gct->failed_to_evac) { + tso->flags |= TSO_LINK_DIRTY; + } else { + tso->flags &= ~TSO_LINK_DIRTY; + } } gct->eager_promotion = saved_eager; @@ -516,7 +528,6 @@ linear_scan: case TSO: { scavengeTSO((StgTSO*)p); - gct->failed_to_evac = rtsTrue; // always on the mutable list break; } @@ -836,7 +847,6 @@ scavenge_one(StgPtr p) case TSO: { scavengeTSO((StgTSO*)p); - gct->failed_to_evac = rtsTrue; // always on the mutable list break; } @@ -1025,14 +1035,17 @@ scavenge_mutable_list(generation *gen) case TSO: { StgTSO *tso = (StgTSO *)p; if ((tso->flags & TSO_DIRTY) == 0) { - // A clean TSO: we don't have to traverse its - // stack. However, we *do* follow the link field: - // we don't want to have to mark a TSO dirty just - // because we put it on a different queue. - if (tso->why_blocked != BlockedOnBlackHole) { - evacuate((StgClosure **)&tso->link); - } - recordMutableGen_GC((StgClosure *)p,gen); + // Must be on the mutable list because its link + // field is dirty. + ASSERT(tso->flags & TSO_LINK_DIRTY); + + scavenge_TSO_link(tso); + if (gct->failed_to_evac) { + recordMutableGen_GC((StgClosure *)p,gen); + gct->failed_to_evac = rtsFalse; + } else { + tso->flags &= ~TSO_LINK_DIRTY; + } continue; } } @@ -1238,17 +1251,22 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // discarding it. { nat type; - type = get_itbl(((StgUpdateFrame *)p)->updatee)->type; - if (type == IND) { - ((StgUpdateFrame *)p)->updatee->header.info = - (StgInfoTable *)&stg_IND_PERM_info; - } else if (type == IND_OLDGEN) { - ((StgUpdateFrame *)p)->updatee->header.info = - (StgInfoTable *)&stg_IND_OLDGEN_PERM_info; - } - evacuate(&((StgUpdateFrame *)p)->updatee); - p += sizeofW(StgUpdateFrame); - continue; + const StgInfoTable *i; + + i = ((StgUpdateFrame *)p)->updatee->header.info; + if (!IS_FORWARDING_PTR(i)) { + type = get_itbl(((StgUpdateFrame *)p)->updatee)->type; + if (type == IND) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_PERM_info; + } else if (type == IND_OLDGEN) { + ((StgUpdateFrame *)p)->updatee->header.info = + (StgInfoTable *)&stg_IND_OLDGEN_PERM_info; + } + evacuate(&((StgUpdateFrame *)p)->updatee); + p += sizeofW(StgUpdateFrame); + continue; + } } // small bitmap (< 32 entries, or 64 on a 64-bit machine) @@ -1355,7 +1373,7 @@ scavenge_large (step_workspace *ws) bdescr *bd; StgPtr p; - gct->evac_step = ws->stp; + gct->evac_step = ws->step; bd = ws->todo_large_objects; @@ -1367,17 +1385,20 @@ scavenge_large (step_workspace *ws) // the front when evacuating. ws->todo_large_objects = bd->link; - ACQUIRE_SPIN_LOCK(&ws->stp->sync_large_objects); - dbl_link_onto(bd, &ws->stp->scavenged_large_objects); - ws->stp->n_scavenged_large_blocks += bd->blocks; - RELEASE_SPIN_LOCK(&ws->stp->sync_large_objects); + ACQUIRE_SPIN_LOCK(&ws->step->sync_large_objects); + dbl_link_onto(bd, &ws->step->scavenged_large_objects); + ws->step->n_scavenged_large_blocks += bd->blocks; + RELEASE_SPIN_LOCK(&ws->step->sync_large_objects); p = bd->start; if (scavenge_one(p)) { - if (ws->stp->gen_no > 0) { - recordMutableGen_GC((StgClosure *)p, ws->stp->gen); + if (ws->step->gen_no > 0) { + recordMutableGen_GC((StgClosure *)p, ws->step->gen); } } + + // stats + gct->scanned += closure_sizeW((StgClosure*)p); } } @@ -1385,11 +1406,14 @@ scavenge_large (step_workspace *ws) Scavenge a block ------------------------------------------------------------------------- */ -#define PARALLEL_GC -#include "Scav.c-inc" #undef PARALLEL_GC #include "Scav.c-inc" +#ifdef THREADED_RTS +#define PARALLEL_GC +#include "Scav.c-inc" +#endif + /* ---------------------------------------------------------------------------- Look for work to do. @@ -1417,7 +1441,7 @@ scavenge_find_work (void) rtsBool did_something, did_anything; bdescr *bd; - gct->scav_local_work++; + gct->scav_find_work++; did_anything = rtsFalse; @@ -1428,46 +1452,21 @@ loop: continue; } ws = &gct->steps[s]; - - if (ws->todo_bd != NULL) - { - ws->todo_bd->free = ws->todo_free; - } - - // If we have a todo block and no scan block, start - // scanning the todo block. - if (ws->scan_bd == NULL && ws->todo_bd != NULL) - { - ws->scan_bd = ws->todo_bd; - ws->scan = ws->scan_bd->start; - } + gct->scan_bd = NULL; + // If we have a scan block with some work to do, // scavenge everything up to the free pointer. - if (ws->scan != NULL && ws->scan < ws->scan_bd->free) + if (ws->todo_bd->u.scan < ws->todo_free) { if (n_gc_threads == 1) { - scavenge_block1(ws->scan_bd, ws->scan); + scavenge_block1(ws->todo_bd); } else { - scavenge_block(ws->scan_bd, ws->scan); + scavenge_block(ws->todo_bd); } - ws->scan = ws->scan_bd->free; did_something = rtsTrue; + break; } - - if (ws->scan_bd != NULL && ws->scan == ws->scan_bd->free - && ws->scan_bd != ws->todo_bd) - { - // we're not going to evac any more objects into - // this block, so push it now. - push_scan_block(ws->scan_bd, ws); - ws->scan_bd = NULL; - ws->scan = NULL; - // we might be able to scan the todo block now. - did_something = rtsTrue; - } - - if (did_something) break; // If we have any large objects to scavenge, do them now. if (ws->todo_large_objects) { @@ -1477,16 +1476,11 @@ loop: } if ((bd = grab_todo_block(ws)) != NULL) { - // no need to assign this to ws->scan_bd, we're going - // to scavenge the whole thing and then push it on - // our scavd list. This saves pushing out the - // scan_bd block, which might be partial. if (n_gc_threads == 1) { - scavenge_block1(bd, bd->start); + scavenge_block1(bd); } else { - scavenge_block(bd, bd->start); + scavenge_block(bd); } - push_scan_block(bd, ws); did_something = rtsTrue; break; } @@ -1561,7 +1555,7 @@ any_work (void) } ws = &gct->steps[s]; if (ws->todo_large_objects) return rtsTrue; - if (ws->stp->todos) return rtsTrue; + if (ws->step->todos) return rtsTrue; } gct->no_work++;