Separate StablePtr and StableName tables (#7674)
authorSimon Marlow <marlowsd@gmail.com>
Thu, 14 Feb 2013 08:46:55 +0000 (08:46 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Thu, 14 Feb 2013 10:56:58 +0000 (10:56 +0000)
To improve performance of StablePtr.

15 files changed:
includes/HsFFI.h
includes/rts/Stable.h
includes/stg/MiscClosures.h
rts/Hash.c
rts/Hash.h
rts/HsFFI.c
rts/Linker.c
rts/PrimOps.cmm
rts/RetainerProfile.c
rts/RtsStartup.c
rts/Stable.c
rts/Stable.h
rts/sm/Compact.c
rts/sm/GC.c
utils/deriveConstants/DeriveConstants.hs

index dceabab..652fbea 100644 (file)
@@ -153,6 +153,10 @@ extern void hs_add_root (void (*init_root)(void));
 
 extern void hs_perform_gc (void);
 
+extern void hs_lock_stable_tables (void);
+extern void hs_unlock_stable_tables (void);
+extern void hs_free_stable_ptr_unsafe (HsStablePtr sp);
+
 extern void hs_free_stable_ptr (HsStablePtr sp);
 extern void hs_free_fun_ptr    (HsFunPtr fp);
 
index ec867e4..9f785ee 100644 (file)
@@ -21,19 +21,22 @@ StgStablePtr getStablePtr  (StgPtr p);
    PRIVATE from here.
    -------------------------------------------------------------------------- */
 
-typedef struct { 
-  StgPtr  addr;                        /* Haskell object, free list, or NULL */
-  StgPtr  old;                 /* old Haskell object, used during GC */
-  StgWord ref;                 /* used for reference counting */
-  StgClosure *sn_obj;          /* the StableName object (or NULL) */
+typedef struct {
+    StgPtr  addr;                      /* Haskell object, free list, or NULL */
+    StgPtr  old;                       /* old Haskell object, used during GC */
+    StgClosure *sn_obj;                /* the StableName object (or NULL) */
 } snEntry;
 
-extern DLL_IMPORT_RTS snEntry *stable_ptr_table;
+typedef struct {
+    StgPtr addr;
+} spEntry;
+
+extern DLL_IMPORT_RTS snEntry *stable_name_table;
+extern DLL_IMPORT_RTS spEntry *stable_ptr_table;
 
 EXTERN_INLINE
 StgPtr deRefStablePtr(StgStablePtr sp)
 {
-    ASSERT(stable_ptr_table[(StgWord)sp].ref > 0);
     return stable_ptr_table[(StgWord)sp].addr;
 }
 
index eec98c2..68c6212 100644 (file)
@@ -472,7 +472,7 @@ extern StgWord RTS_VAR(atomic_modify_mutvar_mutex);
 extern StgWord RTS_VAR(RtsFlags); // bogus type
 
 // Stable.c
-extern StgWord RTS_VAR(stable_ptr_table);
+extern StgWord RTS_VAR(stable_name_table);
 
 // Profiling.c
 extern unsigned int RTS_VAR(era);
index 9c9b2bc..9ab8ffb 100644 (file)
@@ -392,3 +392,8 @@ exitHashTable(void)
 {
     /* nothing to do */
 }
+
+int keyCountHashTable (HashTable *table)
+{
+    return table->kcount;
+}
index 727c042..d22caba 100644 (file)
@@ -19,6 +19,8 @@ void *      lookupHashTable ( HashTable *table, StgWord key );
 void        insertHashTable ( HashTable *table, StgWord key, void *data );
 void *      removeHashTable ( HashTable *table, StgWord key, void *data );
 
+int keyCountHashTable (HashTable *table);
+
 /* Hash table access where the keys are C strings (the strings are
  * assumed to be allocated by the caller, and mustn't be deallocated
  * until the corresponding hash table entry has been removed).
@@ -41,7 +43,7 @@ HashTable * allocHashTable_(HashFunction *hash, CompareFunction *compare);
 int hashWord(HashTable *table, StgWord key);
 int hashStr(HashTable *table, char *key);
 
-/* Freeing hash tables 
+/* Freeing hash tables
  */
 void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) );
 
@@ -50,4 +52,3 @@ void exitHashTable ( void );
 #include "EndPrivate.h"
 
 #endif /* HASH_H */
-
index 38a520d..856536f 100644 (file)
@@ -27,6 +27,16 @@ hs_perform_gc(void)
     performMajorGC();
 }
 
