diff options
| -rw-r--r-- | compiler/ghci/Linker.hs | 74 | ||||
| -rw-r--r-- | compiler/main/SysTools.lhs | 3 | ||||
| -rw-r--r-- | rts/Linker.c | 43 |
3 files changed, 87 insertions, 33 deletions
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 8560310af1..8573f6a37b 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -117,8 +117,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 :: ![PackageKey] - } + pkgs_loaded :: ![PackageKey], + + -- 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 { @@ -126,7 +130,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. @@ -316,14 +321,15 @@ linkCmdLineLibs' dflags@(DynFlags { ldInputs = cmdline_ld_inputs ; 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 }} @@ -362,19 +368,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) @@ -390,12 +399,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) @@ -403,6 +414,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 @@ -422,11 +434,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 @@ -784,8 +798,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 @@ -799,9 +813,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 @@ -809,10 +825,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. @@ -824,7 +852,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/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index c13790a4ff..4c7ab03664 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -1468,6 +1468,7 @@ linkDynLib dflags0 o_files dep_packages in package_hs_libs ++ extra_libs ++ other_flags -- probably _stub.o files + -- and last temporary shared object file let extra_ld_inputs = ldInputs dflags case os of @@ -1585,8 +1586,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 ) diff --git a/rts/Linker.c b/rts/Linker.c index 0c390ae46c..9c9de61519 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1839,7 +1839,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) { @@ -1849,11 +1849,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 ------------------- @@ -1861,14 +1862,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) { @@ -1876,7 +1902,6 @@ internal_dlsym(void *hdl, const char *symbol) { return v; } } - v = dlsym(hdl, symbol); RELEASE_LOCK(&dl_mutex); return v; } @@ -2036,7 +2061,7 @@ static void* 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 @@ -2050,7 +2075,7 @@ static void* 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); |