Commit f48e276a authored by David Feuer's avatar David Feuer Committed by David Feuer

Finish stable split

Long ago, the stable name table and stable pointer tables were one.
Now, they are separate, and have significantly different
implementations. I believe the time has come to finish the split
that began in #7674.

* Divide `rts/Stable` into `rts/StableName` and `rts/StablePtr`.

* Give each table its own mutex.

* Add FFI functions `hs_lock_stable_ptr_table` and
`hs_unlock_stable_ptr_table` and document them.
  These are intended to replace the previously undocumented
`hs_lock_stable_tables` and `hs_lock_stable_tables`,
  which are now documented as deprecated synonyms.

* Make `eqStableName#` use pointer equality instead of unnecessarily
comparing stable name table indices.

Reviewers: simonmar, bgamari, erikd

Reviewed By: bgamari

Subscribers: rwbarton, carter

GHC Trac Issues: #15555

Differential Revision: https://phabricator.haskell.org/D5084
parent 65eec9cf
......@@ -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.
......
......@@ -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
~~~~~~~~~~~~~~~~
......
......@@ -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
......
......@@ -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);
......
......@@ -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"
......
......@@ -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;
}
/* -----------------------------------------------------------------------------
*
* (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;
}
......@@ -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
......
......@@ -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"
......
......@@ -21,7 +21,7 @@
#include "Rts.h"
#include "Globals.h"
#include "Stable.h"
#include "StablePtr.h"
typedef enum {
GHCConcSignalSignalHandlerStore,
......
......@@ -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
......
......@@ -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"
......
......@@ -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"
......
......@@ -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
......
......@@ -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"
......
......@@ -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 */
......
......@@ -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) \
......
......@@ -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++) {
......
......@@ -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)
{