Index: ghc-7.8.3/compiler/ghci/Linker.lhs =================================================================== --- ghc-7.8.3.orig/compiler/ghci/Linker.lhs +++ ghc-7.8.3/compiler/ghci/Linker.lhs @@ -123,7 +123,10 @@ 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 @@ -132,7 +135,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. @@ -314,14 +318,15 @@ 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 }} @@ -360,19 +365,22 @@ 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) @@ -388,12 +396,14 @@ preloadLib dflags lib_paths framework_pa 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) @@ -401,6 +411,7 @@ preloadLib dflags lib_paths framework_pa case maybe_errstr of Nothing -> maybePutStrLn dflags "done" Just mm -> preloadFailed mm framework_paths lib_spec + return pls else panic "preloadLib Framework" where @@ -420,11 +431,13 @@ preloadLib dflags lib_paths framework_pa -- 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 @@ -791,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 @@ -806,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 @@ -816,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. @@ -831,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 Index: ghc-7.8.3/compiler/main/SysTools.lhs =================================================================== --- ghc-7.8.3.orig/compiler/main/SysTools.lhs +++ ghc-7.8.3/compiler/main/SysTools.lhs @@ -1365,6 +1365,7 @@ linkDynLib dflags0 o_files dep_packages in package_hs_libs ++ extra_libs ++ other_flags -- probably _stub.o files + -- and last temporary shaerd object file let extra_ld_inputs = ldInputs dflags case os of @@ -1482,8 +1483,8 @@ linkDynLib dflags0 o_files dep_packages -- Set the library soname. We use -h rather than -soname as -- Solaris 10 doesn't support the latter: ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ] - ++ map Option lib_path_opts ++ extra_ld_inputs + ++ map Option lib_path_opts ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ) Index: ghc-7.8.3/rts/Linker.c =================================================================== --- ghc-7.8.3.orig/rts/Linker.c +++ ghc-7.8.3/rts/Linker.c @@ -1776,7 +1776,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) { @@ -1786,11 +1786,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 ------------------- @@ -1798,14 +1799,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) { @@ -1813,7 +1839,6 @@ internal_dlsym(void *hdl, const char *sy return v; } } - v = dlsym(hdl, symbol); RELEASE_LOCK(&dl_mutex); return v; } @@ -1981,7 +2006,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 @@ -1995,7 +2020,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);