X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=00faff1d84cf88d36e1c752bcae89d6892eaa678;hb=0981e24e9980b8b26e6f20fc56bebc1c7416cc4f;hp=26b33f479e5eaa3595fa87ae7b5c1cfcbc2e3926;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3;p=ghc-hetmet.git diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 26b33f4..00faff1 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -4,6 +4,11 @@ * * Generational garbage collector: scavenging functions * + * Documentation on the architecture of the Garbage Collector can be + * found in the online commentary: + * + * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC + * * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -72,7 +77,7 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap) while (bitmap != 0) { if ((bitmap & 1) != 0) { -#ifdef ENABLE_WIN32_DLL_SUPPORT +#if defined(__PIC__) && defined(mingw32_TARGET_OS) // 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) @@ -128,10 +133,6 @@ scavengeTSO (StgTSO *tso) if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnBlackHole || tso->why_blocked == BlockedOnException -#if defined(PAR) - || tso->why_blocked == BlockedOnGA - || tso->why_blocked == BlockedOnGA_NoSend -#endif ) { tso->block_info.closure = evacuate(tso->block_info.closure); } @@ -199,7 +200,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) StgWord bitmap; StgFunInfoTable *fun_info; - fun_info = get_fun_itbl(fun); + fun_info = get_fun_itbl(UNTAG_CLOSURE(fun)); ASSERT(fun_info->i.type != PAP); p = (StgPtr)payload; @@ -410,7 +411,6 @@ scavenge(step *stp) bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); - bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); p += bco_sizeW(bco); break; } @@ -563,60 +563,6 @@ scavenge(step *stp) break; } -#if defined(PAR) - case RBH: - { -#if 0 - nat size, ptrs, nonptrs, vhs; - char str[80]; - StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); -#endif - StgRBH *rbh = (StgRBH *)p; - (StgClosure *)rbh->blocking_queue = - evacuate((StgClosure *)rbh->blocking_queue); - failed_to_evac = rtsTrue; // mutable anyhow. - debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue); - // ToDo: use size of reverted closure here! - p += BLACKHOLE_sizeW(); - break; - } - - case BLOCKED_FETCH: - { - StgBlockedFetch *bf = (StgBlockedFetch *)p; - // follow the pointer to the node which is being demanded - (StgClosure *)bf->node = - evacuate((StgClosure *)bf->node); - // follow the link to the rest of the blocking queue - (StgClosure *)bf->link = - evacuate((StgClosure *)bf->link); - debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); - p += sizeofW(StgBlockedFetch); - break; - } - -#ifdef DIST - case REMOTE_REF: -#endif - case FETCH_ME: - p += sizeofW(StgFetchMe); - break; // nothing to do in this case - - case FETCH_ME_BQ: - { - StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; - (StgClosure *)fmbq->blocking_queue = - evacuate((StgClosure *)fmbq->blocking_queue); - debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); - p += sizeofW(StgFetchMeBlockingQueue); - break; - } -#endif - case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); @@ -845,7 +791,6 @@ linear_scan: bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); - bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); break; } @@ -978,55 +923,6 @@ linear_scan: break; } -#if defined(PAR) - case RBH: - { -#if 0 - nat size, ptrs, nonptrs, vhs; - char str[80]; - StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); -#endif - StgRBH *rbh = (StgRBH *)p; - bh->blocking_queue = - (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); - failed_to_evac = rtsTrue; // mutable anyhow. - debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue)); - break; - } - - case BLOCKED_FETCH: - { - StgBlockedFetch *bf = (StgBlockedFetch *)p; - // follow the pointer to the node which is being demanded - (StgClosure *)bf->node = - evacuate((StgClosure *)bf->node); - // follow the link to the rest of the blocking queue - (StgClosure *)bf->link = - evacuate((StgClosure *)bf->link); - debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); - break; - } - -#ifdef DIST - case REMOTE_REF: -#endif - case FETCH_ME: - break; // nothing to do in this case - - case FETCH_ME_BQ: - { - StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; - (StgClosure *)fmbq->blocking_queue = - evacuate((StgClosure *)fmbq->blocking_queue); - debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); - break; - } -#endif /* PAR */ - case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); @@ -1351,57 +1247,6 @@ scavenge_one(StgPtr p) break; } -#if defined(PAR) - case RBH: - { -#if 0 - nat size, ptrs, nonptrs, vhs; - char str[80]; - StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); -#endif - StgRBH *rbh = (StgRBH *)p; - (StgClosure *)rbh->blocking_queue = - evacuate((StgClosure *)rbh->blocking_queue); - failed_to_evac = rtsTrue; // mutable anyhow. - debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue)); - // ToDo: use size of reverted closure here! - break; - } - - case BLOCKED_FETCH: - { - StgBlockedFetch *bf = (StgBlockedFetch *)p; - // follow the pointer to the node which is being demanded - (StgClosure *)bf->node = - evacuate((StgClosure *)bf->node); - // follow the link to the rest of the blocking queue - (StgClosure *)bf->link = - evacuate((StgClosure *)bf->link); - debugTrace(DEBUG_gc, - "scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); - break; - } - -#ifdef DIST - case REMOTE_REF: -#endif - case FETCH_ME: - break; // nothing to do in this case - - case FETCH_ME_BQ: - { - StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; - (StgClosure *)fmbq->blocking_queue = - evacuate((StgClosure *)fmbq->blocking_queue); - debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); - break; - } -#endif - case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); @@ -1804,7 +1649,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end) case STOP_FRAME: case CATCH_FRAME: case RET_SMALL: - case RET_VEC_SMALL: bitmap = BITMAP_BITS(info->i.layout.bitmap); size = BITMAP_SIZE(info->i.layout.bitmap); // NOTE: the payload starts immediately after the info-ptr, we @@ -1833,7 +1677,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // large bitmap (> 32 entries, or > 64 on a 64-bit machine) case RET_BIG: - case RET_VEC_BIG: { nat size; @@ -1877,7 +1720,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) StgFunInfoTable *fun_info; ret_fun->fun = evacuate(ret_fun->fun); - fun_info = get_fun_itbl(ret_fun->fun); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); p = scavenge_arg_block(fun_info, ret_fun->payload); goto follow_srt; }