+void hs_lock_stable_tables (void)
+{
+    stableLock();
+}
+
+void hs_unlock_stable_tables (void)
+{
+    stableUnlock();
+}
+
 void
 hs_free_stable_ptr(HsStablePtr sp)
 {
@@ -36,6 +46,14 @@ hs_free_stable_ptr(HsStablePtr sp)
 }
 
 void
+hs_free_stable_ptr_unsafe(HsStablePtr sp)
+{
+    /* The cast is for clarity only, both HsStablePtr and StgStablePtr are
+       typedefs for void*. */
+    freeStablePtrUnsafe((StgStablePtr)sp);
+}
+
+void
 hs_free_fun_ptr(HsFunPtr fp)
 {
     /* I simply *love* all these similar names... */
index ef4f924..cf4f350 100644 (file)
@@ -1112,7 +1112,10 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(hs_set_argv)                                        \
       SymI_HasProto(hs_add_root)                                        \
       SymI_HasProto(hs_perform_gc)                                      \
+      SymI_HasProto(hs_lock_stable_tables)                              \
+      SymI_HasProto(hs_unlock_stable_tables)                            \
       SymI_HasProto(hs_free_stable_ptr)                                 \
+      SymI_HasProto(hs_free_stable_ptr_unsafe)                          \
       SymI_HasProto(hs_free_fun_ptr)                                    \
       SymI_HasProto(hs_hpc_rootModule)                                  \
       SymI_HasProto(hs_hpc_module)                                      \
@@ -1213,6 +1216,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(startupHaskell)                                     \
       SymI_HasProto(shutdownHaskell)                                    \
       SymI_HasProto(shutdownHaskellAndExit)                             \
+      SymI_HasProto(stable_name_table)                                  \
       SymI_HasProto(stable_ptr_table)                                   \
       SymI_HasProto(stackOverflow)                                      \
       SymI_HasProto(stg_CAF_BLACKHOLE_info)                             \
@@ -4113,7 +4117,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
 #    define R_X86_64_PC64 24
 #  endif
 
-/* 
+/*
  * Workaround for libc implementations (e.g. eglibc) with incomplete
  * relocation lists
  */
@@ -4992,7 +4996,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
                   | (offset & 0x01fe);
             break;
          }
-         
+
          case R_ARM_THM_JUMP11:
          {
             StgWord16 *word = (StgWord16 *)P;
index ebcee6a..f4e80e9 100644 (file)
@@ -1,3 +1,4 @@
+/* -*- tab-width: 8 -*- */
 /* -----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2012
@@ -1513,22 +1514,21 @@ stg_makeStableNamezh ( P_ obj )
 {
     W_ index, sn_obj;
 
-    ALLOC_PRIM_P (SIZEOF_StgStableName, stg_makeStableNamezh, obj);
-  
     (index) = ccall lookupStableName(obj "ptr");
 
     /* Is there already a StableName for this heap object?
-     *  stable_ptr_table is a pointer to an array of snEntry structs.
+     *  stable_name_table is a pointer to an array of snEntry structs.
      */
-    if ( snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) == NULL ) {
-       sn_obj = Hp - SIZEOF_StgStableName + WDS(1);
-       SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS);
-       StgStableName_sn(sn_obj) = index;
-       snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) = sn_obj;
+    if ( snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) == NULL ) {
+        ALLOC_PRIM (SIZEOF_StgStableName);
+        sn_obj = Hp - SIZEOF_StgStableName + WDS(1);
+        SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS);
+        StgStableName_sn(sn_obj) = index;
+        snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj;
     } else {
-       sn_obj = snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry);
+        sn_obj = snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry);
     }
