X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=2019836fabd1e3e73b62088ecf4d59f98a51b42d;hb=0e6ff027979263c36703f26da836a784fe1606a2;hp=7dc9e14b51b7dc221802efd78d60c7cf1c114585;hpb=f1a72b2938cc289c9a3879301ab445ec9efd63dd;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 7dc9e14..2019836 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -48,6 +48,7 @@ import Maybes ( expectJust ) import ParserCoreUtils ( getCoreModuleName ) import SrcLoc import FastString +import LlvmCodeGen ( llvmFixupAsm ) -- import MonadUtils -- import Data.Either @@ -697,27 +698,30 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags0 = hsc_dflags hsc_env - src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn + let dflags0' = flattenExtensionFlags dflags0 + src_opts <- liftIO $ getOptionsFromFile dflags0' input_fn (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts checkProcessArgsResult unhandled_flags + let dflags1' = flattenExtensionFlags dflags1 - if not (dopt Opt_Cpp dflags1) then do + if not (dopt Opt_Cpp dflags1') then do -- we have to be careful to emit warnings only once. - unless (dopt Opt_Pp dflags1) $ handleFlagWarnings dflags1 warns + unless (dopt Opt_Pp dflags1') $ handleFlagWarnings dflags1' warns -- no need to preprocess CPP, just pass input file along -- to the next phase of the pipeline. return (HsPp sf, dflags1, maybe_loc, input_fn) else do - output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc - liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn output_fn + output_fn <- liftIO $ get_output_fn dflags1' (HsPp sf) maybe_loc + liftIO $ doCpp dflags1' True{-raw-} False{-no CC opts-} input_fn output_fn -- re-read the pragmas now that we've preprocessed the file -- See #2464,#3457 - src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn + src_opts <- liftIO $ getOptionsFromFile dflags0' output_fn (dflags2, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts - unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns + let dflags2' = flattenExtensionFlags dflags2 + unless (dopt Opt_Pp dflags2') $ handleFlagWarnings dflags2' warns -- the HsPp pass below will emit warnings checkProcessArgsResult unhandled_flags @@ -728,10 +732,11 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env + dflags' = flattenExtensionFlags dflags if not (dopt Opt_Pp dflags) then -- no need to preprocess, just pass input file along -- to the next phase of the pipeline. - return (Hsc sf, dflags, maybe_loc, input_fn) + return (Hsc sf, dflags', maybe_loc, input_fn) else do let hspp_opts = getOpts dflags opt_F let orig_fn = basename <.> suff @@ -745,13 +750,14 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc ) -- re-read pragmas now that we've parsed the file (see #3674) - src_opts <- liftIO $ getOptionsFromFile dflags output_fn + src_opts <- liftIO $ getOptionsFromFile dflags' output_fn (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags src_opts - handleFlagWarnings dflags1 warns + let dflags1' = flattenExtensionFlags dflags1 + handleFlagWarnings dflags1' warns checkProcessArgsResult unhandled_flags - return (Hsc sf, dflags1, maybe_loc, output_fn) + return (Hsc sf, dflags1', maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Hsc phase @@ -899,9 +905,10 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env - output_fn <- liftIO $ get_output_fn dflags Cmm maybe_loc - liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn - return (Cmm, dflags, maybe_loc, output_fn) + dflags' = flattenExtensionFlags dflags + output_fn <- liftIO $ get_output_fn dflags' Cmm maybe_loc + liftIO $ 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 = do @@ -1247,11 +1254,11 @@ runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc output_fn <- get_output_fn dflags LlvmLlc maybe_loc SysTools.runLlvmOpt dflags - (map SysTools.Option lo_opts - ++ [ SysTools.FileOption "" input_fn, + ([ SysTools.FileOption "" input_fn, SysTools.Option (llvmOpts !! opt_lvl), SysTools.Option "-o", - SysTools.FileOption "" output_fn]) + SysTools.FileOption "" output_fn] + ++ map SysTools.Option lo_opts) return (LlvmLlc, dflags, maybe_loc, output_fn) where @@ -1268,19 +1275,38 @@ runPhase LlvmLlc _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc let dflags = hsc_dflags hsc_env let lc_opts = getOpts dflags opt_lc let opt_lvl = max 0 (min 2 $ optLevel dflags) +#if darwin_TARGET_OS + let nphase = LlvmMangle +#else + let nphase = As +#endif - output_fn <- get_output_fn dflags As maybe_loc + output_fn <- get_output_fn dflags nphase maybe_loc SysTools.runLlvmLlc dflags - (map SysTools.Option lc_opts - ++ [ -- SysTools.Option "-tailcallopt", - SysTools.Option (llvmOpts !! opt_lvl), + ([ SysTools.Option (llvmOpts !! opt_lvl), SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn]) + SysTools.Option "-o", SysTools.FileOption "" output_fn] + ++ map SysTools.Option lc_opts) - return (As, dflags, maybe_loc, output_fn) + return (nphase, dflags, maybe_loc, output_fn) where +#if darwin_TARGET_OS + llvmOpts = ["-O1", "-O2", "-O2"] +#else llvmOpts = ["-O1", "-O2", "-O3"] +#endif + + +----------------------------------------------------------------------------- +-- LlvmMangle phase + +runPhase LlvmMangle _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc + = liftIO $ do + let dflags = hsc_dflags hsc_env + output_fn <- get_output_fn dflags As maybe_loc + llvmFixupAsm input_fn output_fn + return (As, dflags, maybe_loc, output_fn) -- warning suppression @@ -1328,12 +1354,14 @@ runPhase_MoveBinary dflags input_fn dep_packages let behaviour' = concatMap (\x -> if x=='\\' then "\\\\" else [x]) behaviour renameFile input_fn wrapped_executable let rtsDetails = (getPackageDetails (pkgState dflags) rtsPackageId); + (md_c_flags, _) = machdepCCOpts dflags SysTools.runCc dflags ([ SysTools.FileOption "" ((head (libraryDirs rtsDetails)) ++ "/dyn-wrapper.c") , SysTools.Option ("-DBEHAVIOUR=\"" ++ behaviour' ++ "\"") , SysTools.Option "-o" - , SysTools.FileOption "" input_fn - ] ++ map (SysTools.FileOption "-I") (includeDirs rtsDetails)) + , SysTools.FileOption "" input_fn] ++ + map (SysTools.FileOption "-I") (includeDirs rtsDetails) ++ + map Option md_c_flags) return True _ -> return True | otherwise = return True @@ -1842,9 +1870,9 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do cpp_prog ([SysTools.Option verb] ++ map SysTools.Option include_paths ++ map SysTools.Option hsSourceCppOpts + ++ map SysTools.Option target_defs ++ map SysTools.Option hscpp_opts ++ map SysTools.Option cc_opts - ++ map SysTools.Option target_defs ++ [ SysTools.Option "-x" , SysTools.Option "c" , SysTools.Option input_fn