import NameEnv
import NameSet
import qualified OccName
-import LazyUniqFM
+import UniqFM
import Module
import ListSetOps
import DynFlags
import Data.Char
import Data.IORef
import Data.List
+import qualified Data.Map as Map
import Foreign
import Control.Concurrent.MVar
-- When a new Unlinked is linked into the running image, or an existing
-- module in the image is replaced, the itbl_env must be updated
-- appropriately.
- itbl_env :: ItblEnv,
+ itbl_env :: !ItblEnv,
-- The currently loaded interpreted modules (home package)
- bcos_loaded :: [Linkable],
+ bcos_loaded :: ![Linkable],
-- And the currently-loaded compiled modules (home package)
- objs_loaded :: [Linkable],
+ objs_loaded :: ![Linkable],
-- 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]
}
emptyPLS :: DynFlags -> PersistentLinkerState
checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
checkNonStdWay dflags srcspan = do
let tag = buildTag dflags
- if null tag then return Nothing else do
+ if null tag {- || tag == "dyn" -} then return Nothing else do
+ -- see #3604: object files compiled for way "dyn" need to link to the
+ -- dynamic packages, so we can't load them into a statically-linked GHCi.
+ -- we have to treat "dyn" in the same way as "prof".
+ --
+ -- In the future when GHCi is dynamically linked we should be able to relax
+ -- this, but they we may have to make it possible to load either ordinary
+ -- .o files or -dynamic .o files into GHCi (currently that's not possible
+ -- because the dynamic objects contain refs to e.g. __stginit_base_Prelude_dyn
+ -- whereas we have __stginit_base_Prelude_.
let default_osuf = phaseInputExt StopLn
if objectSuf dflags == default_osuf
then failNonStd srcspan
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
+ no_obj :: Outputable a => a -> IO b
no_obj mod = dieWith span $
ptext (sLit "cannot find object file for module ") <>
quotes (ppr mod) $$
-- ...and then find the linkable for it
mb_lnk <- findObjectLinkableMaybe mod loc ;
case mb_lnk of {
- Nothing -> no_obj mod ;
+ Nothing -> no_obj mod ;
Just lnk -> adjust_linkable lnk
}}
linkModules :: DynFlags -> PersistentLinkerState -> [Linkable]
-> IO (PersistentLinkerState, SuccessFlag)
linkModules dflags pls linkables
- = block $ do -- don't want to be interrupted by ^C in here
+ = mask_ $ do -- don't want to be interrupted by ^C in here
let (objs, bcos) = partition isObjectLinkable
(concatMap partitionLinkable linkables)
-> [Linkable] -- ^ The linkables to *keep*.
-> IO ()
unload dflags linkables
- = block $ do -- block, so we're safe from Ctrl-C in here
+ = mask_ $ do -- mask, so we're safe from Ctrl-C in here
-- Initialise the linker (if it's not been done already)
initDynLinker dflags
linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState
-> IO PersistentLinkerState
linkPackages' dflags new_pks pls = do
- let pkg_map = pkgIdMap (pkgState dflags)
-
- pkgs' <- link pkg_map (pkgs_loaded pls) new_pks
-
+ pkgs' <- link (pkgs_loaded pls) new_pks
return $! pls { pkgs_loaded = pkgs' }
where
- link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
- link pkg_map pkgs new_pkgs =
- foldM (link_one pkg_map) pkgs new_pkgs
+ pkg_map = pkgIdMap (pkgState dflags)
+ ipid_map = installedPackageIdMap (pkgState dflags)
- link_one pkg_map pkgs new_pkg
+ link :: [PackageId] -> [PackageId] -> IO [PackageId]
+ link pkgs new_pkgs =
+ foldM link_one pkgs new_pkgs
+
+ link_one pkgs new_pkg
| new_pkg `elem` pkgs -- Already linked
= return pkgs
| Just pkg_cfg <- lookupPackage pkg_map new_pkg
= do { -- Link dependents first
- pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
+ pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
+ Map.lookup ipid ipid_map
+ | ipid <- depends pkg_cfg ]
-- Now link the package itself
; linkPackage dflags pkg_cfg
; return (new_pkg : pkgs') }
let dlls = [ dll | DLL dll <- classifieds ]
objs = [ obj | Object obj <- classifieds ]
- maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
+ maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
-- See comments with partOfGHCi
when (packageName pkg `notElem` partOfGHCi) $ do
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
- else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
+ else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
load_dyn :: [FilePath] -> FilePath -> IO ()
load_dyn dirs dll = do r <- loadDynamic dirs dll
-- If it isn't present, we assume it's a dynamic library.
locateOneObj :: [FilePath] -> String -> IO LibrarySpec
locateOneObj dirs lib
- | not picIsOn
+ | not isDynamicGhcLib
-- When the GHC package was not compiled as dynamic library
- -- (=__PIC__ not set), we search for .o libraries first.
+ -- (=DYNAMIC not set), we search for .o libraries.
= do { mb_obj_path <- findFile mk_obj_path dirs
; case mb_obj_path of
Just obj_path -> return (Object obj_path)
- Nothing ->
- do { mb_lib_path <- findFile mk_dyn_lib_path dirs
- ; case mb_lib_path of
- Just _ -> return (DLL dyn_lib_name)
- Nothing -> return (DLL lib) }} -- We assume
- | otherwise
- -- When the GHC package was compiled as dynamic library (=__PIC__ set),
+ Nothing -> return (DLL lib) }
+
+ | otherwise
+ -- When the GHC package was compiled as dynamic library (=DYNAMIC set),
-- we search for .so libraries first.
= do { mb_lib_path <- findFile mk_dyn_lib_path dirs
; case mb_lib_path of
- Just _ -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
+ Just _ -> return (DLL dyn_lib_name)
Nothing ->
do { mb_obj_path <- findFile mk_obj_path dirs
; case mb_obj_path of
projects / ghc-hetmet.git / blobdiff