import NameEnv
import NameSet
import qualified OccName
-import LazyUniqFM
+import UniqFM
import Module
import ListSetOps
import DynFlags
import SrcLoc
import qualified Maybes
import UniqSet
-import FiniteMap
import Constants
import FastString
-import Config ( cProjectVersion )
+import Config
-- Standard libraries
import Control.Monad
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
Object static_ish
-> do b <- preload_static lib_paths static_ish
maybePutStrLn dflags (if b then "done"
- else "not found")
-
+ else "not found")
+
+ Archive static_ish
+ -> do b <- preload_static_archive lib_paths static_ish
+ maybePutStrLn dflags (if b then "done"
+ else "not found")
+
DLL dll_unadorned
-> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
case maybe_errstr of
= do b <- doesFileExist name
if not b then return False
else loadObj name >> return True
+ preload_static_archive _paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadArchive name >> return True
\end{code}
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
-- file in all the directories specified in
-- v_Library_paths before giving up.
+ | Archive FilePath -- Full path name of a .a file, including trailing .a
+
| DLL String -- "Unadorned" name of a .DLL/.so
-- e.g. On unix "qt" denotes "libqt.so"
-- On WinDoze "burble" denotes "burble.DLL"
partOfGHCi
| isWindowsTarget || isDarwinTarget = []
| otherwise = map PackageName
- ["base", "haskell98", "template-haskell", "editline"]
+ ["base", "template-haskell", "editline"]
showLS :: LibrarySpec -> String
showLS (Object nm) = "(static) " ++ nm
+showLS (Archive nm) = "(static archive) " ++ nm
showLS (DLL nm) = "(dynamic) " ++ nm
showLS (DLLPath nm) = "(dynamic) " ++ nm
showLS (Framework nm) = "(framework) " ++ nm
| Just pkg_cfg <- lookupPackage pkg_map new_pkg
= do { -- Link dependents first
pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
- lookupFM ipid_map ipid
+ Map.lookup ipid ipid_map
| ipid <- depends pkg_cfg ]
-- Now link the package itself
; linkPackage dflags pkg_cfg
let dirs = Packages.libraryDirs pkg
let libs = Packages.hsLibraries pkg
+ -- The FFI GHCi import lib isn't needed as
+ -- compiler/ghci/Linker.lhs + rts/Linker.c link the
+ -- interpreted references to FFI to the compiled FFI.
+ -- We therefore filter it out so that we don't get
+ -- duplicate symbol errors.
+ libs' = filter ("HSffi" /=) libs
-- Because of slight differences between the GHC dynamic linker and
-- the native system linker some packages have to link with a
-- different list of libraries when using GHCi. Examples include: libs
then Packages.extraLibraries pkg
else Packages.extraGHCiLibraries pkg)
++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
- classifieds <- mapM (locateOneObj dirs) libs
+ 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 ]
+ archs = [ arch | Archive arch <- classifieds ]
maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
-- Ordering isn't important here, because we do one final link
-- step to resolve everything.
mapM_ loadObj objs
+ mapM_ loadArchive archs
maybePutStr dflags "linking ... "
ok <- resolveObjs
| not isDynamicGhcLib
-- When the GHC package was not compiled as dynamic library
-- (=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 -> return (DLL lib) }
+ = do mb_libSpec <- if cUseArchivesForGhci
+ then do mb_arch_path <- findFile mk_arch_path dirs
+ case mb_arch_path of
+ Just arch_path ->
+ return (Just (Archive arch_path))
+ Nothing ->
+ return Nothing
+ else do mb_obj_path <- findFile mk_obj_path dirs
+ case mb_obj_path of
+ Just obj_path ->
+ return (Just (Object obj_path))
+ Nothing ->
+ return Nothing
+ case mb_libSpec of
+ Just ls -> return ls
+ Nothing -> return (DLL lib)
| otherwise
-- When the GHC package was compiled as dynamic library (=DYNAMIC set),
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir </> (lib <.> "o")
+ mk_arch_path dir = dir </> ("lib" ++ lib <.> "a")
dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name