projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
add getOrSetSignalHandlerStore, much like getOrSetTypeableStore
[ghc-hetmet.git]
/
rts
/
RetainerProfile.c
diff --git
a/rts/RetainerProfile.c
b/rts/RetainerProfile.c
index
23d6f9d
..
2bd213a
100644
(file)
--- a/
rts/RetainerProfile.c
+++ b/
rts/RetainerProfile.c
@@
-364,8
+364,7
@@
find_srt( stackPos *info )
bitmap = info->next.srt.srt_bitmap;
while (bitmap != 0) {
if ((bitmap & 1) != 0) {
bitmap = info->next.srt.srt_bitmap;
while (bitmap != 0) {
if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
else
if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
else
@@
-454,8
+453,6
@@
push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
case CONSTR_0_2:
case CAF_BLACKHOLE:
case BLACKHOLE:
case CONSTR_0_2:
case CAF_BLACKHOLE:
case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
case ARR_WORDS:
*first_child = NULL;
return;
case ARR_WORDS:
*first_child = NULL;
return;
@@
-492,7
+489,8
@@
push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
// three children (fixed), no SRT
// need to push a stackElement
// 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;
// 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;
@@
-618,9
+616,7
@@
push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
case RET_DYN:
case RET_BCO:
case RET_SMALL:
case RET_DYN:
case RET_BCO:
case RET_SMALL:
- case RET_VEC_SMALL:
case RET_BIG:
case RET_BIG:
- case RET_VEC_BIG:
// invalid objects
case IND:
case BLOCKED_FETCH:
// invalid objects
case IND:
case BLOCKED_FETCH:
@@
-628,7
+624,6
@@
push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
case FETCH_ME_BQ:
case RBH:
case REMOTE_REF:
case FETCH_ME_BQ:
case RBH:
case REMOTE_REF:
- case EVACUATED:
case INVALID_OBJECT:
default:
barf("Invalid object *c in push()");
case INVALID_OBJECT:
default:
barf("Invalid object *c in push()");
@@
-807,7
+802,8
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
// three children (fixed), no SRT
// need to push a stackElement
// 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
if (se->info.next.step == 2) {
*c = (StgClosure *)((StgMVar *)se->c)->tail;
se->info.next.step++; // move to the next step
@@
-867,6
+863,7
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
// 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).
// 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).
+ TRecEntry *entry;
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) {
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) {
@@
-874,7
+871,7
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
popOff();
return;
}
popOff();
return;
}
- TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no];
+ entry = &((StgTRecChunk *)se->c)->entries[entry_no];
if (field_no == 0) {
*c = (StgClosure *)entry->tvar;
} else if (field_no == 1) {
if (field_no == 0) {
*c = (StgClosure *)entry->tvar;
} else if (field_no == 1) {
@@
-959,8
+956,6
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
case CONSTR_0_2:
case CAF_BLACKHOLE:
case BLACKHOLE:
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 ARR_WORDS:
// one child (fixed), no SRT
case MUT_VAR_CLEAN:
@@
-984,9
+979,7
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
case STOP_FRAME:
case RET_BCO:
case RET_SMALL:
case STOP_FRAME:
case RET_BCO:
case RET_SMALL:
- case RET_VEC_SMALL:
case RET_BIG:
case RET_BIG:
- case RET_VEC_BIG:
// invalid objects
case IND:
case BLOCKED_FETCH:
// invalid objects
case IND:
case BLOCKED_FETCH:
@@
-994,7
+987,6
@@
pop( StgClosure **c, StgClosure **cp, retainer *r )
case FETCH_ME_BQ:
case RBH:
case REMOTE_REF:
case FETCH_ME_BQ:
case RBH:
case REMOTE_REF:
- case EVACUATED:
case INVALID_OBJECT:
default:
barf("Invalid object *c in pop()");
case INVALID_OBJECT:
default:
barf("Invalid object *c in pop()");
@@
-1061,7
+1053,8
@@
isRetainer( StgClosure *c )
case TSO:
// mutable objects
case TSO:
// mutable objects
- case MVAR:
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case MUT_ARR_PTRS_CLEAN:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case MUT_ARR_PTRS_CLEAN:
@@
-1115,8
+1108,6
@@
isRetainer( StgClosure *c )
// blackholes
case CAF_BLACKHOLE:
case BLACKHOLE:
// blackholes
case CAF_BLACKHOLE:
case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
// indirection
case IND_PERM:
case IND_OLDGEN_PERM:
// indirection
case IND_PERM:
case IND_OLDGEN_PERM:
@@
-1150,9
+1141,7
@@
isRetainer( StgClosure *c )
case RET_DYN:
case RET_BCO:
case RET_SMALL:
case RET_DYN:
case RET_BCO:
case RET_SMALL:
- case RET_VEC_SMALL:
case RET_BIG:
case RET_BIG:
- case RET_VEC_BIG:
// other cases
case IND:
case BLOCKED_FETCH:
// other cases
case IND:
case BLOCKED_FETCH:
@@
-1160,7
+1149,6
@@
isRetainer( StgClosure *c )
case FETCH_ME_BQ:
case RBH:
case REMOTE_REF:
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);
case INVALID_OBJECT:
default:
barf("Invalid object in isRetainer(): %d", get_itbl(c)->type);
@@
-1387,7
+1375,6
@@
retainStack( StgClosure *c, retainer c_child_r,
case CATCH_RETRY_FRAME:
case ATOMICALLY_FRAME:
case RET_SMALL:
case CATCH_RETRY_FRAME:
case ATOMICALLY_FRAME:
case RET_SMALL:
- case RET_VEC_SMALL:
bitmap = BITMAP_BITS(info->i.layout.bitmap);
size = BITMAP_SIZE(info->i.layout.bitmap);
p++;
bitmap = BITMAP_BITS(info->i.layout.bitmap);
size = BITMAP_SIZE(info->i.layout.bitmap);
p++;
@@
-1412,7
+1399,6
@@
retainStack( StgClosure *c, retainer c_child_r,
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
- case RET_VEC_BIG:
size = GET_LARGE_BITMAP(&info->i)->size;
p++;
retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
size = GET_LARGE_BITMAP(&info->i)->size;
p++;
retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
@@
-1448,7
+1434,7
@@
retainStack( StgClosure *c, retainer c_child_r,
StgFunInfoTable *fun_info;
retainClosure(ret_fun->fun, c, c_child_r);
StgFunInfoTable *fun_info;
retainClosure(ret_fun->fun, c, c_child_r);
- fun_info = get_fun_itbl(ret_fun->fun);
+ fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
p = (P_)&ret_fun->payload;
switch (fun_info->f.fun_type) {
p = (P_)&ret_fun->payload;
switch (fun_info->f.fun_type) {
@@
-1494,7
+1480,9
@@
retainStack( StgClosure *c, retainer c_child_r,
* ------------------------------------------------------------------------- */
static INLINE StgPtr
* ------------------------------------------------------------------------- */
static INLINE StgPtr
-retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun,
+retain_PAP_payload (StgClosure *pap, /* NOT tagged */
+ retainer c_child_r, /* NOT tagged */
+ StgClosure *fun, /* tagged */
StgClosure** payload, StgWord n_args)
{
StgPtr p;
StgClosure** payload, StgWord n_args)
{
StgPtr p;
@@
-1502,6
+1490,7
@@
retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun,
StgFunInfoTable *fun_info;
retainClosure(fun, pap, c_child_r);
StgFunInfoTable *fun_info;
retainClosure(fun, pap, c_child_r);
+ fun = UNTAG_CLOSURE(fun);
fun_info = get_fun_itbl(fun);
ASSERT(fun_info->i.type != PAP);
fun_info = get_fun_itbl(fun);
ASSERT(fun_info->i.type != PAP);
@@
-1550,9
+1539,9
@@
retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun,
static void
retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
{
static void
retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
{
- // c = Current closure
- // cp = Current closure's Parent
- // r = current closures' most recent Retainer
+ // c = Current closure (possibly tagged)
+ // cp = Current closure's Parent (NOT tagged)
+ // r = current closures' most recent Retainer (NOT tagged)
// c_child_r = current closure's children's most recent retainer
// first_child = first child of c
StgClosure *c, *cp, *first_child;
// c_child_r = current closure's children's most recent retainer
// first_child = first child of c
StgClosure *c, *cp, *first_child;
@@
-1590,6
+1579,8
@@
loop:
//debugBelch("inner_loop");
inner_loop:
//debugBelch("inner_loop");
inner_loop:
+ c = UNTAG_CLOSURE(c);
+
// c = current closure under consideration,
// cp = current closure's parent,
// r = current closure's most recent retainer
// c = current closure under consideration,
// cp = current closure's parent,
// r = current closure's most recent retainer
@@
-1635,7
+1626,7
@@
inner_loop:
#ifdef DEBUG_RETAINER
debugBelch("ThreadRelocated encountered in retainClosure()\n");
#endif
#ifdef DEBUG_RETAINER
debugBelch("ThreadRelocated encountered in retainClosure()\n");
#endif
- c = (StgClosure *)((StgTSO *)c)->link;
+ c = (StgClosure *)((StgTSO *)c)->_link;
goto inner_loop;
}
break;
goto inner_loop;
}
break;
@@
-1800,18
+1791,21
@@
inner_loop:
* Compute the retainer set for every object reachable from *tl.
* -------------------------------------------------------------------------- */
static void
* Compute the retainer set for every object reachable from *tl.
* -------------------------------------------------------------------------- */
static void
-retainRoot( StgClosure **tl )
+retainRoot(void *user STG_UNUSED, StgClosure **tl)
{
{
+ StgClosure *c;
+
// We no longer assume that only TSOs and WEAKs are roots; any closure can
// be a root.
ASSERT(isEmptyRetainerStack());
currentStackBoundary = stackTop;
// We no longer assume that only TSOs and WEAKs are roots; any closure can
// be a root.
ASSERT(isEmptyRetainerStack());
currentStackBoundary = stackTop;
- if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) {
- retainClosure(*tl, *tl, getRetainerFrom(*tl));
+ c = UNTAG_CLOSURE(*tl);
+ if (c != &stg_END_TSO_QUEUE_closure && isRetainer(c)) {
+ retainClosure(c, c, getRetainerFrom(c));
} else {
} else {
- retainClosure(*tl, *tl, CCS_SYSTEM);
+ retainClosure(c, c, CCS_SYSTEM);
}
// NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl)));
}
// NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl)));
@@
-1834,7
+1828,7
@@
computeRetainerSet( void )
RetainerSet tmpRetainerSet;
#endif
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.
// This function is called after a major GC, when key, value, and finalizer
// all are guaranteed to be valid, or reachable.
@@
-1843,10
+1837,10
@@
computeRetainerSet( void )
// for retainer profilng.
for (weak = weak_ptr_list; weak != NULL; weak = weak->link)
// retainRoot((StgClosure *)weak);
// 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.
// 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
// The following code resets the rs field of each unvisited mutable
// object (computing sumOfNewCostExtra and updating costArray[] when
@@
-1910,7
+1904,7
@@
computeRetainerSet( void )
* they are not taken into consideration in computing retainer sets.
* -------------------------------------------------------------------------- */
void
* they are not taken into consideration in computing retainer sets.
* -------------------------------------------------------------------------- */
void
-resetStaticObjectForRetainerProfiling( void )
+resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
{
#ifdef DEBUG_RETAINER
nat count;
{
#ifdef DEBUG_RETAINER
nat count;
@@
-1920,7
+1914,7
@@
resetStaticObjectForRetainerProfiling( void )
#ifdef DEBUG_RETAINER
count = 0;
#endif
#ifdef DEBUG_RETAINER
count = 0;
#endif
- p = scavenged_static_objects;
+ p = static_objects;
while (p != END_OF_STATIC_LIST) {
#ifdef DEBUG_RETAINER
count++;
while (p != END_OF_STATIC_LIST) {
#ifdef DEBUG_RETAINER
count++;
@@
-2118,8
+2112,8
@@
sanityCheckHeapClosure( StgClosure *c )
if ((((StgWord)RSET(c) & 1) ^ flip) != 0) {
if (get_itbl(c)->type == CONSTR &&
if ((((StgWord)RSET(c) & 1) ^ flip) != 0) {
if (get_itbl(c)->type == CONSTR &&
- !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") &&
- !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) {
+ !strcmp(GET_PROF_TYPE(get_itbl(c)), "DEAD_WEAK") &&
+ !strcmp(GET_PROF_DESC(get_itbl(c)), "DEAD_WEAK")) {
debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
costArray[get_itbl(c)->type] += cost(c);
sumOfNewCost += cost(c);
debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
costArray[get_itbl(c)->type] += cost(c);
sumOfNewCost += cost(c);
@@
-2127,7
+2121,7
@@
sanityCheckHeapClosure( StgClosure *c )
debugBelch(
"Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n",
flip, c, get_itbl(c)->type,
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,
+ get_itbl(c)->prof.closure_type, GET_PROF_DESC(get_itbl(c)),
RSET(c));
} else {
// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
RSET(c));
} else {
// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
@@
-2167,7
+2161,7
@@
smallObjectPoolCheck(void)
StgPtr p;
static nat costSum, size;
StgPtr p;
static nat costSum, size;
- bd = small_alloc_list;
+ bd = g0s0->blocks;
costSum = 0;
// first block
costSum = 0;
// first block