Fix obscure problem with using the system linker (#8935)

See Note [RTLD_LOCAL] for a summary of the problem and solution, and

2 files changed, 83 insertions, 32 deletions

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 0b23985be8..162c349a8d 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -124,8 +124,12 @@ data PersistentLinkerState
         -- The currently-loaded packages; always object code
         -- Held, as usual, in dependency order; though I am not sure if
         -- that is really important
-        pkgs_loaded :: ![PackageId]
-     }
+        pkgs_loaded :: ![PackageId],
+
+        -- we need to remember the name of the last temporary DLL/.so
+        -- so we can link it
+        last_temp_so :: !(Maybe FilePath)
+         }
 
 emptyPLS :: DynFlags -> PersistentLinkerState
 emptyPLS _ = PersistentLinkerState {
@@ -133,7 +137,8 @@ emptyPLS _ = PersistentLinkerState {
                         itbl_env    = emptyNameEnv,
                         pkgs_loaded = init_pkgs,
                         bcos_loaded = [],
-                        objs_loaded = [] }
+                        objs_loaded = [],
+                        last_temp_so = Nothing }
 
   -- Packages that don't need loading, because the compiler
   -- shares them with the interpreted program.
@@ -315,14 +320,14 @@ reallyInitDynLinker dflags =
         ; if null cmdline_lib_specs then return pls
                                     else do
 
-        { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+        { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls cmdline_lib_specs
         ; maybePutStr dflags "final link ... "
         ; ok <- resolveObjs
 
         ; if succeeded ok then maybePutStrLn dflags "done"
           else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed")
 
-        ; return pls
+        ; return pls1
         }}
 
 
@@ -361,19 +366,21 @@ classifyLdInput dflags f
         return Nothing
     where platform = targetPlatform dflags
 
-preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
-preloadLib dflags lib_paths framework_paths lib_spec
+preloadLib :: DynFlags -> [String] -> [String] -> PersistentLinkerState -> LibrarySpec -> IO (PersistentLinkerState)
+preloadLib dflags lib_paths framework_paths pls lib_spec
   = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
        case lib_spec of
           Object static_ish
-             -> do b <- preload_static lib_paths static_ish
+             -> do (b, pls1) <- preload_static lib_paths static_ish
                    maybePutStrLn dflags (if b  then "done"
                                                 else "not found")
+                   return pls1
 
           Archive static_ish
              -> do b <- preload_static_archive lib_paths static_ish
                    maybePutStrLn dflags (if b  then "done"
                                                 else "not found")
+                   return pls
 
           DLL dll_unadorned
              -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned)
@@ -389,12 +396,14 @@ preloadLib dflags lib_paths framework_paths lib_spec
                         case err2 of
                           Nothing -> maybePutStrLn dflags "done"
                           Just _  -> preloadFailed mm lib_paths lib_spec
+                   return pls
 
           DLLPath dll_path
              -> do maybe_errstr <- loadDLL dll_path
                    case maybe_errstr of
                       Nothing -> maybePutStrLn dflags "done"
                       Just mm -> preloadFailed mm lib_paths lib_spec
+                   return pls
 
           Framework framework ->
               if platformUsesFrameworks (targetPlatform dflags)
@@ -402,6 +411,7 @@ preloadLib dflags lib_paths framework_paths lib_spec
                       case maybe_errstr of
                          Nothing -> maybePutStrLn dflags "done"
                          Just mm -> preloadFailed mm framework_paths lib_spec
+                      return pls
               else panic "preloadLib Framework"
 
   where
@@ -421,11 +431,13 @@ preloadLib dflags lib_paths framework_paths lib_spec
     -- Not interested in the paths in the static case.
     preload_static _paths name
        = do b <- doesFileExist name
-            if not b then return False
-                     else do if dynamicGhc
-                                 then dynLoadObjs dflags [name]
-                                 else loadObj name
-                             return True
+            if not b then return (False, pls)
+                     else if dynamicGhc
+                             then  do pls1 <- dynLoadObjs dflags pls [name]
+                                      return (True, pls1)
+                             else  do loadObj name
+                                      return (True, pls)
+
     preload_static_archive _paths name
        = do b <- doesFileExist name
             if not b then return False
@@ -792,8 +804,8 @@ dynLinkObjs dflags pls objs = do
             wanted_objs              = map nameOfObject unlinkeds
 
         if dynamicGhc
-            then do dynLoadObjs dflags wanted_objs
-                    return (pls1, Succeeded)
+            then do pls2 <- dynLoadObjs dflags pls1 wanted_objs
+                    return (pls2, Succeeded)
             else do mapM_ loadObj wanted_objs
 
                     -- Link them all together
@@ -807,9 +819,11 @@ dynLinkObjs dflags pls objs = do
                             pls2 <- unload_wkr dflags [] pls1
                             return (pls2, Failed)
 
-dynLoadObjs :: DynFlags -> [FilePath] -> IO ()
-dynLoadObjs _      []   = return ()
-dynLoadObjs dflags objs = do
+
+dynLoadObjs :: DynFlags -> PersistentLinkerState -> [FilePath]
+            -> IO PersistentLinkerState
+dynLoadObjs _      pls []   = return pls
+dynLoadObjs dflags pls objs = do
     let platform = targetPlatform dflags
     soFile <- newTempName dflags (soExt platform)
     let -- When running TH for a non-dynamic way, we still need to make
