X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=8bd4c6c9be30ef5df0ef68d58866a6f3ebbcd3fa;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hp=9b57c4db2ce0eda7cdbba1521b536140f48561a8;hpb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9b57c4d..8bd4c6c 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -58,7 +58,6 @@ import Data.IORef ( readIORef ) import System.Directory import System.FilePath import System.IO -import System.IO.Error as IO import Control.Monad import Data.List ( isSuffixOf ) import Data.Maybe @@ -365,13 +364,13 @@ linkingNeeded dflags linkables pkg_deps = do -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). let exe_file = exeFileName dflags - e_exe_time <- IO.try $ getModificationTime exe_file + e_exe_time <- tryIO $ getModificationTime exe_file case e_exe_time of Left _ -> return True Right t -> do -- first check object files and extra_ld_inputs extra_ld_inputs <- readIORef v_Ld_inputs - e_extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs + e_extra_times <- mapM (tryIO . getModificationTime) extra_ld_inputs let (errs,extra_times) = splitEithers e_extra_times let obj_times = map linkableTime linkables ++ extra_times if not (null errs) || any (t <) obj_times @@ -387,7 +386,7 @@ linkingNeeded dflags linkables pkg_deps = do pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs if any isNothing pkg_libfiles then return True else do - e_lib_times <- mapM (IO.try . getModificationTime) + e_lib_times <- mapM (tryIO . getModificationTime) (catMaybes pkg_libfiles) let (lib_errs,lib_times) = splitEithers e_lib_times if not (null lib_errs) || any (t <) lib_times @@ -1323,6 +1322,20 @@ mkExtraCObj dflags xs map Option md_c_flags) return oFile +mkRtsOptionsLevelObj :: DynFlags -> IO [FilePath] +mkRtsOptionsLevelObj dflags + = do let mkRtsEnabledObj val + = do fn <- mkExtraCObj dflags + ["#include \"Rts.h\"", + "#include \"RtsOpts.h\"", + "const rtsOptsEnabledEnum rtsOptsEnabled = " + ++ val ++ ";"] + return [fn] + case rtsOptsEnabled dflags of + RtsOptsNone -> mkRtsEnabledObj "rtsOptsNone" + RtsOptsSafeOnly -> return [] -- The default + RtsOptsAll -> mkRtsEnabledObj "rtsOptsAll" + -- generates a Perl skript starting a parallel prg under PVM mk_pvm_wrapper_script :: String -> String -> String -> String mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $ @@ -1433,16 +1446,7 @@ linkBinary dflags o_files dep_packages = do let no_hs_main = dopt Opt_NoHsMain dflags let main_lib | no_hs_main = [] | otherwise = [ "-lHSrtsmain" ] - let mkRtsEnabledObj val = do fn <- mkExtraCObj dflags - ["#include \"Rts.h\"", - "#include \"RtsOpts.h\"", - "const rtsOptsEnabledEnum rtsOptsEnabled = " - ++ val ++ ";"] - return [fn] - rtsEnabledObj <- case rtsOptsEnabled dflags of - RtsOptsNone -> mkRtsEnabledObj "rtsOptsNone" - RtsOptsSafeOnly -> return [] - RtsOptsAll -> mkRtsEnabledObj "rtsOptsAll" + rtsEnabledObj <- mkRtsOptionsLevelObj dflags rtsOptsObj <- case rtsOpts dflags of Just opts -> do fn <- mkExtraCObj dflags @@ -1655,6 +1659,9 @@ linkDynLib dflags o_files dep_packages = do let (md_c_flags, _) = machdepCCOpts dflags let extra_ld_opts = getOpts dflags opt_l + + rtsEnabledObj <- mkRtsOptionsLevelObj dflags + #if defined(mingw32_HOST_OS) ----------------------------------------------------------------------------- -- Making a DLL @@ -1682,6 +1689,7 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts + ++ rtsEnabledObj ++ pkg_link_opts )) #elif defined(darwin_TARGET_OS) @@ -1735,6 +1743,7 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts + ++ rtsEnabledObj ++ pkg_link_opts )) #else @@ -1767,6 +1776,7 @@ linkDynLib dflags o_files dep_packages = do ++ lib_path_opts ++ extra_ld_opts ++ pkg_lib_path_opts + ++ rtsEnabledObj ++ pkg_link_opts )) #endif