*
* 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"
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)
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);
}
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;
q = p;
switch (info->type) {
- case MVAR:
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
{
+ rtsBool saved_eager_promotion = eager_promotion;
+
StgMVar *mvar = ((StgMVar *)p);
- evac_gen = 0;
+ eager_promotion = rtsFalse;
mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
mvar->value = evacuate((StgClosure *)mvar->value);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable.
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ mvar->header.info = &stg_MVAR_DIRTY_info;
+ } else {
+ mvar->header.info = &stg_MVAR_CLEAN_info;
+ }
p += sizeofW(StgMVar);
break;
}
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;
}
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);
q = p;
switch (info->type) {
- case MVAR:
- {
- StgMVar *mvar = ((StgMVar *)p);
- evac_gen = 0;
- mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
- mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
- mvar->value = evacuate((StgClosure *)mvar->value);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable.
- break;
- }
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
+ {
+ rtsBool saved_eager_promotion = eager_promotion;
+
+ StgMVar *mvar = ((StgMVar *)p);
+ eager_promotion = rtsFalse;
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ mvar->header.info = &stg_MVAR_DIRTY_info;
+ } else {
+ mvar->header.info = &stg_MVAR_CLEAN_info;
+ }
+ break;
+ }
case FUN_2_0:
scavenge_fun_srt(info);
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;
}
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);
switch (info->type) {
- case MVAR:
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
{
+ rtsBool saved_eager_promotion = eager_promotion;
+
StgMVar *mvar = ((StgMVar *)p);
- evac_gen = 0;
+ eager_promotion = rtsFalse;
mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
mvar->value = evacuate((StgClosure *)mvar->value);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable.
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ mvar->header.info = &stg_MVAR_DIRTY_info;
+ } else {
+ mvar->header.info = &stg_MVAR_CLEAN_info;
+ }
break;
}
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);
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
mutlist_MUTARRS++; break;
+ case MVAR_CLEAN:
+ barf("MVAR_CLEAN on mutable list");
+ case MVAR_DIRTY:
+ mutlist_MVARS++; break;
default:
mutlist_OTHERS++; break;
}
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
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
- case RET_VEC_BIG:
{
nat size;
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;
}
projects / ghc-hetmet.git / blobdiff