X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=8e11bf19cc33ea7680c1e70cf1428e70215d4bc8;hb=412040168f72d73acfb25b991c0c757a817a4aba;hp=7274f2a9b210115ef0a95517520fd4ceef334a6c;hpb=49a8e5c021009430d373d6224b29004c7d18c408;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 7274f2a..8e11bf1 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 @@ -605,7 +606,7 @@ getOutputFilename stop_phase output basename 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 + keep_bc = dopt Opt_KeepLlvmFiles dflags myPhaseInputExt HCc = hcsuf myPhaseInputExt StopLn = osuf @@ -619,8 +620,7 @@ getOutputFilename stop_phase output basename StopLn -> True Mangle | keep_raw_s -> True As | keep_s -> True - LlvmAs | keep_bc -> True - LlvmOpt | keep_bc -> True + LlvmOpt | keep_bc -> True HCc | keep_hc -> True _other -> False @@ -1237,50 +1237,28 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc ----------------------------------------------------------------------------- --- LlvmAs phase +-- LlvmOpt phase -runPhase LlvmAs _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc +runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = liftIO $ do - let dflags = hsc_dflags hsc_env - let la_opts = getOpts dflags opt_la - - output_fn <- get_output_fn dflags LlvmOpt maybe_loc + let dflags = hsc_dflags hsc_env + let lo_opts = getOpts dflags opt_lo + let opt_lvl = max 0 (min 2 $ optLevel dflags) - SysTools.runLlvmAs dflags - (map SysTools.Option la_opts - ++ [ SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn]) + output_fn <- get_output_fn dflags LlvmLlc maybe_loc - return (LlvmOpt, dflags, maybe_loc, output_fn) - - ------------------------------------------------------------------------------ --- LlvmOpt phase + SysTools.runLlvmOpt dflags + ([ SysTools.FileOption "" input_fn, + SysTools.Option (llvmOpts !! opt_lvl), + SysTools.Option "-o", + SysTools.FileOption "" output_fn] + ++ map SysTools.Option lo_opts) -runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc - = liftIO $ do - let dflags = hsc_dflags hsc_env - let lo_opts = getOpts dflags opt_lo - let opt_lvl = max 0 (min 2 $ optLevel dflags) - - -- only run if > 0 OR opt options given by user - if opt_lvl /= 0 || lo_opts /= [] - then do - output_fn <- get_output_fn dflags LlvmLlc maybe_loc - - SysTools.runLlvmOpt dflags - (map SysTools.Option lo_opts - ++ [ SysTools.FileOption "" input_fn, - SysTools.Option (llvmOpts !! opt_lvl), - SysTools.Option "-o", - SysTools.FileOption "" output_fn]) - - return (LlvmLlc, dflags, maybe_loc, output_fn) - - else - return (LlvmLlc, dflags, maybe_loc, input_fn) + return (LlvmLlc, dflags, maybe_loc, output_fn) where - llvmOpts = ["-O1", "-O2", "-O3"] + -- we always run Opt since we rely on it to fix up some pretty + -- big deficiencies in the code we generate + llvmOpts = ["-mem2reg", "-O1", "-O2"] ----------------------------------------------------------------------------- @@ -1288,22 +1266,41 @@ runPhase LlvmOpt _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc runPhase LlvmLlc _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = liftIO $ do - let dflags = hsc_dflags hsc_env - let lc_opts = getOpts dflags opt_lc - let opt_lvl = max 0 (min 2 $ optLevel dflags) + 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.runLlvmLlc dflags + ([ 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 - llvmOpts = ["", "-O2", "-O3"] +#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 @@ -1351,12 +1348,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 @@ -1865,9 +1864,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 @@ -1906,7 +1905,7 @@ hscNextPhase dflags _ hsc_lang = HscC -> HCc HscAsm | dopt Opt_SplitObjs dflags -> SplitMangle | otherwise -> As - HscLlvm -> LlvmAs + HscLlvm -> LlvmOpt HscNothing -> StopLn HscInterpreted -> StopLn _other -> StopLn