X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStable.c;h=a4db5cd749de174afa28a9a89b2b8d8d35fe8ed0;hb=0dbbf1932d550293986af6244202cb735b2cd966;hp=e9c61816a0f918fe206cedfd71aaad276e347447;hpb=b9dfc5ac41801325ddfddd7cf9c13b7b721a2a2f;p=ghc-hetmet.git diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c index e9c6181..a4db5cd 100644 --- a/ghc/rts/Stable.c +++ b/ghc/rts/Stable.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: Stable.c,v 1.24 2003/01/28 17:05:43 simonmar Exp $ * * (c) The GHC Team, 1998-2002 * @@ -13,11 +12,12 @@ #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: @@ -73,21 +73,6 @@ 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 = NULL; @@ -95,6 +80,10 @@ static snEntry *stable_ptr_free = NULL; 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 * stable name. @@ -132,7 +121,7 @@ static HashTable *addrToStableHash = NULL; #define INIT_SPT_SIZE 64 -static inline void +STATIC_INLINE void initFreeList(snEntry *table, nat n, snEntry *free) { snEntry *p; @@ -150,9 +139,23 @@ initFreeList(snEntry *table, nat n, snEntry *free) void initStablePtrTable(void) { - // Nothing to do: - // the table will be allocated the first time makeStablePtr is - // called, and we want the table to persist through multiple inits. + 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)); } } }