X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=1ff0027f8af7a611dcc65b743c83848b3d7cb0c2;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=6f3b09a9ae9f48e2ed0eee2cf7f4534ed1459030;hpb=c2883dfe3256e106345f2a93019b46cdce9a6bbf;p=ghc-hetmet.git diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index 6f3b09a..1ff0027 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RetainerProfile.c,v 1.4 2001/12/19 15:20:27 simonmar Exp $ + * $Id: RetainerProfile.c,v 1.11 2004/08/13 13:10:28 simonmar Exp $ * * (c) The GHC Team, 2001 * Author: Sungwoo Park @@ -10,6 +10,15 @@ #ifdef PROFILING +// Turn off inlining when debugging - it obfuscates things +#ifdef DEBUG +#define INLINE +#else +#define INLINE inline +#endif + +#include + #include "Rts.h" #include "RtsUtils.h" #include "RetainerProfile.h" @@ -17,17 +26,14 @@ #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" -#include "Itimer.h" -#include "Proftimer.h" #include "ProfHeap.h" +#include "Apply.h" /* Note: what to change in order to plug-in a new retainer profiling scheme? @@ -61,7 +67,7 @@ StgWord flip = 0; // flip bit #define setRetainerSetToNull(c) \ (c)->header.prof.hp.rs = (RetainerSet *)((StgWord)NULL | flip) -static void retainStack(StgClosure *, retainer, StgClosure *, StgPtr, StgPtr); +static void retainStack(StgClosure *, retainer, StgPtr, StgPtr); static void retainClosure(StgClosure *, StgClosure *, retainer); #ifdef DEBUG_RETAINER static void belongToHeap(StgPtr p); @@ -103,6 +109,7 @@ typedef enum { posTypeStep, posTypePtrs, posTypeSRT, + posTypeLargeSRT, } nextPosType; typedef union { @@ -125,8 +132,15 @@ typedef union { // SRT struct { StgClosure **srt; - StgClosure **srt_end; + StgWord srt_bitmap; } srt; + + // Large SRT + struct { + StgLargeSRT *srt; + StgWord offset; + } large_srt; + } nextPos; typedef struct { @@ -157,7 +171,7 @@ typedef struct { the topmost element on the previous block group so as to satisfy the invariants described above. */ -bdescr *firstStack = NULL; +static bdescr *firstStack = NULL; static bdescr *currentStack; static stackElement *stackBottom, *stackTop, *stackLimit; @@ -193,7 +207,7 @@ static int stackSize, maxStackSize; * Invariants: * currentStack->link == s. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void newStackBlock( bdescr *bd ) { currentStack = bd; @@ -208,7 +222,7 @@ newStackBlock( bdescr *bd ) * Invariants: * s->link == currentStack. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void returnToOldStack( bdescr *bd ) { currentStack = bd; @@ -250,17 +264,34 @@ closeTraverseStack( void ) /* ----------------------------------------------------------------------------- * Returns rtsTrue if the whole stack is empty. * -------------------------------------------------------------------------- */ -static inline rtsBool +static INLINE rtsBool isEmptyRetainerStack( void ) { return (firstStack == currentStack) && stackTop == stackLimit; } /* ----------------------------------------------------------------------------- + * Returns size of stack + * -------------------------------------------------------------------------- */ +#ifdef DEBUG +lnat +retainerStackBlocks( void ) +{ + bdescr* bd; + lnat res = 0; + + for (bd = firstStack; bd != NULL; bd = bd->link) + res += bd->blocks; + + return res; +} +#endif + +/* ----------------------------------------------------------------------------- * Returns rtsTrue if stackTop is at the stack boundary of the current stack, * i.e., if the current stack chunk is empty. * -------------------------------------------------------------------------- */ -static inline rtsBool +static INLINE rtsBool isOnBoundary( void ) { return stackTop == currentStackBoundary; @@ -271,7 +302,7 @@ isOnBoundary( void ) * Invariants: * payload[] begins with ptrs pointers followed by non-pointers. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void init_ptrs( stackPos *info, nat ptrs, StgPtr payload ) { info->type = posTypePtrs; @@ -283,7 +314,7 @@ init_ptrs( stackPos *info, nat ptrs, StgPtr payload ) /* ----------------------------------------------------------------------------- * Find the next object from *info. * -------------------------------------------------------------------------- */ -static inline StgClosure * +static INLINE StgClosure * find_ptrs( stackPos *info ) { if (info->next.ptrs.pos < info->next.ptrs.ptrs) { @@ -296,35 +327,92 @@ find_ptrs( stackPos *info ) /* ----------------------------------------------------------------------------- * Initializes *info from SRT information stored in *infoTable. * -------------------------------------------------------------------------- */ -static inline void -init_srt( stackPos *info, StgInfoTable *infoTable ) +static INLINE void +init_srt_fun( stackPos *info, StgFunInfoTable *infoTable ) { - info->type = posTypeSRT; - info->next.srt.srt = (StgClosure **)(infoTable->srt); - info->next.srt.srt_end = info->next.srt.srt + infoTable->srt_len; + if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) { + info->type = posTypeLargeSRT; + info->next.large_srt.srt = (StgLargeSRT *)infoTable->f.srt; + info->next.large_srt.offset = 0; + } else { + info->type = posTypeSRT; + info->next.srt.srt = (StgClosure **)(infoTable->f.srt); + info->next.srt.srt_bitmap = infoTable->i.srt_bitmap; + } +} + +static INLINE void +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.offset = 0; + } else { + info->type = posTypeSRT; + info->next.srt.srt = (StgClosure **)(infoTable->srt); + info->next.srt.srt_bitmap = infoTable->i.srt_bitmap; + } } /* ----------------------------------------------------------------------------- * Find the next object from *info. * -------------------------------------------------------------------------- */ -static inline StgClosure * +static INLINE StgClosure * find_srt( stackPos *info ) { StgClosure *c; + StgWord bitmap; - if (info->next.srt.srt < info->next.srt.srt_end) { - // See scavenge_srt() in GC.c for details. + if (info->type == posTypeSRT) { + // Small SRT bitmap + bitmap = info->next.srt.srt_bitmap; + while (bitmap != 0) { + if ((bitmap & 1) != 0) { #ifdef ENABLE_WIN32_DLL_SUPPORT - if ((unsigned long)(*(info->next.srt.srt)) & 0x1) - c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1); - else - c = *(info->next.srt.srt); + + if ((unsigned long)(*(info->next.srt.srt)) & 0x1) + c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1); + else + c = *(info->next.srt.srt); #else - c = *(info->next.srt.srt); + c = *(info->next.srt.srt); #endif - info->next.srt.srt++; - return c; - } else { + bitmap = bitmap >> 1; + info->next.srt.srt++; + info->next.srt.srt_bitmap = bitmap; + return c; + } + bitmap = bitmap >> 1; + info->next.srt.srt++; + } + // bitmap is now zero... + return NULL; + } + else { + // Large SRT bitmap + nat i = info->next.large_srt.offset; + StgWord bitmap; + + // Follow the pattern from GC.c:scavenge_large_srt_bitmap(). + bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)]; + bitmap = bitmap >> (i % BITS_IN(StgWord)); + while (i < info->next.large_srt.srt->l.size) { + if ((bitmap & 1) != 0) { + c = ((StgClosure **)info->next.large_srt.srt->srt)[i]; + i++; + info->next.large_srt.offset = i; + return c; + } + i++; + if (i % BITS_IN(W_) == 0) { + bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)]; + } else { + bitmap = bitmap >> 1; + } + } + // reached the end of this bitmap. + info->next.large_srt.offset = i; return NULL; } } @@ -340,11 +428,11 @@ find_srt( stackPos *info ) * Invariants: * *c_child_r is the most recent retainer of *c's children. - * *c is not any of TSO, PAP, or AP_UPD, which means that + * *c is not any of TSO, AP, PAP, AP_STACK, which means that * there cannot be any stack objects. * Note: SRTs are considered to be children as well. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) { stackElement se; @@ -355,8 +443,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) #endif ASSERT(get_itbl(c)->type != TSO); - ASSERT(get_itbl(c)->type != PAP); - ASSERT(get_itbl(c)->type != AP_UPD); + ASSERT(get_itbl(c)->type != AP_STACK); // // fill in se @@ -456,35 +543,55 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // layout.payload.ptrs, SRT case FUN: // *c is a heap object. case FUN_2_0: + init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload); + *first_child = find_ptrs(&se.info); + if (*first_child == NULL) + // no child from ptrs, so check SRT + goto fun_srt_only; + break; + case THUNK: case THUNK_2_0: init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload); *first_child = find_ptrs(&se.info); if (*first_child == NULL) // no child from ptrs, so check SRT - goto srt_only; + goto thunk_srt_only; break; // 1 fixed child, SRT case FUN_1_0: case FUN_1_1: + *first_child = c->payload[0]; + ASSERT(*first_child != NULL); + init_srt_fun(&se.info, get_fun_itbl(c)); + break; + case THUNK_1_0: case THUNK_1_1: *first_child = c->payload[0]; ASSERT(*first_child != NULL); - init_srt(&se.info, get_itbl(c)); + init_srt_thunk(&se.info, get_thunk_itbl(c)); break; - // SRT only - case THUNK_STATIC: case FUN_STATIC: // *c is a heap object. - ASSERT(get_itbl(c)->srt_len != 0); + ASSERT(get_itbl(c)->srt_bitmap != 0); case FUN_0_1: case FUN_0_2: + fun_srt_only: + init_srt_fun(&se.info, get_fun_itbl(c)); + *first_child = find_srt(&se.info); + if (*first_child == NULL) + return; // no child + break; + + // SRT only + case THUNK_STATIC: + ASSERT(get_itbl(c)->srt_bitmap != 0); case THUNK_0_1: case THUNK_0_2: - srt_only: - init_srt(&se.info, get_itbl(c)); + thunk_srt_only: + init_srt_thunk(&se.info, get_thunk_itbl(c)); *first_child = find_srt(&se.info); if (*first_child == NULL) return; // no child @@ -492,7 +599,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // cannot appear case PAP: - case AP_UPD: + case AP: + case AP_STACK: case TSO: case IND_STATIC: case CONSTR_INTLIKE: @@ -502,7 +610,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) case UPDATE_FRAME: case CATCH_FRAME: case STOP_FRAME: - case SEQ_FRAME: case RET_DYN: case RET_BCO: case RET_SMALL: @@ -568,7 +675,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) * executed at the end of popOff() in necessary. Since popOff() is * likely to be executed quite often while popOffReal() is not, we * separate popOffReal() from popOff(), which is declared as an - * inline function (for the sake of execution speed). popOffReal() + * INLINE function (for the sake of execution speed). popOffReal() * is called only within popOff() and nowhere else. * -------------------------------------------------------------------------- */ static void @@ -618,7 +725,7 @@ popOffReal(void) #endif } -static inline void +static INLINE void popOff(void) { #ifdef DEBUG_RETAINER // fprintf(stderr, "\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary); @@ -660,7 +767,7 @@ popOff(void) { * It is okay to call this function even when the current stack chunk * is empty. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void pop( StgClosure **c, StgClosure **cp, retainer *r ) { stackElement *se; @@ -736,6 +843,17 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) // layout.payload.ptrs, SRT case FUN: // always a heap object case FUN_2_0: + if (se->info.type == posTypePtrs) { + *c = find_ptrs(&se->info); + if (*c != NULL) { + *cp = se->c; + *r = se->c_child_r; + return; + } + init_srt_fun(&se->info, get_fun_itbl(se->c)); + } + goto do_srt; + case THUNK: case THUNK_2_0: if (se->info.type == posTypePtrs) { @@ -745,11 +863,12 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) *r = se->c_child_r; return; } - init_srt(&se->info, get_itbl(se->c)); + init_srt_thunk(&se->info, get_thunk_itbl(se->c)); } - // fall through + goto do_srt; // SRT + do_srt: case THUNK_STATIC: case FUN_STATIC: case FUN_0_1: @@ -788,7 +907,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case CONSTR_1_1: // cannot appear case PAP: - case AP_UPD: + case AP: + case AP_STACK: case TSO: case IND_STATIC: case CONSTR_INTLIKE: @@ -799,7 +919,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case UPDATE_FRAME: case CATCH_FRAME: case STOP_FRAME: - case SEQ_FRAME: case RET_BCO: case RET_SMALL: case RET_VEC_SMALL: @@ -857,7 +976,7 @@ endRetainerProfiling( void ) * We have to perform an XOR (^) operation each time a closure is examined. * The reason is that we do not know when a closure is visited last. * -------------------------------------------------------------------------- */ -static inline void +static INLINE void maybeInitRetainerSet( StgClosure *c ) { if (!isRetainerSetFieldValid(c)) { @@ -868,7 +987,7 @@ maybeInitRetainerSet( StgClosure *c ) /* ----------------------------------------------------------------------------- * Returns rtsTrue if *c is a retainer. * -------------------------------------------------------------------------- */ -static inline rtsBool +static INLINE rtsBool isRetainer( StgClosure *c ) { switch (get_itbl(c)->type) { @@ -893,7 +1012,8 @@ isRetainer( StgClosure *c ) case THUNK_1_1: case THUNK_0_2: case THUNK_SELECTOR: - case AP_UPD: + case AP: + case AP_STACK: // Static thunks, or CAFS, are obviously retainers. case THUNK_STATIC: @@ -958,7 +1078,6 @@ isRetainer( StgClosure *c ) case UPDATE_FRAME: case CATCH_FRAME: case STOP_FRAME: - case SEQ_FRAME: case RET_DYN: case RET_BCO: case RET_SMALL: @@ -994,7 +1113,7 @@ isRetainer( StgClosure *c ) * re-initialize the hash table. * See refreshAllRetainerSet() in RetainerSet.c. * -------------------------------------------------------------------------- */ -static inline retainer +static INLINE retainer getRetainerFrom( StgClosure *c ) { ASSERT(isRetainer(c)); @@ -1018,7 +1137,7 @@ getRetainerFrom( StgClosure *c ) * c != NULL * s != NULL * -------------------------------------------------------------------------- */ -static inline void +static INLINE void associate( StgClosure *c, RetainerSet *s ) { // StgWord has the same size as pointers, so the following type @@ -1027,14 +1146,117 @@ associate( StgClosure *c, RetainerSet *s ) } /* ----------------------------------------------------------------------------- + Call retainClosure for each of the closures covered by a large bitmap. + -------------------------------------------------------------------------- */ + +static void +retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size, + StgClosure *c, retainer c_child_r) +{ + nat i, b; + StgWord bitmap; + + b = 0; + bitmap = large_bitmap->bitmap[b]; + for (i = 0; i < size; ) { + if ((bitmap & 1) == 0) { + retainClosure((StgClosure *)*p, c, c_child_r); + } + i++; + p++; + if (i % BITS_IN(W_) == 0) { + b++; + bitmap = large_bitmap->bitmap[b]; + } else { + bitmap = bitmap >> 1; + } + } +} + +static INLINE StgPtr +retain_small_bitmap (StgPtr p, nat size, StgWord bitmap, + StgClosure *c, retainer c_child_r) +{ + while (size > 0) { + if ((bitmap & 1) == 0) { + retainClosure((StgClosure *)*p, c, c_child_r); + } + p++; + bitmap = bitmap >> 1; + size--; + } + return p; +} + +/* ----------------------------------------------------------------------------- + * Call retainClosure for each of the closures in an SRT. + * ------------------------------------------------------------------------- */ + +static void +retain_large_srt_bitmap (StgLargeSRT *srt, StgClosure *c, retainer c_child_r) +{ + nat i, b, size; + StgWord bitmap; + StgClosure **p; + + b = 0; + p = (StgClosure **)srt->srt; + size = srt->l.size; + bitmap = srt->l.bitmap[b]; + for (i = 0; i < size; ) { + if ((bitmap & 1) != 0) { + retainClosure((StgClosure *)*p, c, c_child_r); + } + i++; + p++; + if (i % BITS_IN(W_) == 0) { + b++; + bitmap = srt->l.bitmap[b]; + } else { + bitmap = bitmap >> 1; + } + } +} + +static INLINE void +retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r) +{ + nat bitmap; + StgClosure **p; + + bitmap = srt_bitmap; + p = srt; + + if (bitmap == (StgHalfWord)(-1)) { + retain_large_srt_bitmap( (StgLargeSRT *)srt, c, c_child_r ); + return; + } + + while (bitmap != 0) { + if ((bitmap & 1) != 0) { +#ifdef ENABLE_WIN32_DLL_SUPPORT + if ( (unsigned long)(*srt) & 0x1 ) { + retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), + c, c_child_r); + } else { + retainClosure(*srt,c,c_child_r); + } +#else + retainClosure(*srt,c,c_child_r); +#endif + } + p++; + bitmap = bitmap >> 1; + } +} + +/* ----------------------------------------------------------------------------- * Process all the objects in the stack chunk from stackStart to stackEnd * with *c and *c_child_r being their parent and their most recent retainer, * respectively. Treat stackOptionalFun as another child of *c if it is * not NULL. * Invariants: - * *c is one of the following: TSO, PAP, and AP_UPD. - * If *c is AP_UPD or PAP, stackOptionalFun is not NULL. Otherwise, - * it is NULL. + * *c is one of the following: TSO, AP_STACK. * If *c is TSO, c == c_child_r. * stackStart < stackEnd. * RSET(c) and RSET(c_child_r) are valid, i.e., their @@ -1048,13 +1270,13 @@ associate( StgClosure *c, RetainerSet *s ) * -------------------------------------------------------------------------- */ static void retainStack( StgClosure *c, retainer c_child_r, - StgClosure *stackOptionalFun, StgPtr stackStart, - StgPtr stackEnd ) + StgPtr stackStart, StgPtr stackEnd ) { stackElement *oldStackBoundary; - StgPtr p, q; - StgInfoTable *info; + StgPtr p; + StgRetInfoTable *info; StgWord32 bitmap; + nat size; #ifdef DEBUG_RETAINER cStackSize++; @@ -1074,62 +1296,16 @@ retainStack( StgClosure *c, retainer c_child_r, // fprintf(stderr, "retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary); #endif - if (stackOptionalFun != NULL) { - ASSERT(get_itbl(c)->type == AP_UPD || get_itbl(c)->type == PAP); - retainClosure(stackOptionalFun, c, c_child_r); - } else { - ASSERT(get_itbl(c)->type == TSO); - ASSERT(((StgTSO *)c)->what_next != ThreadRelocated && - ((StgTSO *)c)->what_next != ThreadComplete && - ((StgTSO *)c)->what_next != ThreadKilled); - } - + ASSERT(get_itbl(c)->type != TSO || + (((StgTSO *)c)->what_next != ThreadRelocated && + ((StgTSO *)c)->what_next != ThreadComplete && + ((StgTSO *)c)->what_next != ThreadKilled)); + p = stackStart; while (p < stackEnd) { - q = *(StgPtr *)p; + info = get_ret_itbl((StgClosure *)p); - // - // Note & Todo: - // The correctness of retainer profiling is subject to the - // correctness of the two macros IS_ARG_TAG() and - // LOOKS_LIKE_GHC_INFO(). Since LOOKS_LIKE_GHC_INFO() is a bit - // precarious macro, so I believe that the current - // implementation may not be quite safe. Also, scavenge_stack() - // in GC.c also exploits this macro in order to identify shallow - // pointers. I am not sure whether scavenge_stack() takes - // further measurements to discern real shallow pointers. - // - // I think this can be a serious problem if a stack chunk - // contains some word which looks like a pointer but is - // actually, say, a word constituting a floating number. - // - - // skip tagged words - if (IS_ARG_TAG((StgWord)q)) { - p += 1 + ARG_SIZE(q); - continue; - } - - // check if *p is a shallow closure pointer - if (!LOOKS_LIKE_GHC_INFO(q)) { - retainClosure((StgClosure *)q, c, c_child_r); - p++; - continue; - } - - // regular stack objects - info = get_itbl((StgClosure *)p); - switch(info->type) { - case RET_DYN: - bitmap = ((StgRetDyn *)p)->liveness; - p = ((StgRetDyn *)p)->payload; - goto small_bitmap; - - // FUN and FUN_STATIC keep only their info pointer. - case FUN: - case FUN_STATIC: - p++; - goto follow_srt; + switch(info->i.type) { case UPDATE_FRAME: retainClosure(((StgUpdateFrame *)p)->updatee, c, c_child_r); @@ -1138,70 +1314,95 @@ retainStack( StgClosure *c, retainer c_child_r, case STOP_FRAME: case CATCH_FRAME: - case SEQ_FRAME: - case RET_BCO: case RET_SMALL: case RET_VEC_SMALL: - bitmap = info->layout.bitmap; + bitmap = BITMAP_BITS(info->i.layout.bitmap); + size = BITMAP_SIZE(info->i.layout.bitmap); p++; - small_bitmap: - while (bitmap != 0) { - if ((bitmap & 1) == 0) - retainClosure((StgClosure *)*p, c, c_child_r); - p++; - bitmap = bitmap >> 1; - } + p = retain_small_bitmap(p, size, bitmap, c, c_child_r); + follow_srt: - { - StgClosure **srt, **srt_end; + retainSRT((StgClosure **)info->srt, info->i.srt_bitmap, c, c_child_r); + continue; - srt = (StgClosure **)(info->srt); - srt_end = srt + info->srt_len; - for (; srt < srt_end; srt++) { - // See scavenge_srt() in GC.c for details. -#ifdef ENABLE_WIN32_DLL_SUPPORT - if ((unsigned long)(*srt) & 0x1) - retainClosure(*(StgClosure **)(((unsigned long)*srt & ~0x1)), c, c_child_r); - else - retainClosure(*srt, c, c_child_r); -#else - retainClosure(*srt, c, c_child_r); -#endif - } - } + case RET_BCO: { + StgBCO *bco; + + p++; + retainClosure((StgClosure *)*p, c, c_child_r); + bco = (StgBCO *)*p; + p++; + size = BCO_BITMAP_SIZE(bco); + retain_large_bitmap(p, BCO_BITMAP(bco), size, c, c_child_r); + p += size; continue; + } + // large bitmap (> 32 entries, or > 64 on a 64-bit machine) case RET_BIG: case RET_VEC_BIG: - { - StgPtr q; - StgLargeBitmap *large_bitmap; - nat i; - - large_bitmap = info->layout.large_bitmap; + size = info->i.layout.large_bitmap->size; p++; + retain_large_bitmap(p, info->i.layout.large_bitmap, + size, c, c_child_r); + p += size; + // and don't forget to follow the SRT + goto follow_srt; - for (i = 0; i < large_bitmap->size; i++) { - bitmap = large_bitmap->bitmap[i]; - q = p + sizeofW(StgWord) * 8; - while (bitmap != 0) { - if ((bitmap & 1) == 0) - retainClosure((StgClosure *)*p, c, c_child_r); - p++; - bitmap = bitmap >> 1; - } - if (i + 1 < large_bitmap->size) { - while (p < q) { - retainClosure((StgClosure *)*p, c, c_child_r); - p++; - } - } + // Dynamic bitmap: the mask is stored on the stack + case RET_DYN: { + StgWord dyn; + dyn = ((StgRetDyn *)p)->liveness; + + // traverse the bitmap first + 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 += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; + + // follow the ptr words + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { + retainClosure((StgClosure *)*p, c, c_child_r); + p++; } + continue; } - goto follow_srt; + + case RET_FUN: { + StgRetFun *ret_fun = (StgRetFun *)p; + StgFunInfoTable *fun_info; + + retainClosure(ret_fun->fun, c, c_child_r); + fun_info = get_fun_itbl(ret_fun->fun); + + 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); + 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, c, c_child_r); + p += size; + break; + default: + 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; + } + goto follow_srt; + } + default: barf("Invalid object found in retainStack(): %d", - (int)(info->type)); + (int)(info->i.type)); } } @@ -1216,6 +1417,49 @@ retainStack( StgClosure *c, retainer c_child_r, #endif } +/* ---------------------------------------------------------------------------- + * Call retainClosure for each of the children of a PAP/AP + * ------------------------------------------------------------------------- */ + +static INLINE StgPtr +retain_PAP (StgPAP *pap, retainer c_child_r) +{ + StgPtr p; + StgWord bitmap, size; + StgFunInfoTable *fun_info; + + retainClosure(pap->fun, (StgClosure *)pap, c_child_r); + fun_info = get_fun_itbl(pap->fun); + ASSERT(fun_info->i.type != PAP); + + p = (StgPtr)pap->payload; + size = pap->n_args; + + 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); + break; + case ARG_GEN_BIG: + retain_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, + size, (StgClosure *)pap, c_child_r); + p += size; + break; + case ARG_BCO: + retain_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), + size, (StgClosure *)pap, c_child_r); + p += size; + 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); + break; + } + return p; +} + /* ----------------------------------------------------------------------------- * Compute the retainer set of *c0 and all its desecents by traversing. * *cp0 is the parent of *c0, and *r0 is the most recent retainer of *c0. @@ -1230,7 +1474,7 @@ retainStack( StgClosure *c, retainer c_child_r, * its descendants. * Note: * stackTop must be the same at the beginning and the exit of this function. - * *c0 can be TSO (as well as PAP and AP_UPD). + * *c0 can be TSO (as well as AP_STACK). * -------------------------------------------------------------------------- */ static void retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) @@ -1342,7 +1586,7 @@ inner_loop: goto loop; case THUNK_STATIC: case FUN_STATIC: - if (get_itbl(c)->srt_len == 0) { + if (get_itbl(c)->srt_bitmap == 0) { // No need to compute the retainer set; no dynamic objects // are reachable from *c. // @@ -1437,27 +1681,27 @@ inner_loop: // process child - if (typeOfc == TSO) { + // Special case closures: we process these all in one go rather + // than attempting to save the current position, because doing so + // would be hard. + switch (typeOfc) { + case TSO: retainStack(c, c_child_r, - NULL, ((StgTSO *)c)->sp, ((StgTSO *)c)->stack + ((StgTSO *)c)->stack_size); - // no more children goto loop; - } else if (typeOfc == PAP) { - retainStack(c, c_child_r, - ((StgPAP *)c)->fun, - (StgPtr)((StgPAP *)c)->payload, - (StgPtr)((StgPAP *)c)->payload + ((StgPAP *)c)->n_args); - // no more children + + case PAP: + case AP: + retain_PAP((StgPAP *)c, c_child_r); goto loop; - } else if (typeOfc == AP_UPD) { + + case AP_STACK: + retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r); retainStack(c, c_child_r, - ((StgAP_UPD *)c)->fun, - (StgPtr)((StgAP_UPD *)c)->payload, - (StgPtr)((StgAP_UPD *)c)->payload + - ((StgAP_UPD *)c)->n_args); - // no more children + (StgPtr)((StgAP_STACK *)c)->payload, + (StgPtr)((StgAP_STACK *)c)->payload + + ((StgAP_STACK *)c)->size); goto loop; } @@ -1872,10 +2116,13 @@ sanityCheckHeapClosure( StgClosure *c ) case MUT_ARR_PTRS_FROZEN: return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c); - case AP_UPD: + 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); @@ -1923,7 +2170,6 @@ sanityCheckHeapClosure( StgClosure *c ) case UPDATE_FRAME: case CATCH_FRAME: case STOP_FRAME: - case SEQ_FRAME: case RET_DYN: case RET_BCO: case RET_SMALL: