bitmap = info->next.srt.srt_bitmap;
while (bitmap != 0) {
if ((bitmap & 1) != 0) {
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
else
// no child, no SRT
case CONSTR_0_1:
case CONSTR_0_2:
- case CAF_BLACKHOLE:
- case BLACKHOLE:
case ARR_WORDS:
*first_child = NULL;
return;
*first_child = ((StgSelector *)c)->selectee;
return;
case IND_PERM:
- case IND_OLDGEN_PERM:
- case IND_OLDGEN:
+ case BLACKHOLE:
*first_child = ((StgInd *)c)->indirectee;
return;
case CONSTR_1_0:
case AP:
case AP_STACK:
case TSO:
+ case STACK:
case IND_STATIC:
case CONSTR_NOCAF_STATIC:
// stack objects
case UPDATE_FRAME:
case CATCH_FRAME:
+ case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_DYN:
case RET_BCO:
// no child (fixed), no SRT
case CONSTR_0_1:
case CONSTR_0_2:
- case CAF_BLACKHOLE:
- case BLACKHOLE:
case ARR_WORDS:
// one child (fixed), no SRT
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case THUNK_SELECTOR:
case IND_PERM:
- case IND_OLDGEN_PERM:
- case IND_OLDGEN:
case CONSTR_1_1:
// cannot appear
case PAP:
case AP:
case AP_STACK:
case TSO:
- case IND_STATIC:
+ case STACK:
+ case IND_STATIC:
case CONSTR_NOCAF_STATIC:
// stack objects
case RET_DYN:
case UPDATE_FRAME:
case CATCH_FRAME:
- case STOP_FRAME:
+ case UNDERFLOW_FRAME:
+ case STOP_FRAME:
case RET_BCO:
case RET_SMALL:
case RET_BIG:
//
// TSOs MUST be retainers: they constitute the set of roots.
case TSO:
+ case STACK:
// mutable objects
case MUT_PRIM:
case FUN_0_2:
// partial applications
case PAP:
- // blackholes
- case CAF_BLACKHOLE:
- case BLACKHOLE:
// indirection
case IND_PERM:
- case IND_OLDGEN_PERM:
- case IND_OLDGEN:
+ // IND_STATIC used to be an error, but at the moment it can happen
+ // as isAlive doesn't look through IND_STATIC as it ignores static
+ // closures. See trac #3956 for a program that hit this error.
+ case IND_STATIC:
+ case BLACKHOLE:
// static objects
case CONSTR_STATIC:
case FUN_STATIC:
//
// Error case
//
- // IND_STATIC cannot be *c, *cp, *r in the retainer profiling loop.
- case IND_STATIC:
// CONSTR_NOCAF_STATIC
// cannot be *c, *cp, *r in the retainer profiling loop.
case CONSTR_NOCAF_STATIC:
// legal objects during retainer profiling.
case UPDATE_FRAME:
case CATCH_FRAME:
+ case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_DYN:
case RET_BCO:
while (bitmap != 0) {
if ((bitmap & 1) != 0) {
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
if ( (unsigned long)(*srt) & 0x1 ) {
retainClosure(* (StgClosure**) ((unsigned long) (*srt) & ~0x1),
c, c_child_r);
* RSET(c) and RSET(c_child_r) are valid, i.e., their
* interpretation conforms to the current value of flip (even when they
* are interpreted to be NULL).
- * If *c is TSO, its state is not any of ThreadRelocated, ThreadComplete,
- * or ThreadKilled, which means that its stack is ready to process.
+ * If *c is TSO, its state is not ThreadComplete,or ThreadKilled,
+ * which means that its stack is ready to process.
* Note:
* This code was almost plagiarzied from GC.c! For each pointer,
* retainClosure() is invoked instead of evacuate().
stackElement *oldStackBoundary;
StgPtr p;
StgRetInfoTable *info;
- StgWord32 bitmap;
+ StgWord bitmap;
nat size;
#ifdef DEBUG_RETAINER
// debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
#endif
- ASSERT(get_itbl(c)->type != TSO ||
- (((StgTSO *)c)->what_next != ThreadRelocated &&
- ((StgTSO *)c)->what_next != ThreadComplete &&
- ((StgTSO *)c)->what_next != ThreadKilled));
-
+ ASSERT(get_itbl(c)->type == STACK);
+
p = stackStart;
while (p < stackEnd) {
info = get_ret_itbl((StgClosure *)p);
p += sizeofW(StgUpdateFrame);
continue;
- case STOP_FRAME:
+ case UNDERFLOW_FRAME:
+ case STOP_FRAME:
case CATCH_FRAME:
case CATCH_STM_FRAME:
case CATCH_RETRY_FRAME:
#endif
goto loop;
}
- if (((StgTSO *)c)->what_next == ThreadRelocated) {
-#ifdef DEBUG_RETAINER
- debugBelch("ThreadRelocated encountered in retainClosure()\n");
-#endif
- c = (StgClosure *)((StgTSO *)c)->_link;
- goto inner_loop;
- }
- break;
+ break;
case IND_STATIC:
// We just skip IND_STATIC, so its retainer set is never computed.
// than attempting to save the current position, because doing so
// would be hard.
switch (typeOfc) {
- case TSO:
+ case STACK:
retainStack(c, c_child_r,
- ((StgTSO *)c)->sp,
- ((StgTSO *)c)->stack + ((StgTSO *)c)->stack_size);
+ ((StgStack *)c)->sp,
+ ((StgStack *)c)->stack + ((StgStack *)c)->stack_size);
goto loop;
+ case TSO:
+ {
+ StgTSO *tso = (StgTSO *)c;
+
+ retainClosure(tso->stackobj, c, c_child_r);
+ retainClosure(tso->blocked_exceptions, c, c_child_r);
+ retainClosure(tso->bq, c, c_child_r);
+ retainClosure(tso->trec, c, c_child_r);
+ if ( tso->why_blocked == BlockedOnMVar
+ || tso->why_blocked == BlockedOnBlackHole
+ || tso->why_blocked == BlockedOnMsgThrowTo
+ ) {
+ retainClosure(tso->block_info.closure, c, c_child_r);
+ }
+ goto loop;
+ }
+
case PAP:
{
StgPAP *pap = (StgPAP *)c;
{
StgWeak *weak;
RetainerSet *rtl;
- nat g;
+ nat g, n;
StgPtr ml;
bdescr *bd;
#ifdef DEBUG_RETAINER
// Traversing through mut_list is necessary
// because we can find MUT_VAR objects which have not been
// visited during retainer profiling.
- for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+ for (n = 0; n < n_capabilities; n++) {
+ for (bd = capabilities[n].mut_lists[g]; bd != NULL; bd = bd->link) {
for (ml = bd->start; ml < bd->free; ml++) {
maybeInitRetainerSet((StgClosure *)*ml);
}
#endif
}
- }
+ }
+ }
}
}
projects / ghc-hetmet.git / blobdiff