-    
+
     return (sn_obj);
 }
 
@@ -1543,7 +1543,7 @@ stg_makeStablePtrzh ( P_ obj )
 stg_deRefStablePtrzh ( P_ sp )
 {
     W_ r;
-    r = snEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_snEntry);
+    r = spEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_spEntry);
     return (r);
 }
 
index 44df06a..4e7ed3e 100644 (file)
@@ -1772,7 +1772,7 @@ computeRetainerSet( void )
        retainRoot(NULL, (StgClosure **)&weak);
 
     // Consider roots from the stable ptr table.
-    markStablePtrTable(retainRoot, NULL);
+    markStableTables(retainRoot, NULL);
 
     // The following code resets the rs field of each unvisited mutable
     // object (computing sumOfNewCostExtra and updating costArray[] when
index f5c29f4..e83d047 100644 (file)
@@ -185,7 +185,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     initStorage();
 
     /* initialise the stable pointer table */
-    initStablePtrTable();
+    initStableTables();
 
     /* 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
@@ -377,7 +377,7 @@ hs_exit_(rtsBool wait_foreign)
     freeFileLocking();
 
     /* free the stable pointer table */
-    exitStablePtrTable();
+    exitStableTables();
 
 #if defined(DEBUG)
     /* free the thread label table */
index 39b2617..ff3843e 100644 (file)
@@ -1,3 +1,5 @@
+/* -*- tab-width: 4 -*- */
+
 /* -----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2002
   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://hackage.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
 
 #ifdef THREADED_RTS
 Mutex stable_mutex;
 #endif
 
+static void enlargeStableNameTable(void);
 static void enlargeStablePtrTable(void);
 
 /* This hash table maps Haskell objects to stable names, so that every
@@ -117,57 +138,74 @@ static void enlargeStablePtrTable(void);
 
 static HashTable *addrToStableHash = NULL;
 
-#define INIT_SPT_SIZE 64
-
 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
 }
 
 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;
+
 #ifdef THREADED_RTS
-  closeMutex(&stable_mutex);
+    closeMutex(&stable_mutex);
 #endif
 }
 
@@ -203,8 +241,8 @@ lookupStableName_(StgPtr p)
   StgWord sn;
   void* sn_tmp;
 
-  if (stable_ptr_free == NULL) {
-    enlargeStablePtrTable();
+  if (stable_name_free == NULL) {
+    enlargeStableNameTable();
   }
 
   /* removing indirections increases the likelihood
@@ -217,24 +255,23 @@ 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);
-
-    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);
+
+  return sn;
 }
 
 StgWord
@@ -242,7 +279,7 @@ lookupStableName(StgPtr p)
 {
     StgWord res;
 
-    initStablePtrTable();
+    initStableTables();
     ACQUIRE_LOCK(&stable_mutex);
     res = lookupStableName_(p);
     RELEASE_LOCK(&stable_mutex);
@@ -250,66 +287,85 @@ lookupStableName(StgPtr p)
 }
 
 STATIC_INLINE void
-freeStableName(snEntry *sn)
+freeSnEntry(snEntry *sn)
 {
   ASSERT(sn->sn_obj == NULL);
-  if (sn->addr != NULL) {
+  if(sn->addr != NULL) {
+      /* StableName object may die before pointee, in which case we
+       * need to remove from hash table, or after pointee, in which
+       * case addr==NULL and we already removed it. */
       removeHashTable(addrToStableHash, (W_)sn->addr, NULL);
   }
