X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=046e21ce5e2ebaf13117a6adad190e47c0ac4754;hp=7274f2a9b210115ef0a95517520fd4ceef334a6c;hb=df1fecb95e3a0cf901184605da96dc8ae092b173;hpb=49a8e5c021009430d373d6224b29004c7d18c408 diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 7274f2a..046e21c 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 - - SysTools.runLlvmAs dflags - (map SysTools.Option la_opts - ++ [ SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn]) - - return (LlvmOpt, dflags, maybe_loc, output_fn) + let dflags = hsc_dflags hsc_env + let lo_opts = getOpts dflags opt_lo + let opt_lvl = max 0 (min 2 $ optLevel dflags) + output_fn <- get_output_fn dflags LlvmLlc maybe_loc ------------------------------------------------------------------------------ --- LlvmOpt phase + SysTools.runLlvmOpt dflags + (map SysTools.Option lo_opts + ++ [ SysTools.FileOption "" input_fn, + SysTools.Option (llvmOpts !! opt_lvl), + SysTools.Option "-o", + SysTools.FileOption "" output_fn]) -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,38 @@ 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.runLlvmLlc dflags + (map SysTools.Option lc_opts + ++ [ -- SysTools.Option "-tailcallopt", SysTools.Option (llvmOpts !! opt_lvl), SysTools.FileOption "" input_fn, - SysTools.Option "-o", SysTools.FileOption "" output_fn]) + SysTools.Option "-o", SysTools.FileOption "" output_fn]) - return (As, dflags, maybe_loc, output_fn) + return (nphase, dflags, maybe_loc, output_fn) where - llvmOpts = ["", "-O2", "-O3"] + llvmOpts = ["-O1", "-O2", "-O3"] + + +----------------------------------------------------------------------------- +-- 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 +1345,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 +1861,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 +1902,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