Trac #9878: Have StaticPointers support dynamic loading.

Summary:
A mutex is used to protect the SPT.

unsafeLookupStaticPtr and staticPtrKeys in GHC.StaticPtr are made
monadic.

SPT entries are removed in a destructor function of modules.

Authored-by: Facundo Domínguez <facundo.dominguez@tweag.io>
Authored-by: Alexander Vershilov <alexander.vershilov@tweag.io>

Test Plan: ./validate

Reviewers: austin, simonpj, hvr

Subscribers: carter, thomie, qnikst, mboes

Differential Revision: https://phabricator.haskell.org/D587

GHC Trac Issues: #9878

1 files changed, 54 insertions, 7 deletions

diff --git a/rts/StaticPtrTable.c b/rts/StaticPtrTable.c
index bd450809d0..f7fe06647a 100644
--- a/rts/StaticPtrTable.c
+++ b/rts/StaticPtrTable.c
@@ -8,12 +8,18 @@
  *
  */
 
-#include "Rts.h"
 #include "StaticPtrTable.h"
+#include "Rts.h"
+#include "RtsUtils.h"
 #include "Hash.h"
+#include "Stable.h"
 
 static HashTable * spt = NULL;
 
+#ifdef THREADED_RTS
+static Mutex spt_lock;
+#endif
+
 /// Hash function for the SPT.
 static int hashFingerprint(HashTable *table, StgWord64 key[2]) {
   // Take half of the key to compute the hash.
@@ -28,21 +34,59 @@ static int compareFingerprint(StgWord64 ptra[2], StgWord64 ptrb[2]) {
 void hs_spt_insert(StgWord64 key[2],void *spe_closure) {
   // hs_spt_insert is called from constructor functions, so
   // the SPT needs to be initialized here.
-  if (spt == NULL)
+  if (spt == NULL) {
     spt = allocHashTable_( (HashFunction *)hashFingerprint
                          , (CompareFunction *)compareFingerprint
                          );
+#ifdef THREADED_RTS
+    initMutex(&spt_lock);
+#endif
+  }
+
+  StgStablePtr * entry = stgMallocBytes( sizeof(StgStablePtr)
+                                       , "hs_spt_insert: entry"
+                                       );
+  *entry = getStablePtr(spe_closure);
+  ACQUIRE_LOCK(&spt_lock);
+  insertHashTable(spt, (StgWord)key, entry);
+  RELEASE_LOCK(&spt_lock);
+}
 
-  getStablePtr(spe_closure);
-  insertHashTable(spt, (StgWord)key, spe_closure);
+static void freeSptEntry(void* entry) {
+  freeStablePtr(*(StgStablePtr*)entry);
+  stgFree(entry);
+}
+
+void hs_spt_remove(StgWord64 key[2]) {
+   if (spt) {
+     ACQUIRE_LOCK(&spt_lock);
+     StgStablePtr* entry = removeHashTable(spt, (StgWord)key, NULL);
+     RELEASE_LOCK(&spt_lock);
+
+     if (entry)
+       freeSptEntry(entry);
+   }
 }
 
 StgPtr hs_spt_lookup(StgWord64 key[2]) {
-  return spt ? lookupHashTable(spt, (StgWord)key) : NULL;
+  if (spt) {
+    ACQUIRE_LOCK(&spt_lock);
+    const StgStablePtr * entry = lookupHashTable(spt, (StgWord)key);
+    RELEASE_LOCK(&spt_lock);
+    const StgPtr ret = entry ? deRefStablePtr(*entry) : NULL;
+    return ret;
+  } else
+    return NULL;
 }
 
 int hs_spt_keys(StgPtr keys[], int szKeys) {
-  return spt ? keysHashTable(spt, (StgWord*)keys, szKeys) : 0;
+  if (spt) {
+    ACQUIRE_LOCK(&spt_lock);
+    const int ret = keysHashTable(spt, (StgWord*)keys, szKeys);
+    RELEASE_LOCK(&spt_lock);
+    return ret;
+  } else
+    return 0;
 }
 
 int hs_spt_key_count() {
@@ -51,7 +95,10 @@ int hs_spt_key_count() {
 
 void exitStaticPtrTable() {
   if (spt) {
-    freeHashTable(spt, NULL);
+    freeHashTable(spt, freeSptEntry);
     spt = NULL;
+#ifdef THREADED_RTS
+    closeMutex(&spt_lock);
+#endif
   }
 }