X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=1849c6b91e09b5dccdf068215a2dd418d6c42efb;hp=9ac8fe4586db068bd0c5f125390af8c43a7be6e5;hb=d436c70d43fb905c63220040168295e473f4b90a;hpb=2c77e092c3a6a5b936838afb7b338af70de2c689 diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9ac8fe4..1849c6b 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -48,12 +48,12 @@ import Maybes ( expectJust ) import ParserCoreUtils ( getCoreModuleName ) import SrcLoc import FastString -import MonadUtils +-- import MonadUtils -import Data.Either +-- import Data.Either import Exception import Data.IORef ( readIORef ) -import GHC.Exts ( Int(..) ) +-- import GHC.Exts ( Int(..) ) import System.Directory import System.FilePath import System.IO @@ -187,7 +187,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) -> return ([], ms_hs_date summary) -- We're in --make mode: finish the compilation pipeline. _other - -> do runPipeline StopLn hsc_env' (output_fn,Nothing) + -> do _ <- runPipeline StopLn hsc_env' (output_fn,Nothing) (Just basename) Persistent (Just location) @@ -264,7 +264,7 @@ compileStub hsc_env mod location = do let (stub_c,_,stub_o) = mkStubPaths (hsc_dflags hsc_env) (moduleName mod) location - runPipeline StopLn hsc_env (stub_c,Nothing) Nothing + _ <- runPipeline StopLn hsc_env (stub_c,Nothing) Nothing (SpecificFile stub_o) Nothing{-no ModLocation-} return stub_o @@ -491,7 +491,7 @@ data PipelineOutput -- at which stage to stop. -- -- The DynFlags can be modified by phases in the pipeline (eg. by --- GHC_OPTIONS pragmas), and the changes affect later phases in the +-- OPTIONS_GHC pragmas), and the changes affect later phases in the -- pipeline. runPipeline :: GhcMonad m => @@ -1234,7 +1234,7 @@ runPhase_MoveBinary dflags input_fn dep_packages pvm_executable_base = "=" ++ input_fn pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base -- nuke old binary; maybe use configur'ed names for cp and rm? - tryIO (removeFile pvm_executable) + _ <- tryIO (removeFile pvm_executable) -- move the newly created binary into PVM land copy dflags "copying PVM executable" input_fn pvm_executable -- generate a wrapper script for running a parallel prg under PVM @@ -1379,6 +1379,13 @@ linkBinary dflags o_files dep_packages = do let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths + -- The C "main" function is not in the rts but in a separate static + -- library libHSrtsmain.a that sits next to the rts lib files. Assuming + -- we're using a Haskell main function then we need to link it in. + let no_hs_main = dopt Opt_NoHsMain dflags + let main_lib | no_hs_main = [] + | otherwise = [ "-lHSrtsmain" ] + pkg_link_opts <- getPackageLinkOpts dflags dep_packages #ifdef darwin_TARGET_OS @@ -1395,12 +1402,6 @@ linkBinary dflags o_files dep_packages = do framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ] -- reverse because they're added in reverse order from the cmd line #endif -#ifdef mingw32_TARGET_OS - let dynMain = if not opt_Static then - (head (libraryDirs (getPackageDetails (pkgState dflags) rtsPackageId))) ++ "/Main.dyn_o" - else - "" -#endif -- probably _stub.o files extra_ld_inputs <- readIORef v_Ld_inputs @@ -1442,9 +1443,6 @@ linkBinary dflags o_files dep_packages = do ++ map SysTools.Option ( md_c_flags ++ o_files -#ifdef mingw32_TARGET_OS - ++ [dynMain] -#endif ++ extra_ld_inputs ++ lib_path_opts ++ extra_ld_opts @@ -1454,6 +1452,7 @@ linkBinary dflags o_files dep_packages = do ++ framework_opts #endif ++ pkg_lib_path_opts + ++ main_lib ++ pkg_link_opts #ifdef darwin_TARGET_OS ++ pkg_framework_path_opts @@ -1562,7 +1561,13 @@ linkDynLib dflags o_files dep_packages = do let pkgs_no_rts = pkgs #endif let pkg_lib_paths = collectLibraryPaths pkgs_no_rts - let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths + let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths +#ifdef linux_TARGET_OS + get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] + | otherwise = ["-L" ++ l] +#else + get_pkg_lib_path_opts l = ["-L" ++ l] +#endif let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths @@ -1662,6 +1667,7 @@ linkDynLib dflags o_files dep_packages = do md_c_flags ++ o_files ++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations + ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname ++ extra_ld_inputs ++ lib_path_opts ++ extra_ld_opts