Commit 379e7af4 authored by Ben Gamari's avatar Ben Gamari 🐢

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.
parent 7e23bbf8
Pipeline #7163 failed with stages
in 174 minutes and 37 seconds
......@@ -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
......@@ -1139,7 +1154,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.
......@@ -1173,7 +1190,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
......@@ -1270,7 +1287,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
......@@ -1478,8 +1496,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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment