--
-----------------------------------------------------------------------------
-#include "../includes/ghcconfig.h"
-
module DriverPipeline (
-- Interfaces for the batch-mode driver
preprocess :: DynFlags -> FilePath -> IO (DynFlags, FilePath)
preprocess dflags filename =
ASSERT2(isHaskellSrcFilename filename, text filename)
- runPipeline (StopBefore anyHsc) dflags ("preprocess")
+ runPipeline anyHsc "preprocess" dflags
False{-temporary output file-}
Nothing{-no specific output file-}
filename
when (not exists) $
throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
- o_file <- readIORef v_Output_file
- no_link <- readIORef v_NoLink -- Set by -c or -no-link
+ split <- readIORef v_Split_object_files
+ o_file <- readIORef v_Output_file
+ ghc_link <- readIORef v_GhcLink -- Set by -c or -no-link
-- When linking, the -o argument refers to the linker's output.
-- otherwise, we use it as the name for the pipeline's output.
- let maybe_o_file | no_link = o_file
- | otherwise = Nothing
-
- stop_flag <- readIORef v_GhcModeFlag
- (_, out_file) <- runPipeline mode dflags stop_flag True maybe_o_file
- src Nothing{-no ModLocation-}
+ let maybe_o_file
+ | isLinkMode mode && not (isNoLink ghc_link) = Nothing
+ -- -o foo applies to linker
+ | otherwise = o_file
+ -- -o foo applies to the file we are compiling now
+
+ stop_phase = case mode of
+ StopBefore As | split -> SplitAs
+ StopBefore phase -> phase
+ other -> StopLn
+
+ mode_flag_string <- readIORef v_GhcModeFlag
+ (_, out_file) <- runPipeline stop_phase mode_flag_string dflags
+ True maybe_o_file src Nothing{-no ModLocation-}
return out_file
data CompResult
= CompOK ModDetails -- New details
- (Maybe GlobalRdrEnv) -- Lexical environment for the module
- -- (Maybe because we may have loaded it from
- -- its precompiled interface)
ModIface -- New iface
(Maybe Linkable) -- New code; Nothing => compilation was not reqd
-- (old code is still valid)
later (writeIORef v_Include_paths old_paths) $ do
-- Figure out what lang we're generating
- todo <- readIORef v_GhcMode
- hsc_lang <- hscMaybeAdjustTarget todo src_flavour (hscTarget dyn_flags)
+ hsc_lang <- hscMaybeAdjustTarget StopLn src_flavour (hscTarget dyn_flags)
-- ... and what the next phase should be
next_phase <- hscNextPhase src_flavour hsc_lang
-- ... and what file to generate the output into
case hsc_result of
HscFail -> return CompErrs
- HscNoRecomp details iface -> return (CompOK details Nothing iface Nothing)
+ HscNoRecomp details iface -> return (CompOK details iface Nothing)
- HscRecomp details rdr_env iface
+ HscRecomp details iface
stub_h_exists stub_c_exists maybe_interpreted_code
| isHsBoot src_flavour -- No further compilation to do
- -> return (CompOK details rdr_env iface Nothing)
+ -> return (CompOK details iface Nothing)
| otherwise -- Normal Haskell source files
-> do
_other -> do
let object_filename = ml_obj_file location
- runPipeline DoLink dyn_flags ""
+ runPipeline StopLn "" dyn_flags
True Nothing output_fn (Just location)
-- the object filename comes from the ModLocation
let linkable = LM unlinked_time this_mod
(hs_unlinked ++ stub_unlinked)
- return (CompOK details rdr_env iface (Just linkable))
+ return (CompOK details iface (Just linkable))
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
| stub_c_exists = do
-- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags
- (_, stub_o) <- runPipeline DoLink dflags "stub-compile"
+ (_, stub_o) <- runPipeline StopLn "stub-compile" dflags
True{-persistent output-}
Nothing{-no specific output file-}
stub_c
hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
-- check for the -no-link flag
- omit_linking <- readIORef v_NoLink
- if omit_linking
+ ghc_link <- readIORef v_GhcLink
+ if isNoLink ghc_link
then do when (verb >= 3) $
hPutStrLn stderr "link(batch): linking omitted (-c flag given)."
return Succeeded
-- pipeline, but we throw away the resulting DynFlags at the end.
runPipeline
- :: GhcMode -- when to stop
- -> DynFlags -- dynamic flags
- -> String -- "stop after" flag
- -> Bool -- final output is persistent?
- -> Maybe FilePath -- where to put the output, optionally
- -> FilePath -- input filename
- -> Maybe ModLocation -- a ModLocation for this module, if we have one
+ :: Phase -- When to stop
+ -> String -- "GhcMode" flag as a string
+ -> DynFlags -- Dynamic flags
+ -> Bool -- Final output is persistent?
+ -> Maybe FilePath -- Where to put the output, optionally
+ -> FilePath -- Input filename
+ -> Maybe ModLocation -- A ModLocation for this module, if we have one
-> IO (DynFlags, FilePath) -- (final flags, output filename)
-runPipeline todo dflags stop_flag keep_output
+runPipeline stop_phase mode_flag_string dflags keep_output
maybe_output_filename input_fn maybe_loc
= do
- split <- readIORef v_Split_object_files
let (basename, suffix) = splitFilename input_fn
start_phase = startPhase suffix
- todo' = case todo of
- StopBefore As | split -> StopBefore SplitAs
- other -> todo
-
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
- --
- let stop_phase = case todo' of
- StopBefore phase -> phase
- other -> StopLn
when (not (start_phase `happensBefore` stop_phase)) $
throwDyn (UsageError
- ("flag `" ++ stop_flag
+ ("flag `" ++ mode_flag_string
++ "' is incompatible with source file `"
++ input_fn ++ "'"))
maybe_output_filename basename
-- Execute the pipeline...
- (dflags', output_fn, maybe_loc) <- pipeLoop todo' dflags start_phase stop_phase input_fn
+ (dflags', output_fn, maybe_loc) <- pipeLoop dflags start_phase stop_phase input_fn
basename suffix get_output_fn maybe_loc
-- Sometimes, a compilation phase doesn't actually generate any output
return (dflags', output_fn)
-pipeLoop :: GhcMode -> DynFlags -> Phase -> Phase
+pipeLoop :: DynFlags -> Phase -> Phase
-> FilePath -> String -> Suffix
-> (Phase -> Maybe ModLocation -> IO FilePath)
-> Maybe ModLocation
-> IO (DynFlags, FilePath, Maybe ModLocation)
-pipeLoop orig_todo dflags phase stop_phase
+pipeLoop dflags phase stop_phase
input_fn orig_basename orig_suff
orig_get_output_fn maybe_loc
| otherwise
= do { (next_phase, dflags', maybe_loc, output_fn)
- <- runPhase phase orig_todo dflags orig_basename
+ <- runPhase phase stop_phase dflags orig_basename
orig_suff input_fn orig_get_output_fn maybe_loc
- ; pipeLoop orig_todo dflags' next_phase stop_phase output_fn
+ ; pipeLoop dflags' next_phase stop_phase output_fn
orig_basename orig_suff orig_get_output_fn maybe_loc }
genOutputFilenameFunc :: Phase -> Bool -> Maybe FilePath -> String
-- of a source file can change the latter stages of the pipeline from
-- taking the via-C route to using the native code generator.
-runPhase :: Phase
- -> GhcMode
+runPhase :: Phase -- Do this phase first
+ -> Phase -- Stop just before this phase
-> DynFlags
-> String -- basename of original input source
-> String -- its extension
-------------------------------------------------------------------------------
-- Unlit phase
-runPhase (Unlit sf) _todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do let unlit_flags = getOpts dflags opt_L
-- The -h option passes the file name for unlit to put in a #line directive
output_fn <- get_output_fn (Cpp sf) maybe_loc
-- Cpp phase : (a) gets OPTIONS out of file
-- (b) runs cpp if necessary
-runPhase (Cpp sf) _todo dflags basename suff input_fn get_output_fn maybe_loc
+runPhase (Cpp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
= do src_opts <- getOptionsFromSource input_fn
(dflags,unhandled_flags) <- processDynamicFlags src_opts dflags
checkProcessArgsResult unhandled_flags (basename++'.':suff)
-------------------------------------------------------------------------------
-- HsPp phase
-runPhase (HsPp sf) _todo dflags basename suff input_fn get_output_fn maybe_loc
+runPhase (HsPp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
= do if not (ppFlag dflags) then
-- no need to preprocess, just pass input file along
-- to the next phase of the pipeline.
-- Compilation of a single module, in "legacy" mode (_not_ under
-- the direction of the compilation manager).
-runPhase (Hsc src_flavour) todo dflags basename suff input_fn get_output_fn _maybe_loc
+runPhase (Hsc src_flavour) stop dflags basename suff input_fn get_output_fn _maybe_loc
= do -- normal Hsc mode, not mkdependHS
-- we add the current directory (i.e. the directory in which
-- the object file for one module.)
-- Note the nasty duplication with the same computation in compileFile above
expl_o_file <- readIORef v_Output_file
- no_link <- readIORef v_NoLink
- let location4 | Just ofile <- expl_o_file, no_link
+ ghc_link <- readIORef v_GhcLink
+ let location4 | Just ofile <- expl_o_file
+ , isNoLink ghc_link
= location3 { ml_obj_file = ofile }
| otherwise = location3
-- Figure out if the source has changed, for recompilation avoidance.
- -- only do this if we're eventually going to generate a .o file.
- -- (ToDo: do when generating .hc files too?)
--
-- Setting source_unchanged to True means that M.o seems
-- to be up to date wrt M.hs; so no need to recompile unless imports have
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
let do_recomp = recompFlag dflags
source_unchanged <-
- if not (do_recomp && case todo of { DoLink -> True; other -> False })
- then return False
+ if not do_recomp || not (isStopLn stop)
+ -- Set source_unchanged to False unconditionally if
+ -- (a) recompilation checker is off, or
+ -- (b) we aren't going all the way to .o file (e.g. ghc -S)
+ then return False
+ -- Otherwise look at file modification dates
else do o_file_exists <- doesFileExist o_file
if not o_file_exists
then return False -- Need to recompile
else return False
-- get the DynFlags
- hsc_lang <- hscMaybeAdjustTarget todo src_flavour (hscTarget dflags)
+ hsc_lang <- hscMaybeAdjustTarget stop src_flavour (hscTarget dflags)
next_phase <- hscNextPhase src_flavour hsc_lang
output_fn <- get_output_fn next_phase (Just location4)
SysTools.touch dflags' "Touching object file" o_file
return (StopLn, dflags', Just location4, o_file)
- HscRecomp _details _rdr_env _iface
+ HscRecomp _details _iface
stub_h_exists stub_c_exists
_maybe_interpreted_code -> do
-----------------------------------------------------------------------------
-- Cmm phase
-runPhase CmmCpp todo dflags basename suff input_fn get_output_fn maybe_loc
+runPhase CmmCpp stop dflags basename suff input_fn get_output_fn maybe_loc
= do
output_fn <- get_output_fn Cmm maybe_loc
doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn
return (Cmm, dflags, maybe_loc, output_fn)
-runPhase Cmm todo dflags basename suff input_fn get_output_fn maybe_loc
+runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc
= do
- hsc_lang <- hscMaybeAdjustTarget todo HsSrcFile (hscTarget dflags)
+ hsc_lang <- hscMaybeAdjustTarget stop HsSrcFile (hscTarget dflags)
next_phase <- hscNextPhase HsSrcFile hsc_lang
output_fn <- get_output_fn next_phase maybe_loc
-- we don't support preprocessing .c files (with -E) now. Doing so introduces
-- way too many hacks, and I can't say I've ever used it anyway.
-runPhase cc_phase todo dflags basename suff input_fn get_output_fn maybe_loc
+runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
| cc_phase `eqPhase` Cc || cc_phase `eqPhase` HCc
= do let cc_opts = getOpts dflags opt_c
hcc = cc_phase `eqPhase` HCc
(cmdline_include_paths ++ pkg_include_dirs)
(md_c_flags, md_regd_c_flags) <- machdepCCOpts dflags
+ pic_c_flags <- picCCOpts dflags
let verb = getVerbFlag dflags
]
++ map SysTools.Option (
md_c_flags
+ ++ pic_c_flags
++ (if hcc && mangle
then md_regd_c_flags
else [])
-----------------------------------------------------------------------------
-- Mangle phase
-runPhase Mangle todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase Mangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do let mangler_opts = getOpts dflags opt_m
- machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
- then do let n_regs = stolen_x86_regs dflags
- return [ show n_regs ]
- else return []
+
+#if i386_TARGET_ARCH
+ machdep_opts <- return [ show (stolen_x86_regs dflags) ]
+#else
+ machdep_opts <- return []
+#endif
split <- readIORef v_Split_object_files
let next_phase
-----------------------------------------------------------------------------
-- Splitting phase
-runPhase SplitMangle todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase SplitMangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do -- tmp_pfx is the prefix used for the split .s files
-- We also use it as the file to contain the no. of split .s files (sigh)
split_s_prefix <- SysTools.newTempName "split"
-----------------------------------------------------------------------------
-- As phase
-runPhase As todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase As stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do let as_opts = getOpts dflags opt_a
cmdline_include_paths <- readIORef v_Include_paths
return (StopLn, dflags, maybe_loc, output_fn)
-runPhase SplitAs todo dflags basename _suff _input_fn get_output_fn maybe_loc
+runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc
= do let as_opts = getOpts dflags opt_a
(split_s_prefix, n) <- readIORef v_Split_info
-- Ilx2Il phase
-- Run ilx2il over the ILX output, getting an IL file
-runPhase Ilx2Il todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase Ilx2Il stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do let ilx2il_opts = getOpts dflags opt_I
SysTools.runIlx2il (map SysTools.Option ilx2il_opts
++ [ SysTools.Option "--no-add-suffix-to-assembly",
-- Ilasm phase
-- Run ilasm over the IL, getting a DLL
-runPhase Ilasm todo dflags _basename _suff input_fn get_output_fn maybe_loc
+runPhase Ilasm stop dflags _basename _suff input_fn get_output_fn maybe_loc
= do let ilasm_opts = getOpts dflags opt_i
SysTools.runIlasm (map SysTools.Option ilasm_opts
++ [ SysTools.Option "/QUIET",
| otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
let target_defs =
- [ "-D" ++ cTARGETOS ++ "_TARGET_OS=1",
- "-D" ++ cTARGETARCH ++ "_TARGET_ARCH=1" ]
+ [ "-D" ++ HOST_OS ++ "_BUILD_OS=1",
+ "-D" ++ HOST_ARCH ++ "_BUILD_ARCH=1",
+ "-D" ++ TARGET_OS ++ "_HOST_OS=1",
+ "-D" ++ TARGET_ARCH ++ "_HOST_ARCH=1" ]
+ -- remember, in code we *compile*, the HOST is the same our TARGET,
+ -- and BUILD is the same as our HOST.
cpp_prog ([SysTools.Option verb]
++ map SysTools.Option include_paths
_other -> StopLn
)
-hscMaybeAdjustTarget :: GhcMode -> HscSource -> HscTarget -> IO HscTarget
-hscMaybeAdjustTarget todo HsBootFile current_hsc_lang
+hscMaybeAdjustTarget :: Phase -> HscSource -> HscTarget -> IO HscTarget
+hscMaybeAdjustTarget stop HsBootFile current_hsc_lang
= return HscNothing -- No output (other than Foo.hi-boot) for hs-boot files
-hscMaybeAdjustTarget todo other current_hsc_lang
+hscMaybeAdjustTarget stop other current_hsc_lang
= do { keep_hc <- readIORef v_Keep_hc_files
; let 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
- | StopBefore HCc <- todo = HscC
- | keep_hc = HscC
+ | HCc <- stop = HscC
+ | keep_hc = HscC
-- otherwise, stick to the plan
| otherwise = current_hsc_lang
; return hsc_lang }