diff options
Diffstat (limited to 'rts')
| -rw-r--r-- | rts/Adjustor.c | 2 | ||||
| -rw-r--r-- | rts/Globals.c | 2 | ||||
| -rw-r--r-- | rts/HsFFI.c | 20 | ||||
| -rw-r--r-- | rts/Interpreter.c | 2 | ||||
| -rw-r--r-- | rts/Linker.c | 2 | ||||
| -rw-r--r-- | rts/RetainerProfile.c | 7 | ||||
| -rw-r--r-- | rts/RtsAPI.c | 2 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 13 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 2 | ||||
| -rw-r--r-- | rts/Schedule.c | 12 | ||||
| -rw-r--r-- | rts/StableName.c (renamed from rts/Stable.c) | 287 | ||||
| -rw-r--r-- | rts/StableName.h | 31 | ||||
| -rw-r--r-- | rts/StablePtr.c | 329 | ||||
| -rw-r--r-- | rts/StablePtr.h (renamed from rts/Stable.h) | 27 | ||||
| -rw-r--r-- | rts/StaticPtrTable.c | 2 | ||||
| -rw-r--r-- | rts/TopHandler.c | 2 | ||||
| -rw-r--r-- | rts/TopHandler.h | 1 | ||||
| -rw-r--r-- | rts/posix/Signals.c | 1 | ||||
| -rw-r--r-- | rts/rts.cabal.in | 6 | ||||
| -rw-r--r-- | rts/sm/Compact.c | 8 | ||||
| -rw-r--r-- | rts/sm/GC.c | 23 |
21 files changed, 465 insertions, 316 deletions
diff --git a/rts/Adjustor.c b/rts/Adjustor.c index a1bfeb96b7..476d63140e 100644 --- a/rts/Adjustor.c +++ b/rts/Adjustor.c @@ -40,7 +40,7 @@ Haskell side. #include "Rts.h" #include "RtsUtils.h" -#include "Stable.h" +#include "StablePtr.h" #if defined(USE_LIBFFI_FOR_ADJUSTORS) #include "ffi.h" diff --git a/rts/Globals.c b/rts/Globals.c index 66c17d0f96..c9980d9a3a 100644 --- a/rts/Globals.c +++ b/rts/Globals.c @@ -21,7 +21,7 @@ #include "Rts.h" #include "Globals.h" -#include "Stable.h" +#include "StablePtr.h" typedef enum { GHCConcSignalSignalHandlerStore, diff --git a/rts/HsFFI.c b/rts/HsFFI.c index 8fae246111..e482932193 100644 --- a/rts/HsFFI.c +++ b/rts/HsFFI.c @@ -10,7 +10,7 @@ #include "HsFFI.h" #include "Rts.h" -#include "Stable.h" +#include "StablePtr.h" #include "Task.h" // hs_init and hs_exit are defined in RtsStartup.c @@ -28,14 +28,28 @@ hs_perform_gc(void) performMajorGC(); } +// Lock the stable pointer table +void hs_lock_stable_ptr_table (void) +{ + stablePtrLock(); +} + +// Deprecated version of hs_lock_stable_ptr_table void hs_lock_stable_tables (void) { - stableLock(); + stablePtrLock(); +} + +// Unlock the stable pointer table +void hs_unlock_stable_ptr_table (void) +{ + stablePtrUnlock(); } +// Deprecated version of hs_unlock_stable_ptr_table void hs_unlock_stable_tables (void) { - stableUnlock(); + stablePtrUnlock(); } void diff --git a/rts/Interpreter.c b/rts/Interpreter.c index 9eb6560a8c..a3b179a4be 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -16,7 +16,7 @@ #include "Schedule.h" #include "Updates.h" #include "Prelude.h" -#include "Stable.h" +#include "StablePtr.h" #include "Printer.h" #include "Profiling.h" #include "Disassembler.h" diff --git a/rts/Linker.c b/rts/Linker.c index aa6ec7fe7a..934b90782d 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -22,7 +22,7 @@ #include "StgPrimFloat.h" // for __int_encodeFloat etc. #include "Proftimer.h" #include "GetEnv.h" -#include "Stable.h" +#include "StablePtr.h" #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 8a64de9e14..d67eeb4834 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -30,7 +30,8 @@ #include "Stats.h" #include "ProfHeap.h" #include "Apply.h" -#include "Stable.h" /* markStableTables */ +#include "StablePtr.h" /* markStablePtrTable */ +#include "StableName.h" /* rememberOldStableNameAddresses */ #include "sm/Storage.h" // for END_OF_STATIC_LIST /* Note [What is a retainer?] @@ -1693,7 +1694,9 @@ computeRetainerSet( void ) } // Consider roots from the stable ptr table. - markStableTables(retainRoot, NULL); + markStablePtrTable(retainRoot, NULL); + // Remember old stable name addresses. + rememberOldStableNameAddresses (); // The following code resets the rs field of each unvisited mutable // object (computing sumOfNewCostExtra and updating costArray[] when diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index 8fd1917392..9396dccc07 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -15,7 +15,7 @@ #include "Prelude.h" #include "Schedule.h" #include "Capability.h" -#include "Stable.h" +#include "StablePtr.h" #include "Threads.h" #include "Weak.h" diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 0cb1ff9700..5e5aef3505 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -26,7 +26,8 @@ #include "ThreadLabels.h" #include "sm/BlockAlloc.h" #include "Trace.h" -#include "Stable.h" +#include "StableName.h" +#include "StablePtr.h" #include "StaticPtrTable.h" #include "Hash.h" #include "Profiling.h" @@ -243,7 +244,10 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) initStorage(); /* initialise the stable pointer table */ - initStableTables(); + initStablePtrTable(); + + /* initialise the stable name table */ + initStableNameTable(); /* 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 @@ -451,7 +455,10 @@ hs_exit_(bool wait_foreign) exitTopHandler(); /* free the stable pointer table */ - exitStableTables(); + exitStablePtrTable(); + + /* free the stable name table */ + exitStableNameTable(); #if defined(DEBUG) /* free the thread label table */ diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index 79ab3f1d12..5091c90dad 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -615,6 +615,8 @@ SymI_HasProto(hs_exit_nowait) \ SymI_HasProto(hs_set_argv) \ SymI_HasProto(hs_perform_gc) \ + SymI_HasProto(hs_lock_stable_ptr_table) \ + SymI_HasProto(hs_unlock_stable_ptr_table) \ SymI_HasProto(hs_lock_stable_tables) \ SymI_HasProto(hs_unlock_stable_tables) \ SymI_HasProto(hs_free_stable_ptr) \ diff --git a/rts/Schedule.c b/rts/Schedule.c index cf975b51dd..0444f0ca15 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -41,7 +41,8 @@ #include "Timer.h" #include "ThreadPaused.h" #include "Messages.h" -#include "Stable.h" +#include "StablePtr.h" +#include "StableName.h" #include "TopHandler.h" #if defined(HAVE_SYS_TYPES_H) @@ -1964,7 +1965,8 @@ forkProcess(HsStablePtr *entry // inconsistent state in the child. See also #1391. ACQUIRE_LOCK(&sched_mutex); ACQUIRE_LOCK(&sm_mutex); - ACQUIRE_LOCK(&stable_mutex); + ACQUIRE_LOCK(&stable_ptr_mutex); + ACQUIRE_LOCK(&stable_name_mutex); ACQUIRE_LOCK(&task->lock); for (i=0; i < n_capabilities; i++) { @@ -1989,7 +1991,8 @@ forkProcess(HsStablePtr *entry RELEASE_LOCK(&sched_mutex); RELEASE_LOCK(&sm_mutex); - RELEASE_LOCK(&stable_mutex); + RELEASE_LOCK(&stable_ptr_mutex); + RELEASE_LOCK(&stable_name_mutex); RELEASE_LOCK(&task->lock); #if defined(THREADED_RTS) @@ -2012,7 +2015,8 @@ forkProcess(HsStablePtr *entry #if defined(THREADED_RTS) initMutex(&sched_mutex); initMutex(&sm_mutex); - initMutex(&stable_mutex); + initMutex(&stable_ptr_mutex); + initMutex(&stable_name_mutex); initMutex(&task->lock); for (i=0; i < n_capabilities; i++) { diff --git a/rts/Stable.c b/rts/StableName.c index 71eaf1a242..abe7b692e0 100644 --- a/rts/Stable.c +++ b/rts/StableName.c @@ -4,7 +4,7 @@ * * (c) The GHC Team, 1998-2002 * - * Stable names and stable pointers. + * Stable names * * ---------------------------------------------------------------------------*/ @@ -15,112 +15,20 @@ #include "Hash.h" #include "RtsUtils.h" #include "Trace.h" -#include "Stable.h" +#include "StableName.h" #include <string.h> -/* Comment from ADR's implementation in old RTS: - - This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a - small change in @HpOverflow.lc@) consists of the changes in the - runtime system required to implement "Stable Pointers". But we're - getting a bit ahead of ourselves --- what is a stable pointer and what - is it used for? - - 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. - - - Of course, all this rather begs the question: why would we want to - pass a boxed value? - - One very good reason is to preserve laziness across the language - interface. Rather than evaluating an integer or a string because it - {\em might\/} be required by the C function, we can wait until the C - function actually wants the value and then force an evaluation. - - Another very good reason (the motivating reason!) is that the C code - might want to execute an object of sort $IO ()$ for the side-effects - 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@ - monad, because we want to be sure we don't allocate one twice by - accident, and then only free one of the copies. - - \begin{verbatim} - makeStablePtr# :: a -> State# RealWorld -> (# RealWorld, a #) - freeStablePtr# :: StablePtr# a -> State# RealWorld -> 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://ghc.haskell.org/trac/ghc/ticket/7670 for details. -*/ - 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 - -/* Each time the stable pointer table is enlarged, we temporarily retain the old - * version to ensure dereferences are thread-safe (see Note [Enlarging the - * stable pointer table]). Since we double the size of the table each time, we - * can (theoretically) enlarge it at most N times on an N-bit machine. Thus, - * there will never be more than N old versions of the table. - */ -#if SIZEOF_VOID_P == 4 -#define MAX_N_OLD_SPTS 32 -#elif SIZEOF_VOID_P == 8 -#define MAX_N_OLD_SPTS 64 -#else -#error unknown SIZEOF_VOID_P -#endif - -static spEntry *old_SPTs[MAX_N_OLD_SPTS]; -static uint32_t n_old_SPTs = 0; - #if defined(THREADED_RTS) -Mutex stable_mutex; +Mutex stable_name_mutex; #endif static void enlargeStableNameTable(void); -static void enlargeStablePtrTable(void); /* * This hash table maps Haskell objects to stable names, so that every @@ -130,26 +38,21 @@ static void enlargeStablePtrTable(void); static HashTable *addrToStableHash = NULL; -/* ----------------------------------------------------------------------------- - * We must lock the StablePtr table during GC, to prevent simultaneous - * calls to freeStablePtr(). - * -------------------------------------------------------------------------- */ - void -stableLock(void) +stableNameLock(void) { - initStableTables(); - ACQUIRE_LOCK(&stable_mutex); + initStableNameTable(); + ACQUIRE_LOCK(&stable_name_mutex); } void -stableUnlock(void) +stableNameUnlock(void) { - RELEASE_LOCK(&stable_mutex); + RELEASE_LOCK(&stable_name_mutex); } /* ----------------------------------------------------------------------------- - * Initialising the tables + * Initialising the table * -------------------------------------------------------------------------- */ STATIC_INLINE void @@ -165,19 +68,8 @@ initSnEntryFreeList(snEntry *table, uint32_t n, snEntry *free) stable_name_free = table; } -STATIC_INLINE void -initSpEntryFreeList(spEntry *table, uint32_t n, spEntry *free) -{ - spEntry *p; - for (p = table + n - 1; p >= table; p--) { - p->addr = (P_)free; - free = p; - } - stable_ptr_free = table; -} - void -initStableTables(void) +initStableNameTable(void) { if (SNT_size > 0) return; SNT_size = INIT_SNT_SIZE; @@ -190,14 +82,8 @@ initStableTables(void) 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(spEntry), - "initStablePtrTable"); - initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL); - #if defined(THREADED_RTS) - initMutex(&stable_mutex); + initMutex(&stable_name_mutex); #endif } @@ -220,37 +106,6 @@ enlargeStableNameTable(void) initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL); } -// Must be holding stable_mutex -static void -enlargeStablePtrTable(void) -{ - uint32_t old_SPT_size = SPT_size; - spEntry *new_stable_ptr_table; - - // 2nd and subsequent times - SPT_size *= 2; - - /* We temporarily retain the old version instead of freeing it; see Note - * [Enlarging the stable pointer table]. - */ - new_stable_ptr_table = - stgMallocBytes(SPT_size * sizeof(spEntry), - "enlargeStablePtrTable"); - memcpy(new_stable_ptr_table, - stable_ptr_table, - old_SPT_size * sizeof(spEntry)); - ASSERT(n_old_SPTs < MAX_N_OLD_SPTS); - old_SPTs[n_old_SPTs++] = stable_ptr_table; - - /* When using the threaded RTS, the update of stable_ptr_table is assumed to - * be atomic, so that another thread simultaneously dereferencing a stable - * pointer will always read a valid address. - */ - stable_ptr_table = new_stable_ptr_table; - - initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); -} - /* Note [Enlarging the stable pointer table] * * To enlarge the stable pointer table, we allocate a new table, copy the @@ -271,19 +126,8 @@ enlargeStablePtrTable(void) * Freeing entries and tables * -------------------------------------------------------------------------- */ -static void -freeOldSPTs(void) -{ - uint32_t i; - - for (i = 0; i < n_old_SPTs; i++) { - stgFree(old_SPTs[i]); - } - n_old_SPTs = 0; -} - void -exitStableTables(void) +exitStableNameTable(void) { if (addrToStableHash) freeHashTable(addrToStableHash, NULL); @@ -294,15 +138,8 @@ exitStableTables(void) stable_name_table = NULL; SNT_size = 0; - if (stable_ptr_table) - stgFree(stable_ptr_table); - stable_ptr_table = NULL; - SPT_size = 0; - - freeOldSPTs(); - #if defined(THREADED_RTS) - closeMutex(&stable_mutex); + closeMutex(&stable_name_mutex); #endif } @@ -315,28 +152,6 @@ freeSnEntry(snEntry *sn) stable_name_free = sn; } -STATIC_INLINE void -freeSpEntry(spEntry *sp) -{ - sp->addr = (P_)stable_ptr_free; - stable_ptr_free = sp; -} - -void -freeStablePtrUnsafe(StgStablePtr sp) -{ - ASSERT((StgWord)sp < SPT_size); - freeSpEntry(&stable_ptr_table[(StgWord)sp]); -} - -void -freeStablePtr(StgStablePtr sp) -{ - stableLock(); - freeStablePtrUnsafe(sp); - stableUnlock(); -} - /* ----------------------------------------------------------------------------- * Looking up * -------------------------------------------------------------------------- */ @@ -377,7 +192,7 @@ removeIndirections (StgClosure* p) StgWord lookupStableName (StgPtr p) { - stableLock(); + stableNameLock(); if (stable_name_free == NULL) { enlargeStableNameTable(); @@ -396,7 +211,7 @@ lookupStableName (StgPtr p) if (sn != 0) { ASSERT(stable_name_table[sn].addr == p); debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p); - stableUnlock(); + stableNameUnlock(); return sn; } @@ -409,44 +224,15 @@ lookupStableName (StgPtr p) /* add the new stable name to the hash table */ insertHashTable(addrToStableHash, (W_)p, (void *)sn); - stableUnlock(); + stableNameUnlock(); return sn; } -StgStablePtr -getStablePtr(StgPtr p) -{ - StgWord sp; - - stableLock(); - 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; - stableUnlock(); - return (StgStablePtr)(sp); -} - /* ----------------------------------------------------------------------------- - * Treat stable pointers as roots for the garbage collector. + * Remember old stable name addresses * -------------------------------------------------------------------------- */ -#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; \ @@ -468,31 +254,13 @@ getStablePtr(StgPtr p) } \ } while(0) -STATIC_INLINE void -markStablePtrTable(evac_fn evac, void *user) -{ - FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); -} - -STATIC_INLINE void +void rememberOldStableNameAddresses(void) { /* TODO: Only if !full GC */ FOR_EACH_STABLE_NAME(p, p->old = p->addr;); } -void -markStableTables(evac_fn evac, void *user) -{ - /* Since no other thread can currently be dereferencing a stable pointer, it - * is safe to free the old versions of the table. - */ - freeOldSPTs(); - - markStablePtrTable(evac, user); - rememberOldStableNameAddresses(); -} - /* ----------------------------------------------------------------------------- * Thread the stable pointer table for compacting GC. * @@ -501,7 +269,7 @@ markStableTables(evac_fn evac, void *user) * collector may move the object it points to. * -------------------------------------------------------------------------- */ -STATIC_INLINE void +void threadStableNameTable( evac_fn evac, void *user ) { FOR_EACH_STABLE_NAME(p, { @@ -514,19 +282,6 @@ threadStableNameTable( evac_fn evac, void *user ) }); } -STATIC_INLINE void -threadStablePtrTable( evac_fn evac, void *user ) -{ - FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); -} - -void -threadStableTables( evac_fn evac, void *user ) -{ - threadStableNameTable(evac, user); - threadStablePtrTable(evac, user); -} - /* ----------------------------------------------------------------------------- * Garbage collect any dead entries in the stable name table. * @@ -542,7 +297,7 @@ threadStableTables( evac_fn evac, void *user ) * -------------------------------------------------------------------------- */ void -gcStableTables( void ) +gcStableNameTable( void ) { FOR_EACH_STABLE_NAME( p, { @@ -579,7 +334,7 @@ gcStableTables( void ) * -------------------------------------------------------------------------- */ void -updateStableTables(bool full) +updateStableNameTable(bool full) { if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) { freeHashTable(addrToStableHash,NULL); diff --git a/rts/StableName.h b/rts/StableName.h new file mode 100644 index 0000000000..6b5e551add --- /dev/null +++ b/rts/StableName.h @@ -0,0 +1,31 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "sm/GC.h" // for evac_fn below + +#include "BeginPrivate.h" + +void initStableNameTable ( void ); +void exitStableNameTable ( void ); +StgWord lookupStableName ( StgPtr p ); + +void rememberOldStableNameAddresses ( void ); + +void threadStableNameTable ( evac_fn evac, void *user ); +void gcStableNameTable ( void ); +void updateStableNameTable ( bool full ); + +void stableNameLock ( void ); +void stableNameUnlock ( void ); + +#if defined(THREADED_RTS) +// needed by Schedule.c:forkProcess() +extern Mutex stable_name_mutex; +#endif + +#include "EndPrivate.h" diff --git a/rts/StablePtr.c b/rts/StablePtr.c new file mode 100644 index 0000000000..0f53ffcdc4 --- /dev/null +++ b/rts/StablePtr.c @@ -0,0 +1,329 @@ +/* -*- tab-width: 4 -*- */ + +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Stable pointers + * + * ---------------------------------------------------------------------------*/ + +#include "PosixSource.h" +#include "Rts.h" +#include "RtsAPI.h" + +#include "Hash.h" +#include "RtsUtils.h" +#include "Trace.h" +#include "StablePtr.h" + +#include <string.h> + +/* Comment from ADR's implementation in old RTS: + + This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a + small change in @HpOverflow.lc@) consists of the changes in the + runtime system required to implement "Stable Pointers". But we're + getting a bit ahead of ourselves --- what is a stable pointer and what + is it used for? + + 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. + + + Of course, all this rather begs the question: why would we want to + pass a boxed value? + + One very good reason is to preserve laziness across the language + interface. Rather than evaluating an integer or a string because it + {\em might\/} be required by the C function, we can wait until the C + function actually wants the value and then force an evaluation. + + Another very good reason (the motivating reason!) is that the C code + might want to execute an object of sort $IO ()$ for the side-effects + 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@ + monad, because we want to be sure we don't allocate one twice by + accident, and then only free one of the copies. + + \begin{verbatim} + makeStablePtr# :: a -> State# RealWorld -> (# RealWorld, a #) + freeStablePtr# :: StablePtr# a -> State# RealWorld -> 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://ghc.haskell.org/trac/ghc/ticket/7670 for details. +*/ + +spEntry *stable_ptr_table = NULL; +static spEntry *stable_ptr_free = NULL; +static unsigned int SPT_size = 0; +#define INIT_SPT_SIZE 64 + +/* Each time the stable pointer table is enlarged, we temporarily retain the old + * version to ensure dereferences are thread-safe (see Note [Enlarging the + * stable pointer table]). Since we double the size of the table each time, we + * can (theoretically) enlarge it at most N times on an N-bit machine. Thus, + * there will never be more than N old versions of the table. + */ +#if SIZEOF_VOID_P == 4 +#define MAX_N_OLD_SPTS 32 +#elif SIZEOF_VOID_P == 8 +#define MAX_N_OLD_SPTS 64 +#else +#error unknown SIZEOF_VOID_P +#endif + +static spEntry *old_SPTs[MAX_N_OLD_SPTS]; +static uint32_t n_old_SPTs = 0; + +#if defined(THREADED_RTS) +Mutex stable_ptr_mutex; +#endif + +static void enlargeStablePtrTable(void); + +/* ----------------------------------------------------------------------------- + * We must lock the StablePtr table during GC, to prevent simultaneous + * calls to freeStablePtr(). + * -------------------------------------------------------------------------- */ + +void +stablePtrLock(void) +{ + initStablePtrTable(); + ACQUIRE_LOCK(&stable_ptr_mutex); +} + +void +stablePtrUnlock(void) +{ + RELEASE_LOCK(&stable_ptr_mutex); +} + +/* ----------------------------------------------------------------------------- + * Initialising the table + * -------------------------------------------------------------------------- */ + +STATIC_INLINE void +initSpEntryFreeList(spEntry *table, uint32_t 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) +{ + if (SPT_size > 0) return; + SPT_size = INIT_SPT_SIZE; + stable_ptr_table = stgMallocBytes(SPT_size * sizeof(spEntry), + "initStablePtrTable"); + initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL); + +#if defined(THREADED_RTS) + initMutex(&stable_ptr_mutex); +#endif +} + +/* ----------------------------------------------------------------------------- + * Enlarging the table + * -------------------------------------------------------------------------- */ + +// Must be holding stable_ptr_mutex +static void +enlargeStablePtrTable(void) +{ + uint32_t old_SPT_size = SPT_size; + spEntry *new_stable_ptr_table; + + // 2nd and subsequent times + SPT_size *= 2; + + /* We temporarily retain the old version instead of freeing it; see Note + * [Enlarging the stable pointer table]. + */ + new_stable_ptr_table = + stgMallocBytes(SPT_size * sizeof(spEntry), + "enlargeStablePtrTable"); + memcpy(new_stable_ptr_table, + stable_ptr_table, + old_SPT_size * sizeof(spEntry)); + ASSERT(n_old_SPTs < MAX_N_OLD_SPTS); + old_SPTs[n_old_SPTs++] = stable_ptr_table; + + /* When using the threaded RTS, the update of stable_ptr_table is assumed to + * be atomic, so that another thread simultaneously dereferencing a stable + * pointer will always read a valid address. + */ + stable_ptr_table = new_stable_ptr_table; + + initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); +} + +/* Note [Enlarging the stable pointer table] + * + * To enlarge the stable pointer table, we allocate a new table, copy the + * existing entries, and then store the old version of the table in old_SPTs + * until we free it during GC. By not immediately freeing the old version + * (or equivalently by not growing the table using realloc()), we ensure that + * another thread simultaneously dereferencing a stable pointer using the old + * version can safely access the table without causing a segfault (see Trac + * #10296). + * + * Note that because the stable pointer table is doubled in size each time it is + * enlarged, the total memory needed to store the old versions is always less + * than that required to hold the current version. + */ + + +/* ----------------------------------------------------------------------------- + * Freeing entries and tables + * -------------------------------------------------------------------------- */ + +static void +freeOldSPTs(void) +{ + uint32_t i; + + for (i = 0; i < n_old_SPTs; i++) { + stgFree(old_SPTs[i]); + } + n_old_SPTs = 0; +} + +void +exitStablePtrTable(void) +{ + if (stable_ptr_table) + stgFree(stable_ptr_table); + stable_ptr_table = NULL; + SPT_size = 0; + + freeOldSPTs(); + +#if defined(THREADED_RTS) + closeMutex(&stable_ptr_mutex); +#endif +} + +STATIC_INLINE void +freeSpEntry(spEntry *sp) +{ + sp->addr = (P_)stable_ptr_free; + stable_ptr_free = sp; +} + +void +freeStablePtrUnsafe(StgStablePtr sp) +{ + ASSERT((StgWord)sp < SPT_size); + freeSpEntry(&stable_ptr_table[(StgWord)sp]); +} + +void +freeStablePtr(StgStablePtr sp) +{ + stablePtrLock(); + freeStablePtrUnsafe(sp); + stablePtrUnlock(); +} + +/* ----------------------------------------------------------------------------- + * Looking up + * -------------------------------------------------------------------------- */ + +StgStablePtr +getStablePtr(StgPtr p) +{ + StgWord sp; + + stablePtrLock(); + 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; + stablePtrUnlock(); + return (StgStablePtr)(sp); +} + +/* ----------------------------------------------------------------------------- + * Treat stable pointers as roots for the garbage collector. + * -------------------------------------------------------------------------- */ + +#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) + +void +markStablePtrTable(evac_fn evac, void *user) +{ + /* Since no other thread can currently be dereferencing a stable pointer, it + * is safe to free the old versions of the table. + */ + freeOldSPTs(); + + FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); +} + +/* ----------------------------------------------------------------------------- + * 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 tables, because the compacting + * collector may move the object it points to. + * -------------------------------------------------------------------------- */ + +void +threadStablePtrTable( evac_fn evac, void *user ) +{ + FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); +} diff --git a/rts/Stable.h b/rts/StablePtr.h index 399a2b3877..3fb305b47b 100644 --- a/rts/Stable.h +++ b/rts/StablePtr.h @@ -20,32 +20,27 @@ void freeStablePtr ( StgStablePtr sp ); -/* Use the "Unsafe" one after manually locking with stableLock/stableUnlock */ +/* Use the "Unsafe" one after only when manually locking and + unlocking with stablePtrLock/stablePtrUnlock */ void freeStablePtrUnsafe ( StgStablePtr sp ); -void initStableTables ( void ); -void exitStableTables ( void ); -StgWord lookupStableName ( StgPtr p ); +void initStablePtrTable ( void ); +void exitStablePtrTable ( void ); -/* Call given function on every stable ptr. markStableTables depends +/* Call given function on every stable ptr. markStablePtrTable 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. + * moved. */ -void markStableTables ( evac_fn evac, void *user ); +void markStablePtrTable ( evac_fn evac, void *user ); -void threadStableTables ( evac_fn evac, void *user ); -void gcStableTables ( void ); -void updateStableTables ( bool full ); +void threadStablePtrTable ( evac_fn evac, void *user ); -void stableLock ( void ); -void stableUnlock ( void ); +void stablePtrLock ( void ); +void stablePtrUnlock ( void ); #if defined(THREADED_RTS) // needed by Schedule.c:forkProcess() -extern Mutex stable_mutex; +extern Mutex stable_ptr_mutex; #endif #include "EndPrivate.h" diff --git a/rts/StaticPtrTable.c b/rts/StaticPtrTable.c index 7711377d7f..0b2244025e 100644 --- a/rts/StaticPtrTable.c +++ b/rts/StaticPtrTable.c @@ -12,7 +12,7 @@ #include "Rts.h" #include "RtsUtils.h" #include "Hash.h" -#include "Stable.h" +#include "StablePtr.h" static HashTable * spt = NULL; diff --git a/rts/TopHandler.c b/rts/TopHandler.c index 8e868e6e92..c0ac936b85 100644 --- a/rts/TopHandler.c +++ b/rts/TopHandler.c @@ -1,5 +1,5 @@ #include "Rts.h" -#include "Stable.h" +#include "StablePtr.h" #include "TopHandler.h" #if defined(THREADED_RTS) diff --git a/rts/TopHandler.h b/rts/TopHandler.h index 1146eea71c..d724354d9a 100644 --- a/rts/TopHandler.h +++ b/rts/TopHandler.h @@ -13,7 +13,6 @@ #include <rts/Types.h> #include <rts/storage/Closures.h> #include <stg/Types.h> -#include <rts/Stable.h> // Initialize the top handler subsystem void initTopHandler(void); diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c index 4cd1e386cc..f033870d16 100644 --- a/rts/posix/Signals.c +++ b/rts/posix/Signals.c @@ -15,7 +15,6 @@ #include "RtsUtils.h" #include "Prelude.h" #include "Ticker.h" -#include "Stable.h" #include "ThreadLabels.h" #include "Libdw.h" diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index d41135ddd3..d509953a1b 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -127,7 +127,8 @@ library rts/Profiling.h rts/Signals.h rts/SpinLock.h - rts/Stable.h + rts/StableName.h + rts/StablePtr.h rts/StaticPtrTable.h rts/TTY.h rts/Threads.h @@ -393,7 +394,8 @@ library STM.c Schedule.c Sparks.c - Stable.c + StableName.c + StablePtr.c StaticPtrTable.c Stats.c StgCRun.c diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index 10ad73c7d7..004e042069 100644 --- a/rts/sm/Compact.c +++ b/rts/sm/Compact.c @@ -25,7 +25,8 @@ #include "Trace.h" #include "Weak.h" #include "MarkWeak.h" -#include "Stable.h" +#include "StablePtr.h" +#include "StableName.h" // Turn off inlining when debugging - it obfuscates things #if defined(DEBUG) @@ -1000,7 +1001,10 @@ compact(StgClosure *static_objects) thread_static(static_objects /* ToDo: ok? */); // the stable pointer table - threadStableTables((evac_fn)thread_root, NULL); + threadStablePtrTable((evac_fn)thread_root, NULL); + + // the stable name table + threadStableNameTable((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 90857abe38..70d6d8efe5 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -46,7 +46,8 @@ #include "RetainerProfile.h" #include "LdvProfile.h" #include "RaiseAsync.h" -#include "Stable.h" +#include "StableName.h" +#include "StablePtr.h" #include "CheckUnload.h" #include "CNF.h" #include "RtsFlags.h" @@ -238,8 +239,9 @@ GarbageCollect (uint32_t collect_gen, // tell the stats department that we've started a GC stat_startGC(cap, gct); - // lock the StablePtr table - stableLock(); + // Lock the StablePtr table. This prevents FFI calls manipulating + // the table from occurring during GC. + stablePtrLock(); #if defined(DEBUG) mutlist_MUTVARS = 0; @@ -405,7 +407,10 @@ GarbageCollect (uint32_t collect_gen, initWeakForGC(); // Mark the stable pointer table. - markStableTables(mark_root, gct); + markStablePtrTable(mark_root, gct); + + // Remember old stable name addresses. + rememberOldStableNameAddresses (); /* ------------------------------------------------------------------------- * Repeatedly scavenge all the areas we know about until there's no @@ -431,7 +436,7 @@ GarbageCollect (uint32_t collect_gen, shutdown_gc_threads(gct->thread_index, idle_cap); // Now see which stable names are still alive. - gcStableTables(); + gcStableNameTable(); #if defined(THREADED_RTS) if (n_gc_threads == 1) { @@ -730,15 +735,15 @@ GarbageCollect (uint32_t collect_gen, if (major_gc) { gcCAFs(); } #endif - // Update the stable pointer hash table. - updateStableTables(major_gc); + // Update the stable name hash table + updateStableNameTable(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. - stableUnlock(); + stablePtrUnlock(); - // Must be after stableUnlock(), because it might free stable ptrs. + // Must be after stablePtrUnlock(), because it might free stable ptrs. if (major_gc) { checkUnload (gct->scavenged_static_objects); } |