rts: Don't use strndup
[ghc.git] / rts / Stable.c
index a2c47d7..3cebd5a 100644 (file)
@@ -1,3 +1,5 @@
+/* -*- tab-width: 4 -*- */
+
 /* -----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2002
@@ -6,21 +8,17 @@
  *
  * ---------------------------------------------------------------------------*/
 
-// Make static versions of inline functions in Stable.h:
-#define RTS_STABLE_C
-
 #include "PosixSource.h"
 #include "Rts.h"
+#include "RtsAPI.h"
+
 #include "Hash.h"
 #include "RtsUtils.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "RtsAPI.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
 #include "Trace.h"
 #include "Stable.h"
 
+#include <string.h>
+
 /* Comment from ADR's implementation in old RTS:
 
   This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
   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@
   \begin{verbatim}
   makeStablePtr#  :: a -> State# RealWorld -> (# RealWorld, a #)
   freeStablePtr#  :: StablePtr# a -> State# RealWorld -> State# RealWorld
-  deRefStablePtr# :: StablePtr# a -> State# RealWorld -> 
+  deRefStablePtr# :: StablePtr# a -> State# RealWorld ->
         (# State# RealWorld, a #)
   \end{verbatim}
 
   There may be additional functions on the C side to allow evaluation,
   application, etc of a stable pointer.
 
+  Stable Pointers are exported to the outside world as indices and not
+  pointers, because the stable pointer table is allowed to be
+  reallocated for growth. The table is never shrunk for its space to
+  be reclaimed.
+
+  Future plans for stable ptrs include distinguishing them by the
+  generation of the pointed object. See
+  http://ghc.haskell.org/trac/ghc/ticket/7670 for details.
 */
 
-snEntry *stable_ptr_table = NULL;
-static snEntry *stable_ptr_free = NULL;
+snEntry *stable_name_table = NULL;
+static snEntry *stable_name_free = NULL;
+static unsigned int SNT_size = 0;
+#define INIT_SNT_SIZE 64
 
+spEntry *stable_ptr_table = NULL;
+static spEntry *stable_ptr_free = NULL;
 static unsigned int SPT_size = 0;
+#define INIT_SPT_SIZE 64
+
+/* 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 nat n_old_SPTs = 0;
 
 #ifdef THREADED_RTS
-static Mutex stable_mutex;
+Mutex stable_mutex;
 #endif
 
-/* This hash table maps Haskell objects to stable names, so that every
+static void enlargeStableNameTable(void);
+static void enlargeStablePtrTable(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.
- *
- * OLD COMMENTS about reference counting follow.  The reference count
- * in a stable name entry is now just a counter.
- *
- * Reference counting
- * ------------------
- * A plain stable name entry has a zero reference count, which means
- * the entry will dissappear when the object it points to is
- * unreachable.  For stable pointers, we need an entry that sticks
- * around and keeps the object it points to alive, so each stable name
- * entry has an associated reference count.
- *
- * A stable pointer has a weighted reference count N attached to it
- * (actually in its upper 5 bits), which represents the weight
- * 2^(N-1).  The stable name entry keeps a 32-bit reference count, which
- * represents any weight between 1 and 2^32 (represented as zero).
- * When the weight is 2^32, the stable name table owns "all" of the
- * stable pointers to this object, and the entry can be garbage
- * collected if the object isn't reachable.
- *
- * A new stable pointer is given the weight log2(W/2), where W is the
- * weight stored in the table entry.  The new weight in the table is W
- * - 2^log2(W/2).
- *
- * A stable pointer can be "split" into two stable pointers, by
- * dividing the weight by 2 and giving each pointer half.
- * When freeing a stable pointer, the weight of the pointer is added
- * to the weight stored in the table entry.
- * */
+ */
 
 static HashTable *addrToStableHash = NULL;
 
-#define INIT_SPT_SIZE 64
+/* -----------------------------------------------------------------------------
+ * We must lock the StablePtr table during GC, to prevent simultaneous
+ * calls to freeStablePtr().
+ * -------------------------------------------------------------------------- */
+
+void
+stableLock(void)
+{
+    initStableTables();
+    ACQUIRE_LOCK(&stable_mutex);
+}
+
+void
+stableUnlock(void)
+{
+    RELEASE_LOCK(&stable_mutex);
+}
+
+/* -----------------------------------------------------------------------------
+ * Initialising the tables
+ * -------------------------------------------------------------------------- */
 
 STATIC_INLINE void
