Revert "Revert "Add purgeObj() to remove the symbol table entries for an object""

This reverts commit 7932b2ad.

includes/rts/Linker.h

@@ -51,6 +51,9 @@ void *lookupSymbol( char *lbl );
 /* delete an object from the pool */
 HsInt unloadObj( pathchar *path );
 
+/* purge an object's symbols from the symbol table, but don't unload it */
+HsInt purgeObj( pathchar *path );
+
 /* add an obj (populate the global symbol table, but don't resolve yet) */
 HsInt loadObj( pathchar *path );
 

rts/Linker.c

@@ -2282,20 +2282,45 @@ mmap_again:
 }
 #endif // USE_MMAP
 
+/*
+ * Remove symbols from the symbol table, and free oc->symbols.
+ * This operation is idempotent.
+ */
 static void removeOcSymbols (ObjectCode *oc)
 {
     if (oc->symbols == NULL) return;
 
-    /* Remove all the mappings for the symbols within this object..
-     */
+    // Remove all the mappings for the symbols within this object..
     int i;
     for (i = 0; i < oc->n_symbols; i++) {
         if (oc->symbols[i] != NULL) {
             ghciRemoveSymbolTable(symhash, oc->symbols[i], oc);
         }
     }
+
+    stgFree(oc->symbols);
+    oc->symbols = NULL;
+}
+
+/*
+ * Release StablePtrs and free oc->stable_ptrs.
+ * This operation is idempotent.
+ */
+static void freeOcStablePtrs (ObjectCode *oc)
+{
+    // Release any StablePtrs that were created when this
+    // object module was initialized.
+    ForeignExportStablePtr *fe_ptr, *next;
+
+    for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
+        next = fe_ptr->next;
+        freeStablePtr(fe_ptr->stable_ptr);
+        stgFree(fe_ptr);
+    }
+    oc->stable_ptrs = NULL;
 }
 
+
 /*
  * freeObjectCode() releases all the pieces of an ObjectCode.  It is called by
  * the GC when a previously unloaded ObjectCode has been determined to be
@@ -3042,6 +3067,7 @@ static HsInt loadObj_ (pathchar *path)
    if (! loadOc(oc)) {
        // failed; free everything we've allocated
        removeOcSymbols(oc);
+       // no need to freeOcStablePtrs, they aren't created until resolveObjs()
        freeObjectCode(oc);
        return 0;
    }
@@ -3177,7 +3203,7 @@ HsInt resolveObjs (void)
 /* -----------------------------------------------------------------------------
  * delete an object from the pool
  */
-static HsInt unloadObj_ (pathchar *path)
+static HsInt unloadObj_ (pathchar *path, rtsBool just_purge)
 {
     ObjectCode *oc, *prev, *next;
     HsBool unloadedAnyObj = HS_BOOL_FALSE;
@@ -3193,30 +3219,24 @@ static HsInt unloadObj_ (pathchar *path)
 
         if (!pathcmp(oc->fileName,path)) {
 
+            // these are both idempotent, so in just_purge mode we can
+            // later call unloadObj() to really unload the object.
             removeOcSymbols(oc);
+            freeOcStablePtrs(oc);
 
-            if (prev == NULL) {
-                objects = oc->next;
-            } else {
-                prev->next = oc->next;
-            }
-            oc->next = unloaded_objects;
-            unloaded_objects = oc;
-
-            // Release any StablePtrs that were created when this
-            // object module was initialized.
-            {
-                ForeignExportStablePtr *fe_ptr, *next;
-
-                for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
-                    next = fe_ptr->next;
-                    freeStablePtr(fe_ptr->stable_ptr);
-                    stgFree(fe_ptr);
+            if (!just_purge) {
+                if (prev == NULL) {
+                    objects = oc->next;
+                } else {
+                    prev->next = oc->next;
                 }
+                oc->next = unloaded_objects;
+                unloaded_objects = oc;
+                oc->status = OBJECT_UNLOADED;
+            } else {
+                prev = oc;
             }
 
-            oc->status = OBJECT_UNLOADED;
-
             /* This could be a member of an archive so continue
              * unloading other members. */
             unloadedAnyObj = HS_BOOL_TRUE;
@@ -3237,7 +3257,15 @@ static HsInt unloadObj_ (pathchar *path)
 HsInt unloadObj (pathchar *path)
 {
     ACQUIRE_LOCK(&linker_mutex);
-    HsInt r = unloadObj_(path);
+    HsInt r = unloadObj_(path, rtsFalse);
+    RELEASE_LOCK(&linker_mutex);
+    return r;
+}
+
+HsInt purgeObj (pathchar *path)
+{
+    ACQUIRE_LOCK(&linker_mutex);
+    HsInt r = unloadObj_(path, rtsTrue);
     RELEASE_LOCK(&linker_mutex);
     return r;
 }

testsuite/tests/rts/linker_unload.c

@@ -87,4 +87,41 @@ int main (int argc, char *argv[])
         printf("%d ", i);
         fflush(stdout);
     }
+
+    for (i=0; i < ITERATIONS; i++) {
+        r = loadObj(OBJPATH);
+        if (!r) {
+            errorBelch("loadObj(%s) failed", OBJPATH);
+            exit(1);
+        }
+        r = resolveObjs();
+        if (!r) {
+            errorBelch("resolveObjs failed");
+            exit(1);
+        }
+#if LEADING_UNDERSCORE
+        f = lookupSymbol("_f");
+#else
+        f = lookupSymbol("f");
+#endif
+        if (!f) {
+            errorBelch("lookupSymbol failed");
+            exit(1);
+        }
+        r = f(3);
+        if (r != 4) {
+            errorBelch("call failed; %d", r);
+            exit(1);
+        }
+        // check that we can purge first, then unload
+        purgeObj(OBJPATH);
+        performMajorGC();
+        unloadObj(OBJPATH);
+        performMajorGC();
+        printf("%d ", i);
+        fflush(stdout);
+    }
+
+    hs_exit();
+    exit(0);
 }