-  sn->addr = (P_)stable_ptr_free;
-  stable_ptr_free = sn;
+  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;
 }
 
 StgStablePtr
 getStablePtr(StgPtr p)
 {
-  StgWord sn;
+  StgWord sp;
 
-  initStablePtrTable();
+  initStableTables();
   ACQUIRE_LOCK(&stable_mutex);
-  sn = lookupStableName_(p);
-  stable_ptr_table[sn].ref++;
+  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;
   RELEASE_LOCK(&stable_mutex);
-  return (StgStablePtr)(sn);
+  return (StgStablePtr)(sp);
 }
 
 void
-freeStablePtr(StgStablePtr sp)
+freeStablePtrUnsafe(StgStablePtr sp)
 {
-    snEntry *sn;
+    ASSERT((StgWord)sp < SPT_size);
+    freeSpEntry(&stable_ptr_table[(StgWord)sp]);
+}
 
-       initStablePtrTable();
+void
+freeStablePtr(StgStablePtr sp)
+{
+    initStableTables();
     ACQUIRE_LOCK(&stable_mutex);
+    freeStablePtrUnsafe(sp);
+    RELEASE_LOCK(&stable_mutex);
+}
 
-    sn = &stable_ptr_table[(StgWord)sp];
-    
-    ASSERT((StgWord)sp < SPT_size  &&  sn->addr != NULL  &&  sn->ref > 0);
-
-    sn->ref--;
+static void
+enlargeStableNameTable(void)
+{
+    nat old_SNT_size = SNT_size;
 
-    // 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);
-    }
+    // 2nd and subsequent times
+    SNT_size *= 2;
+    stable_name_table =
+        stgReallocBytes(stable_name_table,
+                        SNT_size * sizeof *stable_name_table,
+                        "enlargeStableNameTable");
 
-    RELEASE_LOCK(&stable_mutex);
+    initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL);
 }
 
 static void
 enlargeStablePtrTable(void)
 {
-  nat old_SPT_size = SPT_size;
+    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");
+    SPT_size *= 2;
+    stable_ptr_table =
+        stgReallocBytes(stable_ptr_table,
+                        SPT_size * sizeof *stable_ptr_table,
+                        "enlargeStablePtrTable");
 
-  initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
+    initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
 }
 
 /* -----------------------------------------------------------------------------
@@ -318,82 +374,110 @@ enlargeStablePtrTable(void)
  * -------------------------------------------------------------------------- */
 
 void
-stablePtrPreGC(void)
+stableLock(void)
 {
+    initStableTables();
     ACQUIRE_LOCK(&stable_mutex);
 }
 
 void
-stablePtrPostGC(void)
+stableUnlock(void)
 {
     RELEASE_LOCK(&stable_mutex);
 }
 
 /* -----------------------------------------------------------------------------
  * Treat stable pointers as roots for the garbage collector.
- *
- * 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.
  * -------------------------------------------------------------------------- */
 
-void
+#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)
+
+STATIC_INLINE void
 markStablePtrTable(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_PTR(p, evac(user, (StgClosure **)&p->addr););
+}
+
+STATIC_INLINE void
+rememberOldStableNameAddresses(void)
+{
+    /* TODO: Only if !full GC */
+    FOR_EACH_STABLE_NAME(p, p->old = p->addr;);
+}
+
+void
+markStableTables(evac_fn evac, void *user)
+{
+    markStablePtrTable(evac, user);
+    rememberOldStableNameAddresses();
 }
 
 /* -----------------------------------------------------------------------------
  * 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
+ * the heap from the stable tables, because the compacting
  * collector may move the object it points to.
  * -------------------------------------------------------------------------- */
 
-void
+STATIC_INLINE 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);
+        }
+    });
+}
+
+STATIC_INLINE void
 threadStablePtrTable( 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);
