X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStable.c;h=a4db5cd749de174afa28a9a89b2b8d8d35fe8ed0;hb=7f24ae51ed36c5c0308a2d0de23e243f32a0043c;hp=7bfd15ecaabc74e83a51cd3507e1f9616d8ec90d;hpb=95371b03d1e5310f3b344cc2ecf29982e2bc9f5d;p=ghc-hetmet.git diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c index 7bfd15e..a4db5cd 100644 --- a/ghc/rts/Stable.c +++ b/ghc/rts/Stable.c @@ -1,20 +1,23 @@ /* ----------------------------------------------------------------------------- - * $Id: Stable.c,v 1.22 2002/08/16 13:29:07 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2002 * * Stable names and stable pointers. * * ---------------------------------------------------------------------------*/ +// Make static versions of inline functions in Stable.h: +#define RTS_STABLE_C + #include "PosixSource.h" #include "Rts.h" #include "Hash.h" -#include "StablePriv.h" #include "RtsUtils.h" +#include "OSThreads.h" #include "Storage.h" #include "RtsAPI.h" #include "RtsFlags.h" +#include "OSThreads.h" /* Comment from ADR's implementation in old RTS: @@ -70,27 +73,16 @@ There may be additional functions on the C side to allow evaluation, application, etc of a stable pointer. - When Haskell calls C, it normally just passes over primitive integers, - floats, bools, strings, etc. This doesn't cause any problems at all - for garbage collection because the act of passing them makes a copy - from the heap, stack or wherever they are onto the C-world stack. - However, if we were to pass a heap object such as a (Haskell) @String@ - and a garbage collection occured before we finished using it, we'd run - into problems since the heap object might have been moved or even - deleted. - - So, if a C call is able to cause a garbage collection or we want to - store a pointer to a heap object between C calls, we must be careful - when passing heap objects. Our solution is to keep a table of all - objects we've given to the C-world and to make sure that the garbage - collector collects these objects --- updating the table as required to - make sure we can still find the object. */ -snEntry *stable_ptr_table; -static snEntry *stable_ptr_free; +snEntry *stable_ptr_table = NULL; +static snEntry *stable_ptr_free = NULL; -static unsigned int SPT_size; +static unsigned int SPT_size = 0; + +#ifdef THREADED_RTS +static Mutex stable_mutex; +#endif /* This hash table maps Haskell objects to stable names, so that every * call to lookupStableName on a given object will return the same @@ -125,11 +117,11 @@ static unsigned int SPT_size; * to the weight stored in the table entry. * */ -static HashTable *addrToStableHash; +static HashTable *addrToStableHash = NULL; #define INIT_SPT_SIZE 64 -static inline void +STATIC_INLINE void initFreeList(snEntry *table, nat n, snEntry *free) { snEntry *p; @@ -147,12 +139,23 @@ initFreeList(snEntry *table, nat n, snEntry *free) void initStablePtrTable(void) { - /* the table will be allocated the first time makeStablePtr is - * called */ - stable_ptr_table = NULL; - stable_ptr_free = NULL; - addrToStableHash = NULL; - SPT_size = 0; + if (SPT_size > 0) + return; + + SPT_size = INIT_SPT_SIZE; + stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry), + "initStablePtrTable"); + + /* we don't use index 0 in the stable name table, because that + * would conflict with the hash table lookup operations which + * return NULL if an entry isn't found in the hash table. + */ + initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL); + addrToStableHash = allocHashTable(); + +#ifdef THREADED_RTS + initMutex(&stable_mutex); +#endif } /* @@ -176,10 +179,11 @@ removeIndirections(StgClosure* p) return q; } -StgWord -lookupStableName(StgPtr p) +static StgWord +lookupStableName_(StgPtr p) { StgWord sn; + void* sn_tmp; if (stable_ptr_free == NULL) { enlargeStablePtrTable(); @@ -190,20 +194,20 @@ lookupStableName(StgPtr p) */ p = (StgPtr)removeIndirections((StgClosure*)p); - (void *)sn = lookupHashTable(addrToStableHash,(W_)p); + sn_tmp = lookupHashTable(addrToStableHash,(W_)p); + sn = (StgWord)sn_tmp; if (sn != 0) { ASSERT(stable_ptr_table[sn].addr == p); - IF_DEBUG(stable,fprintf(stderr,"cached stable name %d at %p\n",sn,p)); + IF_DEBUG(stable,debugBelch("cached stable name %ld at %p\n",sn,p)); return sn; } else { sn = stable_ptr_free - stable_ptr_table; - (P_)stable_ptr_free = stable_ptr_free->addr; + stable_ptr_free = (snEntry*)(stable_ptr_free->addr); stable_ptr_table[sn].ref = 0; stable_ptr_table[sn].addr = p; stable_ptr_table[sn].sn_obj = NULL; - /* IF_DEBUG(stable,fprintf(stderr,"new stable name %d at - %p\n",sn,p)); */ + /* IF_DEBUG(stable,debugBelch("new stable name %d at %p\n",sn,p)); */ /* add the new stable name to the hash table */ insertHashTable(addrToStableHash, (W_)p, (void *)sn); @@ -212,7 +216,19 @@ lookupStableName(StgPtr p) } } -static inline void +StgWord +lookupStableName(StgPtr p) +{ + StgWord res; + + initStablePtrTable(); + ACQUIRE_LOCK(&stable_mutex); + res = lookupStableName_(p); + RELEASE_LOCK(&stable_mutex); + return res; +} + +STATIC_INLINE void freeStableName(snEntry *sn) { ASSERT(sn->sn_obj == NULL); @@ -228,15 +244,23 @@ getStablePtr(StgPtr p) { StgWord sn; - sn = lookupStableName(p); + initStablePtrTable(); + ACQUIRE_LOCK(&stable_mutex); + sn = lookupStableName_(p); stable_ptr_table[sn].ref++; + RELEASE_LOCK(&stable_mutex); return (StgStablePtr)(sn); } void freeStablePtr(StgStablePtr sp) { - snEntry *sn = &stable_ptr_table[(StgWord)sp]; + snEntry *sn; + + initStablePtrTable(); + ACQUIRE_LOCK(&stable_mutex); + + sn = &stable_ptr_table[(StgWord)sp]; ASSERT((StgWord)sp < SPT_size && sn->addr != NULL && sn->ref > 0); @@ -248,35 +272,23 @@ freeStablePtr(StgStablePtr sp) if (sn->sn_obj == NULL && sn->ref == 0) { freeStableName(sn); } + + RELEASE_LOCK(&stable_mutex); } void enlargeStablePtrTable(void) { nat old_SPT_size = SPT_size; - - if (SPT_size == 0) { - // 1st time - SPT_size = INIT_SPT_SIZE; - stable_ptr_table = stgMallocWords(SPT_size * sizeof(snEntry), - "initStablePtrTable"); - - /* we don't use index 0 in the stable name table, because that - * would conflict with the hash table lookup operations which - * return NULL if an entry isn't found in the hash table. - */ - initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL); - addrToStableHash = allocHashTable(); - } - else { + // 2nd and subsequent times - SPT_size *= 2; - stable_ptr_table = - stgReallocWords(stable_ptr_table, SPT_size * sizeof(snEntry), + SPT_size *= 2; + stable_ptr_table = + stgReallocBytes(stable_ptr_table, + SPT_size * sizeof(snEntry), "enlargeStablePtrTable"); - - initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); - } + + initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); } /* ----------------------------------------------------------------------------- @@ -387,13 +399,13 @@ gcStablePtrTable( void ) if (p->sn_obj == NULL) { // StableName object is dead freeStableName(p); - IF_DEBUG(stable, fprintf(stderr,"GC'd Stable name %d\n", - p - stable_ptr_table)); + IF_DEBUG(stable, debugBelch("GC'd Stable name %ld\n", + p - stable_ptr_table)); continue; } else { - (StgClosure *)p->addr = isAlive((StgClosure *)p->addr); - IF_DEBUG(stable, fprintf(stderr,"Stable name %d still alive at %p, ref %d\n", p - stable_ptr_table, p->addr, p->ref)); + p->addr = (StgPtr)isAlive((StgClosure *)p->addr); + IF_DEBUG(stable, debugBelch("Stable name %ld still alive at %p, ref %ld\n", p - stable_ptr_table, p->addr, p->ref)); } } }