{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module Linker ( HValue, initLinker, showLinkerState,
- linkPackages, linkLibraries, findLinkable,
- linkModules, unload, extendLinkEnv, linkExpr,
- LibrarySpec(..)
+ linkLibraries, linkExpr,
+ unload, extendLinkEnv,
+ LibrarySpec(..),
+ linkPackages,
) where
#include "../includes/config.h"
import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initLinker )
import ByteCodeLink ( HValue, ClosureEnv, extendClosureEnv, linkBCO )
import ByteCodeItbls ( ItblEnv )
-import ByteCodeAsm ( CompiledByteCode(..), bcosFreeNames,
- UnlinkedBCO, UnlinkedBCOExpr, nameOfUnlinkedBCO )
-
-import Packages ( PackageConfig(..), PackageName, PackageConfigMap, lookupPkg,
- packageDependents, packageNameString )
-import DriverState ( v_Library_paths, v_Cmdline_libraries, getPackageConfigMap )
-import DriverUtil ( splitFilename3 )
-import Finder ( findModule )
-import HscTypes ( Linkable(..), isObjectLinkable, nameOfObject, byteCodeOfObject,
- Unlinked(..), isInterpretable, isObject, Dependencies(..),
- HscEnv(..), PersistentCompilerState(..), ExternalPackageState(..),
- HomePackageTable, PackageIfaceTable, ModIface(..), HomeModInfo(..),
- lookupIface )
+import ByteCodeAsm ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
+
+import Packages
+import DriverState ( v_Library_paths, v_Opt_l,
+ v_Cmdline_frameworks, v_Framework_paths, getStaticOpts )
+import Finder ( findModule, findLinkable )
+import HscTypes
import Name ( Name, nameModule, isExternalName )
import NameEnv
import NameSet ( nameSetToList )
-import Module ( ModLocation(..), Module, ModuleName, moduleName, lookupModuleEnvByName )
+import Module
import FastString ( FastString(..), unpackFS )
import ListSetOps ( minusList )
import CmdLineOpts ( DynFlags(verbosity) )
import Outputable
import Panic ( GhcException(..) )
import Util ( zipLazy, global )
-import ErrUtils ( Message )
-- Standard libraries
import Control.Monad ( when, filterM, foldM )
import Data.List ( partition, nub )
import System.IO ( putStr, putStrLn, hPutStrLn, stderr, fixIO )
-import System.Directory ( doesFileExist, getModificationTime )
+import System.Directory ( doesFileExist )
import Control.Exception ( block, throwDyn )
\begin{code}
linkExpr :: HscEnv -> PersistentCompilerState
- -> UnlinkedBCOExpr -> IO HValue -- IO BCO# really
+ -> 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, aux_ul_bcos)
+linkExpr hsc_env pcs root_ul_bco
= do {
-- Find what packages and linkables are required
(lnks, pkgs) <- getLinkDeps hpt pit needed_mods ;
ce = closure_env pls
-- Link the necessary packages and linkables
- ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce all_bcos
+ ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
; return root_hval
}}
where
pit = eps_PIT (pcs_EPS pcs)
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
- all_bcos = root_ul_bco : aux_ul_bcos
- free_names = nameSetToList (bcosFreeNames all_bcos)
-
+ free_names = nameSetToList (bcoFreeNames root_ul_bco)
+
needed_mods :: [Module]
needed_mods = [ nameModule n | n <- free_names, isExternalName n ]
-- Find all the packages and linkables that a set of modules depends on
= do { pls <- readIORef v_PersistentLinkerState ;
let {
- -- 1. Find the iface for each module (must exist),
- -- and extract its dependencies
- deps = [ mi_deps (get_iface mod) | mod <- mods ] ;
-
- -- 2. Find the dependent home-pkg-modules/packages from each iface
- -- Include mods themselves; and exclude ones already linked
- mods_needed = nub (map moduleName mods ++ [m | dep <- deps, (m,_) <- dep_mods dep])
- `minusList`
- linked_mods ;
- linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls) ;
-
- pkgs_needed = nub (concatMap dep_pkgs deps)
- `minusList`
- pkgs_loaded pls } ;
+ -- 1. Find the dependent home-pkg-modules/packages from each iface
+ (mods_s, pkgs_s) = unzip (map get_deps mods) ;
+
+ -- 2. Exclude ones already linked
+ -- Main reason: avoid findModule calls in get_linkable
+ mods_needed = nub (concat mods_s) `minusList` linked_mods ;
+ pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
+
+ linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls)
+ } ;
-- 3. For each dependent module, find its linkable
- -- This will either be in the HPT or (in the case of one-shot compilation)
- -- we may need to use maybe_getFileLinkable
+ -- This will either be in the HPT or (in the case of one-shot
+ -- compilation) we may need to use maybe_getFileLinkable
lnks_needed <- mapM get_linkable mods_needed ;
return (lnks_needed, pkgs_needed) }
where
+ get_deps :: Module -> ([ModuleName],[PackageName])
+ -- Get the things needed for the specified module
+ -- This is rather similar to the code in RnNames.importsFromImportDecl
+ get_deps mod
+ | isHomeModule (mi_module iface)
+ = (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
+ | otherwise
+ = ([], mi_package iface : dep_pkgs deps)
+ where
+ iface = get_iface mod
+ deps = mi_deps iface
+
get_iface mod = case lookupIface hpt pit mod of
- Just iface -> iface
- Nothing -> pprPanic "getLinkDeps" (no_iface mod)
+ Just iface -> iface
+ Nothing -> pprPanic "getLinkDeps" (no_iface mod)
no_iface mod = ptext SLIT("No iface for") <+> ppr mod
-- This one is a GHC bug
- no_obj mod = dieWith (ptext SLIT("No compiled code for for") <+> ppr mod)
+ no_obj mod = dieWith (ptext SLIT("No compiled code for") <+> ppr mod)
-- This one is a build-system bug
get_linkable mod_name -- A home-package module
-- specified on the command line.
linkLibraries dflags objs
= do { lib_paths <- readIORef v_Library_paths
- ; minus_ls <- readIORef v_Cmdline_libraries
+ ; opt_l <- getStaticOpts v_Opt_l
+ ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
+#ifdef darwin_TARGET_OS
+ ; framework_paths <- readIORef v_Framework_paths
+ ; frameworks <- readIORef v_Cmdline_frameworks
+#endif
; let cmdline_lib_specs = map Object objs ++ map DLL minus_ls
-
+#ifdef darwin_TARGET_OS
+ ++ map Framework frameworks
+#endif
; if (null cmdline_lib_specs) then return ()
else do {
-- Now link them
+#ifdef darwin_TARGET_OS
+ ; mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+#else
; mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
-
+#endif
; maybePutStr dflags "final link ... "
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done."
else throwDyn (InstallationError "linking extra libraries/objects failed")
}}
where
+#ifdef darwin_TARGET_OS
+ preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
+ preloadLib dflags lib_paths framework_paths lib_spec
+#else
preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
preloadLib dflags lib_paths lib_spec
+#endif
= do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
case lib_spec of
Object static_ish
Nothing -> return ()
Just mm -> preloadFailed mm lib_paths lib_spec
maybePutStrLn dflags "done"
-
+#ifdef darwin_TARGET_OS
+ Framework framework
+ -> do maybe_errstr <- loadFramework framework_paths framework
+ case maybe_errstr of
+ Nothing -> return ()
+ Just mm -> preloadFailed mm framework_paths lib_spec
+ maybePutStrLn dflags "done"
+#endif
preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
preloadFailed sys_errmsg paths spec
= do maybePutStr dflags
linkSomeBCOs toplevs_only ie ce_in ul_bcos
- = do let nms = map nameOfUnlinkedBCO ul_bcos
+ = do let nms = map unlinkedBCOName ul_bcos
hvals <- fixIO
( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
in mapM (linkBCO ie ce_out) ul_bcos )
-- of DLL handles that rts/Linker.c maintains, and that in turn is
-- used by lookupSymbol. So we must call addDLL for each library
-- just to get the DLL handle into the list.
-partOfGHCi
-# ifndef mingw32_TARGET_OS
- = [ "base", "haskell98", "haskell-src", "readline" ]
+partOfGHCi
+# if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
+ = [ ]
# else
- = [ ]
+ = [ "base", "haskell98", "haskell-src", "readline" ]
# endif
showLS (Object nm) = "(static) " ++ nm
-- (unless of course they are already linked)
-- The dependents are linked automatically, and it doesn't matter
-- what order you specify the input packages.
+--
+-- NOTE: in fact, since each module tracks all the packages it depends on,
+-- we don't really need to use the package-config dependencies.
+-- However we do need the package-config stuff (to find aux libs etc),
+-- and following them lets us load libraries in the right order, which
+-- perhaps makes the error message a bit more localised if we get a link
+-- failure. So the dependency walking code is still here.
linkPackages dflags new_pkgs
= do { pls <- readIORef v_PersistentLinkerState
= do
let dirs = Packages.library_dirs pkg
let libs = Packages.hs_libraries pkg ++ extra_libraries pkg
+ ++ [ lib | '-':'l':lib <- extra_ld_opts pkg ]
classifieds <- mapM (locateOneObj dirs) libs
#ifdef darwin_TARGET_OS
let fwDirs = Packages.framework_dirs pkg
return (Just file_path)
else
findFile mk_file_path dirs }
-
-
-findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
-findLinkable mod locn
- | Just obj_fn <- ml_obj_file locn
- = do obj_exist <- doesFileExist obj_fn
- if not obj_exist
- then return Nothing
- else
- do let stub_fn = case splitFilename3 obj_fn of
- (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
- stub_exist <- doesFileExist stub_fn
- obj_time <- getModificationTime obj_fn
- if stub_exist
- then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
- else return (Just (LM obj_time mod [DotO obj_fn]))
- | otherwise
- = return Nothing
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff