[commit: ghc] master: Fix linker_unload now that we are running constructors in the linker (#8291) (1908195)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1908195261ccf16b0f3d2e77ebd5cd40c9e29cbc/ghc

>---------------------------------------------------------------

commit 1908195261ccf16b0f3d2e77ebd5cd40c9e29cbc
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Sun Sep 22 13:08:01 2013 +0100

    Fix linker_unload now that we are running constructors in the linker (#8291)
    
    See also #5435.
    
    Now we have to remember the the StablePtrs that get created by the
    module initializer so that we can free them again in unloadObj().


>---------------------------------------------------------------

1908195261ccf16b0f3d2e77ebd5cd40c9e29cbc
 compiler/deSugar/DsForeign.lhs |    2 +-
 includes/rts/Linker.h          |    3 +++
 rts/Linker.c                   |   49 ++++++++++++++++++++++++++++++++++++++++
 rts/LinkerInternals.h          |   13 +++++++++++
 4 files changed, 66 insertions(+), 1 deletion(-)

diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index c7cc13f..e2f4f4f 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -676,7 +676,7 @@ foreignExportInitialiser hs_fn =
     [ text "static void stginit_export_" <> ppr hs_fn
          <> text "() __attribute__((constructor));"
     , text "static void stginit_export_" <> ppr hs_fn <> text "()"
-    , braces (text "getStablePtr"
+    , braces (text "foreignExportStablePtr"
        <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
        <> semi)
     ]
diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h
index 28f0a0e..2e88fe4 100644
--- a/includes/rts/Linker.h
+++ b/includes/rts/Linker.h
@@ -49,4 +49,7 @@ HsInt resolveObjs( void );
 /* load a dynamic library */
 const char *addDLL( pathchar* dll_name );
 
+/* called by the initialization code for a module, not a user API */
+StgStablePtr foreignExportStablePtr (StgPtr p);
+
 #endif /* RTS_LINKER_H */
diff --git a/rts/Linker.c b/rts/Linker.c
index 31f60c0..7334a80 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1116,6 +1116,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(getProgArgv)                                        \
       SymI_HasProto(getFullProgArgv)                                    \
       SymI_HasProto(getStablePtr)                                       \
+      SymI_HasProto(foreignExportStablePtr)                             \
       SymI_HasProto(hs_init)                                            \
       SymI_HasProto(hs_exit)                                            \
       SymI_HasProto(hs_set_argv)                                        \
@@ -1948,6 +1949,37 @@ lookupSymbol( char *lbl )
 }
 
 /* -----------------------------------------------------------------------------
+   Create a StablePtr for a foeign export.  This is normally called by
+   a C function with __attribute__((constructor)), which is generated
+   by GHC and linked into the module.
+
+   If the object code is being loaded dynamically, then we remember
+   which StablePtrs were allocated by the constructors and free them
+   again in unloadObj().
+   -------------------------------------------------------------------------- */
+
+static ObjectCode *loading_obj = NULL;
+
+StgStablePtr foreignExportStablePtr (StgPtr p)
+{
+    ForeignExportStablePtr *fe_sptr;
+    StgStablePtr *sptr;
+
+    sptr = getStablePtr(p);
+
+    if (loading_obj != NULL) {
+        fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr),
+                                 "foreignExportStablePtr");
+        fe_sptr->stable_ptr = sptr;
+        fe_sptr->next = loading_obj->stable_ptrs;
+        loading_obj->stable_ptrs = fe_sptr;
+    }
+
+    return sptr;
+}
+
+
+/* -----------------------------------------------------------------------------
  * Debugging aid: look in GHCi's object symbol tables for symbols
  * within DELTA bytes of the specified address, and show their names.
  */
@@ -2143,6 +2175,7 @@ mkOc( pathchar *path, char *image, int imageSize,
    oc->symbols           = NULL;
    oc->sections          = NULL;
    oc->proddables        = NULL;
+   oc->stable_ptrs       = NULL;
 
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
@@ -2786,6 +2819,8 @@ resolveObjs( void )
             if (!r) { return r; }
 
             // run init/init_array/ctors/mod_init_func
+
+            loading_obj = oc; // tells foreignExportStablePtr what to do
 #if defined(OBJFORMAT_ELF)
             r = ocRunInit_ELF ( oc );
 #elif defined(OBJFORMAT_PEi386)
@@ -2795,6 +2830,8 @@ resolveObjs( void )
 #else
             barf("resolveObjs: initializers not implemented on this platform");
 #endif
+            loading_obj = NULL;
+
             if (!r) { return r; }
 
             oc->status = OBJECT_RESOLVED;
@@ -2863,6 +2900,18 @@ unloadObj( pathchar *path )
 
             freeProddableBlocks(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->status = OBJECT_UNLOADED;
 
             /* This could be a member of an archive so continue
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index b788ea7..e1942bc 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -44,6 +44,17 @@ typedef
    }
    ProddableBlock;
 
+/*
+ * We must keep track of the StablePtrs that are created for foreign
+ * exports by constructor functions when the module is loaded, so that
+ * we can free them again when the module is unloaded.  If we don't do
+ * this, then the StablePtr will keep the module alive indefinitely.
+ */
+typedef struct ForeignExportStablePtr_ {
+    StgStablePtr stable_ptr;
+    struct ForeignExportStablePtr_ *next;
+} ForeignExportStablePtr;
+
 /* Jump Islands are sniplets of machine code required for relative
  * address relocations on the PowerPC, x86_64 and ARM.
  */
@@ -120,6 +131,8 @@ typedef struct _ObjectCode {
     unsigned long   n_symbol_extras;
 #endif
 
+    ForeignExportStablePtr *stable_ptrs;
+
 } ObjectCode;
 
 #define OC_INFORMATIVE_FILENAME(OC)             \