{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
-module Linker ( HValue, initDynLinker, showLinkerState,
+module Linker ( HValue, showLinkerState,
linkExpr, unload, extendLinkEnv,
linkPackages,
) where
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
#include "HsVersions.h"
import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
import Packages
import DriverState ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts, v_ExplicitPackages )
+import DriverPhases ( isObjectFilename, isDynLibFilename )
+import DriverUtil ( getFileSuffix )
#ifdef darwin_TARGET_OS
import DriverState ( v_Cmdline_frameworks, v_Framework_paths )
#endif
import Finder ( findModule, findLinkable )
import HscTypes
-import Name ( Name, nameModule, isExternalName )
+import Name ( Name, nameModule, nameModuleName, isExternalName, isWiredInName )
import NameEnv
import NameSet ( nameSetToList )
import Module
-import FastString ( FastString(..), unpackFS )
import ListSetOps ( minusList )
import CmdLineOpts ( DynFlags(verbosity), getDynFlags )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
= filterNameEnv keep_elt env
where
keep_elt (n,_) = isExternalName n
- && (moduleName (nameModule n) `elem` mods)
+ && (nameModuleName n `elem` mods)
\end{code}
; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
-- (d) Link .o files from the command-line
- ; lib_paths <- readIORef v_Library_paths
- ; cmdline_objs <- readIORef v_Ld_inputs
+ ; lib_paths <- readIORef v_Library_paths
+ ; cmdline_ld_inputs <- readIORef v_Ld_inputs
+
+ ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
-- (e) Link any MacOS frameworks
#ifdef darwin_TARGET_OS
; let framework_paths = []
#endif
-- Finally do (c),(d),(e)
- ; let cmdline_lib_specs = map Object cmdline_objs
+ ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
++ map DLL minus_ls
++ map Framework frameworks
; if null cmdline_lib_specs then return ()
else throwDyn (InstallationError "linking extra libraries/objects failed")
}}
+classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
+classifyLdInput f
+ | isObjectFilename f = return (Just (Object f))
+ | isDynLibFilename f = return (Just (DLLPath f))
+ | otherwise = do
+ hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
+ return Nothing
+
preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
preloadLib dflags lib_paths framework_paths lib_spec
= do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
case maybe_errstr of
Nothing -> maybePutStrLn dflags "done"
Just mm -> preloadFailed mm lib_paths lib_spec
-
+
+ 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
+
#ifdef darwin_TARGET_OS
Framework framework
-> do maybe_errstr <- loadFramework framework_paths framework
%************************************************************************
\begin{code}
-linkExpr :: HscEnv -> PersistentCompilerState
- -> UnlinkedBCO -> IO HValue
+linkExpr :: HscEnv -> UnlinkedBCO -> IO HValue
-- Link a single expression, *including* first linking packages and
-- modules that this expression depends on.
-- Raises an IO exception if it can't find a compiled version of the
-- dependents to link.
-linkExpr hsc_env pcs root_ul_bco
+linkExpr hsc_env root_ul_bco
= do {
-- Initialise the linker (if it's not been done already)
initDynLinker
-- Find what packages and linkables are required
- ; (lnks, pkgs) <- getLinkDeps hpt pit needed_mods
+ ; eps <- readIORef (hsc_EPS hsc_env)
+ ; (lnks, pkgs) <- getLinkDeps hpt (eps_PIT eps) needed_mods
-- Link the packages and modules required
; linkPackages dflags pkgs
; return root_hval
}}
where
- pit = eps_PIT (pcs_EPS pcs)
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
free_names = nameSetToList (bcoFreeNames root_ul_bco)
needed_mods :: [Module]
- needed_mods = [ nameModule n | n <- free_names, isExternalName n ]
+ needed_mods = [ nameModule n | n <- free_names,
+ isExternalName n, -- Names from other modules
+ not (isWiredInName n) -- Exclude wired-in names
+ ] -- (see note below)
+ -- Exclude wired-in names because we may not have read
+ -- their interface files, so getLinkDeps will fail
+ -- All wired-in names are in the base package, which we link
+ -- by default, so we can safely ignore them here.
dieWith msg = throwDyn (ProgramError (showSDoc msg))
[li] -> Just li
many -> pprPanic "findModuleLinkable" (ppr mod)
-filterModuleLinkables :: (ModuleName -> Bool) -> [Linkable] -> [Linkable]
-filterModuleLinkables p ls = filter (p . linkableModName) ls
-
linkableInSet :: Linkable -> [Linkable] -> Bool
linkableInSet l objs_loaded =
case findModuleLinkable_maybe objs_loaded (linkableModName l) of
objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
- let objs_retained = map linkableModName objs_loaded'
- bcos_retained = map linkableModName bcos_loaded'
+ let bcos_retained = map linkableModName bcos_loaded'
itbl_env' = filterNameMap bcos_retained (itbl_env pls)
closure_env' = filterNameMap bcos_retained (closure_env pls)
new_pls = pls { itbl_env = itbl_env',
-- loadDLL is platform-specific and adds the lib/.so/.DLL
-- suffixes platform-dependently
+ | DLLPath FilePath -- Absolute or relative pathname to a dynamic library
+ -- (ends with .dll or .so).
+
| Framework String -- Only used for darwin, but does no harm
-- If this package is already part of the GHCi binary, we'll already
# if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
= [ ]
# else
- = [ "base", "haskell98", "haskell-src", "readline" ]
+ = [ "base", "haskell98", "template-haskell", "readline" ]
# endif
showLS (Object nm) = "(static) " ++ nm
showLS (DLL nm) = "(dynamic) " ++ nm
+showLS (DLLPath nm) = "(dynamic) " ++ nm
showLS (Framework nm) = "(framework) " ++ nm
linkPackages :: DynFlags -> [PackageName] -> IO ()
linkPackage :: DynFlags -> PackageConfig -> IO ()
linkPackage dflags pkg
= do
- let dirs = Packages.library_dirs pkg
- let libs = Packages.hs_libraries pkg ++ extra_libraries pkg
- ++ [ lib | '-':'l':lib <- extra_ld_opts pkg ]
+ let dirs = Packages.libraryDirs pkg
+ let libs = Packages.hsLibraries pkg ++ Packages.extraLibraries pkg
+ ++ [ lib | '-':'l':lib <- Packages.extraLdOpts pkg ]
classifieds <- mapM (locateOneObj dirs) libs
-- Complication: all the .so's must be loaded before any of the .o's.
let dlls = [ dll | DLL dll <- classifieds ]
objs = [ obj | Object obj <- classifieds ]
- maybePutStr dflags ("Loading package " ++ Packages.name pkg ++ " ... ")
+ maybePutStr dflags ("Loading package " ++ showPackageId (package pkg) ++ " ... ")
-- See comments with partOfGHCi
- when (Packages.name pkg `notElem` partOfGHCi) $ do
+ when (pkgName (package pkg) `notElem` partOfGHCi) $ do
loadFrameworks pkg
- mapM_ (load_dyn dirs) dlls
+ -- When a library A needs symbols from a library B, the order in
+ -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
+ -- way ld expects it for static linking. Dynamic linking is a
+ -- different story: When A has no dependency information for B,
+ -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
+ -- when B has not been loaded before. In a nutshell: Reverse the
+ -- order of DLLs for dynamic linking.
+ -- This fixes a problem with the HOpenGL package (see "Compiling
+ -- HOpenGL under recent versions of GHC" on the HOpenGL list).
+ mapM_ (load_dyn dirs) (reverse dlls)
-- After loading all the DLLs, we can load the static objects.
+ -- Ordering isn't important here, because we do one final link
+ -- step to resolve everything.
mapM_ loadObj objs
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
- else panic ("can't load package `" ++ name pkg ++ "'")
+ else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'"))
load_dyn dirs dll = do r <- loadDynamic dirs dll
case r of
#else
loadFrameworks pkg = mapM_ load frameworks
where
- fw_dirs = Packages.framework_dirs pkg
- frameworks = Packages.extra_frameworks pkg
+ fw_dirs = Packages.frameworkDirs pkg
+ frameworks = Packages.extraFrameworks pkg
load fw = do r <- loadFramework fw_dirs fw
case r of
projects / ghc-hetmet.git / blobdiff