Commit 46258b40 authored by ian@well-typed.com's avatar ian@well-typed.com

Make the ways dynamic

parent 494eb3dc
...@@ -104,7 +104,6 @@ module CLabel ( ...@@ -104,7 +104,6 @@ module CLabel (
) where ) where
import IdInfo import IdInfo
import StaticFlags
import BasicTypes import BasicTypes
import Packages import Packages
import DataCon import DataCon
...@@ -808,15 +807,15 @@ labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool ...@@ -808,15 +807,15 @@ labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
labelDynamic dflags this_pkg lbl = labelDynamic dflags this_pkg lbl =
case lbl of case lbl of
-- is the RTS in a DLL or not? -- is the RTS in a DLL or not?
RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) RtsLabel _ -> not (dopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
IdLabel n _ _ -> isDllName this_pkg n IdLabel n _ _ -> isDllName dflags this_pkg n
-- When compiling in the "dyn" way, each package is to be linked into -- When compiling in the "dyn" way, each package is to be linked into
-- its own shared library. -- its own shared library.
CmmLabel pkg _ _ CmmLabel pkg _ _
| os == OSMinGW32 -> | os == OSMinGW32 ->
not opt_Static && (this_pkg /= pkg) not (dopt Opt_Static dflags) && (this_pkg /= pkg)
| otherwise -> | otherwise ->
True True
...@@ -834,14 +833,14 @@ labelDynamic dflags this_pkg lbl = ...@@ -834,14 +833,14 @@ labelDynamic dflags this_pkg lbl =
-- When compiling in the "dyn" way, each package is to be -- When compiling in the "dyn" way, each package is to be
-- linked into its own DLL. -- linked into its own DLL.
ForeignLabelInPackage pkgId -> ForeignLabelInPackage pkgId ->
(not opt_Static) && (this_pkg /= pkgId) (not (dopt Opt_Static dflags)) && (this_pkg /= pkgId)
else -- On Mac OS X and on ELF platforms, false positives are OK, else -- On Mac OS X and on ELF platforms, false positives are OK,
-- so we claim that all foreign imports come from dynamic -- so we claim that all foreign imports come from dynamic
-- libraries -- libraries
True True
PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m) PlainModuleInitLabel m -> not (dopt Opt_Static dflags) && this_pkg /= (modulePackageId m)
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False _ -> False
......
...@@ -39,7 +39,7 @@ import Module ...@@ -39,7 +39,7 @@ import Module
import UniqFM ( eltsUFM ) import UniqFM ( eltsUFM )
import ErrUtils import ErrUtils
import DynFlags import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, Way(..) ) import StaticFlags ( v_Ld_inputs )
import Config import Config
import Panic import Panic
import Util import Util
...@@ -1352,9 +1352,9 @@ runPhase LlvmLlc input_fn dflags ...@@ -1352,9 +1352,9 @@ runPhase LlvmLlc input_fn dflags
let lc_opts = getOpts dflags opt_lc let lc_opts = getOpts dflags opt_lc
opt_lvl = max 0 (min 2 $ optLevel dflags) opt_lvl = max 0 (min 2 $ optLevel dflags)
rmodel | dopt Opt_PIC dflags = "pic" rmodel | dopt Opt_PIC dflags = "pic"
| not opt_Static = "dynamic-no-pic" | not (dopt Opt_Static dflags) = "dynamic-no-pic"
| otherwise = "static" | otherwise = "static"
tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
| dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" | dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
| otherwise = "--enable-tbaa=false" | otherwise = "--enable-tbaa=false"
...@@ -1448,7 +1448,7 @@ maybeMergeStub ...@@ -1448,7 +1448,7 @@ maybeMergeStub
runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
runPhase_MoveBinary dflags input_fn runPhase_MoveBinary dflags input_fn
| WayPar `elem` ways dflags && not opt_Static = | WayPar `elem` ways dflags && not (dopt Opt_Static dflags) =
panic ("Don't know how to combine PVM wrapper and dynamic wrapper") panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
| WayPar `elem` ways dflags = do | WayPar `elem` ways dflags = do
let sysMan = pgm_sysman dflags let sysMan = pgm_sysman dflags
...@@ -1668,7 +1668,7 @@ linkBinary dflags o_files dep_packages = do ...@@ -1668,7 +1668,7 @@ linkBinary dflags o_files dep_packages = do
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 opt_Static not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l] | otherwise = ["-L" ++ l]
...@@ -1891,7 +1891,7 @@ linkDynLib dflags o_files dep_packages ...@@ -1891,7 +1891,7 @@ linkDynLib dflags o_files dep_packages
get_pkg_lib_path_opts l get_pkg_lib_path_opts l
| osElfTarget (platformOS (targetPlatform dflags)) && | osElfTarget (platformOS (targetPlatform dflags)) &&
dynLibLoader dflags == SystemDependent && dynLibLoader dflags == SystemDependent &&
not opt_Static not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l] | otherwise = ["-L" ++ l]
......
...@@ -50,6 +50,8 @@ module DynFlags ( ...@@ -50,6 +50,8 @@ module DynFlags (
printOutputForUser, printInfoForUser, printOutputForUser, printInfoForUser,
Way(..), mkBuildTag, wayRTSOnly,
-- ** Safe Haskell -- ** Safe Haskell
SafeHaskellMode(..), SafeHaskellMode(..),
safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn, safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
...@@ -122,7 +124,6 @@ import Platform ...@@ -122,7 +124,6 @@ import Platform
import Module import Module
import PackageConfig import PackageConfig
import PrelNames ( mAIN ) import PrelNames ( mAIN )
import StaticFlags
import {-# SOURCE #-} Packages (PackageState) import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt ) import DriverPhases ( Phase(..), phaseInputExt )
import Config import Config
...@@ -144,7 +145,7 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage ) ...@@ -144,7 +145,7 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
import System.IO.Unsafe ( unsafePerformIO ) import System.IO.Unsafe ( unsafePerformIO )
#endif #endif
import Data.IORef import Data.IORef
import Control.Monad ( when ) import Control.Monad
import Data.Char import Data.Char
import Data.List import Data.List
...@@ -325,6 +326,8 @@ data DynFlag ...@@ -325,6 +326,8 @@ data DynFlag
| Opt_GranMacros | Opt_GranMacros
| Opt_PIC | Opt_PIC
| Opt_SccProfilingOn | Opt_SccProfilingOn
| Opt_Ticky
| Opt_Static
-- output style opts -- output style opts
| Opt_PprCaseAsLet | Opt_PprCaseAsLet
...@@ -852,12 +855,8 @@ isNoLink :: GhcLink -> Bool ...@@ -852,12 +855,8 @@ isNoLink :: GhcLink -> Bool
isNoLink NoLink = True isNoLink NoLink = True
isNoLink _ = False isNoLink _ = False
-- Is it worth evaluating this Bool and caching it in the DynFlags value
-- during initDynFlags?
doingTickyProfiling :: DynFlags -> Bool doingTickyProfiling :: DynFlags -> Bool
doingTickyProfiling _ = opt_Ticky doingTickyProfiling dflags = dopt Opt_Ticky dflags
-- XXX -ticky is a static flag, because it implies -debug which is also
-- static. If the way flags were made dynamic, we could fix this.
data PackageFlag data PackageFlag
= ExposePackage String = ExposePackage String
...@@ -899,19 +898,184 @@ data DynLibLoader ...@@ -899,19 +898,184 @@ data DynLibLoader
data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
deriving (Show) deriving (Show)
-----------------------------------------------------------------------------
-- Ways
-- The central concept of a "way" is that all objects in a given
-- program must be compiled in the same "way". Certain options change
-- parameters of the virtual machine, eg. profiling adds an extra word
-- to the object header, so profiling objects cannot be linked with
-- non-profiling objects.
-- After parsing the command-line options, we determine which "way" we
-- are building - this might be a combination way, eg. profiling+threaded.
-- We then find the "build-tag" associated with this way, and this
-- becomes the suffix used to find .hi files and libraries used in
-- this compilation.
data Way
= WayThreaded
| WayDebug
| WayProf
| WayEventLog
| WayPar
| WayGran
| WayNDP
| WayDyn
deriving (Eq,Ord)
allowed_combination :: [Way] -> Bool
allowed_combination way = and [ x `allowedWith` y
| x <- way, y <- way, x < y ]
where
-- Note ordering in these tests: the left argument is
-- <= the right argument, according to the Ord instance
-- on Way above.
-- dyn is allowed with everything
_ `allowedWith` WayDyn = True
WayDyn `allowedWith` _ = True
-- debug is allowed with everything
_ `allowedWith` WayDebug = True
WayDebug `allowedWith` _ = True
WayProf `allowedWith` WayNDP = True
WayThreaded `allowedWith` WayProf = True
WayThreaded `allowedWith` WayEventLog = True
_ `allowedWith` _ = False
mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
wayTag :: Way -> String
wayTag WayThreaded = "thr"
wayTag WayDebug = "debug"
wayTag WayDyn = "dyn"
wayTag WayProf = "p"
wayTag WayEventLog = "l"
wayTag WayPar = "mp"
-- wayTag WayPar = "mt"
-- wayTag WayPar = "md"
wayTag WayGran = "mg"
wayTag WayNDP = "ndp"
wayRTSOnly :: Way -> Bool
wayRTSOnly WayThreaded = True
wayRTSOnly WayDebug = True
wayRTSOnly WayDyn = False
wayRTSOnly WayProf = False
wayRTSOnly WayEventLog = True
wayRTSOnly WayPar = False
-- wayRTSOnly WayPar = False
-- wayRTSOnly WayPar = False
wayRTSOnly WayGran = False
wayRTSOnly WayNDP = False
wayDesc :: Way -> String
wayDesc WayThreaded = "Threaded"
wayDesc WayDebug = "Debug"
wayDesc WayDyn = "Dynamic"
wayDesc WayProf = "Profiling"
wayDesc WayEventLog = "RTS Event Logging"
wayDesc WayPar = "Parallel"
-- wayDesc WayPar = "Parallel ticky profiling"
-- wayDesc WayPar = "Distributed"
wayDesc WayGran = "GranSim"
wayDesc WayNDP = "Nested data parallelism"
wayOpts :: Way -> DynP ()
wayOpts WayThreaded = do
#if defined(freebsd_TARGET_OS)
-- "-optc-pthread"
-- , "-optl-pthread"
-- FreeBSD's default threading library is the KSE-based M:N libpthread,
-- which GHC has some problems with. It's currently not clear whether
-- the problems are our fault or theirs, but it seems that using the
-- alternative 1:1 threading library libthr works around it:
upd $ addOptl "-lthr"
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
upd $ addOptc "-pthread"
upd $ addOptl "-pthread"
#elif defined(solaris2_TARGET_OS)
upd $ addOptl "-lrt"
#endif
return ()
wayOpts WayDebug = return ()
wayOpts WayDyn = do
upd $ addOptP "-DDYNAMIC"
upd $ addOptc "-DDYNAMIC"
#if defined(mingw32_TARGET_OS)
-- On Windows, code that is to be linked into a dynamic library must be compiled
-- with -fPIC. Labels not in the current package are assumed to be in a DLL
-- different from the current one.
setFPIC
#elif defined(darwin_TARGET_OS)
setFPIC
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
-- Without this, linking the shared libHSffi fails because
-- it uses pthread mutexes.
upd $ addOptl "-optl-pthread"
#endif
wayOpts WayProf = do
setDynFlag Opt_SccProfilingOn
upd $ addOptP "-DPROFILING"
upd $ addOptc "-DPROFILING"
wayOpts WayEventLog = do
upd $ addOptP "-DTRACING"
upd $ addOptc "-DTRACING"
wayOpts WayPar = do
setDynFlag Opt_Parallel
upd $ addOptP "-D__PARALLEL_HASKELL__"
upd $ addOptc "-DPAR"
exposePackage "concurrent"
upd $ addOptc "-w"
upd $ addOptl "-L${PVM_ROOT}/lib/${PVM_ARCH}"
upd $ addOptl "-lpvm3"
upd $ addOptl "-lgpvm3"
{-
wayOpts WayPar =
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
, "-optc-DPAR_TICKY"
, "-package concurrent"
, "-optc-w"
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
, "-optl-lpvm3"
, "-optl-lgpvm3" ]
wayOpts WayPar =
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-D__DISTRIBUTED_HASKELL__"
, "-optc-DPAR"
, "-optc-DDIST"
, "-package concurrent"
, "-optc-w"
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
, "-optl-lpvm3"
, "-optl-lgpvm3" ]
-}
wayOpts WayGran = do
setDynFlag Opt_GranMacros
upd $ addOptP "-D__GRANSIM__"
upd $ addOptc "-DGRAN"
exposePackage "concurrent"
wayOpts WayNDP = do
setExtensionFlag Opt_ParallelArrays
setDynFlag Opt_Vectorise
-----------------------------------------------------------------------------
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
refFilesToClean <- newIORef [] refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty refGeneratedDumps <- newIORef Set.empty
refLlvmVersion <- newIORef 28 refLlvmVersion <- newIORef 28
return dflags{ return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean, filesToClean = refFilesToClean,
dirsToClean = refDirsToClean, dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps, generatedDumps = refGeneratedDumps,
...@@ -980,7 +1144,7 @@ defaultDynFlags mySettings = ...@@ -980,7 +1144,7 @@ defaultDynFlags mySettings =
packageFlags = [], packageFlags = [],
pkgDatabase = Nothing, pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags", pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
ways = panic "defaultDynFlags: No ways", ways = [],
buildTag = panic "defaultDynFlags: No buildTag", buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing, splitInfo = Nothing,
...@@ -1286,7 +1450,7 @@ getVerbFlags dflags ...@@ -1286,7 +1450,7 @@ getVerbFlags dflags
setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir, setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
setDylibInstallName, setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, addOptl, addOptP, setPgmP, addOptl, addOptc, addOptP,
addCmdlineFramework, addHaddockOpts, addGhciScript, addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint setInteractivePrint
:: String -> DynFlags -> DynFlags :: String -> DynFlags -> DynFlags
...@@ -1332,6 +1496,7 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f} ...@@ -1332,6 +1496,7 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
-- Config.hs should really use Option. -- Config.hs should really use Option.
setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s}) addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s})
...@@ -1483,7 +1648,19 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do ...@@ -1483,7 +1648,19 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
-- check for disabled flags in safe haskell -- check for disabled flags in safe haskell
let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1 let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
return (dflags2, leftover, sh_warns ++ warns) theWays = sort $ nub $ ways dflags2
theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays)
dflags3 = dflags2 {
ways = theWays,
buildTag = theBuildTag,
rtsBuildTag = mkBuildTag theWays
}
unless (allowed_combination theWays) $
ghcError (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc theWays)))
return (dflags3, leftover, sh_warns ++ warns)
-- | Check (and potentially disable) any extensions that aren't allowed -- | Check (and potentially disable) any extensions that aren't allowed
...@@ -1579,6 +1756,32 @@ dynamic_flags = [ ...@@ -1579,6 +1756,32 @@ dynamic_flags = [
addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")) addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
, Flag "v" (OptIntSuffix setVerbosity) , Flag "v" (OptIntSuffix setVerbosity)
------- ways --------------------------------------------------------
, Flag "prof" (NoArg (addWay WayProf))
, Flag "eventlog" (NoArg (addWay WayEventLog))
, Flag "parallel" (NoArg (addWay WayPar))
, Flag "gransim" (NoArg (addWay WayGran))
, Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
, Flag "debug" (NoArg (addWay WayDebug))
, Flag "ndp" (NoArg (addWay WayNDP))
, Flag "threaded" (NoArg (addWay WayThreaded))
, Flag "ticky" (NoArg (setDynFlag Opt_Ticky >> addWay WayDebug))
-- -ticky enables ticky-ticky code generation, and also implies -debug which
-- is required to get the RTS ticky support.
----- Linker --------------------------------------------------------
-- -static is the default. If -dynamic has been given then, due to the
-- way wayOpts is currently used, we've already set -DDYNAMIC etc.
-- It's too fiddly to undo that, so we just give an error if
-- Opt_Static has been unset.
, 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:
, Flag "rdynamic" (NoArg (return ()))
------- 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.
, Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) , Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
...@@ -1600,7 +1803,7 @@ dynamic_flags = [ ...@@ -1600,7 +1803,7 @@ dynamic_flags = [
, Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) , Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, Flag "optP" (hasArg addOptP) , Flag "optP" (hasArg addOptP)
, Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) , Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
, Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s}))) , Flag "optc" (hasArg addOptc)
, Flag "optm" (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release")) , Flag "optm" (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release"))
, Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) , Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, Flag "optl" (hasArg addOptl) , Flag "optl" (hasArg addOptl)
...@@ -2064,9 +2267,6 @@ fFlags = [ ...@@ -2064,9 +2267,6 @@ fFlags = [
( "ghci-history", Opt_GhciHistory, nop ), ( "ghci-history", Opt_GhciHistory, nop ),
( "helpful-errors", Opt_HelpfulErrors, nop ), ( "helpful-errors", Opt_HelpfulErrors, nop ),
( "defer-type-errors", Opt_DeferTypeErrors, nop ), ( "defer-type-errors", Opt_DeferTypeErrors, nop ),
( "parallel", Opt_Parallel, nop ),
( "scc-profiling", Opt_SccProfilingOn, nop ),
( "gransim", Opt_GranMacros, nop ),
( "building-cabal-package", Opt_BuildingCabalPackage, nop ), ( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
( "prof-count-entries", Opt_ProfCountEntries, nop ), ( "prof-count-entries", Opt_ProfCountEntries, nop ),
...@@ -2239,6 +2439,7 @@ xFlags = [ ...@@ -2239,6 +2439,7 @@ xFlags = [
defaultFlags :: Platform -> [DynFlag] defaultFlags :: Platform -> [DynFlag]
defaultFlags platform defaultFlags platform
= [ Opt_AutoLinkPackages, = [ Opt_AutoLinkPackages,
Opt_Static,
Opt_SharedImplib, Opt_SharedImplib,
...@@ -2260,7 +2461,6 @@ defaultFlags platform ...@@ -2260,7 +2461,6 @@ defaultFlags platform
OSDarwin -> OSDarwin ->
case platformArch platform of case platformArch platform of
ArchX86_64 -> [Opt_PIC] ArchX86_64 -> [Opt_PIC]
_ | not opt_Static -> [Opt_PIC]
_ -> [] _ -> []
_ -> []) _ -> [])
...@@ -2523,6 +2723,11 @@ optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi)) ...@@ -2523,6 +2723,11 @@ optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags) setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
--------------------------
addWay :: Way -> DynP ()
addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
wayOpts w
-------------------------- --------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP () setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
setDynFlag f = upd (\dfs -> dopt_set dfs f) setDynFlag f = upd (\dfs -> dopt_set dfs f)
...@@ -2667,7 +2872,7 @@ setObjTarget l = updM set ...@@ -2667,7 +2872,7 @@ setObjTarget l = updM set
return dflags return dflags
HscLlvm HscLlvm
| not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) && | not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
(not opt_Static || dopt Opt_PIC dflags) (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
-> ->
do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform") do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
return dflags return dflags
...@@ -2704,7 +2909,7 @@ unSetFPIC = updM set ...@@ -2704,7 +2909,7 @@ unSetFPIC = updM set
| platformArch platform == ArchX86_64 -> | platformArch platform == ArchX86_64 ->
do addWarn "Ignoring -fno-PIC on this platform" do addWarn "Ignoring -fno-PIC on this platform"
return dflags return dflags
_ | not opt_Static -> _ | not (dopt Opt_Static dflags) ->
do addWarn "Ignoring -fno-PIC as -fstatic is off" do addWarn "Ignoring -fno-PIC as -fstatic is off"
return dflags return dflags
_ -> return $ dopt_unset dflags Opt_PIC _ -> return $ dopt_unset dflags Opt_PIC
...@@ -2879,7 +3084,8 @@ picCCOpts dflags ...@@ -2879,7 +3084,8 @@ picCCOpts dflags
-- correctly. They need to reference data in the Haskell -- correctly. They need to reference data in the Haskell
-- objects, but can't without -fPIC. See -- objects, but can't without -fPIC. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
| dopt Opt_PIC dflags || not opt_Static -> ["-fPIC", "-U __PIC__", "-D__PIC__"] | dopt Opt_PIC dflags || not (dopt Opt_Static dflags) ->
["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise -> [] | otherwise -> []
picPOpts :: DynFlags -> [String] picPOpts :: DynFlags -> [String]
......
...@@ -37,7 +37,6 @@ where ...@@ -37,7 +37,6 @@ where
import PackageConfig import PackageConfig
import DynFlags import DynFlags
import StaticFlags
import Config ( cProjectVersion ) import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe ) import Name ( Name, nameModule_maybe )
import UniqFM import UniqFM
...@@ -896,7 +895,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) ...@@ -896,7 +895,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
tag = mkBuildTag (filter (not . wayRTSOnly) ways2) tag = mkBuildTag (filter (not . wayRTSOnly) ways2)