X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=e015876e9ec62678633ef10761dc5f6bdd25a708;hb=3a50b1f6cb7d4455c0df851b213a51e67bb16c7f;hp=d900f62966aee93f05cc8a2c07bb2cdf675a195a;hpb=003790317ddc02cf220d8907fccc6b5a237321aa;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index d900f62..e015876 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 @@ -142,7 +141,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) hsc_env = hsc_env0 {hsc_dflags = dflags} -- Figure out what lang we're generating - let hsc_lang = hscMaybeAdjustTarget dflags StopLn src_flavour (hscTarget dflags) + let hsc_lang = hscTarget dflags -- ... and what the next phase should be let next_phase = hscNextPhase dflags src_flavour hsc_lang -- ... and what file to generate the output into @@ -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 @@ -586,7 +585,6 @@ getOutputFilename stop_phase output basename odir = objectDir dflags osuf = objectSuf dflags keep_hc = dopt Opt_KeepHcFiles dflags - keep_raw_s = dopt Opt_KeepRawSFiles dflags keep_s = dopt Opt_KeepSFiles dflags keep_bc = dopt Opt_KeepLlvmFiles dflags @@ -600,7 +598,6 @@ getOutputFilename stop_phase output basename keep_this_output = case next_phase of StopLn -> True - Mangle | keep_raw_s -> True As | keep_s -> True LlvmOpt | keep_bc -> True HCc | keep_hc -> True @@ -810,7 +807,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma src_timestamp <- getModificationTime (basename <.> suff) let force_recomp = dopt Opt_ForceRecomp dflags - hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags) + hsc_lang = hscTarget dflags source_unchanged <- if force_recomp || not (isStopLn stop) -- Set source_unchanged to False unconditionally if @@ -885,10 +882,10 @@ runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn return (Cmm, dflags, maybe_loc, output_fn) -runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc +runPhase Cmm _ hsc_env basename _ input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env - let hsc_lang = hscMaybeAdjustTarget dflags stop HsSrcFile (hscTarget dflags) + let hsc_lang = hscTarget dflags let next_phase = hscNextPhase dflags HsSrcFile hsc_lang output_fn <- get_output_fn dflags next_phase maybe_loc @@ -930,7 +927,7 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc let include_paths = foldr (\ x xs -> "-I" : x : xs) [] (cmdline_include_paths ++ pkg_include_dirs) - let (md_c_flags, md_regd_c_flags) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags gcc_extra_viac_flags <- getExtraViaCOpts dflags let pic_c_flags = picCCOpts dflags @@ -960,10 +957,7 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- Decide next phase - let mangle = dopt Opt_DoAsmMangling dflags - next_phase - | hcc && mangle = Mangle - | otherwise = As + let next_phase = As output_fn <- get_output_fn dflags next_phase maybe_loc let @@ -1020,18 +1014,8 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- This is a temporary hack. ++ ["-mcpu=v9"] #endif - ++ (if hcc && mangle - then md_regd_c_flags - else []) - ++ (if hcc - then if mangle - then gcc_extra_viac_flags - else filter (=="-fwrapv") - gcc_extra_viac_flags - -- still want -fwrapv even for unreg'd - else []) ++ (if hcc - then more_hcc_opts + then gcc_extra_viac_flags ++ more_hcc_opts else []) ++ [ verb, "-S", "-Wimplicit", cc_opt ] ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] @@ -1049,33 +1033,6 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- ToDo: postprocess the output from gcc ----------------------------------------------------------------------------- --- Mangle phase - -runPhase Mangle _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc - = do let dflags = hsc_dflags hsc_env - let mangler_opts = getOpts dflags opt_m - -#if i386_TARGET_ARCH - machdep_opts <- return [ show (stolen_x86_regs dflags) ] -#else - machdep_opts <- return [] -#endif - - let split = dopt Opt_SplitObjs dflags - next_phase - | split = SplitMangle - | otherwise = As - output_fn <- get_output_fn dflags next_phase maybe_loc - - SysTools.runMangle dflags (map SysTools.Option mangler_opts - ++ [ SysTools.FileOption "" input_fn - , SysTools.FileOption "" output_fn - ] - ++ map SysTools.Option machdep_opts) - - return (next_phase, dflags, maybe_loc, output_fn) - ------------------------------------------------------------------------------ -- Splitting phase runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe_loc @@ -1117,7 +1074,7 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- might be a hierarchical module. createDirectoryHierarchy (takeDirectory output_fn) - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags SysTools.runAs dflags (map SysTools.Option as_opts ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -1167,7 +1124,7 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc split_obj n = split_odir takeFileName base_o ++ "__" ++ show n <.> osuf - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags let assemble_file n = SysTools.runAs dflags (map SysTools.Option as_opts ++ @@ -1313,7 +1270,7 @@ mkExtraCObj dflags xs oFile <- newTempName dflags "o" writeFile cFile $ unlines xs let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags SysTools.runCc dflags ([Option "-c", FileOption "" cFile, @@ -1505,7 +1462,7 @@ linkBinary dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags SysTools.runLink dflags ( [ SysTools.Option verb , SysTools.Option "-o" @@ -1658,7 +1615,7 @@ linkDynLib dflags o_files dep_packages = do -- probably _stub.o files extra_ld_inputs <- readIORef v_Ld_inputs - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags let extra_ld_opts = getOpts dflags opt_l rtsEnabledObj <- mkRtsOptionsLevelObj dflags @@ -1739,7 +1696,10 @@ linkDynLib dflags o_files dep_packages = do md_c_flags ++ o_files ++ [ "-undefined", "dynamic_lookup", "-single_module", - "-Wl,-read_only_relocs,suppress", "-install_name", instName ] +#if !defined(x86_64_TARGET_ARCH) + "-Wl,-read_only_relocs,suppress", +#endif + "-install_name", instName ] ++ extra_ld_inputs ++ lib_path_opts ++ extra_ld_opts @@ -1772,7 +1732,9 @@ linkDynLib dflags o_files dep_packages = do ++ o_files ++ [ "-shared" ] ++ bsymbolicFlag - ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname + -- Set the library soname. We use -h rather than -soname as + -- Solaris 10 doesn't support the latter: + ++ [ "-Wl,-h," ++ takeFileName output_fn ] ++ extra_ld_inputs ++ lib_path_opts ++ extra_ld_opts @@ -1800,7 +1762,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do | otherwise = (optc ++ md_c_flags) where optc = getOpts dflags opt_c - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags let cpp_prog args | raw = SysTools.runCpp dflags args | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args) @@ -1856,7 +1818,7 @@ joinObjectFiles dflags o_files output_fn = do ld_x_flag | null cLD_X = "" | otherwise = "-Wl,-x" - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags if cLdIsGNULd == "YES" then do @@ -1881,19 +1843,3 @@ hscNextPhase dflags _ hsc_lang = HscInterpreted -> StopLn _other -> StopLn - -hscMaybeAdjustTarget :: DynFlags -> Phase -> HscSource -> HscTarget -> HscTarget -hscMaybeAdjustTarget dflags stop _ current_hsc_lang - = hsc_lang - where - keep_hc = dopt Opt_KeepHcFiles dflags - hsc_lang - -- don't change the lang if we're interpreting - | current_hsc_lang == HscInterpreted = current_hsc_lang - - -- force -fvia-C if we are being asked for a .hc file - | HCc <- stop = HscC - | keep_hc = HscC - -- otherwise, stick to the plan - | otherwise = current_hsc_lang -