1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
-- | 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.
--
-- There are two kinds of ways:
-- - RTS only: only affect the runtime system (RTS) and don't affect code
-- generation (e.g. threaded, debug)
-- - Full ways: affect code generation and the RTS (e.g. profiling, dynamic
-- linking)
--
-- 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.
module GHC.Driver.Ways
( Way(..)
, allowed_combination
, wayGeneralFlags
, wayUnsetGeneralFlags
, wayOptc
, wayOptl
, wayOptP
, wayDesc
, wayRTSOnly
, wayTag
, waysTag
-- * Host GHC ways
, hostFullWays
, hostIsProfiled
, hostIsDynamic
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Flags
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List (intersperse)
import System.IO.Unsafe ( unsafeDupablePerformIO )
-- | A way
--
-- Don't change the constructor order as it us used by `waysTag` to create a
-- unique tag (e.g. thr_debug_p) which is expected by other tools (e.g. Cabal).
data Way
= WayCustom String -- ^ for GHC API clients building custom variants
| WayThreaded -- ^ (RTS only) Multithreaded runtime system
| WayDebug -- ^ Debugging, enable trace messages and extra checks
| WayProf -- ^ Profiling, enable cost-centre stacks and profiling reports
| WayEventLog -- ^ (RTS only) enable event logging
| WayDyn -- ^ Dynamic linking
deriving (Eq, Ord, Show)
-- | Check if a combination of ways is allowed
allowed_combination :: Set Way -> Bool
allowed_combination ways = not disallowed
where
disallowed = or [ Set.member ways x && Set.member ways y
| (x,y) <- couples
]
-- List of disallowed couples of ways
couples = [] -- we don't have any disallowed combination of ways nowadays
-- | Unique build-tag associated to a list of ways
waysTag :: Set Way -> String
waysTag = concat . intersperse "_" . map wayTag . Set.toAscList
-- | Unique build-tag associated to a way
wayTag :: Way -> String
wayTag (WayCustom xs) = xs
wayTag WayThreaded = "thr"
wayTag WayDebug = "debug"
wayTag WayDyn = "dyn"
wayTag WayProf = "p"
wayTag WayEventLog = "l"
-- | Return true for ways that only impact the RTS, not the generated code
wayRTSOnly :: Way -> Bool
wayRTSOnly (WayCustom {}) = False
wayRTSOnly WayDyn = False
wayRTSOnly WayProf = False
wayRTSOnly WayThreaded = True
wayRTSOnly WayDebug = True
wayRTSOnly WayEventLog = True
wayDesc :: Way -> String
wayDesc (WayCustom xs) = xs
wayDesc WayThreaded = "Threaded"
wayDesc WayDebug = "Debug"
wayDesc WayDyn = "Dynamic"
wayDesc WayProf = "Profiling"
wayDesc WayEventLog = "RTS Event Logging"
-- | Turn these flags on when enabling this way
wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
wayGeneralFlags _ (WayCustom {}) = []
wayGeneralFlags _ WayThreaded = []
wayGeneralFlags _ WayDebug = []
wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
-- We could get away without adding -fPIC when compiling the
-- modules of a program that is to be linked with -dynamic; the
-- program itself does not need to be position-independent, only
-- the libraries need to be. HOWEVER, GHCi links objects into a
-- .so before loading the .so using the system linker. Since only
-- PIC objects can be linked into a .so, we have to compile even
-- modules of the main program with -fPIC when using -dynamic.
wayGeneralFlags _ WayProf = [Opt_SccProfilingOn]
wayGeneralFlags _ WayEventLog = []
-- | Turn these flags off when enabling this way
wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
wayUnsetGeneralFlags _ (WayCustom {}) = []
wayUnsetGeneralFlags _ WayThreaded = []
wayUnsetGeneralFlags _ WayDebug = []
wayUnsetGeneralFlags _ WayDyn = [Opt_SplitSections]
-- There's no point splitting when we're going to be dynamically linking.
-- Plus it breaks compilation on OSX x86.
wayUnsetGeneralFlags _ WayProf = []
wayUnsetGeneralFlags _ WayEventLog = []
-- | Pass these options to the C compiler when enabling this way
wayOptc :: Platform -> Way -> [String]
wayOptc _ (WayCustom {}) = []
wayOptc platform WayThreaded = case platformOS platform of
OSOpenBSD -> ["-pthread"]
OSNetBSD -> ["-pthread"]
_ -> []
wayOptc _ WayDebug = []
wayOptc _ WayDyn = []
wayOptc _ WayProf = ["-DPROFILING"]
wayOptc _ WayEventLog = ["-DTRACING"]
-- | Pass these options to linker when enabling this way
wayOptl :: Platform -> Way -> [String]
wayOptl _ (WayCustom {}) = []
wayOptl platform WayThreaded =
case platformOS platform of
-- N.B. FreeBSD cc throws a warning if we pass -pthread without
-- actually using any pthread symbols.
OSFreeBSD -> ["-pthread", "-Wno-unused-command-line-argument"]
OSOpenBSD -> ["-pthread"]
OSNetBSD -> ["-pthread"]
_ -> []
wayOptl _ WayDebug = []
wayOptl _ WayDyn = []
wayOptl _ WayProf = []
wayOptl _ WayEventLog = []
-- | Pass these options to the preprocessor when enabling this way
wayOptP :: Platform -> Way -> [String]
wayOptP _ (WayCustom {}) = []
wayOptP _ WayThreaded = []
wayOptP _ WayDebug = []
wayOptP _ WayDyn = []
wayOptP _ WayProf = ["-DPROFILING"]
wayOptP _ WayEventLog = ["-DTRACING"]
-- | Consult the RTS to find whether it has been built with profiling enabled.
hostIsProfiled :: Bool
hostIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0
foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO Int
-- | Consult the RTS to find whether GHC itself has been built with
-- dynamic linking. This can't be statically known at compile-time,
-- because we build both the static and dynamic versions together with
-- -dynamic-too.
hostIsDynamic :: Bool
hostIsDynamic = unsafeDupablePerformIO rtsIsDynamicIO /= 0
foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO Int
-- | Return host "full" ways (i.e. ways that have an impact on the compilation,
-- not RTS only ways). These ways must be used when compiling codes targeting
-- the internal interpreter.
hostFullWays :: Set Way
hostFullWays = Set.unions
[ if hostIsDynamic then Set.singleton WayDyn else Set.empty
, if hostIsProfiled then Set.singleton WayProf else Set.empty
]
|
