Separate StablePtr and StableName tables (#7674)

To improve performance of StablePtr.

includes/HsFFI.h

@@ -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);
 

includes/rts/Stable.h

@@ -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;
 }
 

includes/stg/MiscClosures.h

@@ -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);

rts/Hash.c

@@ -392,3 +392,8 @@ exitHashTable(void)
 {
     /* nothing to do */
 }
+
+int keyCountHashTable (HashTable *table)
+{
+    return table->kcount;
+}

rts/Hash.h

@@ -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 */
-

rts/HsFFI.c

@@ -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)
 {
@@ -35,6 +45,14 @@ hs_free_stable_ptr(HsStablePtr sp)
     freeStablePtr((StgStablePtr)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)
 {

rts/Linker.c

@@ -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;

rts/PrimOps.cmm

+/* -*- 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);
 }
 

rts/RetainerProfile.c

@@ -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

rts/RtsStartup.c

@@ -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 */

rts/Stable.h

@@ -21,17 +21,28 @@
 
 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()

rts/sm/Compact.c

@@ -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);

rts/sm/GC.c

@@ -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;

utils/deriveConstants/DeriveConstants.hs

@@ -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.