Skip to content

GitLab

GHC
GHC
Commit 46258b40 authored by ian@well-typed.com's avatar ian@well-typed.com
15 Browse files
Options

Make the ways dynamic

parent 494eb3dc
Hide whitespace changes
Inline Side-by-side
Showing with 278 additions and 318 deletions
compiler/cmm/CLabel.hs
View file @ 46258b40
......@@ -104,7 +104,6 @@ module CLabel (
) where
import IdInfo
import StaticFlags
import BasicTypes
import Packages
import DataCon
......@@ -808,15 +807,15 @@ labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
labelDynamic dflags this_pkg lbl =
case lbl of
-- 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
-- its own shared library.
CmmLabel pkg _ _
| os == OSMinGW32 ->
not opt_Static && (this_pkg /= pkg)
not (dopt Opt_Static dflags) && (this_pkg /= pkg)
| otherwise ->
True
......@@ -834,14 +833,14 @@ labelDynamic dflags this_pkg lbl =
-- When compiling in the "dyn" way, each package is to be
-- linked into its own DLL.
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,
-- so we claim that all foreign imports come from dynamic
-- libraries
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.
_ -> False
......
compiler/main/DriverPipeline.hs
View file @ 46258b40
......@@ -39,7 +39,7 @@ import Module
import UniqFM ( eltsUFM )
import ErrUtils
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, Way(..) )
import StaticFlags ( v_Ld_inputs )
import Config
import Panic
import Util
......@@ -1352,9 +1352,9 @@ runPhase LlvmLlc input_fn dflags
let lc_opts = getOpts dflags opt_lc
opt_lvl = max 0 (min 2 $ optLevel dflags)
rmodel | dopt Opt_PIC dflags = "pic"
| not opt_Static = "dynamic-no-pic"
| otherwise = "static"
rmodel | dopt Opt_PIC dflags = "pic"
| not (dopt Opt_Static dflags) = "dynamic-no-pic"
| otherwise = "static"
tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
| dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
| otherwise = "--enable-tbaa=false"
......@@ -1448,7 +1448,7 @@ maybeMergeStub
runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
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")
| WayPar `elem` ways dflags = do
let sysMan = pgm_sysman dflags
......@@ -1668,7 +1668,7 @@ linkBinary dflags o_files dep_packages = do
get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent &&
not opt_Static
not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
......@@ -1891,7 +1891,7 @@ linkDynLib dflags o_files dep_packages
get_pkg_lib_path_opts l
| osElfTarget (platformOS (targetPlatform dflags)) &&
dynLibLoader dflags == SystemDependent &&
not opt_Static
not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
......
compiler/main/DynFlags.hs
View file @ 46258b40
......@@ -50,6 +50,8 @@ module DynFlags (
printOutputForUser, printInfoForUser,
Way(..), mkBuildTag, wayRTSOnly,
-- ** Safe Haskell
SafeHaskellMode(..),
safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
......@@ -122,7 +124,6 @@ import Platform
import Module
import PackageConfig
import PrelNames ( mAIN )
import StaticFlags
import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
......@@ -144,7 +145,7 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
import System.IO.Unsafe ( unsafePerformIO )
#endif
import Data.IORef
import Control.Monad ( when )
import Control.Monad
import Data.Char
import Data.List
......@@ -325,6 +326,8 @@ data DynFlag
| Opt_GranMacros
| Opt_PIC
| Opt_SccProfilingOn
| Opt_Ticky
| Opt_Static
-- output style opts
| Opt_PprCaseAsLet
......@@ -852,12 +855,8 @@ isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
-- Is it worth evaluating this Bool and caching it in the DynFlags value
-- during initDynFlags?
doingTickyProfiling :: DynFlags -> Bool
doingTickyProfiling _ = opt_Ticky
-- 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.
doingTickyProfiling dflags = dopt Opt_Ticky dflags
data PackageFlag
= ExposePackage String
......@@ -899,19 +898,184 @@ data DynLibLoader
data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
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
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
refLlvmVersion <- newIORef 28
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps,
......@@ -980,7 +1144,7 @@ defaultDynFlags mySettings =
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
ways = panic "defaultDynFlags: No ways",
ways = [],
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing,
......@@ -1286,7 +1450,7 @@ getVerbFlags dflags
setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, addOptl, addOptP,
setPgmP, addOptl, addOptc, addOptP,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
......@@ -1332,6 +1496,7 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
-- Config.hs should really use Option.
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})
addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s})
......@@ -1483,7 +1648,19 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
-- check for disabled flags in safe haskell
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
......@@ -1579,6 +1756,32 @@ dynamic_flags = [
addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
, 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 --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
, Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
......@@ -1600,7 +1803,7 @@ dynamic_flags = [
, Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, Flag "optP" (hasArg addOptP)
, 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 "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, Flag "optl" (hasArg addOptl)
......@@ -2064,9 +2267,6 @@ fFlags = [
( "ghci-history", Opt_GhciHistory, nop ),
( "helpful-errors", Opt_HelpfulErrors, 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 ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
( "prof-count-entries", Opt_ProfCountEntries, nop ),
......@@ -2239,6 +2439,7 @@ xFlags = [
defaultFlags :: Platform -> [DynFlag]
defaultFlags platform
= [ Opt_AutoLinkPackages,
Opt_Static,
Opt_SharedImplib,
......@@ -2260,7 +2461,6 @@ defaultFlags platform
OSDarwin ->
case platformArch platform of
ArchX86_64 -> [Opt_PIC]
_ | not opt_Static -> [Opt_PIC]
_ -> []
_ -> [])
......@@ -2523,6 +2723,11 @@ optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
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 f = upd (\dfs -> dopt_set dfs f)
......@@ -2667,7 +2872,7 @@ setObjTarget l = updM set
return dflags
HscLlvm
| 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")
return dflags
......@@ -2704,7 +2909,7 @@ unSetFPIC = updM set
| platformArch platform == ArchX86_64 ->
do addWarn "Ignoring -fno-PIC on this platform"
return dflags
_ | not opt_Static ->
_ | not (dopt Opt_Static dflags) ->
do addWarn "Ignoring -fno-PIC as -fstatic is off"
return dflags
_ -> return $ dopt_unset dflags Opt_PIC
......@@ -2879,7 +3084,8 @@ picCCOpts dflags
-- correctly. They need to reference data in the Haskell
-- objects, but can't without -fPIC. See
-- 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 -> []
picPOpts :: DynFlags -> [String]
......
compiler/main/Packages.lhs
View file @ 46258b40
......@@ -37,7 +37,6 @@ where
import PackageConfig
import DynFlags
import StaticFlags
import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
......@@ -896,7 +895,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
tag = mkBuildTag (filter (not . wayRTSOnly) ways2)
rts_tag = mkBuildTag ways2
mkDynName | opt_Static = id
mkDynName | dopt Opt_Static dflags = id
| otherwise = (++ ("-ghc" ++ cProjectVersion))
addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
......@@ -1031,12 +1030,12 @@ missingDependencyMsg (Just parent)
-- -----------------------------------------------------------------------------
-- | Will the 'Name' come from a dynamically linked library?
isDllName :: PackageId -> Name -> Bool
isDllName :: DynFlags -> PackageId -> Name -> Bool
-- Despite the "dll", I think this function just means that
-- the synbol comes from another dynamically-linked package,
-- and applies on all platforms, not just Windows
isDllName this_pkg name
| opt_Static = False
isDllName dflags this_pkg name
| dopt Opt_Static dflags = False
| Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg
| otherwise = False -- no, it is not even an external name
......
compiler/main/StaticFlagParser.hs
View file @ 46258b40
......@@ -18,8 +18,7 @@ module StaticFlagParser (
#include "HsVersions.h"
import qualified StaticFlags as SF
import StaticFlags ( v_opt_C_ready, getWayFlags, Way(..)
, opt_SimplExcessPrecision )
import StaticFlags ( v_opt_C_ready, opt_SimplExcessPrecision )
import CmdLineParser
import SrcLoc
import Util
......@@ -60,18 +59,9 @@ parseStaticFlagsFull flagsAvailable args = do
ready <- readIORef v_opt_C_ready
when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
(leftover, errs, warns1) <- processArgs flagsAvailable args
(leftover, errs, warns) <- processArgs flagsAvailable args
when (not (null errs)) $ ghcError $ errorsToGhcException errs
-- deal with the way flags: the way (eg. prof) gives rise to
-- further flags, some of which might be static.
way_flags <- getWayFlags
let way_flags' = map (mkGeneralLocated "in way flags") way_flags
-- as these are GHC generated flags, we parse them with all static flags
-- in scope, regardless of what availableFlags are passed in.
(more_leftover, errs, warns2) <- processArgs flagsStatic way_flags'
-- see sanity code in staticOpts
writeIORef v_opt_C_ready True
......@@ -83,9 +73,7 @@ parseStaticFlagsFull flagsAvailable args = do
["-fexcess-precision"]
| otherwise = []
when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (excess_prec ++ more_leftover ++ leftover,
warns1 ++ warns2)
return (excess_prec ++ leftover, warns)
flagsStatic :: [Flag IO]
-- All the static flags should appear in this list. It describes how each
......@@ -102,22 +90,8 @@ flagsStatic :: [Flag IO]
-- flags further down the list with the same prefix.
flagsStatic = [
------- 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" (PassFlag (\f -> do addOpt f; addWay WayDebug))
-- -ticky enables ticky-ticky code generation, and also implies -debug which
-- is required to get the RTS ticky support.
------ Debugging ----------------------------------------------------
, Flag "dppr-debug" (PassFlag addOpt)
Flag "dppr-debug" (PassFlag addOpt)
, Flag "dsuppress-all" (PassFlag addOpt)
, Flag "dsuppress-uniques" (PassFlag addOpt)
, Flag "dsuppress-coercions" (PassFlag addOpt)
......@@ -131,12 +105,6 @@ flagsStatic = [
, Flag "dstub-dead-values" (PassFlag addOpt)
-- rest of the debugging flags are dynamic
----- Linker --------------------------------------------------------
, Flag "static" (PassFlag addOpt)
, Flag "dynamic" (NoArg (removeOpt "-static" >> addWay WayDyn))
-- ignored for compat w/ gcc:
, Flag "rdynamic" (NoArg (return ()))
----- RTS opts ------------------------------------------------------
, Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
......@@ -166,7 +134,6 @@ isStaticFlag f =
"fno-pre-inlining",
"fno-opt-coercion",
"fexcess-precision",
"static",
"fhardwire-lib-paths",
"fcpr-off",
"ferror-spans",
......@@ -203,9 +170,6 @@ type StaticP = EwM IO
addOpt :: String -> StaticP ()
addOpt = liftEwM . SF.addOpt
addWay :: Way -> StaticP ()
addWay = liftEwM . SF.addWay
removeOpt :: String -> StaticP ()
removeOpt = liftEwM . SF.removeOpt
......
compiler/main/StaticFlags.hs
View file @ 46258b40
......@@ -23,9 +23,6 @@ module StaticFlags (
staticFlags,
initStaticOpts,
-- Ways
Way(..), v_Ways, mkBuildTag, wayRTSOnly,
-- Output style options
opt_PprStyle_Debug,
opt_NoDebugOutput,
......@@ -66,18 +63,14 @@ module StaticFlags (
-- Optimization fuel controls
opt_Fuel,
-- Related to linking
opt_Static,
-- misc opts
opt_ErrorSpans,
opt_HistorySize,
v_Ld_inputs,
opt_StubDeadValues,
opt_Ticky,
-- For the parser
addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
addOpt, removeOpt, v_opt_C_ready,
-- Saving/restoring globals
saveStaticFlagGlobals, restoreStaticFlagGlobals
......@@ -90,7 +83,7 @@ import Util
import Maybes ( firstJusts )
import Panic
import Control.Monad ( liftM3 )
import Control.Monad
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Data.List
......@@ -104,9 +97,6 @@ initStaticOpts = writeIORef v_opt_C_ready True
addOpt :: String -> IO ()
addOpt = consIORef v_opt_C
addWay :: Way -> IO ()