X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FStable.c;h=0ed18bcec2c94992a7af8e7b6d7d4b186944b724;hp=2391cb127fb37cec344065a20f15a4f7f15c793b;hb=b7fecf522f271305de84d0efe8af5cad28aa45f5;hpb=5a2769f0273dd389977e8283375e7920d183bdd4 diff --git a/rts/Stable.c b/rts/Stable.c index 2391cb1..0ed18bc 100644 --- a/rts/Stable.c +++ b/rts/Stable.c @@ -19,6 +19,7 @@ #include "RtsFlags.h" #include "OSThreads.h" #include "Trace.h" +#include "Stable.h" /* Comment from ADR's implementation in old RTS: @@ -159,8 +160,26 @@ initStablePtrTable(void) #endif } +void +exitStablePtrTable(void) +{ + if (addrToStableHash) + freeHashTable(addrToStableHash, NULL); + addrToStableHash = NULL; + if (stable_ptr_table) + stgFree(stable_ptr_table); + stable_ptr_table = NULL; + SPT_size = 0; +#ifdef THREADED_RTS + closeMutex(&stable_mutex); +#endif +} + /* * get at the real stuff...remove indirections. + * It untags pointers before dereferencing and + * retags the real stuff with its tag (if there + * is any) when returning. * * ToDo: move to a better home. */ @@ -168,16 +187,18 @@ static StgClosure* removeIndirections(StgClosure* p) { - StgClosure* q = p; + StgWord tag = GET_CLOSURE_TAG(p); + StgClosure* q = UNTAG_CLOSURE(p); while (get_itbl(q)->type == IND || get_itbl(q)->type == IND_STATIC || get_itbl(q)->type == IND_OLDGEN || get_itbl(q)->type == IND_PERM || get_itbl(q)->type == IND_OLDGEN_PERM ) { - q = ((StgInd *)q)->indirectee; + tag = GET_CLOSURE_TAG(q); + q = UNTAG_CLOSURE(((StgInd *)q)->indirectee); } - return q; + return TAG_CLOSURE(tag,q); } static StgWord @@ -400,15 +421,15 @@ gcStablePtrTable( void ) if (p->sn_obj == NULL) { // StableName object is dead freeStableName(p); - debugTrace(DEBUG_stable, "GC'd Stable name %ld", - p - stable_ptr_table); + debugTrace(DEBUG_stable, "GC'd Stable name %ld", + (long)(p - stable_ptr_table)); continue; } else { p->addr = (StgPtr)isAlive((StgClosure *)p->addr); debugTrace(DEBUG_stable, "stable name %ld still alive at %p, ref %ld\n", - p - stable_ptr_table, p->addr, p->ref); + (long)(p - stable_ptr_table), p->addr, p->ref); } } }