Commit 1e2b3780 authored by Simon Marlow's avatar Simon Marlow

Handle -opt<blah> options more consistently (#7909)

Now these are always added by the run<blah> functions in SysTools, so
we never miss any out.  Several cleanups resulted.
parent 1d3fa868
......@@ -291,15 +291,14 @@ reallyInitDynLinker dflags =
; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0
-- (c) Link libraries from the command-line
; let optl = getOpts dflags opt_l
; let minus_ls = [ lib | '-':'l':lib <- optl ]
; let cmdline_ld_inputs = ldInputs dflags
; let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
; let lib_paths = libraryPaths dflags
; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls
-- (d) Link .o files from the command-line
; let cmdline_ld_inputs = ldInputs dflags
; classified_ld_inputs <- mapM (classifyLdInput dflags) cmdline_ld_inputs
; classified_ld_inputs <- mapM (classifyLdInput dflags)
[ f | FileOption _ f <- cmdline_ld_inputs ]
-- (e) Link any MacOS frameworks
; let platform = targetPlatform dflags
......
......@@ -370,7 +370,7 @@ linkingNeeded dflags linkables pkg_deps = do
Left _ -> return True
Right t -> do
-- first check object files and extra_ld_inputs
let extra_ld_inputs = ldInputs dflags
let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
let (errs,extra_times) = splitEithers e_extra_times
let obj_times = map linkableTime linkables ++ extra_times
......@@ -820,9 +820,7 @@ runPhase (RealPhase (Unlit sf)) input_fn dflags
= do
output_fn <- phaseOutputFilename (Cpp sf)
let unlit_flags = getOpts dflags opt_L
flags = map SysTools.Option unlit_flags ++
[ -- The -h option passes the file name for unlit to
let flags = [ -- The -h option passes the file name for unlit to
-- put in a #line directive
SysTools.Option "-h"
, SysTools.Option $ escape $ normalise input_fn
......@@ -869,7 +867,7 @@ runPhase (RealPhase (Cpp sf)) input_fn dflags0
return (RealPhase (HsPp sf), input_fn)
else do
output_fn <- phaseOutputFilename (HsPp sf)
liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-}
liftIO $ doCpp dflags1 True{-raw-}
input_fn output_fn
-- re-read the pragmas now that we've preprocessed the file
-- See #2464,#3457
......@@ -895,7 +893,6 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags
-- to the next phase of the pipeline.
return (RealPhase (Hsc sf), input_fn)
else do
let hspp_opts = getOpts dflags opt_F
PipeEnv{src_basename, src_suffix} <- getPipeEnv
let orig_fn = src_basename <.> src_suffix
output_fn <- phaseOutputFilename (Hsc sf)
......@@ -903,8 +900,7 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags
( [ SysTools.Option orig_fn
, SysTools.Option input_fn
, SysTools.FileOption "" output_fn
] ++
map SysTools.Option hspp_opts
]
)
-- re-read pragmas now that we've parsed the file (see #3674)
......@@ -1053,7 +1049,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
runPhase (RealPhase CmmCpp) input_fn dflags
= do
output_fn <- phaseOutputFilename Cmm
liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-}
liftIO $ doCpp dflags False{-not raw-}
input_fn output_fn
return (RealPhase Cmm, output_fn)
......@@ -1081,7 +1077,6 @@ runPhase (RealPhase cc_phase) input_fn dflags
| any (cc_phase `eqPhase`) [Cc, Ccpp, HCc, Cobjc, Cobjcpp]
= do
let platform = targetPlatform dflags
cc_opts = getOpts dflags opt_c
hcc = cc_phase `eqPhase` HCc
let cmdline_include_paths = includePaths dflags
......@@ -1195,7 +1190,6 @@ runPhase (RealPhase cc_phase) input_fn dflags
++ [ "-S", cc_opt ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ framework_paths
++ cc_opts
++ split_opt
++ include_paths
++ pkg_extra_cc_opts
......@@ -1254,8 +1248,7 @@ runPhase (RealPhase As) input_fn dflags
| otherwise = return SysTools.runAs
as_prog <- whichAsProg
let as_opts = getOpts dflags opt_a
cmdline_include_paths = includePaths dflags
let cmdline_include_paths = includePaths dflags
next_phase <- maybeMergeStub
output_fn <- phaseOutputFilename next_phase
......@@ -1266,8 +1259,7 @@ runPhase (RealPhase As) input_fn dflags
let runAssembler inputFilename outputFilename
= liftIO $ as_prog dflags
(map SysTools.Option as_opts
++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
-- We only support SparcV9 and better because V8 lacks an atomic CAS
-- instruction so we have to make sure that the assembler accepts the
......@@ -1313,8 +1305,6 @@ runPhase (RealPhase SplitAs) _input_fn dflags
liftIO $ mapM_ removeFile $
map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
let as_opts = getOpts dflags opt_a
let (split_s_prefix, n) = case splitInfo dflags of
Nothing -> panic "No split info"
Just x -> x
......@@ -1326,8 +1316,7 @@ runPhase (RealPhase SplitAs) _input_fn dflags
takeFileName base_o ++ "__" ++ show n <.> osuf
let assemble_file n
= SysTools.runAs dflags
(map SysTools.Option as_opts ++
= SysTools.runAs dflags (
-- We only support SparcV9 and better because V8 lacks an atomic CAS
-- instruction so we have to make sure that the assembler accepts the
......@@ -1383,13 +1372,12 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
= do
ver <- liftIO $ readIORef (llvmVersion dflags)
let lo_opts = getOpts dflags opt_lo
opt_lvl = max 0 (min 2 $ optLevel dflags)
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.
optFlag = if null lo_opts
optFlag = if null (getOpts dflags opt_lo)
then [SysTools.Option (llvmOpts !! opt_lvl)]
else []
tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
......@@ -1404,8 +1392,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
SysTools.Option "-o",
SysTools.FileOption "" output_fn]
++ optFlag
++ [SysTools.Option tbaa]
++ map SysTools.Option lo_opts)
++ [SysTools.Option tbaa])
return (RealPhase LlvmLlc, output_fn)
where
......@@ -1420,8 +1407,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
= do
ver <- liftIO $ readIORef (llvmVersion dflags)
let lc_opts = getOpts dflags opt_lc
opt_lvl = max 0 (min 2 $ optLevel dflags)
let opt_lvl = max 0 (min 2 $ optLevel dflags)
-- iOS requires external references to be loaded indirectly from the
-- DATA segment or dyld traps at runtime writing into TEXT: see #7722
rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic"
......@@ -1445,7 +1431,6 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
SysTools.Option $ "-relocation-model=" ++ rmodel,
SysTools.FileOption "" input_fn,
SysTools.Option "-o", SysTools.FileOption "" output_fn]
++ map SysTools.Option lc_opts
++ [SysTools.Option tbaa]
++ map SysTools.Option fpOpts
++ map SysTools.Option abiOpts
......@@ -1598,7 +1583,6 @@ mkExtraObj dflags extn xs
FileOption "" cFile,
Option "-o",
FileOption "" oFile]
++ map SysTools.Option (getOpts dflags opt_c) -- see #5528
++ map (FileOption "-I") (includeDirs rtsDetails))
return oFile
......@@ -1685,7 +1669,7 @@ getLinkInfo dflags dep_packages = do
rtsOpts dflags,
rtsOptsEnabled dflags,
gopt Opt_NoHsMain dflags,
extra_ld_inputs,
map showOpt extra_ld_inputs,
getOpts dflags opt_l)
--
return (show link_info)
......@@ -1857,9 +1841,6 @@ linkBinary dflags o_files dep_packages = do
-- probably _stub.o files
let extra_ld_inputs = ldInputs dflags
-- opts from -optl-<blah> (including -l<blah> options)
let extra_ld_opts = getOpts dflags opt_l
-- Here are some libs that need to be linked at the *end* of
-- the command line, because they contain symbols that are referred to
-- by the RTS. We can't therefore use the ordinary way opts for these.
......@@ -1923,10 +1904,10 @@ linkBinary dflags o_files dep_packages = do
else [])
++ o_files
++ lib_path_opts)
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
++ rc_objs
++ map SysTools.Option (
rc_objs
++ framework_path_opts
++ framework_opts
++ pkg_lib_path_opts
......@@ -1997,12 +1978,10 @@ maybeCreateManifest dflags exe_filename
-- show is a bit hackish above, but we need to escape the
-- backslashes in the path.
let wr_opts = getOpts dflags opt_windres
runWindres dflags $ map SysTools.Option $
["--input="++rc_filename,
"--output="++rc_obj_filename,
"--output-format=coff"]
++ wr_opts
-- no FileOptions here: windres doesn't like seeing
-- backslashes, apparently
......@@ -2025,9 +2004,9 @@ linkDynLibCheck dflags o_files dep_packages
-- -----------------------------------------------------------------------------
-- Running CPP
doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
doCpp dflags raw include_cc_opts input_fn output_fn = do
let hscpp_opts = getOpts dflags opt_P ++ picPOpts dflags
doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp dflags raw input_fn output_fn = do
let hscpp_opts = picPOpts dflags
let cmdline_include_paths = includePaths dflags
pkg_include_dirs <- getPackageIncludePath dflags []
......@@ -2036,10 +2015,6 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
let verbFlags = getVerbFlags dflags
let cc_opts
| include_cc_opts = getOpts dflags opt_c
| otherwise = []
let cpp_prog args | raw = SysTools.runCpp dflags args
| otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
......@@ -2066,7 +2041,6 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
++ map SysTools.Option target_defs
++ map SysTools.Option backend_defs
++ map SysTools.Option hscpp_opts
++ map SysTools.Option cc_opts
++ map SysTools.Option sse_defs
++ [ SysTools.Option "-x"
, SysTools.Option "c"
......
......@@ -631,7 +631,7 @@ data DynFlags = DynFlags {
-- Set by @-ddump-file-prefix@
dumpPrefixForce :: Maybe FilePath,
ldInputs :: [String],
ldInputs :: [Option],
includePaths :: [String],
libraryPaths :: [String],
......@@ -2059,7 +2059,7 @@ dynamic_flags = [
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath)
, Flag "l" (hasArg (addOptl . ("-l" ++)))
, Flag "l" (hasArg (addLdInputs . Option . ("-l" ++)))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
......@@ -3206,6 +3206,9 @@ setMainIs arg
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
addLdInputs :: Option -> DynFlags -> DynFlags
addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}
-----------------------------------------------------------------------------
-- Paths & Libraries
......
......@@ -371,30 +371,35 @@ findTopDir Nothing
\begin{code}
runUnlit :: DynFlags -> [Option] -> IO ()
runUnlit dflags args = do
let p = pgm_L dflags
runSomething dflags "Literate pre-processor" p args
let prog = pgm_L dflags
opts = getOpts dflags opt_L
runSomething dflags "Literate pre-processor" prog
(map Option opts ++ args)
runCpp :: DynFlags -> [Option] -> IO ()
runCpp dflags args = do
let (p,args0) = pgm_P dflags
args1 = args0 ++ args
args1 = map Option (getOpts dflags opt_P)
args2 = if gopt Opt_WarnIsError dflags
then Option "-Werror" : args1
else args1
then [Option "-Werror"]
else []
mb_env <- getGccEnv args2
runSomethingFiltered dflags id "C pre-processor" p args2 mb_env
runSomethingFiltered dflags id "C pre-processor" p
(args0 ++ args1 ++ args2 ++ args) mb_env
runPp :: DynFlags -> [Option] -> IO ()
runPp dflags args = do
let p = pgm_F dflags
runSomething dflags "Haskell pre-processor" p args
let prog = pgm_F dflags
opts = map Option (getOpts dflags opt_F)
runSomething dflags "Haskell pre-processor" prog (opts ++ args)
runCc :: DynFlags -> [Option] -> IO ()
runCc dflags args = do
let (p,args0) = pgm_c dflags
args1 = args0 ++ args
mb_env <- getGccEnv args1
runSomethingFiltered dflags cc_filter "C Compiler" p args1 mb_env
args1 = map Option (getOpts dflags opt_c)
args2 = args0 ++ args1 ++ args
mb_env <- getGccEnv args2
runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env
where
-- discard some harmless warnings from gcc that we can't turn off
cc_filter = unlines . doFilter . lines
......@@ -452,9 +457,10 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
askCc :: DynFlags -> [Option] -> IO String
askCc dflags args = do
let (p,args0) = pgm_c dflags
args1 = args0 ++ args
mb_env <- getGccEnv args1
runSomethingWith dflags "gcc" p args1 $ \real_args ->
args1 = map Option (getOpts dflags opt_c)
args2 = args0 ++ args1 ++ args
mb_env <- getGccEnv args2
runSomethingWith dflags "gcc" p args2 $ \real_args ->
readCreateProcess (proc p real_args){ env = mb_env }
-- Version of System.Process.readProcessWithExitCode that takes an environment
......@@ -507,21 +513,24 @@ runSplit dflags args = do
runAs :: DynFlags -> [Option] -> IO ()
runAs dflags args = do
let (p,args0) = pgm_a dflags
args1 = args0 ++ args
mb_env <- getGccEnv args1
runSomethingFiltered dflags id "Assembler" p args1 mb_env
args1 = map Option (getOpts dflags opt_a)
args2 = args0 ++ args1 ++ args
mb_env <- getGccEnv args2
runSomethingFiltered dflags id "Assembler" p args2 mb_env
-- | Run the LLVM Optimiser
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt dflags args = do
let (p,args0) = pgm_lo dflags
runSomething dflags "LLVM Optimiser" p (args0++args)
args1 = map Option (getOpts dflags opt_lo)
runSomething dflags "LLVM Optimiser" p (args0 ++ args1 ++ args)
-- | Run the LLVM Compiler
runLlvmLlc :: DynFlags -> [Option] -> IO ()
runLlvmLlc dflags args = do
let (p,args0) = pgm_lc dflags
runSomething dflags "LLVM Compiler" p (args0++args)
args1 = map Option (getOpts dflags opt_lc)
runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
-- | Run the clang compiler (used as an assembler for the LLVM
-- backend on OS X as LLVM doesn't support the OS X system
......@@ -533,10 +542,11 @@ runClang dflags args = do
-- be careful what options we call clang with
-- see #5903 and #7617 for bugs caused by this.
(_,args0) = pgm_a dflags
args1 = args0 ++ args
mb_env <- getGccEnv args1
args1 = map Option (getOpts dflags opt_a)
args2 = args0 ++ args1 ++ args
mb_env <- getGccEnv args2
Exception.catch (do
runSomethingFiltered dflags id "Clang (Assembler)" clang args1 mb_env
runSomethingFiltered dflags id "Clang (Assembler)" clang args2 mb_env
)
(\(err :: SomeException) -> do
errorMsg dflags $
......@@ -591,9 +601,10 @@ figureLlvmVersion dflags = do
runLink :: DynFlags -> [Option] -> IO ()
runLink dflags args = do
let (p,args0) = pgm_l dflags
args1 = args0 ++ args
mb_env <- getGccEnv args1
runSomethingFiltered dflags id "Linker" p args1 mb_env
args1 = map Option (getOpts dflags opt_l)
args2 = args0 ++ args1 ++ args
mb_env <- getGccEnv args2
runSomethingFiltered dflags id "Linker" p args2 mb_env
runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL dflags args = do
......@@ -606,6 +617,7 @@ runWindres :: DynFlags -> [Option] -> IO ()
runWindres dflags args = do
let (gcc, gcc_args) = pgm_c dflags
windres = pgm_windres dflags
opts = map Option (getOpts dflags opt_windres)
quote x = "\"" ++ x ++ "\""
args' = -- If windres.exe and gcc.exe are in a directory containing
-- spaces then windres fails to run gcc. We therefore need
......@@ -613,6 +625,7 @@ runWindres dflags args = do
Option ("--preprocessor=" ++
unwords (map quote (gcc :
map showOpt gcc_args ++
map showOpt opts ++
["-E", "-xc", "-DRC_INVOKED"])))
-- ...but if we do that then if windres calls popen then
-- it can't understand the quoting, so we have to use
......@@ -1101,8 +1114,6 @@ linkDynLib dflags0 o_files dep_packages
-- probably _stub.o files
let extra_ld_inputs = ldInputs dflags
let extra_ld_opts = getOpts dflags opt_l
case os of
OSMinGW32 -> do
-------------------------------------------------------------
......@@ -1122,15 +1133,14 @@ linkDynLib dflags0 o_files dep_packages
| gopt Opt_SharedImplib dflags
]
++ map (FileOption "") o_files
++ map Option (
-- Permit the linker to auto link _symbol to _imp_symbol
-- This lets us link against DLLs without needing an "import library"
["-Wl,--enable-auto-import"]
++ [Option "-Wl,--enable-auto-import"]
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
++ map Option (
lib_path_opts
++ pkg_lib_path_opts
++ pkg_link_opts
))
......@@ -1181,19 +1191,19 @@ linkDynLib dflags0 o_files dep_packages
, Option "-o"
, FileOption "" output_fn
]
++ map Option (
o_files
++ [ "-undefined", "dynamic_lookup", "-single_module" ]
++ map Option o_files
++ [ Option "-undefined",
Option "dynamic_lookup",
Option "-single_module" ]
++ (if platformArch platform == ArchX86_64
then [ ]
else [ "-Wl,-read_only_relocs,suppress" ])
++ [ "-install_name", instName ]
else [ Option "-Wl,-read_only_relocs,suppress" ])
++ [ Option "-install_name", Option instName ]
++ map Option lib_path_opts
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
++ pkg_lib_path_opts
++ pkg_link_opts
))
++ map Option pkg_lib_path_opts
++ map Option pkg_link_opts
)
_ -> do
-------------------------------------------------------------------
-- Making a DSO
......@@ -1214,18 +1224,15 @@ linkDynLib dflags0 o_files dep_packages
++ [ Option "-o"
, FileOption "" output_fn
]
++ map Option (
o_files
++ [ "-shared" ]
++ bsymbolicFlag
++ map Option o_files
++ [ Option "-shared" ]
++ map Option bsymbolicFlag
-- Set the library soname. We use -h rather than -soname as
-- Solaris 10 doesn't support the latter:
++ [ "-Wl,-h," ++ takeFileName output_fn ]
++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
++ map Option lib_path_opts
++ extra_ld_inputs
++ lib_path_opts
++ extra_ld_opts
++ pkg_lib_path_opts
++ pkg_link_opts
))
++ map Option pkg_lib_path_opts
++ map Option pkg_link_opts
)
\end{code}
......@@ -198,7 +198,8 @@ main' postLoadMode dflags0 args flagWarnings = do
normal_fileish_paths = map (normalise . unLoc) fileish_args
(srcs, objs) = partition_args normal_fileish_paths [] []
dflags5 = dflags4 { ldInputs = objs ++ ldInputs dflags4 }
dflags5 = dflags4 { ldInputs = map (FileOption "") objs
++ ldInputs dflags4 }
-- we've finished manipulating the DynFlags, update the session
_ <- GHC.setSessionDynFlags dflags5
......@@ -638,7 +639,8 @@ doMake srcs = do
o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x)
non_hs_srcs
dflags <- GHC.getSessionDynFlags
let dflags' = dflags { ldInputs = o_files ++ ldInputs dflags }
let dflags' = dflags { ldInputs = map (FileOption "") o_files
++ ldInputs dflags }
_ <- GHC.setSessionDynFlags dflags'
targets <- mapM (uncurry GHC.guessTarget) hs_srcs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment