/* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.c,v 1.12 2004/09/03 15:28:38 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
{
if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
info->type = posTypeLargeSRT;
- info->next.large_srt.srt = (StgLargeSRT *)infoTable->f.srt;
+ info->next.large_srt.srt = (StgLargeSRT *)GET_FUN_SRT(infoTable);
info->next.large_srt.offset = 0;
} else {
info->type = posTypeSRT;
- info->next.srt.srt = (StgClosure **)(infoTable->f.srt);
+ info->next.srt.srt = (StgClosure **)GET_FUN_SRT(infoTable);
info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
}
}
{
if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
info->type = posTypeLargeSRT;
- info->next.large_srt.srt = (StgLargeSRT *)infoTable->srt;
+ info->next.large_srt.srt = (StgLargeSRT *)GET_SRT(infoTable);
info->next.large_srt.offset = 0;
} else {
info->type = posTypeSRT;
- info->next.srt.srt = (StgClosure **)(infoTable->srt);
+ info->next.srt.srt = (StgClosure **)GET_SRT(infoTable);
info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
}
}
return;
// one child (fixed), no SRT
- case MUT_VAR:
- case MUT_CONS:
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY:
*first_child = ((StgMutVar *)c)->var;
return;
- case BLACKHOLE_BQ:
- // blocking_queue must be TSO and the head of a linked list of TSOs.
- // Shoule it be a child? Seems to be yes.
- *first_child = (StgClosure *)((StgBlockingQueue *)c)->blocking_queue;
- return;
case THUNK_SELECTOR:
*first_child = ((StgSelector *)c)->selectee;
return;
case IND_PERM:
case IND_OLDGEN_PERM:
case IND_OLDGEN:
- *first_child = ((StgIndOldGen *)c)->indirectee;
+ *first_child = ((StgInd *)c)->indirectee;
return;
case CONSTR_1_0:
case CONSTR_1_1:
// layout.payload.ptrs, no SRT
case CONSTR:
- case FOREIGN:
case STABLE_NAME:
case BCO:
case CONSTR_STATIC:
break;
// StgMutArrPtr.ptrs, no SRT
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
init_ptrs(&se.info, ((StgMutArrPtrs *)c)->ptrs,
(StgPtr)(((StgMutArrPtrs *)c)->payload));
*first_child = find_ptrs(&se.info);
case THUNK:
case THUNK_2_0:
- init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload);
+ init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs,
+ (StgPtr)((StgThunk *)c)->payload);
*first_child = find_ptrs(&se.info);
if (*first_child == NULL)
// no child from ptrs, so check SRT
case THUNK_1_0:
case THUNK_1_1:
- *first_child = c->payload[0];
+ *first_child = ((StgThunk *)c)->payload[0];
ASSERT(*first_child != NULL);
init_srt_thunk(&se.info, get_thunk_itbl(c));
break;
if (*first_child == NULL)
return; // no child
break;
+
+ case TVAR_WAIT_QUEUE:
+ *first_child = (StgClosure *)((StgTVarWaitQueue *)c)->waiting_tso;
+ se.info.next.step = 2; // 2 = second
+ break;
+ case TVAR:
+ *first_child = (StgClosure *)((StgTVar *)c)->current_value;
+ break;
+ case TREC_HEADER:
+ *first_child = (StgClosure *)((StgTRecHeader *)c)->enclosing_trec;
+ break;
+ case TREC_CHUNK:
+ *first_child = (StgClosure *)((StgTRecChunk *)c)->prev_chunk;
+ se.info.next.step = 0; // entry no.
+ break;
// cannot appear
case PAP:
*r = se->c_child_r;
return;
+ case TVAR_WAIT_QUEUE:
+ if (se->info.next.step == 2) {
+ *c = (StgClosure *)((StgTVarWaitQueue *)se->c)->next_queue_entry;
+ se->info.next.step++; // move to the next step
+ // no popOff
+ } else {
+ *c = (StgClosure *)((StgTVarWaitQueue *)se->c)->prev_queue_entry;
+ popOff();
+ }
+ *cp = se->c;
+ *r = se->c_child_r;
+ return;
+
+ case TVAR:
+ *c = (StgClosure *)((StgTVar *)se->c)->first_wait_queue_entry;
+ *cp = se->c;
+ *r = se->c_child_r;
+ popOff();
+ return;
+
+ case TREC_HEADER:
+ *c = (StgClosure *)((StgTRecHeader *)se->c)->current_chunk;
+ *cp = se->c;
+ *r = se->c_child_r;
+ popOff();
+ return;
+
+ case TREC_CHUNK: {
+ // These are pretty complicated: we have N entries, each
+ // of which contains 3 fields that we want to follow. So
+ // we divide the step counter: the 2 low bits indicate
+ // which field, and the rest of the bits indicate the
+ // entry number (starting from zero).
+ nat entry_no = se->info.next.step >> 2;
+ nat field_no = se->info.next.step & 3;
+ if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) {
+ *c = NULL;
+ popOff();
+ return;
+ }
+ TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no];
+ if (field_no == 0) {
+ *c = (StgClosure *)entry->tvar;
+ } else if (field_no == 1) {
+ *c = entry->expected_value;
+ } else {
+ *c = entry->new_value;
+ }
+ *cp = se->c;
+ *r = se->c_child_r;
+ se->info.next.step++;
+ return;
+ }
+
case CONSTR:
- case FOREIGN:
case STABLE_NAME:
case BCO:
case CONSTR_STATIC:
// StgMutArrPtr.ptrs, no SRT
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
*c = find_ptrs(&se->info);
if (*c == NULL) {
popOff();
case SE_CAF_BLACKHOLE:
case ARR_WORDS:
// one child (fixed), no SRT
- case MUT_VAR:
- case MUT_CONS:
- case BLACKHOLE_BQ:
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY:
case THUNK_SELECTOR:
case IND_PERM:
case IND_OLDGEN_PERM:
// mutable objects
case MVAR:
- case MUT_VAR:
- case MUT_CONS:
- case MUT_ARR_PTRS:
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
// thunks are retainers.
case THUNK:
// WEAK objects are roots; there is separate code in which traversing
// begins from WEAK objects.
case WEAK:
+
+ // Since the other mutvar-type things are retainers, seems
+ // like the right thing to do:
+ case TVAR:
return rtsTrue;
//
case BLACKHOLE:
case SE_BLACKHOLE:
case SE_CAF_BLACKHOLE:
- case BLACKHOLE_BQ:
// indirection
case IND_PERM:
case IND_OLDGEN_PERM:
case CONSTR_STATIC:
case FUN_STATIC:
// misc
- case FOREIGN:
case STABLE_NAME:
case BCO:
case ARR_WORDS:
+ // STM
+ case TVAR_WAIT_QUEUE:
+ case TREC_HEADER:
+ case TREC_CHUNK:
return rtsFalse;
//
case STOP_FRAME:
case CATCH_FRAME:
+ case CATCH_STM_FRAME:
+ case CATCH_RETRY_FRAME:
+ case ATOMICALLY_FRAME:
case RET_SMALL:
case RET_VEC_SMALL:
bitmap = BITMAP_BITS(info->i.layout.bitmap);
p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
follow_srt:
- retainSRT((StgClosure **)info->srt, info->i.srt_bitmap, c, c_child_r);
+ retainSRT((StgClosure **)GET_SRT(info), info->i.srt_bitmap, c, c_child_r);
continue;
case RET_BCO: {
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
case RET_VEC_BIG:
- size = info->i.layout.large_bitmap->size;
+ size = GET_LARGE_BITMAP(&info->i)->size;
p++;
- retain_large_bitmap(p, info->i.layout.large_bitmap,
+ retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
size, c, c_child_r);
p += size;
// and don't forget to follow the SRT
p = (P_)&ret_fun->payload;
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);
p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
break;
case ARG_GEN_BIG:
- size = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
- retain_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap,
+ size = GET_FUN_LARGE_BITMAP(fun_info)->size;
+ retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
size, c, c_child_r);
p += size;
break;
* ------------------------------------------------------------------------- */
static INLINE StgPtr
-retain_PAP (StgPAP *pap, retainer c_child_r)
+retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun,
+ StgClosure** payload, StgWord n_args)
{
StgPtr p;
- StgWord bitmap, size;
+ StgWord bitmap;
StgFunInfoTable *fun_info;
- retainClosure(pap->fun, (StgClosure *)pap, c_child_r);
- fun_info = get_fun_itbl(pap->fun);
+ retainClosure(fun, pap, c_child_r);
+ fun_info = get_fun_itbl(fun);
ASSERT(fun_info->i.type != PAP);
- p = (StgPtr)pap->payload;
- size = pap->n_args;
+ p = (StgPtr)payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
- bitmap = BITMAP_BITS(fun_info->f.bitmap);
- p = retain_small_bitmap(p, pap->n_args, bitmap,
- (StgClosure *)pap, c_child_r);
+ bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+ p = retain_small_bitmap(p, n_args, bitmap,
+ pap, c_child_r);
break;
case ARG_GEN_BIG:
- retain_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap,
- size, (StgClosure *)pap, c_child_r);
- p += size;
+ retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
+ n_args, pap, c_child_r);
+ p += n_args;
break;
case ARG_BCO:
- retain_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun),
- size, (StgClosure *)pap, c_child_r);
- p += size;
+ retain_large_bitmap((StgPtr)payload, BCO_BITMAP(fun),
+ n_args, pap, c_child_r);
+ p += n_args;
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
- p = retain_small_bitmap(p, pap->n_args, bitmap,
- (StgClosure *)pap, c_child_r);
+ p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r);
break;
}
return p;
goto loop;
case PAP:
+ {
+ StgPAP *pap = (StgPAP *)c;
+ retain_PAP_payload(c, c_child_r, pap->fun, pap->payload, pap->n_args);
+ goto loop;
+ }
+
case AP:
- retain_PAP((StgPAP *)c, c_child_r);
+ {
+ StgAP *ap = (StgAP *)c;
+ retain_PAP_payload(c, c_child_r, ap->fun, ap->payload, ap->n_args);
goto loop;
+ }
case AP_STACK:
retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r);
ASSERT(isEmptyRetainerStack());
currentStackBoundary = stackTop;
- if (isRetainer(*tl)) {
+ if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) {
retainClosure(*tl, *tl, getRetainerFrom(*tl));
} else {
retainClosure(*tl, *tl, CCS_SYSTEM);
StgWeak *weak;
RetainerSet *rtl;
nat g;
- StgMutClosure *ml;
+ StgPtr ml;
+ bdescr *bd;
#ifdef DEBUG_RETAINER
RetainerSet tmpRetainerSet;
#endif
// object (computing sumOfNewCostExtra and updating costArray[] when
// debugging retainer profiler).
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- ASSERT(g != 0 ||
- (generations[g].mut_list == END_MUT_LIST &&
- generations[g].mut_once_list == END_MUT_LIST));
-
- // Todo:
- // I think traversing through mut_list is unnecessary.
- // Think about removing this part.
- for (ml = generations[g].mut_list; ml != END_MUT_LIST;
- ml = ml->mut_link) {
-
- maybeInitRetainerSet((StgClosure *)ml);
- rtl = retainerSetOf((StgClosure *)ml);
+ // NOT TRUE: even G0 has a block on its mutable list
+ // ASSERT(g != 0 || (generations[g].mut_list == NULL));
-#ifdef DEBUG_RETAINER
- if (rtl == NULL) {
- // first visit to *ml
- // This is a violation of the interface rule!
- RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
- switch (get_itbl((StgClosure *)ml)->type) {
- case IND_STATIC:
- // no cost involved
- break;
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- case CONSTR_STATIC:
- case THUNK_STATIC:
- case FUN_STATIC:
- barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
- break;
- default:
- // dynamic objects
- costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
- sumOfNewCostExtra += cost((StgClosure *)ml);
- break;
- }
- }
-#endif
- }
-
- // Traversing through mut_once_list is, in contrast, necessary
+ // Traversing through mut_list is necessary
// because we can find MUT_VAR objects which have not been
// visited during retainer profiling.
- for (ml = generations[g].mut_once_list; ml != END_MUT_LIST;
- ml = ml->mut_link) {
+ for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+ for (ml = bd->start; ml < bd->free; ml++) {
+
+ maybeInitRetainerSet((StgClosure *)*ml);
+ rtl = retainerSetOf((StgClosure *)*ml);
- maybeInitRetainerSet((StgClosure *)ml);
- rtl = retainerSetOf((StgClosure *)ml);
#ifdef DEBUG_RETAINER
- if (rtl == NULL) {
- // first visit to *ml
- // This is a violation of the interface rule!
- RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
- switch (get_itbl((StgClosure *)ml)->type) {
- case IND_STATIC:
- // no cost involved
- break;
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- case CONSTR_STATIC:
- case THUNK_STATIC:
- case FUN_STATIC:
- barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
- break;
- default:
- // dynamic objects
- costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
- sumOfNewCostExtra += cost((StgClosure *)ml);
- break;
+ if (rtl == NULL) {
+ // first visit to *ml
+ // This is a violation of the interface rule!
+ RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
+
+ switch (get_itbl((StgClosure *)ml)->type) {
+ case IND_STATIC:
+ // no cost involved
+ break;
+ case CONSTR_INTLIKE:
+ case CONSTR_CHARLIKE:
+ case CONSTR_NOCAF_STATIC:
+ case CONSTR_STATIC:
+ case THUNK_STATIC:
+ case FUN_STATIC:
+ barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
+ break;
+ default:
+ // dynamic objects
+ costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
+ sumOfNewCostExtra += cost((StgClosure *)ml);
+ break;
+ }
}
- }
#endif
+ }
}
}
}
// Since we do not compute the retainer set of any
// IND_STATIC object, we don't have to reset its retainer
// field.
- p = IND_STATIC_LINK(p);
+ p = (StgClosure*)*IND_STATIC_LINK(p);
break;
case THUNK_STATIC:
maybeInitRetainerSet(p);
- p = THUNK_STATIC_LINK(p);
+ p = (StgClosure*)*THUNK_STATIC_LINK(p);
break;
case FUN_STATIC:
maybeInitRetainerSet(p);
- p = FUN_STATIC_LINK(p);
+ p = (StgClosure*)*FUN_STATIC_LINK(p);
break;
case CONSTR_STATIC:
maybeInitRetainerSet(p);
- p = STATIC_LINK(get_itbl(p), p);
+ p = (StgClosure*)*STATIC_LINK(get_itbl(p), p);
break;
default:
barf("resetStaticObjectForRetainerProfiling: %p (%s)",
#ifdef DEBUG_RETAINER
#define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
- ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1))) && \
+ ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \
((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
static nat
// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
}
- info = get_itbl(c);
- switch (info->type) {
- case TSO:
- return tso_sizeW((StgTSO *)c);
-
- case THUNK:
- case THUNK_1_0:
- case THUNK_0_1:
- case THUNK_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
-
- case MVAR:
- return sizeofW(StgMVar);
-
- case MUT_ARR_PTRS:
- case MUT_ARR_PTRS_FROZEN:
- return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
-
- case AP:
- case PAP:
- return pap_sizeW((StgPAP *)c);
-
- case AP:
- return ap_stack_sizeW((StgAP_STACK *)c);
-
- case ARR_WORDS:
- return arr_words_sizeW((StgArrWords *)c);
-
- case CONSTR:
- case CONSTR_1_0:
- case CONSTR_0_1:
- case CONSTR_2_0:
- case CONSTR_1_1:
- case CONSTR_0_2:
- case FUN:
- case FUN_1_0:
- case FUN_0_1:
- case FUN_2_0:
- case FUN_1_1:
- case FUN_0_2:
- case WEAK:
- case MUT_VAR:
- case MUT_CONS:
- case CAF_BLACKHOLE:
- case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- case BLACKHOLE_BQ:
- case IND_PERM:
- case IND_OLDGEN:
- case IND_OLDGEN_PERM:
- case FOREIGN:
- case BCO:
- case STABLE_NAME:
- return sizeW_fromITBL(info);
-
- case THUNK_SELECTOR:
- return sizeofW(StgHeader) + MIN_UPD_SIZE;
-
- /*
- Error case
- */
- case IND_STATIC:
- case CONSTR_STATIC:
- case FUN_STATIC:
- case THUNK_STATIC:
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- case UPDATE_FRAME:
- case CATCH_FRAME:
- case STOP_FRAME:
- case RET_DYN:
- case RET_BCO:
- case RET_SMALL:
- case RET_VEC_SMALL:
- case RET_BIG:
- case RET_VEC_BIG:
- case IND:
- case BLOCKED_FETCH:
- case FETCH_ME:
- case FETCH_ME_BQ:
- case RBH:
- case REMOTE_REF:
- case EVACUATED:
- case INVALID_OBJECT:
- default:
- barf("Invalid object in sanityCheckHeapClosure(): %d",
- get_itbl(c)->type);
- return 0;
- }
+ return closure_sizeW(c);
}
static nat
}
}
}
-#endif // DEBUG_RETAINER
+#endif /* DEBUG_RETAINER */
#endif /* PROFILING */
projects / ghc-hetmet.git / blobdiff