-initFreeList(snEntry *table, nat n, snEntry *free)
+initSnEntryFreeList(snEntry *table, nat n, snEntry *free)
 {
   snEntry *p;
-
   for (p = table + n - 1; p >= table; p--) {
     p->addr   = (P_)free;
     p->old    = NULL;
-    p->ref    = 0;
     p->sn_obj = NULL;
     free = p;
   }
+  stable_name_free = table;
+}
+
+STATIC_INLINE void
+initSpEntryFreeList(spEntry *table, nat n, spEntry *free)
+{
+  spEntry *p;
+  for (p = table + n - 1; p >= table; p--) {
+      p->addr = (P_)free;
+      free = p;
+  }
   stable_ptr_free = table;
 }
 
 void
-initStablePtrTable(void)
+initStableTables(void)
 {
-       if (SPT_size > 0)
-               return;
-
-    SPT_size = INIT_SPT_SIZE;
-    stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry),
-                                     "initStablePtrTable");
-
+    if (SNT_size > 0) return;
+    SNT_size = INIT_SNT_SIZE;
+    stable_name_table = stgMallocBytes(SNT_size * sizeof *stable_name_table,
+                                       "initStableNameTable");
     /* we don't use index 0 in the stable name table, because that
      * would conflict with the hash table lookup operations which
      * return NULL if an entry isn't found in the hash table.
      */
-    initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL);
+    initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL);
     addrToStableHash = allocHashTable();
 
+    if (SPT_size > 0) return;
+    SPT_size = INIT_SPT_SIZE;
+    stable_ptr_table = stgMallocBytes(SPT_size * sizeof *stable_ptr_table,
+                                      "initStablePtrTable");
+    initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL);
+
 #ifdef THREADED_RTS
     initMutex(&stable_mutex);
 #endif
 }
 
+/* -----------------------------------------------------------------------------
+ * Enlarging the tables
+ * -------------------------------------------------------------------------- */
+
+static void
+enlargeStableNameTable(void)
+{
+    nat old_SNT_size = SNT_size;
+
+    // 2nd and subsequent times
+    SNT_size *= 2;
+    stable_name_table =
+        stgReallocBytes(stable_name_table,
+                        SNT_size * sizeof *stable_name_table,
+                        "enlargeStableNameTable");
+
+    initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL);
+}
+
+static void
+enlargeStablePtrTable(void)
+{
+    nat 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 *stable_ptr_table,
+                       "enlargeStablePtrTable");
+    memcpy(new_stable_ptr_table,
+           stable_ptr_table,
+           old_SPT_size * sizeof *stable_ptr_table);
+    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)
+{
+    nat i;
+
+    for (i = 0; i < n_old_SPTs; i++) {
+        stgFree(old_SPTs[i]);
+    }
+    n_old_SPTs = 0;
+}
+
 void
