X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStable.c;h=815bac7690549ffd5a998e31cc37aef93f09a4a3;hb=47ff06307547e20eff37477a9bc9be80a460917a;hp=d0d64dd63f23df8a6bbf85494ec2ed2751be8a73;hpb=e19ffca9c4f5192a8757bfb3f35e6a3907f29e76;p=ghc-hetmet.git diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c index d0d64dd..815bac7 100644 --- a/ghc/rts/Stable.c +++ b/ghc/rts/Stable.c @@ -1,16 +1,18 @@ /* ----------------------------------------------------------------------------- - * $Id: Stable.c,v 1.10 2000/02/29 19:59:38 sof Exp $ + * $Id: Stable.c,v 1.29 2004/08/22 15:50:42 panne 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 "GC.h" #include "RtsUtils.h" #include "Storage.h" #include "RtsAPI.h" @@ -66,37 +68,24 @@ deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) \end{verbatim} - There is also a C procedure @FreeStablePtr@ which frees a stable pointer. 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; -snEntry *stable_ptr_free; +snEntry *stable_ptr_table = NULL; +static snEntry *stable_ptr_free = NULL; -unsigned int SPT_size; +static unsigned int SPT_size = 0; /* 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. * + * OLD COMMENTS about reference counting follow. The reference count + * in a stable name entry is now just a counter. + * * Reference counting * ------------------ * A plain stable name entry has a zero reference count, which means @@ -107,7 +96,7 @@ unsigned int SPT_size; * * A stable pointer has a weighted reference count N attached to it * (actually in its upper 5 bits), which represents the weight - * 2^N. The stable name entry keeps a 32-bit reference count, which + * 2^(N-1). The stable name entry keeps a 32-bit reference count, which * represents any weight between 1 and 2^32 (represented as zero). * When the weight is 2^32, the stable name table owns "all" of the * stable pointers to this object, and the entry can be garbage @@ -123,18 +112,19 @@ unsigned int SPT_size; * to the weight stored in the table entry. * */ -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; for (p = table + n - 1; p >= table; p--) { p->addr = (P_)free; - p->weight = 0; + p->old = NULL; + p->ref = 0; p->sn_obj = NULL; free = p; } @@ -144,12 +134,9 @@ 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; + // Nothing to do: + // the table will be allocated the first time makeStablePtr is + // called, and we want the table to persist through multiple inits. } /* @@ -163,11 +150,11 @@ removeIndirections(StgClosure* p) { StgClosure* q = p; - while (q->header.info->type == IND || - q->header.info->type == IND_STATIC || - q->header.info->type == IND_OLDGEN || - q->header.info->type == IND_PERM || - q->header.info->type == IND_OLDGEN_PERM ) { + 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; } return q; @@ -177,18 +164,19 @@ StgWord lookupStableName(StgPtr p) { StgWord sn; + void* sn_tmp; if (stable_ptr_free == NULL) { enlargeStablePtrTable(); } /* removing indirections increases the likelihood - * of finding a match in the stable name - * hash table. + * of finding a match in the stable name hash table. */ 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); @@ -196,8 +184,8 @@ lookupStableName(StgPtr p) return sn; } else { sn = stable_ptr_free - stable_ptr_table; - (P_)stable_ptr_free = stable_ptr_free->addr; - stable_ptr_table[sn].weight = 0; + 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 @@ -210,12 +198,12 @@ lookupStableName(StgPtr p) } } -static inline void +STATIC_INLINE void freeStableName(snEntry *sn) { ASSERT(sn->sn_obj == NULL); if (sn->addr != NULL) { - removeHashTable(addrToStableHash, (W_)sn->addr, NULL); + removeHashTable(addrToStableHash, (W_)sn->addr, NULL); } sn->addr = (P_)stable_ptr_free; stable_ptr_free = sn; @@ -224,26 +212,28 @@ freeStableName(snEntry *sn) StgStablePtr getStablePtr(StgPtr p) { - StgWord sn = lookupStableName(p); - StgWord weight, weight_2; - weight = stable_ptr_table[sn].weight; - if (weight == 0) { - weight = (StgWord)1 << (BITS_IN(StgWord)-1); - stable_ptr_table[sn].weight = weight; - return (StgStablePtr)(sn + ((BITS_IN(StgWord)-1) << STABLEPTR_WEIGHT_SHIFT)); - } - else if (weight == 1) { - barf("getStablePtr: too light"); - } - else { - weight /= 2; - /* find log2(weight) */ - for (weight_2 = 1; weight != 1; weight_2++) { - weight >>= 1; + StgWord sn; + + sn = lookupStableName(p); + stable_ptr_table[sn].ref++; + return (StgStablePtr)(sn); +} + +void +freeStablePtr(StgStablePtr sp) +{ + snEntry *sn = &stable_ptr_table[(StgWord)sp]; + + ASSERT((StgWord)sp < SPT_size && sn->addr != NULL && sn->ref > 0); + + sn->ref--; + + // If this entry has no StableName attached, then just free it + // immediately. This is important; it might be a while before the + // next major GC which actually collects the entry. + if (sn->sn_obj == NULL && sn->ref == 0) { + freeStableName(sn); } - stable_ptr_table[sn].weight -= 2^weight_2; - return (StgStablePtr)(sn + (weight_2 << STABLEPTR_WEIGHT_SHIFT)); - } } void @@ -252,10 +242,10 @@ enlargeStablePtrTable(void) nat old_SPT_size = SPT_size; if (SPT_size == 0) { - /* 1st time */ + // 1st time SPT_size = INIT_SPT_SIZE; - stable_ptr_table = stgMallocWords(SPT_size * sizeof(snEntry), - "initStablePtrTable"); + stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry), + "enlargeStablePtrTable"); /* we don't use index 0 in the stable name table, because that * would conflict with the hash table lookup operations which @@ -265,12 +255,13 @@ enlargeStablePtrTable(void) addrToStableHash = allocHashTable(); } else { - /* 2nd and subsequent times */ + // 2nd and subsequent times SPT_size *= 2; stable_ptr_table = - stgReallocWords(stable_ptr_table, SPT_size * sizeof(snEntry), + stgReallocBytes(stable_ptr_table, + SPT_size * sizeof(snEntry), "enlargeStablePtrTable"); - + initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); } } @@ -278,54 +269,68 @@ enlargeStablePtrTable(void) /* ----------------------------------------------------------------------------- * Treat stable pointers as roots for the garbage collector. * - * A stable pointer is any stable name entry with a weight > 0. We'll + * A stable pointer is any stable name entry with a ref > 0. We'll * take the opportunity to zero the "keep" flags at the same time. * -------------------------------------------------------------------------- */ void -markStablePtrTable(rtsBool full) +markStablePtrTable(evac_fn evac) { - snEntry *p, *end_stable_ptr_table; - StgPtr q; - StgClosure *new; - - if (SPT_size == 0) - return; + snEntry *p, *end_stable_ptr_table; + StgPtr q; + + end_stable_ptr_table = &stable_ptr_table[SPT_size]; + + // Mark all the stable *pointers* (not stable names). + // _starting_ at index 1; index 0 is unused. + for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) { + q = p->addr; + + // Internal pointers are free slots. If q == NULL, it's a + // stable name where the object has been GC'd, but the + // StableName object (sn_obj) is still alive. + if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { + + // save the current addr away: we need to be able to tell + // whether the objects moved in order to be able to update + // the hash table later. + p->old = p->addr; + + // if the ref is non-zero, treat addr as a root + if (p->ref != 0) { + evac((StgClosure **)&p->addr); + } + } + } +} - if (full) { - freeHashTable(addrToStableHash,NULL); - addrToStableHash = allocHashTable(); - } +/* ----------------------------------------------------------------------------- + * Thread the stable pointer table for compacting GC. + * + * Here we must call the supplied evac function for each pointer into + * the heap from the stable pointer table, because the compacting + * collector may move the object it points to. + * -------------------------------------------------------------------------- */ - end_stable_ptr_table = &stable_ptr_table[SPT_size]; +void +threadStablePtrTable( evac_fn evac ) +{ + snEntry *p, *end_stable_ptr_table; + StgPtr q; + + end_stable_ptr_table = &stable_ptr_table[SPT_size]; + + for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) { + + if (p->sn_obj != NULL) { + evac((StgClosure **)&p->sn_obj); + } - /* Mark all the stable *pointers* (not stable names). - * _starting_ at index 1; index 0 is unused. - */ - for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) { - q = p->addr; - /* internal pointers or NULL are free slots - */ - if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { - if (p->weight != 0) { - new = MarkRoot((StgClosure *)q); - /* Update the hash table */ - if (full) { - insertHashTable(addrToStableHash, (W_)new, - (void *)(p - stable_ptr_table)); - (StgClosure *)p->addr = new; - } else if ((P_)new != q) { - removeHashTable(addrToStableHash, (W_)q, NULL); - if (!lookupHashTable(addrToStableHash, (W_)new)) { - insertHashTable(addrToStableHash, (W_)new, - (void *)(p - stable_ptr_table)); - } - (StgClosure *)p->addr = new; + q = p->addr; + if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { + evac((StgClosure **)&p->addr); } - IF_DEBUG(stable, fprintf(stderr,"Stable ptr %d still alive at %p, weight %d\n", p - stable_ptr_table, new, p->weight)); - } } - } } /* ----------------------------------------------------------------------------- @@ -333,13 +338,57 @@ markStablePtrTable(rtsBool full) * * A dead entry has: * - * - a weight of zero (i.e. 2^32) + * - a zero reference count * - a dead sn_obj * * Both of these conditions must be true in order to re-use the stable * name table entry. We can re-use stable name table entries for live * heap objects, as long as the program has no StableName objects that * refer to the entry. + * -------------------------------------------------------------------------- */ + +void +gcStablePtrTable( void ) +{ + snEntry *p, *end_stable_ptr_table; + StgPtr q; + + end_stable_ptr_table = &stable_ptr_table[SPT_size]; + + // NOTE: _starting_ at index 1; index 0 is unused. + for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) { + + // Update the pointer to the StableName object, if there is one + if (p->sn_obj != NULL) { + p->sn_obj = isAlive(p->sn_obj); + } + + // Internal pointers are free slots. If q == NULL, it's a + // stable name where the object has been GC'd, but the + // StableName object (sn_obj) is still alive. + q = p->addr; + if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { + + // StableNames only: + if (p->ref == 0) { + 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)); + continue; + + } else { + p->addr = (StgPtr)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)); + } + } + } + } +} + +/* ----------------------------------------------------------------------------- + * Update the StablePtr/StableName hash table * * The boolean argument 'full' indicates that a major collection is * being done, so we might as well throw away the hash table and build @@ -348,65 +397,39 @@ markStablePtrTable(rtsBool full) * -------------------------------------------------------------------------- */ void -gcStablePtrTable(rtsBool full) +updateStablePtrTable(rtsBool full) { - snEntry *p, *end_stable_ptr_table; - StgPtr q, new; - - if (SPT_size == 0) { - return; - } - - end_stable_ptr_table = &stable_ptr_table[SPT_size]; - - /* NOTE: _starting_ at index 1; index 0 is unused. */ - for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) { - - /* Update the pointer to the StableName object, if there is one */ - if (p->sn_obj != NULL) { - p->sn_obj = isAlive(p->sn_obj); + snEntry *p, *end_stable_ptr_table; + + if (full && addrToStableHash != NULL) { + freeHashTable(addrToStableHash,NULL); + addrToStableHash = allocHashTable(); } - - q = p->addr; - if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { - - /* We're only interested in Stable Names here. The weight != 0 - * case is handled in markStablePtrTable above. - */ - if (p->weight == 0) { + + end_stable_ptr_table = &stable_ptr_table[SPT_size]; + + // NOTE: _starting_ at index 1; index 0 is unused. + for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) { - 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)); - } - else { - (StgClosure *)new = isAlive((StgClosure *)q); - IF_DEBUG(stable, fprintf(stderr,"Stable name %d still alive at %p, weight %d\n", p - stable_ptr_table, new, p->weight)); - - if (new == NULL) { - /* The target has been garbage collected. Remove its - * entry from the hash table. - */ - removeHashTable(addrToStableHash, (W_)q, NULL); - - } else { - /* Target still alive, Re-hash this stable name - */ + if (p->addr == NULL) { + if (p->old != NULL) { + // The target has been garbage collected. Remove its + // entry from the hash table. + removeHashTable(addrToStableHash, (W_)p->old, NULL); + p->old = NULL; + } + } + else if (p->addr < (P_)stable_ptr_table + || p->addr >= (P_)end_stable_ptr_table) { + // Target still alive, Re-hash this stable name if (full) { - insertHashTable(addrToStableHash, (W_)new, (void *)(p - stable_ptr_table)); - } else if (new != q) { - removeHashTable(addrToStableHash, (W_)q, NULL); - insertHashTable(addrToStableHash, (W_)new, (void *)(p - stable_ptr_table)); + insertHashTable(addrToStableHash, (W_)p->addr, + (void *)(p - stable_ptr_table)); + } else if (p->addr != p->old) { + removeHashTable(addrToStableHash, (W_)p->old, NULL); + insertHashTable(addrToStableHash, (W_)p->addr, + (void *)(p - stable_ptr_table)); } - } - - /* finally update the address of the target to point to its - * new location. - */ - p->addr = new; } - } } - } }