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

This allows us to replace an object without actually unloading the old
object, which is necessary when we know we have references to the old
object so it can't be completely unloaded.  Using unloadObj() would
cause the GC (CheckUnload) to repeatedly and fruitlessly try to unload
the old object.

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

@@ -2255,20 +2255,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
@@ -3015,6 +3040,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;
    }
@@ -3150,7 +3176,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;
@@ -3166,30 +3192,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;
@@ -3210,7 +3230,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);
 }