Commit ed5ebee4 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc

parents b9fccbc8 911bc5ce
...@@ -1185,13 +1185,6 @@ searchForLibUsingGcc dflags so dirs = do ...@@ -1185,13 +1185,6 @@ searchForLibUsingGcc dflags so dirs = do
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32) -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
mkSOName :: Platform -> FilePath -> FilePath
mkSOName platform root
= case platformOS platform of
OSDarwin -> ("lib" ++ root) <.> "dylib"
OSMinGW32 -> root <.> "dll"
_ -> ("lib" ++ root) <.> "so"
-- Darwin / MacOS X only: load a framework -- Darwin / MacOS X only: load a framework
-- a framework is a dynamic library packaged inside a directory of the same -- a framework is a dynamic library packaged inside a directory of the same
-- name. They are searched for in different paths than normal libraries. -- name. They are searched for in different paths than normal libraries.
......
...@@ -371,7 +371,7 @@ linkingNeeded dflags linkables pkg_deps = do ...@@ -371,7 +371,7 @@ linkingNeeded dflags linkables pkg_deps = do
| Just c <- map (lookupPackage pkg_map) pkg_deps, | Just c <- map (lookupPackage pkg_map) pkg_deps,
lib <- packageHsLibs dflags c ] lib <- packageHsLibs dflags c ]
pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
if any isNothing pkg_libfiles then return True else do if any isNothing pkg_libfiles then return True else do
e_lib_times <- mapM (tryIO . getModificationUTCTime) e_lib_times <- mapM (tryIO . getModificationUTCTime)
(catMaybes pkg_libfiles) (catMaybes pkg_libfiles)
...@@ -408,9 +408,11 @@ ghcLinkInfoSectionName :: String ...@@ -408,9 +408,11 @@ ghcLinkInfoSectionName :: String
ghcLinkInfoSectionName = ".debug-ghc-link-info" ghcLinkInfoSectionName = ".debug-ghc-link-info"
-- if we use the ".debug" prefix, then strip will strip it by default -- if we use the ".debug" prefix, then strip will strip it by default
findHSLib :: [String] -> String -> IO (Maybe FilePath) findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)
findHSLib dirs lib = do findHSLib dflags dirs lib = do
let batch_lib_file = "lib" ++ lib <.> "a" let batch_lib_file = if dopt Opt_Static dflags
then "lib" ++ lib <.> "a"
else mkSOName (targetPlatform dflags) lib
found <- filterM doesFileExist (map (</> batch_lib_file) dirs) found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
case found of case found of
[] -> return Nothing [] -> return Nothing
...@@ -1662,13 +1664,24 @@ linkBinary dflags o_files dep_packages = do ...@@ -1662,13 +1664,24 @@ linkBinary dflags o_files dep_packages = do
-- explicit packages with the auto packages and all of their -- explicit packages with the auto packages and all of their
-- dependencies, and eliminating duplicates. -- dependencies, and eliminating duplicates.
full_output_fn <- if isAbsolute output_fn
then return output_fn
else do d <- getCurrentDirectory
return $ normalise (d </> output_fn)
pkg_lib_paths <- getPackageLibraryPath dflags dep_packages pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths) let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
get_pkg_lib_path_opts l get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) && | osElfTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent && dynLibLoader dflags == SystemDependent &&
not (dopt Opt_Static dflags) not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] = let libpath = if dopt Opt_RelativeDynlibPaths dflags
then "$ORIGIN" </>
(l `makeRelativeTo` full_output_fn)
else l
rpath = if dopt Opt_RPath dflags
then ["-Wl,-rpath", "-Wl," ++ libpath]
else []
in ["-L" ++ l, "-Wl,-rpath-link", "-Wl," ++ l] ++ rpath
| otherwise = ["-L" ++ l] | otherwise = ["-L" ++ l]
let lib_paths = libraryPaths dflags let lib_paths = libraryPaths dflags
......
...@@ -339,6 +339,8 @@ data DynFlag ...@@ -339,6 +339,8 @@ data DynFlag
| Opt_SccProfilingOn | Opt_SccProfilingOn
| Opt_Ticky | Opt_Ticky
| Opt_Static | Opt_Static
| Opt_RPath
| Opt_RelativeDynlibPaths
| Opt_Hpc | Opt_Hpc
-- output style opts -- output style opts
...@@ -768,15 +770,18 @@ pgm_lc dflags = sPgm_lc (settings dflags) ...@@ -768,15 +770,18 @@ pgm_lc dflags = sPgm_lc (settings dflags)
opt_L :: DynFlags -> [String] opt_L :: DynFlags -> [String]
opt_L dflags = sOpt_L (settings dflags) opt_L dflags = sOpt_L (settings dflags)
opt_P :: DynFlags -> [String] opt_P :: DynFlags -> [String]
opt_P dflags = sOpt_P (settings dflags) opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
++ sOpt_P (settings dflags)
opt_F :: DynFlags -> [String] opt_F :: DynFlags -> [String]
opt_F dflags = sOpt_F (settings dflags) opt_F dflags = sOpt_F (settings dflags)
opt_c :: DynFlags -> [String] opt_c :: DynFlags -> [String]
opt_c dflags = sOpt_c (settings dflags) opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
++ sOpt_c (settings dflags)
opt_a :: DynFlags -> [String] opt_a :: DynFlags -> [String]
opt_a dflags = sOpt_a (settings dflags) opt_a dflags = sOpt_a (settings dflags)
opt_l :: DynFlags -> [String] opt_l :: DynFlags -> [String]
opt_l dflags = sOpt_l (settings dflags) opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
++ sOpt_l (settings dflags)
opt_windres :: DynFlags -> [String] opt_windres :: DynFlags -> [String]
opt_windres dflags = sOpt_windres (settings dflags) opt_windres dflags = sOpt_windres (settings dflags)
opt_lo :: DynFlags -> [String] opt_lo :: DynFlags -> [String]
...@@ -812,13 +817,6 @@ data HscTarget ...@@ -812,13 +817,6 @@ data HscTarget
| HscNothing -- ^ Don't generate any code. See notes above. | HscNothing -- ^ Don't generate any code. See notes above.
deriving (Eq, Show) deriving (Eq, Show)
showHscTargetFlag :: HscTarget -> String
showHscTargetFlag HscC = "-fvia-c"
showHscTargetFlag HscAsm = "-fasm"
showHscTargetFlag HscLlvm = "-fllvm"
showHscTargetFlag HscInterpreted = "-fbyte-code"
showHscTargetFlag HscNothing = "-fno-code"
-- | Will this target result in an object file on the disk? -- | Will this target result in an object file on the disk?
isObjectTarget :: HscTarget -> Bool isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True isObjectTarget HscC = True
...@@ -969,8 +967,6 @@ wayTag WayDyn = "dyn" ...@@ -969,8 +967,6 @@ wayTag WayDyn = "dyn"
wayTag WayProf = "p" wayTag WayProf = "p"
wayTag WayEventLog = "l" wayTag WayEventLog = "l"
wayTag WayPar = "mp" wayTag WayPar = "mp"
-- wayTag WayPar = "mt"
-- wayTag WayPar = "md"
wayTag WayGran = "mg" wayTag WayGran = "mg"
wayTag WayNDP = "ndp" wayTag WayNDP = "ndp"
...@@ -981,8 +977,6 @@ wayRTSOnly WayDyn = False ...@@ -981,8 +977,6 @@ wayRTSOnly WayDyn = False
wayRTSOnly WayProf = False wayRTSOnly WayProf = False
wayRTSOnly WayEventLog = True wayRTSOnly WayEventLog = True
wayRTSOnly WayPar = False wayRTSOnly WayPar = False
-- wayRTSOnly WayPar = False
-- wayRTSOnly WayPar = False
wayRTSOnly WayGran = False wayRTSOnly WayGran = False
wayRTSOnly WayNDP = False wayRTSOnly WayNDP = False
...@@ -993,33 +987,14 @@ wayDesc WayDyn = "Dynamic" ...@@ -993,33 +987,14 @@ wayDesc WayDyn = "Dynamic"
wayDesc WayProf = "Profiling" wayDesc WayProf = "Profiling"
wayDesc WayEventLog = "RTS Event Logging" wayDesc WayEventLog = "RTS Event Logging"
wayDesc WayPar = "Parallel" wayDesc WayPar = "Parallel"
-- wayDesc WayPar = "Parallel ticky profiling"
-- wayDesc WayPar = "Distributed"
wayDesc WayGran = "GranSim" wayDesc WayGran = "GranSim"
wayDesc WayNDP = "Nested data parallelism" wayDesc WayNDP = "Nested data parallelism"
wayOpts :: Platform -> Way -> DynP () wayExtras :: Platform -> Way -> DynP ()
wayOpts platform WayThreaded = do wayExtras _ WayThreaded = return ()
-- FreeBSD's default threading library is the KSE-based M:N libpthread, wayExtras _ WayDebug = return ()
-- which GHC has some problems with. It's currently not clear whether wayExtras platform WayDyn =
-- the problems are our fault or theirs, but it seems that using the case platformOS platform of
-- alternative 1:1 threading library libthr works around it:
let os = platformOS platform
case os of
OSFreeBSD -> upd $ addOptl "-lthr"
OSSolaris2 -> upd $ addOptl "-lrt"
_
| os `elem` [OSOpenBSD, OSNetBSD] ->
do upd $ addOptc "-pthread"
upd $ addOptl "-pthread"
_ ->
return ()
wayOpts _ WayDebug = return ()
wayOpts platform WayDyn = do
upd $ addOptP "-DDYNAMIC"
upd $ addOptc "-DDYNAMIC"
let os = platformOS platform
case os of
OSMinGW32 -> OSMinGW32 ->
-- On Windows, code that is to be linked into a dynamic -- On Windows, code that is to be linked into a dynamic
-- library must be compiled with -fPIC. Labels not in -- library must be compiled with -fPIC. Labels not in
...@@ -1028,59 +1003,69 @@ wayOpts platform WayDyn = do ...@@ -1028,59 +1003,69 @@ wayOpts platform WayDyn = do
setFPIC setFPIC
OSDarwin -> OSDarwin ->
setFPIC setFPIC
_ | os `elem` [OSOpenBSD, OSNetBSD] ->
-- Without this, linking the shared libHSffi fails
-- because it uses pthread mutexes.
upd $ addOptl "-optl-pthread"
_ -> _ ->
return () return ()
wayOpts _ WayProf = do wayExtras _ WayProf = setDynFlag Opt_SccProfilingOn
setDynFlag Opt_SccProfilingOn wayExtras _ WayEventLog = return ()
upd $ addOptP "-DPROFILING" wayExtras _ WayPar = do setDynFlag Opt_Parallel
upd $ addOptc "-DPROFILING" exposePackage "concurrent"
wayOpts _ WayEventLog = do wayExtras _ WayGran = do setDynFlag Opt_GranMacros
upd $ addOptP "-DTRACING" exposePackage "concurrent"
upd $ addOptc "-DTRACING" wayExtras _ WayNDP = do setExtensionFlag Opt_ParallelArrays
wayOpts _ WayPar = do setDynFlag Opt_Vectorise
setDynFlag Opt_Parallel
upd $ addOptP "-D__PARALLEL_HASKELL__" wayOptc :: Platform -> Way -> [String]
upd $ addOptc "-DPAR" wayOptc platform WayThreaded = case platformOS platform of
exposePackage "concurrent" OSOpenBSD -> ["-pthread"]
upd $ addOptc "-w" OSNetBSD -> ["-pthread"]
upd $ addOptl "-L${PVM_ROOT}/lib/${PVM_ARCH}" _ -> []
upd $ addOptl "-lpvm3" wayOptc _ WayDebug = []
upd $ addOptl "-lgpvm3" wayOptc _ WayDyn = ["-DDYNAMIC"]
{- wayOptc _ WayProf = ["-DPROFILING"]
wayOpts WayPar = wayOptc _ WayEventLog = ["-DTRACING"]
[ "-fparallel" wayOptc _ WayPar = ["-DPAR", "-w"]
, "-D__PARALLEL_HASKELL__" wayOptc _ WayGran = ["-DGRAN"]
, "-optc-DPAR" wayOptc _ WayNDP = []
, "-optc-DPAR_TICKY"
, "-package concurrent" wayOptl :: Platform -> Way -> [String]
, "-optc-w" wayOptl platform WayThreaded =
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}" case platformOS platform of
, "-optl-lpvm3" -- FreeBSD's default threading library is the KSE-based M:N libpthread,
, "-optl-lgpvm3" ] -- which GHC has some problems with. It's currently not clear whether
wayOpts WayPar = -- the problems are our fault or theirs, but it seems that using the
[ "-fparallel" -- alternative 1:1 threading library libthr works around it:
, "-D__PARALLEL_HASKELL__" OSFreeBSD -> ["-lthr"]
, "-D__DISTRIBUTED_HASKELL__" OSSolaris2 -> ["-lrt"]
, "-optc-DPAR" OSOpenBSD -> ["-pthread"]
, "-optc-DDIST" OSNetBSD -> ["-pthread"]
, "-package concurrent" _ -> []
, "-optc-w" wayOptl _ WayDebug = []
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}" wayOptl platform WayDyn =
, "-optl-lpvm3" case platformOS platform of
, "-optl-lgpvm3" ] OSOpenBSD -> -- Without this, linking the shared libHSffi fails
-} -- because it uses pthread mutexes.
wayOpts _ WayGran = do ["-optl-pthread"]
setDynFlag Opt_GranMacros OSNetBSD -> -- Without this, linking the shared libHSffi fails
upd $ addOptP "-D__GRANSIM__" -- because it uses pthread mutexes.
upd $ addOptc "-DGRAN" ["-optl-pthread"]
exposePackage "concurrent" _ -> []
wayOpts _ WayNDP = do wayOptl _ WayProf = []
setExtensionFlag Opt_ParallelArrays wayOptl _ WayEventLog = []
setDynFlag Opt_Vectorise wayOptl _ WayPar = ["-L${PVM_ROOT}/lib/${PVM_ARCH}",
"-lpvm3",
"-lgpvm3"]
wayOptl _ WayGran = []
wayOptl _ WayNDP = []
wayOptP :: Platform -> Way -> [String]
wayOptP _ WayThreaded = []
wayOptP _ WayDebug = []
wayOptP _ WayDyn = ["-DDYNAMIC"]
wayOptP _ WayProf = ["-DPROFILING"]
wayOptP _ WayEventLog = ["-DTRACING"]
wayOptP _ WayPar = ["-D__PARALLEL_HASKELL__"]
wayOptP _ WayGran = ["-D__GRANSIM__"]
wayOptP _ WayNDP = []
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -1177,7 +1162,7 @@ defaultDynFlags mySettings = ...@@ -1177,7 +1162,7 @@ defaultDynFlags mySettings =
dirsToClean = panic "defaultDynFlags: No dirsToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps", generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing, haddockOptions = Nothing,
flags = IntSet.fromList (map fromEnum (defaultFlags (sTargetPlatform mySettings))), flags = IntSet.fromList (map fromEnum (defaultFlags mySettings)),
warningFlags = IntSet.fromList (map fromEnum standardWarnings), warningFlags = IntSet.fromList (map fromEnum standardWarnings),
ghciScripts = [], ghciScripts = [],
language = Nothing, language = Nothing,
...@@ -1678,7 +1663,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do ...@@ -1678,7 +1663,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
ghcError (CmdLineError ("combination not supported: " ++ ghcError (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc theWays))) intercalate "/" (map wayDesc theWays)))
return (dflags3, leftover, sh_warns ++ warns) let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns)
-- | Check (and potentially disable) any extensions that aren't allowed -- | Check (and potentially disable) any extensions that aren't allowed
...@@ -1790,15 +1777,13 @@ dynamic_flags = [ ...@@ -1790,15 +1777,13 @@ dynamic_flags = [
-- is required to get the RTS ticky support. -- is required to get the RTS ticky support.
----- Linker -------------------------------------------------------- ----- Linker --------------------------------------------------------
-- -static is the default. If -dynamic has been given then, due to the , Flag "static" (NoArg (do setDynFlag Opt_Static
-- way wayOpts is currently used, we've already set -DDYNAMIC etc. removeWay WayDyn))
-- It's too fiddly to undo that, so we just give an error if , Flag "dynamic" (NoArg (do unSetDynFlag Opt_Static
-- Opt_Static has been unset. addWay WayDyn))
, Flag "static" (noArgM (\dfs -> do unless (dopt Opt_Static dfs) (addErr "Can't use -static after -dynamic")
return dfs))
, Flag "dynamic" (NoArg (unSetDynFlag Opt_Static >> addWay WayDyn))
-- ignored for compat w/ gcc: -- ignored for compat w/ gcc:
, Flag "rdynamic" (NoArg (return ())) , Flag "rdynamic" (NoArg (return ()))
, Flag "relative-dynlib-paths" (NoArg (setDynFlag Opt_RelativeDynlibPaths))
------- Specific phases -------------------------------------------- ------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags. -- need to appear before -pgmL to be parsed as LLVM flags.
...@@ -2290,7 +2275,8 @@ fFlags = [ ...@@ -2290,7 +2275,8 @@ fFlags = [
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
( "prof-count-entries", Opt_ProfCountEntries, nop ), ( "prof-count-entries", Opt_ProfCountEntries, nop ),
( "prof-cafs", Opt_AutoSccsOnIndividualCafs, nop ), ( "prof-cafs", Opt_AutoSccsOnIndividualCafs, nop ),
( "hpc", Opt_Hpc, nop ) ( "hpc", Opt_Hpc, nop ),
( "use-rpaths", Opt_RPath, nop )
] ]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
...@@ -2456,10 +2442,9 @@ xFlags = [ ...@@ -2456,10 +2442,9 @@ xFlags = [
( "TypeHoles", Opt_TypeHoles, nop ) ( "TypeHoles", Opt_TypeHoles, nop )
] ]
defaultFlags :: Platform -> [DynFlag] defaultFlags :: Settings -> [DynFlag]
defaultFlags platform defaultFlags settings
= [ Opt_AutoLinkPackages, = [ Opt_AutoLinkPackages,
Opt_Static,
Opt_SharedImplib, Opt_SharedImplib,
...@@ -2471,7 +2456,8 @@ defaultFlags platform ...@@ -2471,7 +2456,8 @@ defaultFlags platform
Opt_GhciSandbox, Opt_GhciSandbox,
Opt_GhciHistory, Opt_GhciHistory,
Opt_HelpfulErrors, Opt_HelpfulErrors,
Opt_ProfCountEntries Opt_ProfCountEntries,
Opt_RPath
] ]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
...@@ -2484,6 +2470,12 @@ defaultFlags platform ...@@ -2484,6 +2470,12 @@ defaultFlags platform
_ -> [] _ -> []
_ -> []) _ -> [])
++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
then []
else [Opt_Static])
where platform = sTargetPlatform settings
impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)] impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
impliedFlags impliedFlags
= [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll) = [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll)
...@@ -2747,7 +2739,10 @@ setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) ...@@ -2747,7 +2739,10 @@ setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
addWay :: Way -> DynP () addWay :: Way -> DynP ()
addWay w = do upd (\dfs -> dfs { ways = w : ways dfs }) addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
dfs <- liftEwM getCmdLineState dfs <- liftEwM getCmdLineState
wayOpts (targetPlatform dfs) w wayExtras (targetPlatform dfs) w
removeWay :: Way -> DynP ()
removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
-------------------------- --------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP () setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
...@@ -2881,59 +2876,16 @@ setObjTarget l = updM set ...@@ -2881,59 +2876,16 @@ setObjTarget l = updM set
where where
set dflags set dflags
| isObjectTarget (hscTarget dflags) | isObjectTarget (hscTarget dflags)
= case l of = return $ dflags { hscTarget = l }
HscC
| platformUnregisterised (targetPlatform dflags) ->
do addWarn ("Compiler not unregisterised, so ignoring " ++ flag)
return dflags
HscAsm
| cGhcWithNativeCodeGen /= "YES" ->
do addWarn ("Compiler has no native codegen, so ignoring " ++
flag)
return dflags
HscLlvm
| not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
(not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
->
do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
return dflags
_ -> return $ dflags { hscTarget = l }
| otherwise = return dflags | otherwise = return dflags
where platform = targetPlatform dflags
arch = platformArch platform
os = platformOS platform
flag = showHscTargetFlag l
setFPIC :: DynP () setFPIC :: DynP ()
setFPIC = updM set setFPIC = updM set
where where set dflags = return $ dopt_set dflags Opt_PIC
set dflags
| cGhcWithNativeCodeGen == "YES" || platformUnregisterised (targetPlatform dflags)
= let platform = targetPlatform dflags
in case hscTarget dflags of
HscLlvm
| (platformArch platform == ArchX86_64) &&
(platformOS platform `elem` [OSLinux, OSDarwin]) ->
do addWarn "Ignoring -fPIC as it is incompatible with LLVM on this platform"
return dflags
_ -> return $ dopt_set dflags Opt_PIC
| otherwise
= ghcError $ CmdLineError "-fPIC is not supported on this platform"
unSetFPIC :: DynP () unSetFPIC :: DynP ()
unSetFPIC = updM set unSetFPIC = updM set
where where set dflags = return $ dopt_unset dflags Opt_PIC
set dflags
= let platform = targetPlatform dflags
in case platformOS platform of
OSDarwin
| platformArch platform == ArchX86_64 ->
do addWarn "Ignoring -fno-PIC on this platform"
return dflags
_ | not (dopt Opt_Static dflags) ->
do addWarn "Ignoring -fno-PIC as -fstatic is off"
return dflags
_ -> return $ dopt_unset dflags Opt_PIC
setOptLevel :: Int -> DynFlags -> DynP DynFlags setOptLevel :: Int -> DynFlags -> DynP DynFlags
setOptLevel n dflags setOptLevel n dflags
...@@ -3145,6 +3097,8 @@ compilerInfo dflags ...@@ -3145,6 +3097,8 @@ compilerInfo dflags
("Support SMP", cGhcWithSMP), ("Support SMP", cGhcWithSMP),
("Tables next to code", cGhcEnableTablesNextToCode), ("Tables next to code", cGhcEnableTablesNextToCode),
("RTS ways", cGhcRTSWays), ("RTS ways", cGhcRTSWays),
("Dynamic by default", if dYNAMIC_BY_DEFAULT dflags
then "YES" else "NO"),
("Leading underscore", cLeadingUnderscore), ("Leading underscore", cLeadingUnderscore),
("Debug on", show debugIsOn), ("Debug on", show debugIsOn),
("LibDir", topDir dflags), ("LibDir", topDir dflags),
...@@ -3184,3 +3138,48 @@ tARGET_MAX_WORD dflags ...@@ -3184,3 +3138,48 @@ tARGET_MAX_WORD dflags
8 -> toInteger (maxBound :: Word64) 8 -> toInteger (maxBound :: Word64)
w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w) w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
-- Whenever makeDynFlagsConsistent does anything, it starts over, to
-- ensure that a later change doesn't invalidate an earlier check.
-- Be careful not to introduce potential loops!
makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
makeDynFlagsConsistent dflags
| hscTarget dflags == HscC &&
not (platformUnregisterised (targetPlatform dflags))
= if cGhcWithNativeCodeGen == "YES"
then let dflags' = dflags { hscTarget = HscAsm }
warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"
in loop dflags' warn
else let dflags' = dflags { hscTarget = HscLlvm }
warn = "Compiler not unregisterised, so using LLVM rather than compiling via C"
in loop dflags' warn
| hscTarget dflags /= HscC &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { hscTarget = HscC })
"Compiler unregisterised, so compiling via C"
| hscTarget dflags == HscAsm &&
cGhcWithNativeCodeGen /= "YES"
= let dflags' = dflags { hscTarget = HscLlvm }
warn = "No native code generator, so using LLVM"
in loop dflags' warn
| hscTarget dflags == HscLlvm &&
not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
(not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
= if cGhcWithNativeCodeGen == "YES"
then let dflags' = dflags { hscTarget = HscAsm }
warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform"
in loop dflags' warn
else ghcError $ CmdLineError "Can't use -fPIC or -dynamic on this platform"
| os == OSDarwin &&
arch == ArchX86_64 &&
not (dopt Opt_PIC dflags)
= loop (dopt_set dflags Opt_PIC)
"Enabling -fPIC as it is always on for this platform"
| otherwise = (dflags, [])
where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
loop updated_dflags warning
= case makeDynFlagsConsistent updated_dflags of
(dflags', ws) -> (dflags', L loc warning : ws)
platform = targetPlatform dflags
arch = platformArch platform
os = platformOS platform
...@@ -37,6 +37,8 @@ module HscTypes ( ...@@ -37,6 +37,8 @@ module HscTypes (
PackageInstEnv, PackageRuleBase, PackageInstEnv, PackageRuleBase,
mkSOName,
-- * Annotations -- * Annotations
prepareAnnotations, prepareAnnotations,
...@@ -157,6 +159,7 @@ import Fingerprint ...@@ -157,6 +159,7 @@ import Fingerprint
import MonadUtils