-       }
-    }
+    FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
+}
+
+void
+threadStableTables( evac_fn evac, void *user )
+{
+    threadStableNameTable(evac, user);
+    threadStablePtrTable(evac, user);
 }
 
 /* -----------------------------------------------------------------------------
@@ -411,49 +495,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
@@ -462,39 +538,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));
+                    }
+                }
+            });
     }
 }
index bec932a..4786d47 100644 (file)
 
 void    freeStablePtr         ( StgStablePtr sp );
 
-void    initStablePtrTable    ( void );
-void    exitStablePtrTable    ( void );
-StgWord lookupStableName      ( StgPtr p );
+/* Use the "Unsafe" one after manually locking with stableLock/stableUnlock */
+void    freeStablePtrUnsafe   ( StgStablePtr sp );
 
-void    markStablePtrTable    ( evac_fn evac, void *user );
-void    threadStablePtrTable  ( evac_fn evac, void *user );
-void    gcStablePtrTable      ( void );
-void    updateStablePtrTable  ( rtsBool full );
+void    initStableTables      ( void );
+void    exitStableTables      ( void );
+StgWord lookupStableName      ( StgPtr p );
 
-void    stablePtrPreGC        ( void );
-void    stablePtrPostGC       ( void );
+/* Call given function on every stable ptr. markStableTables 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.
+ */
+void    markStableTables      ( evac_fn evac, void *user );
+
+void    threadStableTables    ( evac_fn evac, void *user );
+void    gcStableTables        ( void );
+void    updateStableTables    ( rtsBool full );
+
+void    stableLock            ( void );
+void    stableUnlock          ( void );
 
 #ifdef THREADED_RTS
 // needed by Schedule.c:forkProcess()
index 02183c6..7c89418 100644 (file)
@@ -964,7 +964,7 @@ compact(StgClosure *static_objects)
     thread_static(static_objects /* ToDo: ok? */);
 
     // the stable pointer table
-    threadStablePtrTable((evac_fn)thread_root, NULL);
+    threadStableTables((evac_fn)thread_root, NULL);
 
     // the CAF list (used by GHCi)
     markCAFs((evac_fn)thread_root, NULL);
index ea0e403..dfebd55 100644 (file)
@@ -220,7 +220,7 @@ GarbageCollect (nat collect_gen,
   stat_startGC(cap, gct);
 
   // lock the StablePtr table
-  stablePtrPreGC();
+  stableLock();
 
 #ifdef DEBUG
   mutlist_MUTVARS = 0;
@@ -390,7 +390,7 @@ GarbageCollect (nat collect_gen,
   initWeakForGC();
 
   // Mark the stable pointer table.
-  markStablePtrTable(mark_root, gct);
+  markStableTables(mark_root, gct);
 
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
@@ -420,7 +420,7 @@ GarbageCollect (nat collect_gen,
   shutdown_gc_threads(gct->thread_index);
 
   // Now see which stable names are still alive.
-  gcStablePtrTable();
+  gcStableTables();
 
 #ifdef THREADED_RTS
   if (n_gc_threads == 1) {
@@ -698,15 +698,15 @@ GarbageCollect (nat collect_gen,
   }
 
   // Update the stable pointer hash table.
-  updateStablePtrTable(major_gc);
+  updateStableTables(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.
-  stablePtrPostGC();
+  stableUnlock();
 
   // Start any pending finalizers.  Must be after
-  // updateStablePtrTable() and stablePtrPostGC() (see #4221).
+  // updateStableTables() and stableUnlock() (see #4221).
   RELEASE_SM_LOCK;
   scheduleFinalizers(cap, old_weak_ptr_list);
   ACQUIRE_SM_LOCK;
index e726bf7..77daf5c 100644 (file)
@@ -536,6 +536,9 @@ wanteds = concat
           ,structField C "snEntry" "sn_obj"
           ,structField C "snEntry" "addr"
 
+          ,structSize  C "spEntry"
+          ,structField C "spEntry" "addr"
+
            -- Note that this conditional part only affects the C headers.
            -- That's important, as it means we get the same PlatformConstants
            -- type on all platforms.