diff options
30 files changed, 586 insertions, 344 deletions
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index a6e13086aa..266ab3a0f6 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -352,14 +352,6 @@ emitPrimOp dflags [res] ByteArrayContents_Char [arg]  emitPrimOp dflags [res] StableNameToIntOp [arg]     = emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags)) ---  #define eqStableNamezh(r,sn1,sn2)                                   \ ---    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn)) -emitPrimOp dflags [res] EqStableNameOp [arg1,arg2] -   = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [ -                                   cmmLoadIndexW dflags arg1 (fixedHdrSizeW dflags) (bWord dflags), -                                   cmmLoadIndexW dflags arg2 (fixedHdrSizeW dflags) (bWord dflags) -                         ]) -  emitPrimOp dflags [res] ReallyUnsafePtrEqualityOp [arg1,arg2]     = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2]) @@ -1405,9 +1397,22 @@ translateOp dflags SameMutableArrayArrayOp= Just (mo_wordEq dflags)  translateOp dflags SameSmallMutableArrayOp= Just (mo_wordEq dflags)  translateOp dflags SameTVarOp             = Just (mo_wordEq dflags)  translateOp dflags EqStablePtrOp          = Just (mo_wordEq dflags) +-- See Note [Comparing stable names] +translateOp dflags EqStableNameOp         = Just (mo_wordEq dflags)  translateOp _      _ = Nothing +-- Note [Comparing stable names] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- A StableName# is actually a pointer to a stable name object (SNO) +-- containing an index into the stable name table (SNT). We +-- used to compare StableName#s by following the pointers to the +-- SNOs and checking whether they held the same SNT indices. However, +-- this is not necessary: there is a one-to-one correspondence +-- between SNOs and entries in the SNT, so simple pointer equality +-- does the trick. +  -- These primops are implemented by CallishMachOps, because they sometimes  -- turn into foreign calls depending on the backend. diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index da236f923d..50323b3939 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -48,6 +48,14 @@ Compiler  Runtime system  ~~~~~~~~~~~~~~ +- Add and document new FFI functions ``hs_lock_stable_ptr_table`` +  and ``hs_unlock_stable_ptr_table``. These replace the undocumented +  functions ``hs_lock_stable_tables`` and ``hs_unlock_stable_tables``, +  respectively. The latter should now be considered deprecated. + +- Document the heretofore undocumented FFI function +  ``hs_free_stable_ptr_unsafe``, used in conjunction with manual +  locking and unlocking.  Template Haskell  ~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/ffi-chap.rst b/docs/users_guide/ffi-chap.rst index 0b107de234..62bad46781 100644 --- a/docs/users_guide/ffi-chap.rst +++ b/docs/users_guide/ffi-chap.rst @@ -245,6 +245,46 @@ allocated until ``hs_exit()`` is called. If you call it too often, the  worst that can happen is that the next call to a Haskell function incurs  some extra overhead. +.. _ffi-stable-ptr-extras: + +Freeing many stable pointers efficiently +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The standard function ``hs_free_stable_ptr`` locks the stable pointer +table, frees the given stable pointer, and then unlocks the stable pointer +table again. When freeing many stable pointers at once, it is usually +more efficient to lock and unlock the table only once. + +.. code-block:: c + +    extern void hs_lock_stable_ptr_table (void); + +    extern void hs_unlock_stable_ptr_table (void); + +    extern void hs_free_stable_ptr_unsafe (HsStablePtr sp); + +``hs_free_stable_ptr_unsafe`` must be used *only* when the table has been +locked using ``hs_lock_stable_ptr_table``. It must be unlocked afterwards +using ``hs_unlock_stable_ptr_table``. The Haskell garbage collector cannot +run while the table is locked, so it should be unlocked promptly. The +following operations are forbidden while the stable pointer table is locked: + +* Calling any Haskell function, whether or not that function +  manipulates stable pointers. + +* Calling any FFI function that deals with the stable pointer table +  except for arbitrarily many calls to ``hs_free_stable_ptr_unsafe`` +  and the final call to ``hs_unlock_stable_ptr_table``. + +* Calling ``hs_free_fun_ptr``. + +.. note:: + +    GHC versions before 8.8 defined undocumented functions +    ``hs_lock_stable_tables`` and ``hs_unlock_stable_tables`` instead +    of ``hs_lock_stable_ptr_table`` and ``hs_unlock_stable_ptr_table``. +    Those names are now deprecated. +  .. _ffi-ghc:  Using the FFI with GHC diff --git a/includes/HsFFI.h b/includes/HsFFI.h index dea365cb65..84976474f5 100644 --- a/includes/HsFFI.h +++ b/includes/HsFFI.h @@ -101,8 +101,26 @@ extern void hs_thread_done (void);  extern void hs_perform_gc (void); +// Lock the stable pointer table. The table must be unlocked +// again before calling any Haskell functions, even if those +// functions do not manipulate stable pointers. The Haskell +// garbage collector will not be able to run until this lock +// is released! It is also forbidden to call hs_free_fun_ptr +// or any stable pointer-related FFI functions other than +// hs_free_stable_ptr_unsafe while the table is locked. +extern void hs_lock_stable_ptr_table (void); + +// A deprecated synonym.  extern void hs_lock_stable_tables (void); + +// Unlock the stable pointer table. +extern void hs_unlock_stable_ptr_table (void); + +// A deprecated synonym.  extern void hs_unlock_stable_tables (void); + +// Free a stable pointer assuming that the stable pointer +// table is already locked.  extern void hs_free_stable_ptr_unsafe (HsStablePtr sp);  extern void hs_free_stable_ptr (HsStablePtr sp); diff --git a/includes/Rts.h b/includes/Rts.h index fc70479eb6..eb11536c19 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -198,7 +198,8 @@ void _assertFail(const char *filename, unsigned int linenum)  #include "rts/Linker.h"  #include "rts/Ticky.h"  #include "rts/Timer.h" -#include "rts/Stable.h" +#include "rts/StablePtr.h" +#include "rts/StableName.h"  #include "rts/TTY.h"  #include "rts/Utils.h"  #include "rts/PrimFloat.h" diff --git a/includes/rts/Stable.h b/includes/rts/StableName.h index 4550ad6117..d43ffcb2f6 100644 --- a/includes/rts/Stable.h +++ b/includes/rts/StableName.h @@ -2,7 +2,7 @@   *   * (c) The GHC Team, 1998-2009   * - * Stable Pointers + * Stable Names   *   * Do not #include this file directly: #include "Rts.h" instead.   * @@ -13,9 +13,6 @@  #pragma once -EXTERN_INLINE StgPtr deRefStablePtr (StgStablePtr stable_ptr); -StgStablePtr getStablePtr  (StgPtr p); -  /* -----------------------------------------------------------------------------     PRIVATE from here.     -------------------------------------------------------------------------- */ @@ -32,17 +29,4 @@ typedef struct {                           // free  } snEntry; -typedef struct { -    StgPtr addr;         // Haskell object when entry is in use, next free -                         // entry (NULL when this is the last free entry) -                         // otherwise. -} spEntry; -  extern DLL_IMPORT_RTS snEntry *stable_name_table; -extern DLL_IMPORT_RTS spEntry *stable_ptr_table; - -EXTERN_INLINE -StgPtr deRefStablePtr(StgStablePtr sp) -{ -    return stable_ptr_table[(StgWord)sp].addr; -} diff --git a/includes/rts/StablePtr.h b/includes/rts/StablePtr.h new file mode 100644 index 0000000000..0d3642fbfe --- /dev/null +++ b/includes/rts/StablePtr.h @@ -0,0 +1,35 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * Stable Pointers + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +EXTERN_INLINE StgPtr deRefStablePtr (StgStablePtr stable_ptr); +StgStablePtr getStablePtr  (StgPtr p); + +/* ----------------------------------------------------------------------------- +   PRIVATE from here. +   -------------------------------------------------------------------------- */ + +typedef struct { +    StgPtr addr;         // Haskell object when entry is in use, next free +                         // entry (NULL when this is the last free entry) +                         // otherwise. +} spEntry; + +extern DLL_IMPORT_RTS spEntry *stable_ptr_table; + +EXTERN_INLINE +StgPtr deRefStablePtr(StgStablePtr sp) +{ +    return stable_ptr_table[(StgWord)sp].addr; +} diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 5328ed3f4a..c13b5ff052 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -514,8 +514,10 @@ extern StgWord RTS_VAR(atomic_modify_mutvar_mutex);  // RtsFlags  extern StgWord RTS_VAR(RtsFlags); // bogus type -// Stable.c +// StablePtr.c  extern StgWord RTS_VAR(stable_ptr_table); + +// StableName.c  extern StgWord RTS_VAR(stable_name_table);  // Profiling.c 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);    } diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index 84de914e08..5d5dbc404f 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -724,7 +724,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram                       "",                       "#include \"PosixSource.h\"",                       "#include \"Rts.h\"", -                     "#include \"Stable.h\"", +                     "#include \"StableName.h\"",                       "#include \"Capability.h\"",                       "",                       "#include <inttypes.h>",  | 