-exitStablePtrTable(void)
+exitStableTables(void)
 {
-  if (addrToStableHash)
-    freeHashTable(addrToStableHash, NULL);
-  addrToStableHash = NULL;
-  if (stable_ptr_table)
-    stgFree(stable_ptr_table);
-  stable_ptr_table = NULL;
-  SPT_size = 0;
+    if (addrToStableHash)
+        freeHashTable(addrToStableHash, NULL);
+    addrToStableHash = NULL;
+
+    if (stable_name_table)
+        stgFree(stable_name_table);
+    stable_name_table = NULL;
+    SNT_size = 0;
+
+    if (stable_ptr_table)
+        stgFree(stable_ptr_table);
+    stable_ptr_table = NULL;
+    SPT_size = 0;
+
+    freeOldSPTs();
+
 #ifdef THREADED_RTS
-  closeMutex(&stable_mutex);
+    closeMutex(&stable_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;
+}
+
+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
+ * -------------------------------------------------------------------------- */
+
 /*
  * get at the real stuff...remove indirections.
- * It untags pointers before dereferencing and
- * retags the real stuff with its tag (if there
- * is any) when returning.
- *
- * ToDo: move to a better home.
  */
-static
-StgClosure*
-removeIndirections(StgClosure* p)
+static StgClosure*
+removeIndirections (StgClosure* p)
 {
-  StgWord tag = GET_CLOSURE_TAG(p);
-  StgClosure* q = UNTAG_CLOSURE(p);
-
-  while (get_itbl(q)->type == IND ||
-         get_itbl(q)->type == IND_STATIC ||
-         get_itbl(q)->type == IND_OLDGEN ||
-         get_itbl(q)->type == IND_PERM ||
-         get_itbl(q)->type == IND_OLDGEN_PERM ) {
-      q = ((StgInd *)q)->indirectee;
-      tag = GET_CLOSURE_TAG(q);
-      q = UNTAG_CLOSURE(q);
-  }
-
-  return TAG_CLOSURE(tag,q);
+    StgClosure* q;
+
+    while (1)
+    {
+        q = UNTAG_CLOSURE(p);
+
+        switch (get_itbl(q)->type) {
+        case IND:
+        case IND_STATIC:
+        case IND_PERM:
+            p = ((StgInd *)q)->indirectee;
+            continue;
+
+        case BLACKHOLE:
+            p = ((StgInd *)q)->indirectee;
+            if (GET_CLOSURE_TAG(p) != 0) {
+                continue;
+            } else {
+                break;
+            }
+
+        default:
+            break;
+        }
+        return p;
+    }
 }
 
-static StgWord
-lookupStableName_(StgPtr p)
+StgWord
+lookupStableName (StgPtr p)
 {
   StgWord sn;
   void* sn_tmp;
 
-  if (stable_ptr_free == NULL) {
-    enlargeStablePtrTable();
+  stableLock();
+
+  if (stable_name_free == NULL) {
+    enlargeStableNameTable();
   }
 
   /* removing indirections increases the likelihood
@@ -223,166 +396,139 @@ lookupStableName_(StgPtr p)
 
   sn_tmp = lookupHashTable(addrToStableHash,(W_)p);
   sn = (StgWord)sn_tmp;
-  
+
   if (sn != 0) {
-    ASSERT(stable_ptr_table[sn].addr == p);
+    ASSERT(stable_name_table[sn].addr == p);
     debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
-    return sn;
-  } else {
-    sn = stable_ptr_free - stable_ptr_table;
-    stable_ptr_free  = (snEntry*)(stable_ptr_free->addr);
-    stable_ptr_table[sn].ref = 0;
-    stable_ptr_table[sn].addr = p;
-    stable_ptr_table[sn].sn_obj = NULL;
-    /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
-    
-    /* add the new stable name to the hash table */
-    insertHashTable(addrToStableHash, (W_)p, (void *)sn);
-
+    stableUnlock();
     return sn;
   }
-}
 
-StgWord
-lookupStableName(StgPtr p)
-{
-    StgWord res;
+  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); */
 
-    initStablePtrTable();
-    ACQUIRE_LOCK(&stable_mutex);
-    res = lookupStableName_(p);
-    RELEASE_LOCK(&stable_mutex);
-    return res;
-}
+  /* add the new stable name to the hash table */
+  insertHashTable(addrToStableHash, (W_)p, (void *)sn);
 
-STATIC_INLINE void
-freeStableName(snEntry *sn)
-{
-  ASSERT(sn->sn_obj == NULL);
-  if (sn->addr != NULL) {
-      removeHashTable(addrToStableHash, (W_)sn->addr, NULL);
-  }
-  sn->addr = (P_)stable_ptr_free;
-  stable_ptr_free = sn;
+  stableUnlock();
+
+  return sn;
 }
 
 StgStablePtr
 getStablePtr(StgPtr p)
 {
-  StgWord sn;
-
-  initStablePtrTable();
-  ACQUIRE_LOCK(&stable_mutex);
-  sn = lookupStableName_(p);
-  stable_ptr_table[sn].ref++;
-  RELEASE_LOCK(&stable_mutex);
-  return (StgStablePtr)(sn);
+  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);
 }
 
