X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=ebdeb327adbf97096a78e1418b1b03e81335efef;hb=615d88d1912a81ca3bef44010285424f6c454449;hp=4c85ac6940b6cf2a152f4c9e997090c06301b691;hpb=72547264724117d689a7fa400104185557fb2a0c;p=ghc-hetmet.git diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 4c85ac6..ebdeb32 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -38,7 +38,7 @@ import Name import NameEnv import NameSet import qualified OccName -import LazyUniqFM +import UniqFM import Module import ListSetOps import DynFlags @@ -528,7 +528,16 @@ dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg))) 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 @@ -683,7 +692,7 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods 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) @@ -853,7 +862,7 @@ unload :: DynFlags -> [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 @@ -1024,7 +1033,7 @@ linkPackage dflags pkg 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 @@ -1048,7 +1057,7 @@ linkPackage dflags pkg 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 @@ -1075,23 +1084,20 @@ loadFrameworks pkg -- 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