diff options
| -rw-r--r-- | includes/HsFFI.h | 4 | ||||
| -rw-r--r-- | includes/rts/Stable.h | 17 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 2 | ||||
| -rw-r--r-- | rts/Hash.c | 5 | ||||
| -rw-r--r-- | rts/Hash.h | 5 | ||||
| -rw-r--r-- | rts/HsFFI.c | 18 | ||||
| -rw-r--r-- | rts/Linker.c | 8 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 22 | ||||
| -rw-r--r-- | rts/RetainerProfile.c | 2 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 4 | ||||
| -rw-r--r-- | rts/Stable.c | 460 | ||||
| -rw-r--r-- | rts/Stable.h | 29 | ||||
| -rw-r--r-- | rts/sm/Compact.c | 2 | ||||
| -rw-r--r-- | rts/sm/GC.c | 12 | ||||
| -rw-r--r-- | utils/deriveConstants/DeriveConstants.hs | 3 |
15 files changed, 355 insertions, 238 deletions
diff --git a/includes/HsFFI.h b/includes/HsFFI.h index dceabab86f..652fbea22b 100644 --- a/includes/HsFFI.h +++ b/includes/HsFFI.h @@ -153,6 +153,10 @@ extern void hs_add_root (void (*init_root)(void)); extern void hs_perform_gc (void); +extern void hs_lock_stable_tables (void); +extern void hs_unlock_stable_tables (void); +extern void hs_free_stable_ptr_unsafe (HsStablePtr sp); + extern void hs_free_stable_ptr (HsStablePtr sp); extern void hs_free_fun_ptr (HsFunPtr fp); diff --git a/includes/rts/Stable.h b/includes/rts/Stable.h index ec867e486c..9f785eea01 100644 --- a/includes/rts/Stable.h +++ b/includes/rts/Stable.h @@ -21,19 +21,22 @@ StgStablePtr getStablePtr (StgPtr p); PRIVATE from here. -------------------------------------------------------------------------- */ -typedef struct { - StgPtr addr; /* Haskell object, free list, or NULL */ - StgPtr old; /* old Haskell object, used during GC */ - StgWord ref; /* used for reference counting */ - StgClosure *sn_obj; /* the StableName object (or NULL) */ +typedef struct { + StgPtr addr; /* Haskell object, free list, or NULL */ + StgPtr old; /* old Haskell object, used during GC */ + StgClosure *sn_obj; /* the StableName object (or NULL) */ } snEntry; -extern DLL_IMPORT_RTS snEntry *stable_ptr_table; +typedef struct { + StgPtr addr; +} spEntry; + +extern DLL_IMPORT_RTS snEntry *stable_name_table; +extern DLL_IMPORT_RTS spEntry *stable_ptr_table; EXTERN_INLINE StgPtr deRefStablePtr(StgStablePtr sp) { - ASSERT(stable_ptr_table[(StgWord)sp].ref > 0); return stable_ptr_table[(StgWord)sp].addr; } diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index eec98c2357..68c6212396 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -472,7 +472,7 @@ extern StgWord RTS_VAR(atomic_modify_mutvar_mutex); extern StgWord RTS_VAR(RtsFlags); // bogus type // Stable.c -extern StgWord RTS_VAR(stable_ptr_table); +extern StgWord RTS_VAR(stable_name_table); // Profiling.c extern unsigned int RTS_VAR(era); diff --git a/rts/Hash.c b/rts/Hash.c index 9c9b2bce42..9ab8ffb53e 100644 --- a/rts/Hash.c +++ b/rts/Hash.c @@ -392,3 +392,8 @@ exitHashTable(void) { /* nothing to do */ } + +int keyCountHashTable (HashTable *table) +{ + return table->kcount; +} diff --git a/rts/Hash.h b/rts/Hash.h index 727c04298c..d22caba555 100644 --- a/rts/Hash.h +++ b/rts/Hash.h @@ -19,6 +19,8 @@ void * lookupHashTable ( HashTable *table, StgWord key ); void insertHashTable ( HashTable *table, StgWord key, void *data ); void * removeHashTable ( HashTable *table, StgWord key, void *data ); +int keyCountHashTable (HashTable *table); + /* Hash table access where the keys are C strings (the strings are * assumed to be allocated by the caller, and mustn't be deallocated * until the corresponding hash table entry has been removed). @@ -41,7 +43,7 @@ HashTable * allocHashTable_(HashFunction *hash, CompareFunction *compare); int hashWord(HashTable *table, StgWord key); int hashStr(HashTable *table, char *key); -/* Freeing hash tables +/* Freeing hash tables */ void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) ); @@ -50,4 +52,3 @@ void exitHashTable ( void ); #include "EndPrivate.h" #endif /* HASH_H */ - diff --git a/rts/HsFFI.c b/rts/HsFFI.c index 38a520da00..856536f5aa 100644 --- a/rts/HsFFI.c +++ b/rts/HsFFI.c @@ -27,6 +27,16 @@ hs_perform_gc(void) performMajorGC(); } +void hs_lock_stable_tables (void) +{ + stableLock(); +} + +void hs_unlock_stable_tables (void) +{ + stableUnlock(); +} + void hs_free_stable_ptr(HsStablePtr sp) { @@ -36,6 +46,14 @@ hs_free_stable_ptr(HsStablePtr sp) } void +hs_free_stable_ptr_unsafe(HsStablePtr sp) +{ + /* The cast is for clarity only, both HsStablePtr and StgStablePtr are + typedefs for void*. */ + freeStablePtrUnsafe((StgStablePtr)sp); +} + +void hs_free_fun_ptr(HsFunPtr fp) { /* I simply *love* all these similar names... */ diff --git a/rts/Linker.c b/rts/Linker.c index ef4f924bca..cf4f350af1 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1112,7 +1112,10 @@ typedef struct _RtsSymbolVal { SymI_HasProto(hs_set_argv) \ SymI_HasProto(hs_add_root) \ SymI_HasProto(hs_perform_gc) \ + SymI_HasProto(hs_lock_stable_tables) \ + SymI_HasProto(hs_unlock_stable_tables) \ SymI_HasProto(hs_free_stable_ptr) \ + SymI_HasProto(hs_free_stable_ptr_unsafe) \ SymI_HasProto(hs_free_fun_ptr) \ SymI_HasProto(hs_hpc_rootModule) \ SymI_HasProto(hs_hpc_module) \ @@ -1213,6 +1216,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(startupHaskell) \ SymI_HasProto(shutdownHaskell) \ SymI_HasProto(shutdownHaskellAndExit) \ + SymI_HasProto(stable_name_table) \ SymI_HasProto(stable_ptr_table) \ SymI_HasProto(stackOverflow) \ SymI_HasProto(stg_CAF_BLACKHOLE_info) \ @@ -4113,7 +4117,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) # define R_X86_64_PC64 24 # endif -/* +/* * Workaround for libc implementations (e.g. eglibc) with incomplete * relocation lists */ @@ -4992,7 +4996,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, | (offset & 0x01fe); break; } - + case R_ARM_THM_JUMP11: { StgWord16 *word = (StgWord16 *)P; diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ebcee6a1d4..f4e80e9c35 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1,3 +1,4 @@ +/* -*- tab-width: 8 -*- */ /* ----------------------------------------------------------------------------- * * (c) The GHC Team, 1998-2012 @@ -1513,22 +1514,21 @@ stg_makeStableNamezh ( P_ obj ) { W_ index, sn_obj; - ALLOC_PRIM_P (SIZEOF_StgStableName, stg_makeStableNamezh, obj); - (index) = ccall lookupStableName(obj "ptr"); /* Is there already a StableName for this heap object? - * stable_ptr_table is a pointer to an array of snEntry structs. + * stable_name_table is a pointer to an array of snEntry structs. */ - if ( snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) == NULL ) { - sn_obj = Hp - SIZEOF_StgStableName + WDS(1); - SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); - StgStableName_sn(sn_obj) = index; - snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) = sn_obj; + if ( snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) == NULL ) { + ALLOC_PRIM (SIZEOF_StgStableName); + sn_obj = Hp - SIZEOF_StgStableName + WDS(1); + SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); + StgStableName_sn(sn_obj) = index; + snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj; } else { - sn_obj = snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry); + sn_obj = snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry); } - + return (sn_obj); } @@ -1543,7 +1543,7 @@ stg_makeStablePtrzh ( P_ obj ) stg_deRefStablePtrzh ( P_ sp ) { W_ r; - r = snEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_snEntry); + r = spEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_spEntry); return (r); } diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 44df06a40d..4e7ed3e222 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -1772,7 +1772,7 @@ computeRetainerSet( void ) retainRoot(NULL, (StgClosure **)&weak); // Consider roots from the stable ptr table. - markStablePtrTable(retainRoot, NULL); + markStableTables(retainRoot, NULL); // The following code resets the rs field of each unvisited mutable // object (computing sumOfNewCostExtra and updating costArray[] when diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index f5c29f4a70..e83d047695 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -185,7 +185,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) initStorage(); /* initialise the stable pointer table */ - initStablePtrTable(); + initStableTables(); /* Add some GC roots for things in the base package that the RTS * knows about. We don't know whether these turn out to be CAFs @@ -377,7 +377,7 @@ hs_exit_(rtsBool wait_foreign) freeFileLocking(); /* free the stable pointer table */ - exitStablePtrTable(); + exitStableTables(); #if defined(DEBUG) /* free the thread label table */ diff --git a/rts/Stable.c b/rts/Stable.c index 39b26173d8..ff3843ecd7 100644 --- a/rts/Stable.c +++ b/rts/Stable.c @@ -1,3 +1,5 @@ +/* -*- tab-width: 4 -*- */ + /* ----------------------------------------------------------------------------- * * (c) The GHC Team, 1998-2002 @@ -53,6 +55,11 @@ it will produce. For example, this is used when interfacing to an X widgets library to allow a direct implementation of callbacks. + One final reason is that we may want to store composite Haskell + values in data structures implemented in the C side. Serializing and + deserializing these structures into unboxed form suitable for C may + be more expensive than maintaining the extra layer of indirection of + stable pointers. The @makeStablePointer :: a -> IO (StablePtr a)@ function converts a value into a stable pointer. It is part of the @PrimIO@ @@ -62,24 +69,38 @@ \begin{verbatim} makeStablePtr# :: a -> State# RealWorld -> (# RealWorld, a #) freeStablePtr# :: StablePtr# a -> State# RealWorld -> State# RealWorld - deRefStablePtr# :: StablePtr# a -> State# RealWorld -> + deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) \end{verbatim} There may be additional functions on the C side to allow evaluation, application, etc of a stable pointer. + Stable Pointers are exported to the outside world as indices and not + pointers, because the stable pointer table is allowed to be + reallocated for growth. The table is never shrunk for its space to + be reclaimed. + + Future plans for stable ptrs include distinguishing them by the + generation of the pointed object. See + http://hackage.haskell.org/trac/ghc/ticket/7670 for details. */ -snEntry *stable_ptr_table = NULL; -static snEntry *stable_ptr_free = NULL; +snEntry *stable_name_table = NULL; +static snEntry *stable_name_free = NULL; +static unsigned int SNT_size = 0; +#define INIT_SNT_SIZE 64 +spEntry *stable_ptr_table = NULL; +static spEntry *stable_ptr_free = NULL; static unsigned int SPT_size = 0; +#define INIT_SPT_SIZE 64 #ifdef THREADED_RTS Mutex stable_mutex; #endif +static void enlargeStableNameTable(void); static void enlargeStablePtrTable(void); /* This hash table maps Haskell objects to stable names, so that every @@ -117,57 +138,74 @@ static void enlargeStablePtrTable(void); static HashTable *addrToStableHash = NULL; -#define INIT_SPT_SIZE 64 - STATIC_INLINE void -initFreeList(snEntry *table, nat n, snEntry *free) +initSnEntryFreeList(snEntry *table, nat n, snEntry *free) { snEntry *p; - for (p = table + n - 1; p >= table; p--) { p->addr = (P_)free; p->old = NULL; - p->ref = 0; p->sn_obj = NULL; free = p; } + stable_name_free = table; +} + +STATIC_INLINE void +initSpEntryFreeList(spEntry *table, nat n, spEntry *free) +{ + spEntry *p; + for (p = table + n - 1; p >= table; p--) { + p->addr = (P_)free; + free = p; + } stable_ptr_free = table; } void -initStablePtrTable(void) +initStableTables(void) { - if (SPT_size > 0) - return; - - SPT_size = INIT_SPT_SIZE; - stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry), - "initStablePtrTable"); - + if (SNT_size > 0) return; + SNT_size = INIT_SNT_SIZE; + stable_name_table = stgMallocBytes(SNT_size * sizeof *stable_name_table, + "initStableNameTable"); /* 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); + initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL); addrToStableHash = allocHashTable(); + if (SPT_size > 0) return; + SPT_size = INIT_SPT_SIZE; + stable_ptr_table = stgMallocBytes(SPT_size * sizeof *stable_ptr_table, + "initStablePtrTable"); + initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL); + #ifdef THREADED_RTS initMutex(&stable_mutex); #endif } void -exitStablePtrTable(void) +exitStableTables(void) { - if (addrToStableHash) - freeHashTable(addrToStableHash, NULL); - addrToStableHash = NULL; - if (stable_ptr_table) - stgFree(stable_ptr_table); - stable_ptr_table = NULL; - SPT_size = 0; + if (addrToStableHash) + freeHashTable(addrToStableHash, NULL); + addrToStableHash = NULL; + + if (stable_name_table) + stgFree(stable_name_table); + stable_name_table = NULL; + SNT_size = 0; + + if (stable_ptr_table) + stgFree(stable_ptr_table); + stable_ptr_table = NULL; + SPT_size = 0; + #ifdef THREADED_RTS - closeMutex(&stable_mutex); + closeMutex(&stable_mutex); #endif } @@ -203,8 +241,8 @@ lookupStableName_(StgPtr p) StgWord sn; void* sn_tmp; - if (stable_ptr_free == NULL) { - enlargeStablePtrTable(); + if (stable_name_free == NULL) { + enlargeStableNameTable(); } /* removing indirections increases the likelihood @@ -217,24 +255,23 @@ lookupStableName_(StgPtr p) sn_tmp = lookupHashTable(addrToStableHash,(W_)p); sn = (StgWord)sn_tmp; - + if (sn != 0) { - ASSERT(stable_ptr_table[sn].addr == p); + ASSERT(stable_name_table[sn].addr == p); debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p); return sn; - } else { - sn = stable_ptr_free - stable_ptr_table; - 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; - /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */ - - /* add the new stable name to the hash table */ - insertHashTable(addrToStableHash, (W_)p, (void *)sn); - - return sn; } + + sn = stable_name_free - stable_name_table; + stable_name_free = (snEntry*)(stable_name_free->addr); + stable_name_table[sn].addr = p; + stable_name_table[sn].sn_obj = NULL; + /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */ + + /* add the new stable name to the hash table */ + insertHashTable(addrToStableHash, (W_)p, (void *)sn); + + return sn; } StgWord @@ -242,7 +279,7 @@ lookupStableName(StgPtr p) { StgWord res; - initStablePtrTable(); + initStableTables(); ACQUIRE_LOCK(&stable_mutex); res = lookupStableName_(p); RELEASE_LOCK(&stable_mutex); @@ -250,66 +287,85 @@ lookupStableName(StgPtr p) } STATIC_INLINE void -freeStableName(snEntry *sn) +freeSnEntry(snEntry *sn) { ASSERT(sn->sn_obj == NULL); - if (sn->addr != NULL) { + if(sn->addr != NULL) { + /* StableName object may die before pointee, in which case we + * need to remove from hash table, or after pointee, in which + * case addr==NULL and we already removed it. */ removeHashTable(addrToStableHash, (W_)sn->addr, NULL); } - sn->addr = (P_)stable_ptr_free; - stable_ptr_free = sn; + sn->addr = (P_)stable_name_free; + stable_name_free = sn; +} + +STATIC_INLINE void +freeSpEntry(spEntry *sp) +{ + sp->addr = (P_)stable_ptr_free; + stable_ptr_free = sp; } StgStablePtr getStablePtr(StgPtr p) { - StgWord sn; + StgWord sp; - initStablePtrTable(); + initStableTables(); ACQUIRE_LOCK(&stable_mutex); - sn = lookupStableName_(p); - stable_ptr_table[sn].ref++; + if (!stable_ptr_free) enlargeStablePtrTable(); + sp = stable_ptr_free - stable_ptr_table; + stable_ptr_free = (spEntry*)(stable_ptr_free->addr); + stable_ptr_table[sp].addr = p; RELEASE_LOCK(&stable_mutex); - return (StgStablePtr)(sn); + return (StgStablePtr)(sp); } void -freeStablePtr(StgStablePtr sp) +freeStablePtrUnsafe(StgStablePtr sp) { - snEntry *sn; + ASSERT((StgWord)sp < SPT_size); + freeSpEntry(&stable_ptr_table[(StgWord)sp]); +} - initStablePtrTable(); +void +freeStablePtr(StgStablePtr sp) +{ + initStableTables(); ACQUIRE_LOCK(&stable_mutex); + freeStablePtrUnsafe(sp); + RELEASE_LOCK(&stable_mutex); +} - sn = &stable_ptr_table[(StgWord)sp]; - - ASSERT((StgWord)sp < SPT_size && sn->addr != NULL && sn->ref > 0); - - sn->ref--; +static void +enlargeStableNameTable(void) +{ + nat old_SNT_size = SNT_size; - // 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); - } + // 2nd and subsequent times + SNT_size *= 2; + stable_name_table = + stgReallocBytes(stable_name_table, + SNT_size * sizeof *stable_name_table, + "enlargeStableNameTable"); - RELEASE_LOCK(&stable_mutex); + initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL); } static void enlargeStablePtrTable(void) { - nat old_SPT_size = SPT_size; + nat old_SPT_size = SPT_size; // 2nd and subsequent times - SPT_size *= 2; - stable_ptr_table = - stgReallocBytes(stable_ptr_table, - SPT_size * sizeof(snEntry), - "enlargeStablePtrTable"); + SPT_size *= 2; + stable_ptr_table = + stgReallocBytes(stable_ptr_table, + SPT_size * sizeof *stable_ptr_table, + "enlargeStablePtrTable"); - initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); + initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); } /* ----------------------------------------------------------------------------- @@ -318,82 +374,110 @@ enlargeStablePtrTable(void) * -------------------------------------------------------------------------- */ void -stablePtrPreGC(void) +stableLock(void) { + initStableTables(); ACQUIRE_LOCK(&stable_mutex); } void -stablePtrPostGC(void) +stableUnlock(void) { RELEASE_LOCK(&stable_mutex); } /* ----------------------------------------------------------------------------- * Treat stable pointers as roots for the garbage collector. - * - * 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 +#define FOR_EACH_STABLE_PTR(p, CODE) \ + do { \ + spEntry *p; \ + spEntry *__end_ptr = &stable_ptr_table[SPT_size]; \ + for (p = stable_ptr_table; p < __end_ptr; p++) { \ + /* Internal pointers are free slots. NULL is last in free */ \ + /* list. */ \ + if (p->addr && \ + (p->addr < (P_)stable_ptr_table || p->addr >= (P_)__end_ptr)) \ + { \ + do { CODE } while(0); \ + } \ + } \ + } while(0) + +#define FOR_EACH_STABLE_NAME(p, CODE) \ + do { \ + snEntry *p; \ + snEntry *__end_ptr = &stable_name_table[SNT_size]; \ + for (p = stable_name_table + 1; p < __end_ptr; p++) { \ + /* Internal pointers are free slots. */ \ + /* If p->addr == NULL, it's a */ \ + /* stable name where the object has been GC'd, but the */ \ + /* StableName object (sn_obj) is still alive. */ \ + if ((p->addr < (P_)stable_name_table || \ + p->addr >= (P_)__end_ptr)) \ + { \ + /* NOTE: There is an ambiguity here if p->addr == NULL */ \ + /* it is either the last item in the free list or it */ \ + /* is a stable name whose pointee died. sn_obj == NULL */ \ + /* disambiguates as last free list item. */ \ + do { CODE } while(0); \ + } \ + } \ + } while(0) + +STATIC_INLINE void markStablePtrTable(evac_fn evac, void *user) { - 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(user, (StgClosure **)&p->addr); - } - } - } + FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); +} + +STATIC_INLINE void +rememberOldStableNameAddresses(void) +{ + /* TODO: Only if !full GC */ + FOR_EACH_STABLE_NAME(p, p->old = p->addr;); +} + +void +markStableTables(evac_fn evac, void *user) +{ + markStablePtrTable(evac, user); + rememberOldStableNameAddresses(); } /* ----------------------------------------------------------------------------- * 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 + * the heap from the stable tables, because the compacting * collector may move the object it points to. * -------------------------------------------------------------------------- */ -void +STATIC_INLINE void +threadStableNameTable( evac_fn evac, void *user ) +{ + FOR_EACH_STABLE_NAME(p, { + if (p->sn_obj != NULL) { + evac(user, (StgClosure **)&p->sn_obj); + } + if (p->addr != NULL) { + evac(user, (StgClosure **)&p->addr); + } + }); +} + +STATIC_INLINE void threadStablePtrTable( evac_fn evac, void *user ) { - 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(user, (StgClosure **)&p->sn_obj); - } - - q = p->addr; - if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { - evac(user, (StgClosure **)&p->addr); - } - } + FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); +} + +void +threadStableTables( evac_fn evac, void *user ) +{ + threadStableNameTable(evac, user); + threadStablePtrTable(evac, user); } /* ----------------------------------------------------------------------------- @@ -411,49 +495,41 @@ threadStablePtrTable( evac_fn evac, void *user ) * -------------------------------------------------------------------------- */ void -gcStablePtrTable( void ) +gcStableTables( 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); - 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", - (long)(p - stable_ptr_table), p->addr, p->ref); - } - } - } - } + FOR_EACH_STABLE_NAME( + p, { + // Update the pointer to the StableName object, if there is one + if (p->sn_obj != NULL) { + p->sn_obj = isAlive(p->sn_obj); + if(p->sn_obj == NULL) { + // StableName object died + debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)", + (long)(p - stable_name_table), p->addr); + freeSnEntry(p); + /* Can't "continue", so use goto */ + goto next_stable_name; + } + } + /* If sn_obj became NULL, the object died, and addr is now + * invalid. But if sn_obj was null, then the StableName + * object may not have been created yet, while the pointee + * already exists and must be updated to new location. */ + if (p->addr != NULL) { + p->addr = (StgPtr)isAlive((StgClosure *)p->addr); + if(p->addr == NULL) { + // StableName pointee died + debugTrace(DEBUG_stable, "GC'd pointee %ld", + (long)(p - stable_name_table)); + } + } + next_stable_name: + if (0) {} + }); } /* ----------------------------------------------------------------------------- - * Update the StablePtr/StableName hash table + * Update the 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 @@ -462,39 +538,31 @@ gcStablePtrTable( void ) * -------------------------------------------------------------------------- */ void -updateStablePtrTable(rtsBool full) +updateStableTables(rtsBool full) { - snEntry *p, *end_stable_ptr_table; - - if (full && addrToStableHash != NULL) { - freeHashTable(addrToStableHash,NULL); - addrToStableHash = allocHashTable(); + if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) { + freeHashTable(addrToStableHash,NULL); + addrToStableHash = allocHashTable(); } - - 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->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_)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)); - } - } + + if(full) { + FOR_EACH_STABLE_NAME( + p, { + if (p->addr != NULL) { + // Target still alive, Re-hash this stable name + insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table)); + } + }); + } else { + FOR_EACH_STABLE_NAME( + p, { + if (p->addr != p->old) { + removeHashTable(addrToStableHash, (W_)p->old, NULL); + /* Movement happened: */ + if (p->addr != NULL) { + insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table)); + } + } + }); } } diff --git a/rts/Stable.h b/rts/Stable.h index bec932af97..4786d477f3 100644 --- a/rts/Stable.h +++ b/rts/Stable.h @@ -21,17 +21,28 @@ void freeStablePtr ( StgStablePtr sp ); -void initStablePtrTable ( void ); -void exitStablePtrTable ( void ); -StgWord lookupStableName ( StgPtr p ); +/* Use the "Unsafe" one after manually locking with stableLock/stableUnlock */ +void freeStablePtrUnsafe ( StgStablePtr sp ); -void markStablePtrTable ( evac_fn evac, void *user ); -void threadStablePtrTable ( evac_fn evac, void *user ); -void gcStablePtrTable ( void ); -void updateStablePtrTable ( rtsBool full ); +void initStableTables ( void ); +void exitStableTables ( void ); +StgWord lookupStableName ( StgPtr p ); -void stablePtrPreGC ( void ); -void stablePtrPostGC ( void ); +/* Call given function on every stable ptr. markStableTables depends + * on the function updating its pointers in case the object is + * moved. */ +/* TODO: This also remembers old stable name addresses, which isn't + * necessary in some contexts markStableTables is called from. + * Consider splitting it. + */ +void markStableTables ( evac_fn evac, void *user ); + +void threadStableTables ( evac_fn evac, void *user ); +void gcStableTables ( void ); +void updateStableTables ( rtsBool full ); + +void stableLock ( void ); +void stableUnlock ( void ); #ifdef THREADED_RTS // needed by Schedule.c:forkProcess() diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index 02183c6946..7c89418ab9 100644 --- a/rts/sm/Compact.c +++ b/rts/sm/Compact.c @@ -964,7 +964,7 @@ compact(StgClosure *static_objects) thread_static(static_objects /* ToDo: ok? */); // the stable pointer table - threadStablePtrTable((evac_fn)thread_root, NULL); + threadStableTables((evac_fn)thread_root, NULL); // the CAF list (used by GHCi) markCAFs((evac_fn)thread_root, NULL); diff --git a/rts/sm/GC.c b/rts/sm/GC.c index ea0e4030bd..dfebd55334 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -220,7 +220,7 @@ GarbageCollect (nat collect_gen, stat_startGC(cap, gct); // lock the StablePtr table - stablePtrPreGC(); + stableLock(); #ifdef DEBUG mutlist_MUTVARS = 0; @@ -390,7 +390,7 @@ GarbageCollect (nat collect_gen, initWeakForGC(); // Mark the stable pointer table. - markStablePtrTable(mark_root, gct); + markStableTables(mark_root, gct); /* ------------------------------------------------------------------------- * Repeatedly scavenge all the areas we know about until there's no @@ -420,7 +420,7 @@ GarbageCollect (nat collect_gen, shutdown_gc_threads(gct->thread_index); // Now see which stable names are still alive. - gcStablePtrTable(); + gcStableTables(); #ifdef THREADED_RTS if (n_gc_threads == 1) { @@ -698,15 +698,15 @@ GarbageCollect (nat collect_gen, } // Update the stable pointer hash table. - updateStablePtrTable(major_gc); + updateStableTables(major_gc); // unlock the StablePtr table. Must be before scheduleFinalizers(), // because a finalizer may call hs_free_fun_ptr() or // hs_free_stable_ptr(), both of which access the StablePtr table. - stablePtrPostGC(); + stableUnlock(); // Start any pending finalizers. Must be after - // updateStablePtrTable() and stablePtrPostGC() (see #4221). + // updateStableTables() and stableUnlock() (see #4221). RELEASE_SM_LOCK; scheduleFinalizers(cap, old_weak_ptr_list); ACQUIRE_SM_LOCK; diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs index e726bf7e0e..77daf5c790 100644 --- a/utils/deriveConstants/DeriveConstants.hs +++ b/utils/deriveConstants/DeriveConstants.hs @@ -536,6 +536,9 @@ wanteds = concat ,structField C "snEntry" "sn_obj" ,structField C "snEntry" "addr" + ,structSize C "spEntry" + ,structField C "spEntry" "addr" + -- Note that this conditional part only affects the C headers. -- That's important, as it means we get the same PlatformConstants -- type on all platforms. |