X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRetainerProfile.c;h=e80a588e86f1ffd6107e4c02342d901d89fb933a;hb=d108044bef62f6a0d579c92ced5e8188f72edc2d;hp=036eacf08b3e7fd7caca6516479299d3f65541ca;hpb=45202530612593a0ba7a6c559a38dc1ff26670a4;p=ghc-hetmet.git diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 036eacf..e80a588 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -16,19 +16,21 @@ #define INLINE inline #endif +#include "PosixSource.h" #include "Rts.h" + #include "RtsUtils.h" #include "RetainerProfile.h" #include "RetainerSet.h" #include "Schedule.h" #include "Printer.h" -#include "RtsFlags.h" #include "Weak.h" -#include "Sanity.h" +#include "sm/Sanity.h" #include "Profiling.h" #include "Stats.h" #include "ProfHeap.h" #include "Apply.h" +#include "sm/Storage.h" // for END_OF_STATIC_LIST /* Note: what to change in order to plug-in a new retainer profiling scheme? @@ -364,7 +366,7 @@ find_srt( stackPos *info ) 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 @@ -451,10 +453,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // no child, no SRT case CONSTR_0_1: case CONSTR_0_2: - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: case ARR_WORDS: *first_child = NULL; return; @@ -468,8 +466,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) *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: @@ -491,7 +488,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // three children (fixed), no SRT // need to push a stackElement - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: // head must be TSO and the head of a linked list of TSOs. // Shoule it be a child? Seems to be yes. *first_child = (StgClosure *)((StgMVar *)c)->head; @@ -508,7 +506,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // layout.payload.ptrs, no SRT case CONSTR: - case STABLE_NAME: + case PRIM: + case MUT_PRIM: case BCO: case CONSTR_STATIC: init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, @@ -588,16 +587,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) return; // no child break; - case TVAR_WATCH_QUEUE: - *first_child = (StgClosure *)((StgTVarWatchQueue *)c)->closure; - 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. @@ -620,12 +609,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case RET_BIG: // invalid objects 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 *c in push()"); @@ -804,7 +787,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // three children (fixed), no SRT // need to push a stackElement - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: if (se->info.next.step == 2) { *c = (StgClosure *)((StgMVar *)se->c)->tail; se->info.next.step++; // move to the next step @@ -831,33 +815,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) *r = se->c_child_r; return; - case TVAR_WATCH_QUEUE: - if (se->info.next.step == 2) { - *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->next_queue_entry; - se->info.next.step++; // move to the next step - // no popOff - } else { - *c = (StgClosure *)((StgTVarWatchQueue *)se->c)->prev_queue_entry; - popOff(); - } - *cp = se->c; - *r = se->c_child_r; - return; - - case TVAR: - *c = (StgClosure *)((StgTVar *)se->c)->first_watch_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 @@ -887,7 +844,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) } case CONSTR: - case STABLE_NAME: + case PRIM: + case MUT_PRIM: case BCO: case CONSTR_STATIC: // StgMutArrPtr.ptrs, no SRT @@ -955,18 +913,12 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // no child (fixed), no SRT case CONSTR_0_1: case CONSTR_0_2: - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_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: @@ -985,12 +937,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case RET_BIG: // invalid objects 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 *c in pop()"); @@ -1057,7 +1003,9 @@ isRetainer( StgClosure *c ) case TSO: // mutable objects - case MVAR: + case MUT_PRIM: + case MVAR_CLEAN: + case MVAR_DIRTY: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case MUT_ARR_PTRS_CLEAN: @@ -1082,10 +1030,6 @@ isRetainer( StgClosure *c ) // 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; // @@ -1108,33 +1052,27 @@ isRetainer( StgClosure *c ) case FUN_0_2: // partial applications case PAP: - // blackholes - case CAF_BLACKHOLE: - case BLACKHOLE: - case SE_BLACKHOLE: - case SE_CAF_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: // misc - case STABLE_NAME: + case PRIM: case BCO: case ARR_WORDS: // STM - case TVAR_WATCH_QUEUE: - case TREC_HEADER: case TREC_CHUNK: return rtsFalse; // // 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: @@ -1149,12 +1087,6 @@ isRetainer( StgClosure *c ) case RET_BIG: // other cases 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 isRetainer(): %d", get_itbl(c)->type); @@ -1297,9 +1229,9 @@ retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r) while (bitmap != 0) { if ((bitmap & 1) != 0) { -#ifdef ENABLE_WIN32_DLL_SUPPORT +#if defined(__PIC__) && defined(mingw32_HOST_OS) if ( (unsigned long)(*srt) & 0x1 ) { - retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), + retainClosure(* (StgClosure**) ((unsigned long) (*srt) & ~0x1), c, c_child_r); } else { retainClosure(*srt,c,c_child_r); @@ -1632,7 +1564,7 @@ inner_loop: #ifdef DEBUG_RETAINER debugBelch("ThreadRelocated encountered in retainClosure()\n"); #endif - c = (StgClosure *)((StgTSO *)c)->link; + c = (StgClosure *)((StgTSO *)c)->_link; goto inner_loop; } break; @@ -1797,7 +1729,7 @@ inner_loop: * Compute the retainer set for every object reachable from *tl. * -------------------------------------------------------------------------- */ static void -retainRoot( StgClosure **tl ) +retainRoot(void *user STG_UNUSED, StgClosure **tl) { StgClosure *c; @@ -1834,7 +1766,7 @@ computeRetainerSet( void ) RetainerSet tmpRetainerSet; #endif - GetRoots(retainRoot); // for scheduler roots + markCapabilities(retainRoot, NULL); // for scheduler roots // This function is called after a major GC, when key, value, and finalizer // all are guaranteed to be valid, or reachable. @@ -1843,10 +1775,10 @@ computeRetainerSet( void ) // for retainer profilng. for (weak = weak_ptr_list; weak != NULL; weak = weak->link) // retainRoot((StgClosure *)weak); - retainRoot((StgClosure **)&weak); + retainRoot(NULL, (StgClosure **)&weak); // Consider roots from the stable ptr table. - markStablePtrTable(retainRoot); + markStablePtrTable(retainRoot, NULL); // The following code resets the rs field of each unvisited mutable // object (computing sumOfNewCostExtra and updating costArray[] when @@ -1910,7 +1842,7 @@ computeRetainerSet( void ) * they are not taken into consideration in computing retainer sets. * -------------------------------------------------------------------------- */ void -resetStaticObjectForRetainerProfiling( void ) +resetStaticObjectForRetainerProfiling( StgClosure *static_objects ) { #ifdef DEBUG_RETAINER nat count; @@ -1920,7 +1852,7 @@ resetStaticObjectForRetainerProfiling( void ) #ifdef DEBUG_RETAINER count = 0; #endif - p = scavenged_static_objects; + p = static_objects; while (p != END_OF_STATIC_LIST) { #ifdef DEBUG_RETAINER count++; @@ -2167,7 +2099,7 @@ smallObjectPoolCheck(void) StgPtr p; static nat costSum, size; - bd = small_alloc_list; + bd = g0s0->blocks; costSum = 0; // first block