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

1 files changed, 364 insertions, 0 deletions

diff --git a/rts/StableName.c b/rts/StableName.c
new file mode 100644
index 0000000000..abe7b692e0
--- /dev/null
+++ b/rts/StableName.c
@@ -0,0 +1,364 @@
+/* -*- tab-width: 4 -*- */
+
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2002
+ *
+ * Stable names
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "PosixSource.h"
+#include "Rts.h"
+#include "RtsAPI.h"
+
+#include "Hash.h"
+#include "RtsUtils.h"
+#include "Trace.h"
+#include "StableName.h"
+
+#include <string.h>
+
+snEntry *stable_name_table = NULL;
+static snEntry *stable_name_free = NULL;
+static unsigned int SNT_size = 0;
+#define INIT_SNT_SIZE 64
+
+#if defined(THREADED_RTS)
+Mutex stable_name_mutex;
+#endif
+
+static void enlargeStableNameTable(void);
+
+/*
+ * This hash table maps Haskell objects to stable names, so that every
+ * call to lookupStableName on a given object will return the same
+ * stable name.
+ */
+
+static HashTable *addrToStableHash = NULL;
+
+void
+stableNameLock(void)
+{
+    initStableNameTable();
+    ACQUIRE_LOCK(&stable_name_mutex);
+}
+
+void
+stableNameUnlock(void)
+{
+    RELEASE_LOCK(&stable_name_mutex);
+}
+
+/* -----------------------------------------------------------------------------
+ * Initialising the table
+ * -------------------------------------------------------------------------- */
+
+STATIC_INLINE void
+initSnEntryFreeList(snEntry *table, uint32_t n, snEntry *free)
+{
+  snEntry *p;
+  for (p = table + n - 1; p >= table; p--) {
+    p->addr   = (P_)free;
+    p->old    = NULL;
+    p->sn_obj = NULL;
+    free = p;
+  }
+  stable_name_free = table;
+}
+
+void
+initStableNameTable(void)
+{
+    if (SNT_size > 0) return;
+    SNT_size = INIT_SNT_SIZE;
+    stable_name_table = stgMallocBytes(SNT_size * sizeof(snEntry),
+                                       "initStableNameTable");
+    /* we don't use index 0 in the stable name table, because that
+     * would conflict with the hash table lookup operations which
+     * return NULL if an entry isn't found in the hash table.
+     */
+    initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL);
+    addrToStableHash = allocHashTable();
+
+#if defined(THREADED_RTS)
+    initMutex(&stable_name_mutex);
+#endif
+}
+
+/* -----------------------------------------------------------------------------
+ * Enlarging the tables
+ * -------------------------------------------------------------------------- */
+
+static void
+enlargeStableNameTable(void)
+{
+    uint32_t old_SNT_size = SNT_size;
+
+    // 2nd and subsequent times
+    SNT_size *= 2;
+    stable_name_table =
+        stgReallocBytes(stable_name_table,
+                        SNT_size * sizeof(snEntry),
+                        "enlargeStableNameTable");
+
+    initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_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
+ * -------------------------------------------------------------------------- */
+
+void
+exitStableNameTable(void)
+{
+    if (addrToStableHash)
+        freeHashTable(addrToStableHash, NULL);
+    addrToStableHash = NULL;
+
+    if (stable_name_table)
+        stgFree(stable_name_table);
+    stable_name_table = NULL;
+    SNT_size = 0;
+
+#if defined(THREADED_RTS)
+    closeMutex(&stable_name_mutex);
+#endif
+}
+
+STATIC_INLINE void
+freeSnEntry(snEntry *sn)
+{
+  ASSERT(sn->sn_obj == NULL);
+  removeHashTable(addrToStableHash, (W_)sn->old, NULL);
+  sn->addr = (P_)stable_name_free;
+  stable_name_free = sn;
+}
+
+/* -----------------------------------------------------------------------------
+ * Looking up
+ * -------------------------------------------------------------------------- */
+
+/*
+ * get at the real stuff...remove indirections.
+ */
+static StgClosure*
+removeIndirections (StgClosure* p)
+{
+    StgClosure* q;
+
+    while (1)
+    {
+        q = UNTAG_CLOSURE(p);
+
+        switch (get_itbl(q)->type) {
+        case IND:
+        case IND_STATIC:
+            p = ((StgInd *)q)->indirectee;
+            continue;
+
+        case BLACKHOLE:
+            p = ((StgInd *)q)->indirectee;
+            if (GET_CLOSURE_TAG(p) != 0) {
+                continue;
+            } else {
+                break;
+            }
+
+        default:
+            break;
+        }
+        return p;
+    }
+}
+
+StgWord
+lookupStableName (StgPtr p)
+{
+  stableNameLock();
+
+  if (stable_name_free == NULL) {
+    enlargeStableNameTable();
+  }
+
+  /* removing indirections increases the likelihood
+   * of finding a match in the stable name hash table.
+   */
+  p = (StgPtr)removeIndirections((StgClosure*)p);
+
+  // register the untagged pointer.  This just makes things simpler.
+  p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
+
+  StgWord sn = (StgWord)lookupHashTable(addrToStableHash,(W_)p);
+
+  if (sn != 0) {
+    ASSERT(stable_name_table[sn].addr == p);
+    debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
+    stableNameUnlock();
+    return sn;
+  }
+
+  sn = stable_name_free - stable_name_table;
+  stable_name_free  = (snEntry*)(stable_name_free->addr);
+  stable_name_table[sn].addr = p;
+  stable_name_table[sn].sn_obj = NULL;
+  /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
+
+  /* add the new stable name to the hash table */
+  insertHashTable(addrToStableHash, (W_)p, (void *)sn);
+
+  stableNameUnlock();
+
+  return sn;
+}
+
+/* -----------------------------------------------------------------------------
+ * Remember old stable name addresses
+ * -------------------------------------------------------------------------- */
+
+#define FOR_EACH_STABLE_NAME(p, CODE)                                   \
+    do {                                                                \
+        snEntry *p;                                                     \
+        snEntry *__end_ptr = &stable_name_table[SNT_size];              \
+        for (p = stable_name_table + 1; p < __end_ptr; p++) {           \
+            /* Internal pointers are free slots.  */                    \
+            /* If p->addr == NULL, it's a */                            \
+            /* stable name where the object has been GC'd, but the */   \
+            /* StableName object (sn_obj) is still alive. */            \
+            if ((p->addr < (P_)stable_name_table ||                     \
+                 p->addr >= (P_)__end_ptr))                             \
+            {                                                           \
+                /* NOTE: There is an ambiguity here if p->addr == NULL */ \
+                /* it is either the last item in the free list or it */ \
+                /* is a stable name whose pointee died. sn_obj == NULL */ \
+                /* disambiguates as last free list item. */             \
+                do { CODE } while(0);                                   \
+            }                                                           \
+        }                                                               \
+    } while(0)
+
+void
+rememberOldStableNameAddresses(void)
+{
+    /* TODO: Only if !full GC */
+    FOR_EACH_STABLE_NAME(p, p->old = 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
+threadStableNameTable( evac_fn evac, void *user )
+{
+    FOR_EACH_STABLE_NAME(p, {
+        if (p->sn_obj != NULL) {
+            evac(user, (StgClosure **)&p->sn_obj);
+        }
+        if (p->addr != NULL) {
+            evac(user, (StgClosure **)&p->addr);
+        }
+    });
+}
+
+/* -----------------------------------------------------------------------------
+ * Garbage collect any dead entries in the stable name table.
+ *
+ * A dead entry has:
+ *
+ *          - a zero reference count
+ *          - a dead sn_obj
+ *
+ * Both of these conditions must be true in order to re-use the stable
+ * name table entry.  We can re-use stable name table entries for live
+ * heap objects, as long as the program has no StableName objects that
+ * refer to the entry.
+ * -------------------------------------------------------------------------- */
+
+void
+gcStableNameTable( void )
+{
+    FOR_EACH_STABLE_NAME(
+        p, {
+            // FOR_EACH_STABLE_NAME traverses free entries too, so
+            // check sn_obj
+            if (p->sn_obj != NULL) {
+                // Update the pointer to the StableName object, if there is one
+                p->sn_obj = isAlive(p->sn_obj);
+                if (p->sn_obj == NULL) {
+                    // StableName object died
+                    debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
+                               (long)(p - stable_name_table), p->addr);
+                    freeSnEntry(p);
+                } else if (p->addr != NULL) {
+                    // sn_obj is alive, update pointee
+                    p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
+                    if (p->addr == NULL) {
+                        // Pointee died
+                        debugTrace(DEBUG_stable, "GC'd pointee %ld",
+                                   (long)(p - stable_name_table));
+                    }
+                }
+            }
+        });
+}
+
+/* -----------------------------------------------------------------------------
+ * Update the StableName hash table
+ *
+ * The boolean argument 'full' indicates that a major collection is
+ * being done, so we might as well throw away the hash table and build
+ * a new one.  For a minor collection, we just re-hash the elements
+ * that changed.
+ * -------------------------------------------------------------------------- */
+
+void
+updateStableNameTable(bool full)
+{
+    if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) {
+        freeHashTable(addrToStableHash,NULL);
+        addrToStableHash = allocHashTable();
+    }
+
+    if(full) {
+        FOR_EACH_STABLE_NAME(
+            p, {
+                if (p->addr != NULL) {
+                    // Target still alive, Re-hash this stable name
+                    insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
+                }
+            });
+    } else {
+        FOR_EACH_STABLE_NAME(
+            p, {
+                if (p->addr != p->old) {
+                    removeHashTable(addrToStableHash, (W_)p->old, NULL);
+                    /* Movement happened: */
+                    if (p->addr != NULL) {
+                        insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
+                    }
+                }
+            });
+    }
+}