[commit: ghc] master: Allow the linker to be used without retaining CAFs unconditionally (5874f13)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5874f13fd83409b28c4f781a93e80f4605d0593e/ghc

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

commit 5874f13fd83409b28c4f781a93e80f4605d0593e
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Nov 21 12:27:27 2013 +0000

    Allow the linker to be used without retaining CAFs unconditionally
    
    This creates a new C API:
    
       initLinker_ (int retain_cafs)
    
    The old initLinker() was left as-is for backwards compatibility.  See
    documentation in Linker.h.


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

5874f13fd83409b28c4f781a93e80f4605d0593e
 includes/rts/Linker.h |   21 +++++++++++++++++++--
 rts/Linker.c          |   18 ++++++++++++++++--
 rts/sm/GC.c           |    8 ++++----
 3 files changed, 39 insertions(+), 8 deletions(-)

diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h
index ea4daeb..e7e2ea5 100644
--- a/includes/rts/Linker.h
+++ b/includes/rts/Linker.h
@@ -22,8 +22,25 @@ typedef char    pathchar;
 #define PATH_FMT "s"
 #endif
 
-/* initialize the object linker */
-void initLinker( void );
+/* Initialize the object linker. Equivalent to initLinker_(1). */
+void initLinker (void);
+
+/* Initialize the object linker.
+ * The retain_cafs argument is:
+ *
+ *   non-zero => Retain CAFs unconditionally in linked Haskell code.
+ *               Note that this prevents any code from being unloaded.
+ *               It should not be necessary unless you are GHCi or
+ *               hs-plugins, which needs to be able call any function
+ *               in the compiled code.
+ *
+ *   zero     => Do not retain CAFs.  Everything reachable from foreign
+ *               exports will be retained, due to the StablePtrs
+ *               created by the module initialisation code.  unloadObj
+ *               free these StablePtrs, which will allow the CAFs to
+ *               be GC'd and the code to be removed.
+ */
+void initLinker_ (int retain_cafs);
 
 /* insert a symbol in the hash table */
 void insertSymbol(pathchar* obj_name, char* key, void* data);
diff --git a/rts/Linker.c b/rts/Linker.c
index 285984a..1a663cb 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1133,6 +1133,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(hs_hpc_rootModule)                                  \
       SymI_HasProto(hs_hpc_module)                                      \
       SymI_HasProto(initLinker)                                         \
+      SymI_HasProto(initLinker_)                                        \
       SymI_HasProto(stg_unpackClosurezh)                                \
       SymI_HasProto(stg_getApStackValzh)                                \
       SymI_HasProto(stg_getSparkzh)                                     \
@@ -1155,7 +1156,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_newByteArrayzh)                                 \
       SymI_HasProto(stg_casIntArrayzh)                                  \
       SymI_HasProto(stg_fetchAddIntArrayzh)                             \
-      SymI_HasProto_redirect(newCAF, newDynCAF)                         \
       SymI_HasProto(stg_newMVarzh)                                      \
       SymI_HasProto(stg_newMutVarzh)                                    \
       SymI_HasProto(stg_newTVarzh)                                      \
@@ -1558,8 +1558,16 @@ static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
 #endif
 #endif
 
+void initLinker (void)
+{
+    // default to retaining CAFs for backwards compatibility.  Most
+    // users will want initLinker_(0): otherwise unloadObj() will not
+    // be able to object files when they contain CAFs.
+    initLinker_(1);
+}
+
 void
-initLinker( void )
+initLinker_ (int retain_cafs)
 {
     RtsSymbolVal *sym;
 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
@@ -1603,6 +1611,12 @@ initLinker( void )
     ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
         symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL);
 
+    // Redurect newCAF to newDynCAF if retain_cafs is true.
+    ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
+                          MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
+                          retain_cafs ? newDynCAF : newCAF,
+                          HS_BOOL_FALSE, NULL);
+
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 #   if defined(RTLD_DEFAULT)
     dl_prog_handle = RTLD_DEFAULT;
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 80e34fb..58698e9 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -662,15 +662,15 @@ GarbageCollect (nat collect_gen,
 
   resetNurseries();
 
-  if (major_gc) {
-      checkUnload (gct->scavenged_static_objects);
-  }
-
  // mark the garbage collected CAFs as dead
 #if defined(DEBUG)
   if (major_gc) { gcCAFs(); }
 #endif
 
+  if (major_gc) {
+      checkUnload (gct->scavenged_static_objects);
+  }
+
 #ifdef PROFILING
   // resetStaticObjectForRetainerProfiling() must be called before
   // zeroing below.