static void
checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
{
StgClosure *fun;
StgFunInfoTable *fun_info;
fun = UNTAG_CLOSURE(tagged_fun);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
fun_info = get_fun_itbl(fun);
switch (fun_info->f.fun_type) {
case ARG_GEN:
checkSmallBitmap( (StgPtr)payload,
BITMAP_BITS(fun_info->f.b.bitmap), n_args );
break;
case ARG_GEN_BIG:
checkLargeBitmap( (StgPtr)payload,
GET_FUN_LARGE_BITMAP(fun_info),
n_args );
break;
case ARG_BCO:
checkLargeBitmap( (StgPtr)payload,
BCO_BITMAP(fun),
n_args );
break;
default:
checkSmallBitmap( (StgPtr)payload,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
n_args );
break;
}
ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(tagged_fun) == 0
: GET_CLOSURE_TAG(tagged_fun) == fun_info->f.arity);
}
void gtc_heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure *fun, StgClosure **payload, StgWord size) {
StgWord bitmap;
StgFunInfoTable *fun_info;
fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
// ASSERT(fun_info->i.type != PAP);
StgClosure **p = payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
goto small_bitmap;
case ARG_GEN_BIG:
gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, GET_FUN_LARGE_BITMAP(fun_info), size);
break;
case ARG_BCO:
gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, BCO_BITMAP(fun), size);
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
ptrs[(*nptrs)++] = *p;
}
bitmap = bitmap >> 1;
p++;
size--;
}
break;
}
}
STATIC_INLINE GNUC_ATTR_HOT StgPtr
scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
{
StgPtr p;
StgWord bitmap;
StgFunInfoTable *fun_info;
fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
ASSERT(fun_info->i.type != PAP);
p = (StgPtr)payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
goto small_bitmap;
case ARG_GEN_BIG:
scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
p += size;
break;
case ARG_BCO:
scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
p += size;
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
evacuate((StgClosure **)p);
}
p++;
bitmap = bitmap >> 1;
size--;
}
break;
}
return p;
}
void
printStackChunk( StgPtr sp, StgPtr spBottom )
{
StgWord bitmap;
const StgInfoTable *info;
ASSERT(sp <= spBottom);
for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
info = get_itbl((StgClosure *)sp);
switch (info->type) {
case UPDATE_FRAME:
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
printClosure((StgClosure*)sp);
continue;
case RET_SMALL: {
StgWord c = *sp;
if (c == (StgWord)&stg_ctoi_R1p_info) {
debugBelch("tstg_ctoi_ret_R1p_info\n" );
} else if (c == (StgWord)&stg_ctoi_R1n_info) {
debugBelch("stg_ctoi_ret_R1n_info\n" );
} else if (c == (StgWord)&stg_ctoi_F1_info) {
debugBelch("stg_ctoi_ret_F1_info\n" );
} else if (c == (StgWord)&stg_ctoi_D1_info) {
debugBelch("stg_ctoi_ret_D1_info\n" );
} else if (c == (StgWord)&stg_ctoi_V_info) {
debugBelch("stg_ctoi_ret_V_info\n" );
} else if (c == (StgWord)&stg_ap_v_info) {
debugBelch("stg_ap_v_info\n" );
} else if (c == (StgWord)&stg_ap_f_info) {
debugBelch("stg_ap_f_info\n" );
} else if (c == (StgWord)&stg_ap_d_info) {
debugBelch("stg_ap_d_info\n" );
} else if (c == (StgWord)&stg_ap_l_info) {
debugBelch("stg_ap_l_info\n" );
} else if (c == (StgWord)&stg_ap_n_info) {
debugBelch("stg_ap_n_info\n" );
} else if (c == (StgWord)&stg_ap_p_info) {
debugBelch("stg_ap_p_info\n" );
} else if (c == (StgWord)&stg_ap_pp_info) {
debugBelch("stg_ap_pp_info\n" );
} else if (c == (StgWord)&stg_ap_ppp_info) {
debugBelch("stg_ap_ppp_info\n" );
} else if (c == (StgWord)&stg_ap_pppp_info) {
debugBelch("stg_ap_pppp_info\n" );
} else if (c == (StgWord)&stg_ap_ppppp_info) {
debugBelch("stg_ap_ppppp_info\n" );
} else if (c == (StgWord)&stg_ap_pppppp_info) {
debugBelch("stg_ap_pppppp_info\n" );
#ifdef PROFILING
} else if (c == (StgWord)&stg_restore_cccs_info) {
debugBelch("stg_restore_cccs_info\n" );
fprintCCS(stderr, (CostCentreStack*)sp[1]);
debugBelch("\n" );
continue;
#endif
} else {
debugBelch("RET_SMALL (%p)\n", info);
}
bitmap = info->layout.bitmap;
printSmallBitmap(spBottom, sp+1,
BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
continue;
}
case RET_BCO: {
StgBCO *bco;
bco = ((StgBCO *)sp[1]);
debugBelch("RET_BCO (%p)\n", sp);
printLargeBitmap(spBottom, sp+2,
BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
continue;
}
case RET_BIG:
barf("todo");
case RET_FUN:
{
const StgFunInfoTable *fun_info;
StgRetFun *ret_fun;
ret_fun = (StgRetFun *)sp;
fun_info = get_fun_itbl(ret_fun->fun);
debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
switch (fun_info->f.fun_type) {
case ARG_GEN:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(fun_info->f.b.bitmap),
BITMAP_SIZE(fun_info->f.b.bitmap));
break;
case ARG_GEN_BIG:
printLargeBitmap(spBottom, sp+2,
GET_FUN_LARGE_BITMAP(fun_info),
GET_FUN_LARGE_BITMAP(fun_info)->size);
break;
default:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
break;
}
continue;
}
default:
debugBelch("unknown object %d\n", (int)info->type);
barf("printStackChunk");
}
}
}
void
printStackChunk( StgPtr sp, StgPtr spBottom )
{
StgWord bitmap;
const StgInfoTable *info;
ASSERT(sp <= spBottom);
for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
info = get_itbl((StgClosure *)sp);
switch (info->type) {
case UPDATE_FRAME:
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
printObj((StgClosure*)sp);
continue;
case RET_DYN:
{
StgRetDyn* r;
StgPtr p;
StgWord dyn;
nat size;
r = (StgRetDyn *)sp;
dyn = r->liveness;
debugBelch("RET_DYN (%p)\n", r);
p = (P_)(r->payload);
printSmallBitmap(spBottom, sp,
RET_DYN_LIVENESS(r->liveness),
RET_DYN_BITMAP_SIZE);
p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) {
debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p);
debugBelch("Word# %ld\n", (long)*p);
p++;
}
for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p);
printPtr(p);
p++;
}
continue;
}
case RET_SMALL:
debugBelch("RET_SMALL (%p)\n", info);
bitmap = info->layout.bitmap;
printSmallBitmap(spBottom, sp+1,
BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
continue;
case RET_BCO: {
StgBCO *bco;
bco = ((StgBCO *)sp[1]);
debugBelch("RET_BCO (%p)\n", sp);
printLargeBitmap(spBottom, sp+2,
BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
continue;
}
case RET_BIG:
barf("todo");
case RET_FUN:
{
StgFunInfoTable *fun_info;
StgRetFun *ret_fun;
ret_fun = (StgRetFun *)sp;
fun_info = get_fun_itbl(ret_fun->fun);
debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
switch (fun_info->f.fun_type) {
case ARG_GEN:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(fun_info->f.b.bitmap),
BITMAP_SIZE(fun_info->f.b.bitmap));
break;
case ARG_GEN_BIG:
printLargeBitmap(spBottom, sp+2,
GET_FUN_LARGE_BITMAP(fun_info),
GET_FUN_LARGE_BITMAP(fun_info)->size);
break;
default:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
break;
}
continue;
}
default:
debugBelch("unknown object %d\n", (int)info->type);
barf("printStackChunk");
}
}
}
// check an individual stack object
StgOffset
checkStackFrame( StgPtr c )
{
nat size;
const StgRetInfoTable* info;
info = get_ret_itbl((StgClosure *)c);
/* All activation records have 'bitmap' style layout info. */
switch (info->i.type) {
case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
{
StgWord dyn;
StgPtr p;
StgRetDyn* r;
r = (StgRetDyn *)c;
dyn = r->liveness;
p = (P_)(r->payload);
checkSmallBitmap(p,RET_DYN_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE);
p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
// skip over the non-pointers
p += RET_DYN_NONPTRS(dyn);
// follow the ptr words
for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
checkClosureShallow((StgClosure *)*p);
p++;
}
return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
RET_DYN_NONPTR_REGS_SIZE +
RET_DYN_NONPTRS(dyn) + RET_DYN_PTRS(dyn);
}
case UPDATE_FRAME:
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee));
case ATOMICALLY_FRAME:
case CATCH_RETRY_FRAME:
case CATCH_STM_FRAME:
case CATCH_FRAME:
// small bitmap cases (<= 32 entries)
case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_SMALL:
size = BITMAP_SIZE(info->i.layout.bitmap);
checkSmallBitmap((StgPtr)c + 1,
BITMAP_BITS(info->i.layout.bitmap), size);
return 1 + size;
case RET_BCO: {
StgBCO *bco;
nat size;
bco = (StgBCO *)*(c+1);
size = BCO_BITMAP_SIZE(bco);
checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size);
return 2 + size;
}
case RET_BIG: // large bitmap (> 32 entries)
size = GET_LARGE_BITMAP(&info->i)->size;
checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size);
return 1 + size;
case RET_FUN:
{
StgFunInfoTable *fun_info;
StgRetFun *ret_fun;
ret_fun = (StgRetFun *)c;
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
size = ret_fun->size;
switch (fun_info->f.fun_type) {
case ARG_GEN:
checkSmallBitmap((StgPtr)ret_fun->payload,
BITMAP_BITS(fun_info->f.b.bitmap), size);
break;
case ARG_GEN_BIG:
checkLargeBitmap((StgPtr)ret_fun->payload,
GET_FUN_LARGE_BITMAP(fun_info), size);
break;
default:
checkSmallBitmap((StgPtr)ret_fun->payload,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
size);
break;
}
return sizeofW(StgRetFun) + size;
}
default:
barf("checkStackFrame: weird activation record found on stack (%p %d).",c,info->i.type);
}
}
static void
scavenge_stack(StgPtr p, StgPtr stack_end)
{
const StgRetInfoTable* info;
StgWord bitmap;
nat size;
/*
* Each time around this loop, we are looking at a chunk of stack
* that starts with an activation record.
*/
while (p < stack_end) {
info = get_ret_itbl((StgClosure *)p);
switch (info->i.type) {
case UPDATE_FRAME:
// In SMP, we can get update frames that point to indirections
// when two threads evaluate the same thunk. We do attempt to
// discover this situation in threadPaused(), but it's
// possible that the following sequence occurs:
//
// A B
// enter T
// enter T
// blackhole T
// update T
// GC
//
// Now T is an indirection, and the update frame is already
// marked on A's stack, so we won't traverse it again in
// threadPaused(). We could traverse the whole stack again
// before GC, but that seems like overkill.
//
// Scavenging this update frame as normal would be disastrous;
// the updatee would end up pointing to the value. So we
// check whether the value after evacuation is a BLACKHOLE,
// and if not, we change the update frame to an stg_enter
// frame that simply returns the value. Hence, blackholing is
// compulsory (otherwise we would have to check for thunks
// too).
//
// Note [upd-black-hole]
// One slight hiccup is that the THUNK_SELECTOR machinery can
// overwrite the updatee with an IND. In parallel GC, this
// could even be happening concurrently, so we can't check for
// the IND. Fortunately if we assume that blackholing is
// happening (either lazy or eager), then we can be sure that
// the updatee is never a THUNK_SELECTOR and we're ok.
// NB. this is a new invariant: blackholing is not optional.
{
StgUpdateFrame *frame = (StgUpdateFrame *)p;
StgClosure *v;
evacuate(&frame->updatee);
v = frame->updatee;
if (GET_CLOSURE_TAG(v) != 0 ||
(get_itbl(v)->type != BLACKHOLE)) {
// blackholing is compulsory, see above.
frame->header.info = (const StgInfoTable*)&stg_enter_checkbh_info;
}
ASSERT(v->header.info != &stg_TSO_info);
p += sizeofW(StgUpdateFrame);
continue;
}
// small bitmap (< 32 entries, or 64 on a 64-bit machine)
case CATCH_STM_FRAME:
case CATCH_RETRY_FRAME:
case ATOMICALLY_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
case CATCH_FRAME:
case RET_SMALL:
bitmap = BITMAP_BITS(info->i.layout.bitmap);
size = BITMAP_SIZE(info->i.layout.bitmap);
// NOTE: the payload starts immediately after the info-ptr, we
// don't have an StgHeader in the same sense as a heap closure.
p++;
p = scavenge_small_bitmap(p, size, bitmap);
follow_srt:
if (major_gc)
scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap);
continue;
case RET_BCO: {
StgBCO *bco;
nat size;
p++;
evacuate((StgClosure **)p);
bco = (StgBCO *)*p;
p++;
size = BCO_BITMAP_SIZE(bco);
scavenge_large_bitmap(p, BCO_BITMAP(bco), size);
p += size;
continue;
}
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
{
nat size;
size = GET_LARGE_BITMAP(&info->i)->size;
p++;
scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
p += size;
// and don't forget to follow the SRT
goto follow_srt;
}
// Dynamic bitmap: the mask is stored on the stack, and
// there are a number of non-pointers followed by a number
// of pointers above the bitmapped area. (see StgMacros.h,
// HEAP_CHK_GEN).
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 = scavenge_small_bitmap(p, size, bitmap);
// 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--) {
evacuate((StgClosure **)p);
p++;
}
continue;
}
case RET_FUN:
{
StgRetFun *ret_fun = (StgRetFun *)p;
StgFunInfoTable *fun_info;
evacuate(&ret_fun->fun);
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
p = scavenge_arg_block(fun_info, ret_fun->payload);
goto follow_srt;
}
default:
barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type));
}
}
}
void
printStackChunk( StgPtr sp, StgPtr spBottom )
{
StgWord bitmap;
const StgInfoTable *info;
ASSERT(sp <= spBottom);
for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
info = get_itbl((StgClosure *)sp);
switch (info->type) {
case UPDATE_FRAME:
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
printObj((StgClosure*)sp);
continue;
case RET_SMALL:
debugBelch("RET_SMALL (%p)\n", info);
bitmap = info->layout.bitmap;
printSmallBitmap(spBottom, sp+1,
BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
continue;
case RET_BCO: {
StgBCO *bco;
bco = ((StgBCO *)sp[1]);
debugBelch("RET_BCO (%p)\n", sp);
printLargeBitmap(spBottom, sp+2,
BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
continue;
}
case RET_BIG:
barf("todo");
case RET_FUN:
{
StgFunInfoTable *fun_info;
StgRetFun *ret_fun;
ret_fun = (StgRetFun *)sp;
fun_info = get_fun_itbl(ret_fun->fun);
debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
switch (fun_info->f.fun_type) {
case ARG_GEN:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(fun_info->f.b.bitmap),
BITMAP_SIZE(fun_info->f.b.bitmap));
break;
case ARG_GEN_BIG:
printLargeBitmap(spBottom, sp+2,
GET_FUN_LARGE_BITMAP(fun_info),
GET_FUN_LARGE_BITMAP(fun_info)->size);
break;
default:
printSmallBitmap(spBottom, sp+2,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
break;
}
continue;
}
default:
debugBelch("unknown object %d\n", (int)info->type);
barf("printStackChunk");
}
}
}
// check an individual stack object
StgOffset
checkStackFrame( StgPtr c )
{
nat size;
const StgRetInfoTable* info;
info = get_ret_itbl((StgClosure *)c);
/* All activation records have 'bitmap' style layout info. */
switch (info->i.type) {
case UPDATE_FRAME:
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee));
case ATOMICALLY_FRAME:
case CATCH_RETRY_FRAME:
case CATCH_STM_FRAME:
case CATCH_FRAME:
// small bitmap cases (<= 32 entries)
case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_SMALL:
size = BITMAP_SIZE(info->i.layout.bitmap);
checkSmallBitmap((StgPtr)c + 1,
BITMAP_BITS(info->i.layout.bitmap), size);
return 1 + size;
case RET_BCO: {
StgBCO *bco;
nat size;
bco = (StgBCO *)*(c+1);
size = BCO_BITMAP_SIZE(bco);
checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size);
return 2 + size;
}
case RET_BIG: // large bitmap (> 32 entries)
size = GET_LARGE_BITMAP(&info->i)->size;
checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size);
return 1 + size;
case RET_FUN:
{
StgFunInfoTable *fun_info;
StgRetFun *ret_fun;
ret_fun = (StgRetFun *)c;
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
size = ret_fun->size;
switch (fun_info->f.fun_type) {
case ARG_GEN:
checkSmallBitmap((StgPtr)ret_fun->payload,
BITMAP_BITS(fun_info->f.b.bitmap), size);
break;
case ARG_GEN_BIG:
checkLargeBitmap((StgPtr)ret_fun->payload,
GET_FUN_LARGE_BITMAP(fun_info), size);
break;
default:
checkSmallBitmap((StgPtr)ret_fun->payload,
BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
size);
break;
}
return sizeofW(StgRetFun) + size;
}
default:
barf("checkStackFrame: weird activation record found on stack (%p %d).",c,info->i.type);
}
}