import ParserCoreUtils ( getCoreModuleName )
import SrcLoc
import FastString
+import LlvmCodeGen ( llvmFixupAsm )
-- import MonadUtils
-- import Data.Either
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
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
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
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
)
-- 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
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
-----------------------------------------------------------------------------
--- LlvmAs phase
-
-runPhase LlvmAs _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)
-
-
------------------------------------------------------------------------------
-- LlvmOpt phase
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)
+ let dflags = hsc_dflags hsc_env
+ let lo_opts = getOpts dflags opt_lo
+ let opt_lvl = max 0 (min 2 $ optLevel dflags)
+ -- don't specify anything if user has specified commands. We do this for
+ -- opt but not llc since opt is very specifically for optimisation passes
+ -- only, so if the user is passing us extra options we assume they know
+ -- what they are doing and don't get in the way.
+ let optFlag = if null lo_opts
+ then [SysTools.Option (llvmOpts !! opt_lvl)]
+ else []
+
+ output_fn <- get_output_fn dflags LlvmLlc maybe_loc
+
+ SysTools.runLlvmOpt dflags
+ ([ SysTools.FileOption "" input_fn,
+ SysTools.Option "-o",
+ SysTools.FileOption "" output_fn]
+ ++ optFlag
+ ++ map SysTools.Option lo_opts)
+
+ return (LlvmLlc, dflags, maybe_loc, output_fn)
where
- llvmOpts = ["-O1", "-O2", "-O3"]
+ -- we always (unless -optlo specified) run Opt since we rely on it to
+ -- fix up some pretty big deficiencies in the code we generate
+ llvmOpts = ["-mem2reg", "-O1", "-O2"]
-----------------------------------------------------------------------------
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
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
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
HscC -> HCc
HscAsm | dopt Opt_SplitObjs dflags -> SplitMangle
| otherwise -> As
- HscLlvm -> LlvmAs
+ HscLlvm -> LlvmOpt
HscNothing -> StopLn
HscInterpreted -> StopLn
_other -> StopLn