Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
46258b40
Commit
46258b40
authored
Sep 03, 2012
by
ian@well-typed.com
Browse files
Make the ways dynamic
parent
494eb3dc
Changes
10
Hide whitespace changes
Inline
Side-by-side
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
o
pt_Static
&&
(
this_pkg
/=
rtsPackageId
)
RtsLabel
_
->
not
(
dopt
O
pt_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
o
pt_Static
&&
(
this_pkg
/=
pkg
)
not
(
dopt
O
pt_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
o
pt_Static
)
&&
(
this_pkg
/=
pkgId
)
(
not
(
dopt
O
pt_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
o
pt_Static
&&
this_pkg
/=
(
modulePackageId
m
)
PlainModuleInitLabel
m
->
not
(
dopt
O
pt_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
o
pt_Static
=
"dynamic-no-pic"
|
otherwise
=
"static"
rmodel
|
dopt
Opt_PIC
dflags
=
"pic"
|
not
(
dopt
O
pt_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
o
pt_Static
=
|
WayPar
`
elem
`
ways
dflags
&&
not
(
dopt
O
pt_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
o
pt_Static
not
(
dopt
O
pt_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
o
pt_Static
not
(
dopt
O
pt_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
o
pt_Static
||
dopt
Opt_PIC
dflags
)
(
not
(
dopt
O
pt_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
o
pt_Static
->
_
|
not
(
dopt
O
pt_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 |
o
pt_Static = id
mkDynName |
dopt O
pt_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
|
o
pt_Static = False
isDllName
dflags
this_pkg name
|
dopt O
pt_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
,
warns
1
)
<-
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