summaryrefslogtreecommitdiff
path: root/compiler/ghci
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-06-14 16:53:12 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-06-23 17:19:48 -0400
commit5a502cd1431b535a12dced0479b75c5f7dbfb01c (patch)
treedfcbc80191ab4a99572debbc2561422a43e04913 /compiler/ghci
parentade3db5392d0f98cbd2e917fca926f4e08ca4fa7 (diff)
downloadhaskell-5a502cd1431b535a12dced0479b75c5f7dbfb01c.tar.gz
ghci: Load static objects in batches
Previously in the case where GHC was dynamically linked we would load static objects one-by-one by linking each into its own shared object and dlopen'ing each in order. However, this meant that the link would fail in the event that the objects had cyclic symbol dependencies. Here we fix this by merging each "run" of static objects into a single shared object and loading this. Fixes #13786 for the case where GHC is dynamically linked.
Diffstat (limited to 'compiler/ghci')
-rw-r--r--compiler/ghci/Linker.hs44
1 files changed, 31 insertions, 13 deletions
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index c77ca5c5e6..910715e594 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -352,8 +352,10 @@ linkCmdLineLibs' hsc_env pls =
all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
+ let merged_specs = mergeStaticObjects cmdline_lib_specs
pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls
- cmdline_lib_specs
+ merged_specs
+
maybePutStr dflags "final link ... "
ok <- resolveObjs hsc_env
@@ -365,6 +367,19 @@ linkCmdLineLibs' hsc_env pls =
return pls1
+-- | Merge runs of consecutive of 'Objects'. This allows for resolution of
+-- cyclic symbol references when dynamically linking. Specifically, we link
+-- together all of the static objects into a single shared object, avoiding
+-- the issue we saw in #13786.
+mergeStaticObjects :: [LibrarySpec] -> [LibrarySpec]
+mergeStaticObjects specs = go [] specs
+ where
+ go :: [FilePath] -> [LibrarySpec] -> [LibrarySpec]
+ go accum (Objects objs : rest) = go (objs ++ accum) rest
+ go accum@(_:_) rest = Objects (reverse accum) : go [] rest
+ go [] (spec:rest) = spec : go [] rest
+ go [] [] = []
+
{- Note [preload packages]
Why do we need to preload packages from the command line? This is an
@@ -392,7 +407,7 @@ users?
classifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec)
classifyLdInput dflags f
- | isObjectFilename platform f = return (Just (Object f))
+ | isObjectFilename platform f = return (Just (Objects [f]))
| isDynLibFilename platform f = return (Just (DLLPath f))
| otherwise = do
putLogMsg dflags NoReason SevInfo noSrcSpan
@@ -407,8 +422,8 @@ preloadLib
preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
case lib_spec of
- Object static_ish -> do
- (b, pls1) <- preload_static lib_paths static_ish
+ Objects static_ishs -> do
+ (b, pls1) <- preload_statics lib_paths static_ishs
maybePutStrLn dflags (if b then "done" else "not found")
return pls1
@@ -467,13 +482,13 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
intercalate "\n" (map (" "++) paths)))
-- Not interested in the paths in the static case.
- preload_static _paths name
- = do b <- doesFileExist name
+ preload_statics _paths names
+ = do b <- or <$> mapM doesFileExist names
if not b then return (False, pls)
else if dynamicGhc
- then do pls1 <- dynLoadObjs hsc_env pls [name]
+ then do pls1 <- dynLoadObjs hsc_env pls names
return (True, pls1)
- else do loadObj hsc_env name
+ else do mapM_ (loadObj hsc_env) names
return (True, pls)
preload_static_archive _paths name
@@ -1143,7 +1158,9 @@ unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..} = do
********************************************************************* -}
data LibrarySpec
- = Object FilePath -- Full path name of a .o file, including trailing .o
+ = Objects [FilePath] -- Full path names of set of .o files, including trailing .o
+ -- We allow batched loading to ensure that cyclic symbol
+ -- references can be resolved (see #13786).
-- For dynamic objects only, try to find the object
-- file in all the directories specified in
-- v_Library_paths before giving up.
@@ -1177,7 +1194,7 @@ partOfGHCi
["base", "template-haskell", "editline"]
showLS :: LibrarySpec -> String
-showLS (Object nm) = "(static) " ++ nm
+showLS (Objects nms) = "(static) [" ++ intercalate ", " nms ++ "]"
showLS (Archive nm) = "(static archive) " ++ nm
showLS (DLL nm) = "(dynamic) " ++ nm
showLS (DLLPath nm) = "(dynamic) " ++ nm
@@ -1274,7 +1291,8 @@ linkPackage hsc_env pkg
-- Complication: all the .so's must be loaded before any of the .o's.
let known_dlls = [ dll | DLLPath dll <- classifieds ]
dlls = [ dll | DLL dll <- classifieds ]
- objs = [ obj | Object obj <- classifieds ]
+ objs = [ obj | Objects objs <- classifieds
+ , obj <- objs ]
archs = [ arch | Archive arch <- classifieds ]
-- Add directories to library search paths
@@ -1482,8 +1500,8 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
(ArchX86_64, OSSolaris2) -> "64" </> so_name
_ -> so_name
- findObject = liftM (fmap Object) $ findFile dirs obj_file
- findDynObject = liftM (fmap Object) $ findFile dirs dyn_obj_file
+ findObject = liftM (fmap $ Objects . (:[])) $ findFile dirs obj_file
+ findDynObject = liftM (fmap $ Objects . (:[])) $ findFile dirs dyn_obj_file
findArchive = let local name = liftM (fmap Archive) $ findFile dirs name
in apply (map local arch_files)
findHSDll = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file