X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=8217f26f334f04bc620584936129fbe3844feae2;hb=da69fa9c5047c5b0d05bdb05eaddefa1eb5d5a36;hp=b28d898a10121c6ffbce5225789d8473d851ccc5;hpb=7daea7b0e1a01b41ba00c7c29d3c262ea8e94b8c;p=ghc-hetmet.git diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index b28d898..8217f26 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: RetainerProfile.c,v 1.10 2003/05/16 14:39:29 simonmar Exp $ * * (c) The GHC Team, 2001 * Author: Sungwoo Park @@ -17,8 +16,6 @@ #define INLINE inline #endif -#include - #include "Rts.h" #include "RtsUtils.h" #include "RetainerProfile.h" @@ -26,11 +23,9 @@ #include "Schedule.h" #include "Printer.h" #include "Storage.h" -#include "StoragePriv.h" #include "RtsFlags.h" #include "Weak.h" #include "Sanity.h" -#include "StablePriv.h" #include "Profiling.h" #include "Stats.h" #include "BlockAlloc.h" @@ -334,11 +329,11 @@ init_srt_fun( stackPos *info, StgFunInfoTable *infoTable ) { 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_FUN_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_FUN_SRT(infoTable); info->next.srt.srt_bitmap = infoTable->i.srt_bitmap; } } @@ -348,11 +343,11 @@ init_srt_thunk( stackPos *info, StgThunkInfoTable *infoTable ) { 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; } } @@ -441,7 +436,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) bdescr *nbd; // Next Block Descriptor #ifdef DEBUG_RETAINER - // fprintf(stderr, "push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); + // debugBelch("push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); #endif ASSERT(get_itbl(c)->type != TSO); @@ -469,21 +464,15 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // one child (fixed), no SRT case MUT_VAR: - case MUT_CONS: *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: @@ -521,7 +510,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // layout.payload.ptrs, no SRT case CONSTR: - case FOREIGN: case STABLE_NAME: case BCO: case CONSTR_STATIC: @@ -533,8 +521,10 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) 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); @@ -554,7 +544,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) 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 @@ -571,7 +562,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) 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; @@ -634,7 +625,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) if (stackTop - 1 < stackBottom) { #ifdef DEBUG_RETAINER - // fprintf(stderr, "push() to the next stack.\n"); + // debugBelch("push() to the next stack.\n"); #endif // currentStack->free is updated when the active stack is switched // to the next stack. @@ -663,7 +654,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) stackSize++; if (stackSize > maxStackSize) maxStackSize = stackSize; // ASSERT(stackSize >= 0); - // fprintf(stderr, "stackSize = %d\n", stackSize); + // debugBelch("stackSize = %d\n", stackSize); #endif } @@ -686,7 +677,7 @@ popOffReal(void) bdescr *pbd; // Previous Block Descriptor #ifdef DEBUG_RETAINER - // fprintf(stderr, "pop() to the previous stack.\n"); + // debugBelch("pop() to the previous stack.\n"); #endif ASSERT(stackTop + 1 == stackLimit); @@ -701,7 +692,7 @@ popOffReal(void) if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif return; @@ -722,7 +713,7 @@ popOffReal(void) if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif } @@ -730,7 +721,7 @@ popOffReal(void) static INLINE void popOff(void) { #ifdef DEBUG_RETAINER - // fprintf(stderr, "\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); + // debugBelch("\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); #endif ASSERT(stackTop != stackLimit); @@ -744,7 +735,7 @@ popOff(void) { if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif return; @@ -775,7 +766,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) stackElement *se; #ifdef DEBUG_RETAINER - // fprintf(stderr, "pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); + // debugBelch("pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); #endif do { @@ -826,13 +817,14 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) 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(); @@ -900,8 +892,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case ARR_WORDS: // one child (fixed), no SRT case MUT_VAR: - case MUT_CONS: - case BLACKHOLE_BQ: case THUNK_SELECTOR: case IND_PERM: case IND_OLDGEN_PERM: @@ -1002,9 +992,10 @@ isRetainer( StgClosure *c ) // mutable objects case MVAR: case MUT_VAR: - case MUT_CONS: - case MUT_ARR_PTRS: + 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: @@ -1050,7 +1041,6 @@ isRetainer( StgClosure *c ) case BLACKHOLE: case SE_BLACKHOLE: case SE_CAF_BLACKHOLE: - case BLACKHOLE_BQ: // indirection case IND_PERM: case IND_OLDGEN_PERM: @@ -1059,7 +1049,6 @@ isRetainer( StgClosure *c ) case CONSTR_STATIC: case FUN_STATIC: // misc - case FOREIGN: case STABLE_NAME: case BCO: case ARR_WORDS: @@ -1295,7 +1284,7 @@ retainStack( StgClosure *c, retainer c_child_r, currentStackBoundary = stackTop; #ifdef DEBUG_RETAINER - // fprintf(stderr, "retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary); + // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary); #endif ASSERT(get_itbl(c)->type != TSO || @@ -1324,7 +1313,7 @@ retainStack( StgClosure *c, retainer c_child_r, 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: { @@ -1343,9 +1332,9 @@ retainStack( StgClosure *c, retainer c_child_r, // 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 @@ -1357,16 +1346,16 @@ retainStack( StgClosure *c, retainer c_child_r, dyn = ((StgRetDyn *)p)->liveness; // traverse the bitmap first - bitmap = GET_LIVENESS(dyn); + bitmap = RET_DYN_LIVENESS(dyn); p = (P_)&((StgRetDyn *)p)->payload[0]; size = RET_DYN_BITMAP_SIZE; p = retain_small_bitmap(p, size, bitmap, c, c_child_r); // skip over the non-ptr words - p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; + p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; // follow the ptr words - for (size = GET_PTRS(dyn); size > 0; size--) { + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { retainClosure((StgClosure *)*p, c, c_child_r); p++; } @@ -1381,21 +1370,21 @@ retainStack( StgClosure *c, retainer c_child_r, fun_info = get_fun_itbl(ret_fun->fun); p = (P_)&ret_fun->payload; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->bitmap); - size = BITMAP_SIZE(fun_info->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->bitmap)->size; - retain_large_bitmap(p, (StgLargeBitmap *)fun_info->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; default: - bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]); - size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); p = retain_small_bitmap(p, size, bitmap, c, c_child_r); break; } @@ -1411,7 +1400,7 @@ retainStack( StgClosure *c, retainer c_child_r, // restore currentStackBoundary currentStackBoundary = oldStackBoundary; #ifdef DEBUG_RETAINER - // fprintf(stderr, "retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary); + // debugBelch("retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary); #endif #ifdef DEBUG_RETAINER @@ -1424,39 +1413,38 @@ retainStack( StgClosure *c, retainer c_child_r, * ------------------------------------------------------------------------- */ 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->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: - bitmap = BITMAP_BITS(fun_info->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->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->fun_type]); - p = retain_small_bitmap(p, pap->n_args, bitmap, - (StgClosure *)pap, c_child_r); + bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r); break; } return p; @@ -1497,7 +1485,7 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) #ifdef DEBUG_RETAINER // oldStackTop = stackTop; - // fprintf(stderr, "retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0); + // debugBelch("retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0); #endif // (c, cp, r) = (c0, cp0, r0) @@ -1507,18 +1495,18 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) goto inner_loop; loop: - //fprintf(stderr, "loop"); + //debugBelch("loop"); // pop to (c, cp, r); pop(&c, &cp, &r); if (c == NULL) { #ifdef DEBUG_RETAINER - // fprintf(stderr, "retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop); + // debugBelch("retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop); #endif return; } - //fprintf(stderr, "inner_loop"); + //debugBelch("inner_loop"); inner_loop: // c = current closure under consideration, @@ -1560,13 +1548,13 @@ inner_loop: if (((StgTSO *)c)->what_next == ThreadComplete || ((StgTSO *)c)->what_next == ThreadKilled) { #ifdef DEBUG_RETAINER - fprintf(stderr, "ThreadComplete or ThreadKilled encountered in retainClosure()\n"); + debugBelch("ThreadComplete or ThreadKilled encountered in retainClosure()\n"); #endif goto loop; } if (((StgTSO *)c)->what_next == ThreadRelocated) { #ifdef DEBUG_RETAINER - fprintf(stderr, "ThreadRelocated encountered in retainClosure()\n"); + debugBelch("ThreadRelocated encountered in retainClosure()\n"); #endif c = (StgClosure *)((StgTSO *)c)->link; goto inner_loop; @@ -1694,9 +1682,18 @@ inner_loop: 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); @@ -1754,7 +1751,8 @@ computeRetainerSet( void ) StgWeak *weak; RetainerSet *rtl; nat g; - StgMutClosure *ml; + StgPtr ml; + bdescr *bd; #ifdef DEBUG_RETAINER RetainerSet tmpRetainerSet; #endif @@ -1777,81 +1775,44 @@ computeRetainerSet( void ) // 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)); + ASSERT(g != 0 || (generations[g].mut_list == NULL)); - // 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); - -#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 + } } } } @@ -1893,19 +1854,19 @@ resetStaticObjectForRetainerProfiling( void ) // 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)", @@ -1914,7 +1875,7 @@ resetStaticObjectForRetainerProfiling( void ) } } #ifdef DEBUG_RETAINER - // fprintf(stderr, "count in scavenged_static_objects = %d\n", count); + // debugBelch("count in scavenged_static_objects = %d\n", count); #endif } @@ -1936,25 +1897,25 @@ retainerProfile(void) #endif #ifdef DEBUG_RETAINER - fprintf(stderr, " < retainerProfile() invoked : %d>\n", retainerGeneration); + debugBelch(" < retainerProfile() invoked : %d>\n", retainerGeneration); #endif stat_startRP(); // We haven't flipped the bit yet. #ifdef DEBUG_RETAINER - fprintf(stderr, "Before traversing:\n"); + debugBelch("Before traversing:\n"); sumOfCostLinear = 0; for (i = 0;i < N_CLOSURE_TYPES; i++) costArrayLinear[i] = 0; totalHeapSize = checkHeapSanityForRetainerProfiling(); - fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize); + debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize); /* - fprintf(stderr, "costArrayLinear[] = "); + debugBelch("costArrayLinear[] = "); for (i = 0;i < N_CLOSURE_TYPES; i++) - fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]); - fprintf(stderr, "\n"); + debugBelch("[%u:%u] ", i, costArrayLinear[i]); + debugBelch("\n"); */ ASSERT(sumOfCostLinear == totalHeapSize); @@ -1962,7 +1923,7 @@ retainerProfile(void) /* #define pcostArrayLinear(index) \ if (costArrayLinear[index] > 0) \ - fprintf(stderr, "costArrayLinear[" #index "] = %u\n", costArrayLinear[index]) + debugBelch("costArrayLinear[" #index "] = %u\n", costArrayLinear[index]) pcostArrayLinear(THUNK_STATIC); pcostArrayLinear(FUN_STATIC); pcostArrayLinear(CONSTR_STATIC); @@ -1985,7 +1946,7 @@ retainerProfile(void) timesAnyObjectVisited = 0; #ifdef DEBUG_RETAINER - fprintf(stderr, "During traversing:\n"); + debugBelch("During traversing:\n"); sumOfNewCost = 0; sumOfNewCostExtra = 0; for (i = 0;i < N_CLOSURE_TYPES; i++) @@ -2007,13 +1968,13 @@ retainerProfile(void) computeRetainerSet(); #ifdef DEBUG_RETAINER - fprintf(stderr, "After traversing:\n"); + debugBelch("After traversing:\n"); sumOfCostLinear = 0; for (i = 0;i < N_CLOSURE_TYPES; i++) costArrayLinear[i] = 0; totalHeapSize = checkHeapSanityForRetainerProfiling(); - fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize); + debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize); ASSERT(sumOfCostLinear == totalHeapSize); // now, compare the two results @@ -2024,22 +1985,22 @@ retainerProfile(void) 1) Dead weak pointers, whose type is CONSTR. These objects are not reachable from any roots. */ - fprintf(stderr, "Comparison:\n"); - fprintf(stderr, "\tcostArrayLinear[] (must be empty) = "); + debugBelch("Comparison:\n"); + debugBelch("\tcostArrayLinear[] (must be empty) = "); for (i = 0;i < N_CLOSURE_TYPES; i++) if (costArray[i] != costArrayLinear[i]) // nothing should be printed except MUT_VAR after major GCs - fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]); - fprintf(stderr, "\n"); + debugBelch("[%u:%u] ", i, costArrayLinear[i]); + debugBelch("\n"); - fprintf(stderr, "\tsumOfNewCost = %u\n", sumOfNewCost); - fprintf(stderr, "\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra); - fprintf(stderr, "\tcostArray[] (must be empty) = "); + debugBelch("\tsumOfNewCost = %u\n", sumOfNewCost); + debugBelch("\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra); + debugBelch("\tcostArray[] (must be empty) = "); for (i = 0;i < N_CLOSURE_TYPES; i++) if (costArray[i] != costArrayLinear[i]) // nothing should be printed except MUT_VAR after major GCs - fprintf(stderr, "[%u:%u] ", i, costArray[i]); - fprintf(stderr, "\n"); + debugBelch("[%u:%u] ", i, costArray[i]); + debugBelch("\n"); // only for major garbage collection ASSERT(sumOfNewCost + sumOfNewCostExtra == sumOfCostLinear); @@ -2069,7 +2030,7 @@ retainerProfile(void) #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 @@ -2085,17 +2046,17 @@ sanityCheckHeapClosure( StgClosure *c ) if (get_itbl(c)->type == CONSTR && !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") && !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) { - fprintf(stderr, "\tUnvisited dead weak pointer object found: c = %p\n", c); + debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c); costArray[get_itbl(c)->type] += cost(c); sumOfNewCost += cost(c); } else - fprintf(stderr, + debugBelch( "Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n", flip, c, get_itbl(c)->type, get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc, RSET(c)); } else { - // fprintf(stderr, "sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c)); + // debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c)); } info = get_itbl(c); @@ -2114,8 +2075,10 @@ sanityCheckHeapClosure( StgClosure *c ) case MVAR: return sizeofW(StgMVar); - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c); case AP: @@ -2142,16 +2105,13 @@ sanityCheckHeapClosure( StgClosure *c ) 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); @@ -2284,12 +2244,12 @@ checkHeapSanityForRetainerProfiling( void ) nat costSum, g, s; costSum = 0; - fprintf(stderr, "START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); if (RtsFlags.GcFlags.generations == 1) { costSum += heapCheck(g0s0->to_blocks); - fprintf(stderr, "heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); costSum += chainCheck(g0s0->large_objects); - fprintf(stderr, "chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); } else { for (g = 0; g < RtsFlags.GcFlags.generations; g++) for (s = 0; s < generations[g].n_steps; s++) { @@ -2302,14 +2262,14 @@ checkHeapSanityForRetainerProfiling( void ) */ if (g == 0 && s == 0) { costSum += smallObjectPoolCheck(); - fprintf(stderr, "smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); costSum += chainCheck(generations[g].steps[s].large_objects); - fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); } else { costSum += heapCheck(generations[g].steps[s].blocks); - fprintf(stderr, "heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); costSum += chainCheck(generations[g].steps[s].large_objects); - fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); + debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum); } } } @@ -2333,7 +2293,7 @@ findPointer(StgPtr p) if (*q == (StgWord)p) { r = q; while (!LOOKS_LIKE_GHC_INFO(*r)) r--; - fprintf(stderr, "Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r); + debugBelch("Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r); // return; } } @@ -2345,7 +2305,7 @@ findPointer(StgPtr p) if (*q == (StgWord)p) { r = q; while (*r == 0 || !LOOKS_LIKE_GHC_INFO(*r)) r--; - fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, r); + debugBelch("Found in gen[%d], large_objects: %p\n", g, r); // return; } } @@ -2366,20 +2326,20 @@ belongToHeap(StgPtr p) bd = generations[g].steps[s].blocks; for (; bd; bd = bd->link) { if (bd->start <= p && p < bd->free) { - fprintf(stderr, "Belongs to gen[%d], step[%d]", g, s); + debugBelch("Belongs to gen[%d], step[%d]", g, s); return; } } bd = generations[g].steps[s].large_objects; for (; bd; bd = bd->link) { if (bd->start <= p && p < bd->start + getHeapClosureSize((StgClosure *)bd->start)) { - fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, bd->start); + debugBelch("Found in gen[%d], large_objects: %p\n", g, bd->start); return; } } } } } -#endif // DEBUG_RETAINER +#endif /* DEBUG_RETAINER */ #endif /* PROFILING */