[commit: ghc] master: Add option to not retain CAFs to the linker API (f148513)

[git at git.haskell.org]

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

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

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

commit f148513ccd93b927ed36152584228980597c6ebd
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Oct 13 12:51:33 2016 +0100

    Add option to not retain CAFs to the linker API


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

f148513ccd93b927ed36152584228980597c6ebd
 libraries/ghci/GHCi/ObjLink.hs | 25 +++++++++++++++++++++++--
 libraries/ghci/GHCi/Run.hs     |  2 +-
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs
index d422813..05a0a16 100644
--- a/libraries/ghci/GHCi/ObjLink.hs
+++ b/libraries/ghci/GHCi/ObjLink.hs
@@ -11,7 +11,7 @@
 -- | Primarily, this module consists of an interface to the C-land
 -- dynamic linker.
 module GHCi.ObjLink
-  ( initObjLinker
+  ( initObjLinker, ShouldRetainCAFs(..)
   , loadDLL
   , loadArchive
   , loadObj
@@ -33,10 +33,31 @@ import GHC.Exts
 import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )
 import System.FilePath  ( dropExtension, normalise )
 
+
+
+
 -- ---------------------------------------------------------------------------
 -- RTS Linker Interface
 -- ---------------------------------------------------------------------------
 
+data ShouldRetainCAFs
+  = RetainCAFs
+    -- ^ 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.
+  | DontRetainCAFs
+    -- ^ Do not retain CAFs.  Everything reachable from foreign
+    -- exports will be retained, due to the StablePtrs
+    -- created by the module initialisation code.  unloadObj
+    -- frees these StablePtrs, which will allow the CAFs to
+    -- be GC'd and the code to be removed.
+
+initObjLinker :: ShouldRetainCAFs -> IO ()
+initObjLinker RetainCAFs = c_initLinker_ 1
+initObjLinker _ = c_initLinker_ 0
+
 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do
    let str = prefixUnderscore str_in
@@ -128,7 +149,7 @@ resolveObjs = do
 -- ---------------------------------------------------------------------------
 
 foreign import ccall unsafe "addDLL"                  c_addDLL                  :: CFilePath -> IO CString
-foreign import ccall unsafe "initLinker"              initObjLinker             :: IO ()
+foreign import ccall unsafe "initLinker_"             c_initLinker_             :: CInt -> IO ()
 foreign import ccall unsafe "lookupSymbol"            c_lookupSymbol            :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadArchive"             c_loadArchive             :: CFilePath -> IO Int
 foreign import ccall unsafe "loadObj"                 c_loadObj                 :: CFilePath -> IO Int
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index a577480..fefbdc3 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -45,7 +45,7 @@ import Unsafe.Coerce
 
 run :: Message a -> IO a
 run m = case m of
-  InitLinker -> initObjLinker
+  InitLinker -> initObjLinker RetainCAFs
   LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str
   LookupClosure str -> lookupClosure str
   LoadDLL str -> loadDLL str