-void
-freeStablePtr(StgStablePtr sp)
-{
-    snEntry *sn;
-
-       initStablePtrTable();
-    ACQUIRE_LOCK(&stable_mutex);
-
-    sn = &stable_ptr_table[(StgWord)sp];
-    
-    ASSERT((StgWord)sp < SPT_size  &&  sn->addr != NULL  &&  sn->ref > 0);
+/* -----------------------------------------------------------------------------
+ * Treat stable pointers as roots for the garbage collector.
+ * -------------------------------------------------------------------------- */
 
-    sn->ref--;
+#define FOR_EACH_STABLE_PTR(p, CODE)                                    \
+    do {                                                                \
+        spEntry *p;                                                     \
+        spEntry *__end_ptr = &stable_ptr_table[SPT_size];               \
+        for (p = stable_ptr_table; p < __end_ptr; p++) {                \
+            /* Internal pointers are free slots. NULL is last in free */ \
+            /* list. */                                                 \
+            if (p->addr &&                                              \
+                (p->addr < (P_)stable_ptr_table || p->addr >= (P_)__end_ptr)) \
+            {                                                           \
+                do { CODE } while(0);                                   \
+            }                                                           \
+        }                                                               \
+    } while(0)
+
+#define FOR_EACH_STABLE_NAME(p, CODE)                                   \
+    do {                                                                \
+        snEntry *p;                                                     \
+        snEntry *__end_ptr = &stable_name_table[SNT_size];              \
+        for (p = stable_name_table + 1; p < __end_ptr; p++) {           \
+            /* Internal pointers are free slots.  */                    \
+            /* If p->addr == NULL, it's a */                            \
+            /* stable name where the object has been GC'd, but the */   \
+            /* StableName object (sn_obj) is still alive. */            \
+            if ((p->addr < (P_)stable_name_table ||                     \
+                 p->addr >= (P_)__end_ptr))                             \
+            {                                                           \
+                /* NOTE: There is an ambiguity here if p->addr == NULL */ \
+                /* it is either the last item in the free list or it */ \
+                /* is a stable name whose pointee died. sn_obj == NULL */ \
+                /* disambiguates as last free list item. */             \
+                do { CODE } while(0);                                   \
+            }                                                           \
+        }                                                               \
+    } while(0)
 
-    // If this entry has no StableName attached, then just free it
-    // immediately.  This is important; it might be a while before the
-    // next major GC which actually collects the entry.
-    if (sn->sn_obj == NULL && sn->ref == 0) {
-       freeStableName(sn);
-    }
+STATIC_INLINE void
+markStablePtrTable(evac_fn evac, void *user)
+{
+    FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
+}
 
-    RELEASE_LOCK(&stable_mutex);
+STATIC_INLINE void
+rememberOldStableNameAddresses(void)
+{
+    /* TODO: Only if !full GC */
+    FOR_EACH_STABLE_NAME(p, p->old = p->addr;);
 }
 
 void
-enlargeStablePtrTable(void)
+markStableTables(evac_fn evac, void *user)
 {
-  nat old_SPT_size = SPT_size;
-
-    // 2nd and subsequent times
-  SPT_size *= 2;
-  stable_ptr_table =
-    stgReallocBytes(stable_ptr_table,
-                     SPT_size * sizeof(snEntry),
-                     "enlargeStablePtrTable");
+    /* Since no other thread can currently be dereferencing a stable pointer, it
+     * is safe to free the old versions of the table.
+     */
+    freeOldSPTs();
 
-  initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
+    markStablePtrTable(evac, user);
+    rememberOldStableNameAddresses();
 }
 
 /* -----------------------------------------------------------------------------
- * Treat stable pointers as roots for the garbage collector.
+ * Thread the stable pointer table for compacting GC.
  *
- * A stable pointer is any stable name entry with a ref > 0.  We'll
- * take the opportunity to zero the "keep" flags at the same time.
+ * 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
-markStablePtrTable(evac_fn evac, void *user)
+STATIC_INLINE void
+threadStableNameTable( evac_fn evac, void *user )
 {
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // Mark all the stable *pointers* (not stable names).
-    // _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
-       q = p->addr;
-
-       // Internal pointers are free slots.  If q == NULL, it's a
-       // stable name where the object has been GC'd, but the
-       // StableName object (sn_obj) is still alive.
-       if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-
-           // save the current addr away: we need to be able to tell
-           // whether the objects moved in order to be able to update
-           // the hash table later.
-           p->old = p->addr;
-
-           // if the ref is non-zero, treat addr as a root
-           if (p->ref != 0) {
-               evac(user, (StgClosure **)&p->addr);
-           }
-       }
-    }
+    FOR_EACH_STABLE_NAME(p, {
+        if (p->sn_obj != NULL) {
+            evac(user, (StgClosure **)&p->sn_obj);
+        }
+        if (p->addr != NULL) {
+            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 pointer table, because the compacting
- * collector may move the object it points to.
- * -------------------------------------------------------------------------- */
+STATIC_INLINE void
+threadStablePtrTable( evac_fn evac, void *user )
+{
+    FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
+}
 
 void
-threadStablePtrTable( evac_fn evac, void *user )
+threadStableTables( evac_fn evac, void *user )
 {
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
-       
-       if (p->sn_obj != NULL) {
-           evac(user, (StgClosure **)&p->sn_obj);
-       }
-
-       q = p->addr;
-       if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-           evac(user, (StgClosure **)&p->addr);
-       }
-    }
+    threadStableNameTable(evac, user);
+    threadStablePtrTable(evac, user);
 }
 
 /* -----------------------------------------------------------------------------
@@ -400,49 +546,41 @@ threadStablePtrTable( evac_fn evac, void *user )
  * -------------------------------------------------------------------------- */
 
 void
