X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FGCAux.c;h=66806f4d3fe43f701eb3d3f378a9a9f7a4e2cb77;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=fccae2c71d6aa0ea83c29a3c6cf85ce1e0896082;hpb=77798610bc585a1eea3b6695c4a3fee1ccba70ba;p=ghc-hetmet.git diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c index fccae2c..66806f4 100644 --- a/rts/sm/GCAux.c +++ b/rts/sm/GCAux.c @@ -41,7 +41,6 @@ isAlive(StgClosure *p) q = UNTAG_CLOSURE(p); ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); - info = get_itbl(q); // ignore static closures // @@ -63,14 +62,28 @@ isAlive(StgClosure *p) // large objects use the evacuated flag if (bd->flags & BF_LARGE) { + if (get_itbl(q)->type == TSO && + ((StgTSO *)p)->what_next == ThreadRelocated) { + p = (StgClosure *)((StgTSO *)p)->_link; + continue; + } return NULL; } // check the mark bit for compacted steps - if ((bd->flags & BF_COMPACTED) && is_marked((P_)q,bd)) { + if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) { return p; } + info = q->header.info; + + if (IS_FORWARDING_PTR(info)) { + // alive! + return (StgClosure*)UN_FORWARDING_PTR(info); + } + + info = INFO_PTR_TO_STRUCT(info); + switch (info->type) { case IND: @@ -82,13 +95,9 @@ isAlive(StgClosure *p) p = ((StgInd *)q)->indirectee; continue; - case EVACUATED: - // alive! - return ((StgEvacuated *)q)->evacuee; - case TSO: if (((StgTSO *)q)->what_next == ThreadRelocated) { - p = (StgClosure *)((StgTSO *)q)->link; + p = (StgClosure *)((StgTSO *)q)->_link; continue; } return NULL;