@@ -817,10 +831,22 @@ dynLoadObjs dflags objs = do
         -- Opt_Static off
         dflags1 = gopt_unset dflags Opt_Static
         dflags2 = dflags1 {
-                      -- We don't want to link the ldInputs in; we'll
-                      -- be calling dynLoadObjs with any objects that
-                      -- need to be linked.
-                      ldInputs = [],
+                      -- We don't want the original ldInputs in
+                      -- (they're already linked in), but we do want
+                      -- to link against the previous dynLoadObjs
+                      -- library if there was one, so that the linker
+                      -- can resolve dependencies when it loads this
+                      -- library.
+                      ldInputs =
+                        case last_temp_so pls of
+                          Nothing -> []
+                          Just so  ->
+                                 let (lp, l) = splitFileName so in
+                                 [ Option ("-L" ++ lp)
+                                 , Option ("-Wl,-rpath")
+                                 , Option ("-Wl," ++ lp)
+                                 , Option ("-l:" ++ l)
+                                 ],
                       -- Even if we're e.g. profiling, we still want
                       -- the vanilla dynamic libraries, so we set the
                       -- ways / build tag to be just WayDyn.
@@ -832,7 +858,7 @@ dynLoadObjs dflags objs = do
     consIORef (filesToNotIntermediateClean dflags) soFile
     m <- loadDLL soFile
     case m of
-        Nothing -> return ()
+        Nothing -> return pls { last_temp_so = Just soFile }
         Just err -> panic ("Loading temp shared object failed: " ++ err)
 
 rmDupLinkables :: [Linkable]    -- Already loaded
diff --git a/rts/Linker.c b/rts/Linker.c
index e5e61bb49a..f7f554ce6c 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1798,7 +1798,7 @@ internal_dlopen(const char *dll_name)
    // (see POSIX also)
 
    ACQUIRE_LOCK(&dl_mutex);
-   hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+   hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
 
    errmsg = NULL;
    if (hdl == NULL) {
@@ -1808,11 +1808,12 @@ internal_dlopen(const char *dll_name)
       errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
       strcpy(errmsg_copy, errmsg);
       errmsg = errmsg_copy;
+   } else {
+      o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
+      o_so->handle = hdl;
+      o_so->next   = openedSOs;
+      openedSOs    = o_so;
    }
-   o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
-   o_so->handle = hdl;
-   o_so->next   = openedSOs;
-   openedSOs    = o_so;
 
    RELEASE_LOCK(&dl_mutex);
    //--------------- End critical section -------------------
@@ -1820,14 +1821,39 @@ internal_dlopen(const char *dll_name)
    return errmsg;
 }
 
+/*
+  Note [RTLD_LOCAL]
+
+  In GHCi we want to be able to override previous .so's with newly
+  loaded .so's when we recompile something.  This further implies that
+  when we look up a symbol in internal_dlsym() we have to iterate
+  through the loaded libraries (in order from most recently loaded to
+  oldest) looking up the symbol in each one until we find it.
+
+  However, this can cause problems for some symbols that are copied
+  by the linker into the executable image at runtime - see #8935 for a
+  lengthy discussion.  To solve that problem we need to look up
+  symbols in the main executable *first*, before attempting to look
+  them up in the loaded .so's.  But in order to make that work, we
+  have to always call dlopen with RTLD_LOCAL, so that the loaded
+  libraries don't populate the global symbol table.
+*/
+
 static void *
-internal_dlsym(void *hdl, const char *symbol) {
+internal_dlsym(const char *symbol) {
     OpenedSO* o_so;
     void *v;
 
     // We acquire dl_mutex as concurrent dl* calls may alter dlerror
     ACQUIRE_LOCK(&dl_mutex);
     dlerror();
+    // look in program first
+    v = dlsym(dl_prog_handle, symbol);
+    if (dlerror() == NULL) {
+        RELEASE_LOCK(&dl_mutex);
+        return v;
+    }
+
     for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
         v = dlsym(o_so->handle, symbol);
         if (dlerror() == NULL) {
@@ -1835,7 +1861,6 @@ internal_dlsym(void *hdl, const char *symbol) {
             return v;
         }
     }
-    v = dlsym(hdl, symbol);
     RELEASE_LOCK(&dl_mutex);
     return v;
 }
@@ -2003,7 +2028,7 @@ lookupSymbol( char *lbl )
     if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
         IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
 #       if defined(OBJFORMAT_ELF)
-        return internal_dlsym(dl_prog_handle, lbl);
+        return internal_dlsym(lbl);
 #       elif defined(OBJFORMAT_MACHO)
 #       if HAVE_DLFCN_H
         /* On OS X 10.3 and later, we use dlsym instead of the old legacy
@@ -2017,7 +2042,7 @@ lookupSymbol( char *lbl )
         */
         IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
         ASSERT(lbl[0] == '_');
-        return internal_dlsym(dl_prog_handle, lbl + 1);
+        return internal_dlsym(lbl + 1);
 #       else
         if (NSIsSymbolNameDefined(lbl)) {
             NSSymbol symbol = NSLookupAndBindSymbol(lbl);