-gcStablePtrTable( void )
+gcStableTables( void )
 {
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // NOTE: _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
-       
-       // Update the pointer to the StableName object, if there is one
-       if (p->sn_obj != NULL) {
-           p->sn_obj = isAlive(p->sn_obj);
-       }
-       
-       // Internal pointers are free slots.  If q == NULL, it's a
-       // stable name where the object has been GC'd, but the
-       // StableName object (sn_obj) is still alive.
-       q = p->addr;
-       if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-
-           // StableNames only:
-           if (p->ref == 0) {
-               if (p->sn_obj == NULL) {
-                   // StableName object is dead
-                   freeStableName(p);
-                   debugTrace(DEBUG_stable, "GC'd Stable name %ld",
-                              (long)(p - stable_ptr_table));
-                   continue;
-                   
-               } else {
-                 p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
-                 debugTrace(DEBUG_stable, 
-                            "stable name %ld still alive at %p, ref %ld\n",
-                            (long)(p - stable_ptr_table), p->addr, p->ref);
-               }
-           }
-       }
-    }
+    FOR_EACH_STABLE_NAME(
+        p, {
+            // Update the pointer to the StableName object, if there is one
+            if (p->sn_obj != NULL) {
+                p->sn_obj = isAlive(p->sn_obj);
+                if(p->sn_obj == NULL) {
+                    // StableName object died
+                    debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
+                               (long)(p - stable_name_table), p->addr);
+                    freeSnEntry(p);
+                    /* Can't "continue", so use goto */
+                    goto next_stable_name;
+                }
+            }
+            /* If sn_obj became NULL, the object died, and addr is now
+             * invalid. But if sn_obj was null, then the StableName
+             * object may not have been created yet, while the pointee
+             * already exists and must be updated to new location. */
+            if (p->addr != NULL) {
+                p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
+                if(p->addr == NULL) {
+                    // StableName pointee died
+                    debugTrace(DEBUG_stable, "GC'd pointee %ld",
+                               (long)(p - stable_name_table));
+                }
+            }
+    next_stable_name:
+            if (0) {}
+        });
 }
 
 /* -----------------------------------------------------------------------------
- * Update the StablePtr/StableName hash table
+ * Update the StableName hash table
  *
  * The boolean argument 'full' indicates that a major collection is
  * being done, so we might as well throw away the hash table and build
@@ -451,39 +589,31 @@ gcStablePtrTable( void )
  * -------------------------------------------------------------------------- */
 
 void
-updateStablePtrTable(rtsBool full)
+updateStableTables(rtsBool full)
 {
-    snEntry *p, *end_stable_ptr_table;
-    
-    if (full && addrToStableHash != NULL) {
-       freeHashTable(addrToStableHash,NULL);
-       addrToStableHash = allocHashTable();
+    if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) {
+        freeHashTable(addrToStableHash,NULL);
+        addrToStableHash = allocHashTable();
     }
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // NOTE: _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
-       
-       if (p->addr == NULL) {
-           if (p->old != NULL) {
-               // The target has been garbage collected.  Remove its
-               // entry from the hash table.
-               removeHashTable(addrToStableHash, (W_)p->old, NULL);
-               p->old = NULL;
-           }
-       }
-       else if (p->addr < (P_)stable_ptr_table 
-                || p->addr >= (P_)end_stable_ptr_table) {
-           // Target still alive, Re-hash this stable name 
-           if (full) {
-               insertHashTable(addrToStableHash, (W_)p->addr, 
-                               (void *)(p - stable_ptr_table));
-           } else if (p->addr != p->old) {
-               removeHashTable(addrToStableHash, (W_)p->old, NULL);
-               insertHashTable(addrToStableHash, (W_)p->addr, 
-                               (void *)(p - stable_ptr_table));
-           }
-       }
+
+    if(full) {
+        FOR_EACH_STABLE_NAME(
+            p, {
+                if (p->addr != NULL) {
+                    // Target still alive, Re-hash this stable name
+                    insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
+                }
+            });
+    } else {
+        FOR_EACH_STABLE_NAME(
+            p, {
+                if (p->addr != p->old) {
+                    removeHashTable(addrToStableHash, (W_)p->old, NULL);
+                    /* Movement happened: */
+                    if (p->addr != NULL) {
+                        insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
+                    }
+                }
+            });
     }
 }