diff options
Diffstat (limited to 'compiler/ghci/Linker.lhs')
| -rw-r--r-- | compiler/ghci/Linker.lhs | 72 |
1 files changed, 49 insertions, 23 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 |