Commit b521e8b6 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot
Browse files

Refactor Compact.c:

- Remove forward declarations
- Introduce UNTAG_PTR and GET_PTR_TAG for dealing with pointer tags
  without having to cast arguments to StgClosure*
- Remove dead code
- Use W_ instead of StgWord
- Use P_ instead of StgPtr
parent 9b2a5008
......@@ -70,40 +70,47 @@
if we throw away some of the tags).
------------------------------------------------------------------------- */
STATIC_INLINE W_
UNTAG_PTR(W_ p)
{
return p & ~TAG_MASK;
}
STATIC_INLINE W_
GET_PTR_TAG(W_ p)
{
return p & TAG_MASK;
}
STATIC_INLINE void
thread (StgClosure **p)
{
StgClosure *q0;
StgPtr q;
StgWord iptr;
bdescr *bd;
q0 = *p;
q = (StgPtr)UNTAG_CLOSURE(q0);
StgClosure *q0 = *p;
P_ q = (P_)UNTAG_CLOSURE(q0);
// It doesn't look like a closure at the moment, because the info
// ptr is possibly threaded:
// ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
if (HEAP_ALLOCED(q)) {
bd = Bdescr(q);
bdescr *bd = Bdescr(q);
if (bd->flags & BF_MARKED)
{
iptr = *q;
switch (GET_CLOSURE_TAG((StgClosure *)iptr))
W_ iptr = *q;
switch (GET_PTR_TAG(iptr))
{
case 0:
// this is the info pointer; we are creating a new chain.
// save the original tag at the end of the chain.
*p = (StgClosure *)((StgWord)iptr + GET_CLOSURE_TAG(q0));
*q = (StgWord)p + 1;
*p = (StgClosure *)((W_)iptr + GET_CLOSURE_TAG(q0));
*q = (W_)p + 1;
break;
case 1:
case 2:
// this is a chain of length 1 or more
*p = (StgClosure *)iptr;
*q = (StgWord)p + 2;
*q = (W_)p + 2;
break;
}
}
......@@ -121,30 +128,31 @@ thread_root (void *user STG_UNUSED, StgClosure **p)
STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
STATIC_INLINE void
unthread( StgPtr p, StgWord free )
unthread( P_ p, W_ free )
{
StgWord q, r;
StgPtr q0;
q = *p;
W_ q = *p;
loop:
switch (GET_CLOSURE_TAG((StgClosure *)q))
switch (GET_PTR_TAG(q))
{
case 0:
// nothing to do; the chain is length zero
return;
case 1:
q0 = (StgPtr)(q-1);
r = *q0; // r is the info ptr, tagged with the pointer-tag
{
P_ q0 = (P_)(q-1);
W_ r = *q0; // r is the info ptr, tagged with the pointer-tag
*q0 = free;
*p = (StgWord)UNTAG_CLOSURE((StgClosure *)r);
*p = (W_)UNTAG_PTR(r);
return;
}
case 2:
q0 = (StgPtr)(q-2);
r = *q0;
{
P_ q0 = (P_)(q-2);
W_ r = *q0;
*q0 = free;
q = r;
goto loop;
}
default:
barf("unthread");
}
......@@ -154,28 +162,25 @@ loop:
// The info pointer is also tagged with the appropriate pointer tag
// for this closure, which should be attached to the pointer
// subsequently passed to unthread().
STATIC_INLINE StgWord
get_threaded_info( StgPtr p )
STATIC_INLINE W_
get_threaded_info( P_ p )
{
StgWord q;
q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
W_ q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
loop:
switch (GET_CLOSURE_TAG((StgClosure *)q))
switch (GET_PTR_TAG(q))
{
case 0:
ASSERT(LOOKS_LIKE_INFO_PTR(q));
return q;
case 1:
{
StgWord r = *(StgPtr)(q-1);
ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)
UNTAG_CONST_CLOSURE((StgClosure *)r)));
W_ r = *(P_)(q-1);
ASSERT(LOOKS_LIKE_INFO_PTR((W_)UNTAG_CONST_CLOSURE((StgClosure *)r)));
return r;
}
case 2:
q = *(StgPtr)(q-2);
q = *(P_)(q-2);
goto loop;
default:
barf("get_threaded_info");
......@@ -185,7 +190,7 @@ loop:
// A word-aligned memmove will be faster for small objects than libc's or gcc's.
// Remember, the two regions *might* overlap, but: to <= from.
STATIC_INLINE void
move(StgPtr to, StgPtr from, StgWord size)
move(P_ to, P_ from, W_ size)
{
for(; size > 0; --size) {
*to++ = *from++;
......@@ -195,13 +200,11 @@ move(StgPtr to, StgPtr from, StgWord size)
static void
thread_static( StgClosure* p )
{
const StgInfoTable *info;
// keep going until we've threaded all the objects on the linked
// list...
while (p != END_OF_STATIC_OBJECT_LIST) {
p = UNTAG_STATIC_LIST_PTR(p);
info = get_itbl(p);
const StgInfoTable *info = get_itbl(p);
switch (info->type) {
case IND_STATIC:
......@@ -233,14 +236,11 @@ thread_static( StgClosure* p )
}
STATIC_INLINE void
thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
thread_large_bitmap( P_ p, StgLargeBitmap *large_bitmap, W_ size )
{
W_ i, b;
StgWord bitmap;
b = 0;
bitmap = large_bitmap->bitmap[b];
for (i = 0; i < size; ) {
W_ b = 0;
W_ bitmap = large_bitmap->bitmap[b];
for (W_ i = 0; i < size; ) {
if ((bitmap & 1) == 0) {
thread((StgClosure **)p);
}
......@@ -255,8 +255,8 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
}
}
STATIC_INLINE StgPtr
thread_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
STATIC_INLINE P_
thread_small_bitmap (P_ p, W_ size, W_ bitmap)
{
while (size > 0) {
if ((bitmap & 1) == 0) {
......@@ -269,14 +269,13 @@ thread_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
return p;
}
STATIC_INLINE StgPtr
STATIC_INLINE P_
thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
StgPtr p;
StgWord bitmap;
StgWord size;
W_ bitmap;
W_ size;
p = (StgPtr)args;
P_ p = (P_)args;
switch (fun_info->f.fun_type) {
case ARG_GEN:
bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
......@@ -298,12 +297,8 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
}
static void
thread_stack(StgPtr p, StgPtr stack_end)
thread_stack(P_ p, P_ stack_end)
{
const StgRetInfoTable* info;
StgWord bitmap;
StgWord size;
// highly similar to scavenge_stack, but we do pointer threading here.
while (p < stack_end) {
......@@ -312,7 +307,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
// record. All activation records have 'bitmap' style layout
// info.
//
info = get_ret_itbl((StgClosure *)p);
const StgRetInfoTable *info = get_ret_itbl((StgClosure *)p);
switch (info->i.type) {
......@@ -325,22 +320,22 @@ thread_stack(StgPtr p, StgPtr stack_end)
case STOP_FRAME:
case CATCH_FRAME:
case RET_SMALL:
bitmap = BITMAP_BITS(info->i.layout.bitmap);
size = BITMAP_SIZE(info->i.layout.bitmap);
{
W_ bitmap = BITMAP_BITS(info->i.layout.bitmap);
W_ size = BITMAP_SIZE(info->i.layout.bitmap);
p++;
// NOTE: the payload starts immediately after the info-ptr, we
// don't have an StgHeader in the same sense as a heap closure.
p = thread_small_bitmap(p, size, bitmap);
continue;
}
case RET_BCO: {
StgBCO *bco;
p++;
bco = (StgBCO *)*p;
StgBCO *bco = (StgBCO *)*p;
thread((StgClosure **)p);
p++;
size = BCO_BITMAP_SIZE(bco);
W_ size = BCO_BITMAP_SIZE(bco);
thread_large_bitmap(p, BCO_BITMAP(bco), size);
p += size;
continue;
......@@ -349,7 +344,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
// large bitmap (> 32 entries, or 64 on a 64-bit machine)
case RET_BIG:
p++;
size = GET_LARGE_BITMAP(&info->i)->size;
W_ size = GET_LARGE_BITMAP(&info->i)->size;
thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
p += size;
continue;
......@@ -357,10 +352,9 @@ thread_stack(StgPtr p, StgPtr stack_end)
case RET_FUN:
{
StgRetFun *ret_fun = (StgRetFun *)p;
StgFunInfoTable *fun_info;
fun_info = FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)
get_threaded_info((StgPtr)ret_fun->fun)));
StgFunInfoTable *fun_info =
FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(
get_threaded_info((P_)ret_fun->fun)));
// *before* threading it!
thread(&ret_fun->fun);
p = thread_arg_block(fun_info, ret_fun->payload);
......@@ -374,19 +368,16 @@ thread_stack(StgPtr p, StgPtr stack_end)
}
}
STATIC_INLINE StgPtr
thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
STATIC_INLINE P_
thread_PAP_payload (StgClosure *fun, StgClosure **payload, W_ size)
{
StgPtr p;
StgWord bitmap;
StgFunInfoTable *fun_info;
fun_info = FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)
get_threaded_info((StgPtr)fun)));
StgFunInfoTable *fun_info =
FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(get_threaded_info((P_)fun)));
ASSERT(fun_info->i.type != PAP);
p = (StgPtr)payload;
P_ p = (P_)payload;
W_ bitmap;
switch (fun_info->f.fun_type) {
case ARG_GEN:
bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
......@@ -396,7 +387,7 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
p += size;
break;
case ARG_BCO:
thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
thread_large_bitmap((P_)payload, BCO_BITMAP(fun), size);
p += size;
break;
default:
......@@ -409,25 +400,23 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
return p;
}
STATIC_INLINE StgPtr
STATIC_INLINE P_
thread_PAP (StgPAP *pap)
{
StgPtr p;
p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
P_ p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
thread(&pap->fun);
return p;
}
STATIC_INLINE StgPtr
STATIC_INLINE P_
thread_AP (StgAP *ap)
{
StgPtr p;
p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
P_ p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
thread(&ap->fun);
return p;
}
STATIC_INLINE StgPtr
STATIC_INLINE P_
thread_AP_STACK (StgAP_STACK *ap)
{
thread(&ap->fun);
......@@ -435,7 +424,7 @@ thread_AP_STACK (StgAP_STACK *ap)
return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
}
static StgPtr
static P_
thread_TSO (StgTSO *tso)
{
thread_(&tso->_link);
......@@ -455,24 +444,21 @@ thread_TSO (StgTSO *tso)
thread_(&tso->trec);
thread_(&tso->stackobj);
return (StgPtr)tso + sizeofW(StgTSO);
return (P_)tso + sizeofW(StgTSO);
}
static void
update_fwd_large( bdescr *bd )
{
StgPtr p;
const StgInfoTable* info;
for (; bd != NULL; bd = bd->link) {
// nothing to do in a pinned block; it might not even have an object
// at the beginning.
if (bd->flags & BF_PINNED) continue;
p = bd->start;
info = get_itbl((StgClosure *)p);
P_ p = bd->start;
const StgInfoTable *info = get_itbl((StgClosure *)p);
switch (info->type) {
......@@ -502,9 +488,7 @@ update_fwd_large( bdescr *bd )
case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
// follow everything
{
StgSmallMutArrPtrs *a;
a = (StgSmallMutArrPtrs*)p;
StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs*)p;
for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
thread((StgClosure **)p);
}
......@@ -528,11 +512,10 @@ update_fwd_large( bdescr *bd )
case TREC_CHUNK:
{
StgWord i;
StgTRecChunk *tc = (StgTRecChunk *)p;
TRecEntry *e = &(tc -> entries[0]);
thread_(&tc->prev_chunk);
for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
for (W_ i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
thread_(&e->tvar);
thread(&e->expected_value);
thread(&e->new_value);
......@@ -547,8 +530,8 @@ update_fwd_large( bdescr *bd )
}
// ToDo: too big to inline
static /* STATIC_INLINE */ StgPtr
thread_obj (const StgInfoTable *info, StgPtr p)
static /* STATIC_INLINE */ P_
thread_obj (const StgInfoTable *info, P_ p)
{
switch (info->type) {
case THUNK_0_1:
......@@ -604,10 +587,7 @@ thread_obj (const StgInfoTable *info, StgPtr p)
case THUNK:
{
StgPtr end;
end = (P_)((StgThunk *)p)->payload +
info->layout.payload.ptrs;
P_ end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
thread((StgClosure **)p);
}
......@@ -625,10 +605,7 @@ thread_obj (const StgInfoTable *info, StgPtr p)
case BLACKHOLE:
case BLOCKING_QUEUE:
{
StgPtr end;
end = (P_)((StgClosure *)p)->payload +
info->layout.payload.ptrs;
P_ end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
thread((StgClosure **)p);
}
......@@ -687,14 +664,12 @@ thread_obj (const StgInfoTable *info, StgPtr p)
case MUT_ARR_PTRS_FROZEN_DIRTY:
// follow everything
{
StgMutArrPtrs *a;
a = (StgMutArrPtrs *)p;
StgMutArrPtrs *a = (StgMutArrPtrs *)p;
for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
thread((StgClosure **)p);
}
return (StgPtr)a + mut_arr_ptrs_sizeW(a);
return (P_)a + mut_arr_ptrs_sizeW(a);
}
case SMALL_MUT_ARR_PTRS_CLEAN:
......@@ -703,14 +678,12 @@ thread_obj (const StgInfoTable *info, StgPtr p)
case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
// follow everything
{
StgSmallMutArrPtrs *a;
a = (StgSmallMutArrPtrs *)p;
StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs *)p;
for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
thread((StgClosure **)p);
}
return (StgPtr)a + small_mut_arr_ptrs_sizeW(a);
return (P_)a + small_mut_arr_ptrs_sizeW(a);
}
case TSO:
......@@ -725,11 +698,10 @@ thread_obj (const StgInfoTable *info, StgPtr p)
case TREC_CHUNK:
{
StgWord i;
StgTRecChunk *tc = (StgTRecChunk *)p;
TRecEntry *e = &(tc -> entries[0]);
thread_(&tc->prev_chunk);
for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
for (W_ i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
thread_(&e->tvar);
thread(&e->expected_value);
thread(&e->new_value);
......@@ -746,20 +718,16 @@ thread_obj (const StgInfoTable *info, StgPtr p)
static void
update_fwd( bdescr *blocks )
{
StgPtr p;
bdescr *bd;
const StgInfoTable *info;
bd = blocks;
bdescr *bd = blocks;
// cycle through all the blocks in the step
for (; bd != NULL; bd = bd->link) {
p = bd->start;
P_ p = bd->start;
// linearly scan the objects in this block
while (p < bd->free) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
info = get_itbl((StgClosure *)p);
const StgInfoTable *info = get_itbl((StgClosure *)p);
p = thread_obj(info, p);
}
}
......@@ -768,22 +736,13 @@ update_fwd( bdescr *blocks )
static void
update_fwd_compact( bdescr *blocks )
{
StgPtr p, q, free;
#if 0
StgWord m;
#endif
bdescr *bd, *free_bd;
StgInfoTable *info;
StgWord size;
StgWord iptr;
bd = blocks;
free_bd = blocks;
free = free_bd->start;
bdescr *bd = blocks;
bdescr *free_bd = blocks;
P_ free = free_bd->start;
// cycle through all the blocks in the step
for (; bd != NULL; bd = bd->link) {
p = bd->start;
P_ p = bd->start;
while (p < bd->free ) {
......@@ -794,24 +753,6 @@ update_fwd_compact( bdescr *blocks )
break;
}
#if 0
next:
m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
while ( p < bd->free ) {
if ((m & 1) == 0) {
m >>= 1;
p++;
if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
goto next;
} else {
continue;
}
}
#endif
// Problem: we need to know the destination for this cell
// in order to unthread its info pointer. But we can't
// know the destination without the size, because we may
......@@ -821,14 +762,14 @@ update_fwd_compact( bdescr *blocks )
// ToDo: one possible avenue of attack is to use the fact
// that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
// definitely have enough room. Also see bug #1147.
iptr = get_threaded_info(p);
info = INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)iptr));
W_ iptr = get_threaded_info(p);
StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_PTR(iptr));
q = p;
P_ q = p;
p = thread_obj(info, p);
size = p - q;
W_ size = p - q;
if (free + size > free_bd->start + BLOCK_SIZE_W) {
// set the next bit in the bitmap to indicate that this object
// needs to be pushed into the next block. This saves us having
......@@ -842,11 +783,8 @@ update_fwd_compact( bdescr *blocks )
ASSERT(!is_marked(q+1,bd));
}
unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
unthread(q,(W_)free + GET_PTR_TAG(iptr));
free += size;
#if 0
goto next;
#endif
}
}
}
......@@ -854,23 +792,15 @@ update_fwd_compact( bdescr *blocks )
static W_
update_bkwd_compact( generation *gen )
{
StgPtr p, free;
#if 0
StgWord m;
#endif
bdescr *bd, *free_bd;
const StgInfoTable *info;
StgWord size;
W_ free_blocks;
StgWord iptr;
bd = free_bd = gen->old_blocks;
free = free_bd->start;
free_blocks = 1;
P_ free = free_bd->start;
W_ free_blocks = 1;
// cycle through all the blocks in the step
for (; bd != NULL; bd = bd->link) {
p = bd->start;
P_ p = bd->start;
while (p < bd->free ) {
......@@ -881,24 +811,6 @@ update_bkwd_compact( generation *gen )
break;
}
#if 0
next:
m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
while ( p < bd->free ) {
if ((m & 1) == 0) {
m >>= 1;
p++;
if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {