X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FLinker.lhs;h=15786f4303f0f780840f71c63953a23932101701;hb=8002c9d5ceafef6b8fa6765701c5c3103c69760c;hp=b582e7e14829a2905c72bc9bb1b5b5732ee13b08;hpb=d5b3e9b5f30ccdd34a964f109c03c56ff71dee2e;p=ghc-hetmet.git diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index b582e7e..15786f4 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/ghc/compiler/ghci/Linker.lhs @@ -1,5 +1,5 @@ % -% (c) The University of Glasgow 2000 +% (c) The University of Glasgow 2005 % -- -------------------------------------- @@ -29,8 +29,7 @@ import ByteCodeAsm ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..)) import Packages import DriverPhases ( isObjectFilename, isDynLibFilename ) -import Util ( getFileSuffix ) -import Finder ( findModule, findLinkable, FindResult(..) ) +import Finder ( findModule, findObjectLinkableMaybe, FindResult(..) ) import HscTypes import Name ( Name, nameModule, isExternalName, isWiredInName ) import NameEnv @@ -41,8 +40,9 @@ import DynFlags ( DynFlags(..), getOpts ) import BasicTypes ( SuccessFlag(..), succeeded, failed ) import Outputable import Panic ( GhcException(..) ) -import Util ( zipLazy, global ) +import Util ( zipLazy, global, joinFileExt, joinFileName, suffixOf ) import StaticFlags ( v_Ld_inputs ) +import ErrUtils ( debugTraceMsg ) -- Standard libraries import Control.Monad ( when, filterM, foldM ) @@ -54,6 +54,7 @@ import System.IO ( putStr, putStrLn, hPutStrLn, stderr, fixIO ) import System.Directory ( doesFileExist ) import Control.Exception ( block, throwDyn ) +import Maybe ( isJust, fromJust ) #if __GLASGOW_HASKELL__ >= 503 import GHC.IOBase ( IO(..) ) @@ -214,8 +215,8 @@ reallyInitDynLinker dflags -- (e) Link any MacOS frameworks #ifdef darwin_TARGET_OS - ; framework_paths <- readIORef v_Framework_paths - ; frameworks <- readIORef v_Cmdline_frameworks + ; let framework_paths = frameworkPaths dflags + ; let frameworks = cmdlineFrameworks dflags #else ; let frameworks = [] ; let framework_paths = [] @@ -315,7 +316,7 @@ linkExpr hsc_env root_ul_bco -- Find what packages and linkables are required ; eps <- readIORef (hsc_EPS hsc_env) - ; (lnks, pkgs) <- getLinkDeps dflags hpt (eps_PIT eps) needed_mods + ; (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps) needed_mods -- Link the packages and modules required ; linkPackages dflags pkgs @@ -350,12 +351,12 @@ linkExpr hsc_env root_ul_bco dieWith msg = throwDyn (ProgramError (showSDoc msg)) -getLinkDeps :: DynFlags -> HomePackageTable -> PackageIfaceTable +getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable -> [Module] -- If you need these -> IO ([Linkable], [PackageId]) -- ... then link these first -- Fails with an IO exception if it can't find enough files -getLinkDeps dflags hpt pit mods +getLinkDeps hsc_env hpt pit mods -- Find all the packages and linkables that a set of modules depends on = do { pls <- readIORef v_PersistentLinkerState ; let { @@ -400,11 +401,12 @@ getLinkDeps dflags hpt pit mods get_linkable mod_name -- A home-package module | Just mod_info <- lookupModuleEnv hpt mod_name - = return (hm_linkable mod_info) + = ASSERT(isJust (hm_linkable mod_info)) + return (fromJust (hm_linkable mod_info)) | otherwise = -- It's not in the HPT because we are in one shot mode, -- so use the Finder to get a ModLocation... - do { mb_stuff <- findModule dflags mod_name False ; + do { mb_stuff <- findModule hsc_env mod_name False ; case mb_stuff of { Found loc _ -> found loc mod_name ; _ -> no_obj mod_name @@ -412,7 +414,7 @@ getLinkDeps dflags hpt pit mods found loc mod_name = do { -- ...and then find the linkable for it - mb_lnk <- findLinkable mod_name loc ; + mb_lnk <- findObjectLinkableMaybe mod_name loc ; case mb_lnk of { Nothing -> no_obj mod_name ; Just lnk -> return lnk @@ -613,19 +615,17 @@ unload :: DynFlags -> [Linkable] -> IO () unload dflags linkables = block $ do -- block, so we're safe from Ctrl-C in here + + -- Initialise the linker (if it's not been done already) + initDynLinker dflags pls <- readIORef v_PersistentLinkerState new_pls <- unload_wkr dflags linkables pls writeIORef v_PersistentLinkerState new_pls - let verb = verbosity dflags - when (verb >= 3) $ do - hPutStrLn stderr (showSDoc - (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))) - hPutStrLn stderr (showSDoc - (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))) - - return () + debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls)) + debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls)) + return () unload_wkr :: DynFlags -> [Linkable] -- stable linkables @@ -756,8 +756,19 @@ linkPackage :: DynFlags -> PackageConfig -> IO () linkPackage dflags pkg = do let dirs = Packages.libraryDirs pkg - let libs = Packages.hsLibraries pkg ++ Packages.extraLibraries pkg - ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ] + + let libs = Packages.hsLibraries pkg + -- 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 + -- that are actually gnu ld scripts, and the possability that the .a + -- libs do not exactly match the .so/.dll equivalents. So if the + -- package file provides an "extra-ghci-libraries" field then we use + -- that instead of the "extra-libraries" field. + ++ (if null (Packages.extraGHCiLibraries pkg) + then Packages.extraLibraries pkg + else Packages.extraGHCiLibraries pkg) + ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ] classifieds <- mapM (locateOneObj dirs) libs -- Complication: all the .so's must be loaded before any of the .o's. @@ -823,8 +834,8 @@ locateOneObj dirs lib Just lib_path -> return (DLL (lib ++ "_dyn")) Nothing -> return (DLL lib) }} -- We assume where - mk_obj_path dir = dir ++ '/':lib ++ ".o" - mk_dyn_lib_path dir = dir ++ '/':mkSOName (lib ++ "_dyn") + mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o") + mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "_dyn") -- ---------------------------------------------------------------------------- @@ -839,16 +850,16 @@ loadDynamic paths rootname -- Tried all our known library paths, so let -- dlopen() search its own builtin paths now. where - mk_dll_path dir = dir ++ '/':mkSOName rootname + mk_dll_path dir = dir `joinFileName` mkSOName rootname #if defined(darwin_TARGET_OS) -mkSOName root = "lib" ++ root ++ ".dylib" +mkSOName root = ("lib" ++ root) `joinFileExt` "dylib" #elif defined(mingw32_TARGET_OS) -- Win32 DLLs have no .dll extension here, because addDLL tries -- both foo.dll and foo.drv mkSOName root = root #else -mkSOName root = "lib" ++ root ++ ".so" +mkSOName root = ("lib" ++ root) `joinFileExt` "so" #endif -- Darwin / MacOS X only: load a framework @@ -863,7 +874,7 @@ loadFramework extraPaths rootname -- Tried all our known library paths, but dlopen() -- has no built-in paths for frameworks: give up where - mk_fwk dir = dir ++ '/' : rootname ++ ".framework/" ++ rootname + mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname) -- sorry for the hardcoded paths, I hope they won't change anytime soon: defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"] #endif