never executed always true always false
1 {-# LANGUAGE CPP #-}
2
3 -- | Ways
4 --
5 -- The central concept of a "way" is that all objects in a given
6 -- program must be compiled in the same "way". Certain options change
7 -- parameters of the virtual machine, eg. profiling adds an extra word
8 -- to the object header, so profiling objects cannot be linked with
9 -- non-profiling objects.
10 --
11 -- After parsing the command-line options, we determine which "way" we
12 -- are building - this might be a combination way, eg. profiling+threaded.
13 --
14 -- There are two kinds of ways:
15 -- - RTS only: only affect the runtime system (RTS) and don't affect code
16 -- generation (e.g. threaded, debug)
17 -- - Full ways: affect code generation and the RTS (e.g. profiling, dynamic
18 -- linking)
19 --
20 -- We then find the "build-tag" associated with this way, and this
21 -- becomes the suffix used to find .hi files and libraries used in
22 -- this compilation.
23 module GHC.Platform.Ways
24 ( Way(..)
25 , Ways
26 , hasWay
27 , hasNotWay
28 , addWay
29 , removeWay
30 , allowed_combination
31 , wayGeneralFlags
32 , wayUnsetGeneralFlags
33 , wayOptc
34 , wayOptl
35 , wayOptP
36 , wayDesc
37 , wayRTSOnly
38 , wayTag
39 , waysTag
40 , waysBuildTag
41 , fullWays
42 , rtsWays
43 -- * Host GHC ways
44 , hostWays
45 , hostFullWays
46 , hostIsProfiled
47 , hostIsDynamic
48 , hostIsThreaded
49 , hostIsDebugged
50 , hostIsTracing
51 )
52 where
53
54 import GHC.Prelude
55 import GHC.Platform
56 import GHC.Driver.Flags
57
58 import qualified Data.Set as Set
59 import Data.Set (Set)
60 import Data.List (intersperse)
61
62 -- | A way
63 --
64 -- Don't change the constructor order as it us used by `waysTag` to create a
65 -- unique tag (e.g. thr_debug_p) which is expected by other tools (e.g. Cabal).
66 data Way
67 = WayCustom String -- ^ for GHC API clients building custom variants
68 | WayThreaded -- ^ (RTS only) Multithreaded runtime system
69 | WayDebug -- ^ Debugging, enable trace messages and extra checks
70 | WayProf -- ^ Profiling, enable cost-centre stacks and profiling reports
71 | WayTracing -- ^ (RTS only) enable event logging (tracing)
72 | WayDyn -- ^ Dynamic linking
73 deriving (Eq, Ord, Show)
74
75 type Ways = Set Way
76
77 -- | Test if a way is enabled
78 hasWay :: Ways -> Way -> Bool
79 hasWay ws w = Set.member w ws
80
81 -- | Test if a way is not enabled
82 hasNotWay :: Ways -> Way -> Bool
83 hasNotWay ws w = Set.notMember w ws
84
85 -- | Add a way
86 addWay :: Way -> Ways -> Ways
87 addWay = Set.insert
88
89 -- | Remove a way
90 removeWay :: Way -> Ways -> Ways
91 removeWay = Set.delete
92
93 -- | Check if a combination of ways is allowed
94 allowed_combination :: Ways -> Bool
95 allowed_combination ways = not disallowed
96 where
97 disallowed = or [ hasWay ways x && hasWay ways y
98 | (x,y) <- couples
99 ]
100 -- List of disallowed couples of ways
101 couples = [] -- we don't have any disallowed combination of ways nowadays
102
103 -- | Unique tag associated to a list of ways
104 waysTag :: Ways -> String
105 waysTag = concat . intersperse "_" . map wayTag . Set.toAscList
106
107 -- | Unique build-tag associated to a list of ways
108 --
109 -- RTS only ways are filtered out because they have no impact on the build.
110 waysBuildTag :: Ways -> String
111 waysBuildTag ws = waysTag (Set.filter (not . wayRTSOnly) ws)
112
113
114 -- | Unique build-tag associated to a way
115 wayTag :: Way -> String
116 wayTag (WayCustom xs) = xs
117 wayTag WayThreaded = "thr"
118 wayTag WayDebug = "debug"
119 wayTag WayDyn = "dyn"
120 wayTag WayProf = "p"
121 wayTag WayTracing = "l" -- "l" for "logging"
122
123 -- | Return true for ways that only impact the RTS, not the generated code
124 wayRTSOnly :: Way -> Bool
125 wayRTSOnly (WayCustom {}) = False
126 wayRTSOnly WayDyn = False
127 wayRTSOnly WayProf = False
128 wayRTSOnly WayThreaded = True
129 wayRTSOnly WayDebug = True
130 wayRTSOnly WayTracing = True
131
132 -- | Filter ways that have an impact on compilation
133 fullWays :: Ways -> Ways
134 fullWays ws = Set.filter (not . wayRTSOnly) ws
135
136 -- | Filter RTS-only ways (ways that don't have an impact on compilation)
137 rtsWays :: Ways -> Ways
138 rtsWays ws = Set.filter wayRTSOnly ws
139
140 wayDesc :: Way -> String
141 wayDesc (WayCustom xs) = xs
142 wayDesc WayThreaded = "Threaded"
143 wayDesc WayDebug = "Debug"
144 wayDesc WayDyn = "Dynamic"
145 wayDesc WayProf = "Profiling"
146 wayDesc WayTracing = "Tracing"
147
148 -- | Turn these flags on when enabling this way
149 wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
150 wayGeneralFlags _ (WayCustom {}) = []
151 wayGeneralFlags _ WayThreaded = []
152 wayGeneralFlags _ WayDebug = []
153 wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
154 -- We could get away without adding -fPIC when compiling the
155 -- modules of a program that is to be linked with -dynamic; the
156 -- program itself does not need to be position-independent, only
157 -- the libraries need to be. HOWEVER, GHCi links objects into a
158 -- .so before loading the .so using the system linker. Since only
159 -- PIC objects can be linked into a .so, we have to compile even
160 -- modules of the main program with -fPIC when using -dynamic.
161 wayGeneralFlags _ WayProf = []
162 wayGeneralFlags _ WayTracing = []
163
164 -- | Turn these flags off when enabling this way
165 wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
166 wayUnsetGeneralFlags _ (WayCustom {}) = []
167 wayUnsetGeneralFlags _ WayThreaded = []
168 wayUnsetGeneralFlags _ WayDebug = []
169 wayUnsetGeneralFlags _ WayDyn = [Opt_SplitSections]
170 -- There's no point splitting when we're going to be dynamically linking.
171 -- Plus it breaks compilation on OSX x86.
172 wayUnsetGeneralFlags _ WayProf = []
173 wayUnsetGeneralFlags _ WayTracing = []
174
175 -- | Pass these options to the C compiler when enabling this way
176 wayOptc :: Platform -> Way -> [String]
177 wayOptc _ (WayCustom {}) = []
178 wayOptc platform WayThreaded = case platformOS platform of
179 OSOpenBSD -> ["-pthread"]
180 OSNetBSD -> ["-pthread"]
181 _ -> []
182 wayOptc _ WayDebug = []
183 wayOptc _ WayDyn = []
184 wayOptc _ WayProf = ["-DPROFILING"]
185 wayOptc _ WayTracing = ["-DTRACING"]
186
187 -- | Pass these options to linker when enabling this way
188 wayOptl :: Platform -> Way -> [String]
189 wayOptl _ (WayCustom {}) = []
190 wayOptl platform WayThreaded =
191 case platformOS platform of
192 -- N.B. FreeBSD cc throws a warning if we pass -pthread without
193 -- actually using any pthread symbols.
194 OSFreeBSD -> ["-pthread", "-Wno-unused-command-line-argument"]
195 OSOpenBSD -> ["-pthread"]
196 OSNetBSD -> ["-pthread"]
197 _ -> []
198 wayOptl _ WayDebug = []
199 wayOptl _ WayDyn = []
200 wayOptl _ WayProf = []
201 wayOptl _ WayTracing = []
202
203 -- | Pass these options to the preprocessor when enabling this way
204 wayOptP :: Platform -> Way -> [String]
205 wayOptP _ (WayCustom {}) = []
206 wayOptP _ WayThreaded = []
207 wayOptP _ WayDebug = []
208 wayOptP _ WayDyn = []
209 wayOptP _ WayProf = ["-DPROFILING"]
210 wayOptP _ WayTracing = ["-DTRACING"]
211
212
213 -- | Consult the RTS to find whether it has been built with profiling enabled.
214 hostIsProfiled :: Bool
215 hostIsProfiled = rtsIsProfiled_ /= 0
216
217 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiled_ :: Int
218
219 -- | Consult the RTS to find whether GHC itself has been built with
220 -- dynamic linking. This can't be statically known at compile-time,
221 -- because we build both the static and dynamic versions together with
222 -- -dynamic-too.
223 hostIsDynamic :: Bool
224 hostIsDynamic = rtsIsDynamic_ /= 0
225
226 foreign import ccall unsafe "rts_isDynamic" rtsIsDynamic_ :: Int
227
228 -- we need this until the bootstrap GHC is always recent enough
229 #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
230
231 -- | Consult the RTS to find whether it is threaded.
232 hostIsThreaded :: Bool
233 hostIsThreaded = rtsIsThreaded_ /= 0
234
235 foreign import ccall unsafe "rts_isThreaded" rtsIsThreaded_ :: Int
236
237 -- | Consult the RTS to find whether it is debugged.
238 hostIsDebugged :: Bool
239 hostIsDebugged = rtsIsDebugged_ /= 0
240
241 foreign import ccall unsafe "rts_isDebugged" rtsIsDebugged_ :: Int
242
243 -- | Consult the RTS to find whether it is tracing.
244 hostIsTracing :: Bool
245 hostIsTracing = rtsIsTracing_ /= 0
246
247 foreign import ccall unsafe "rts_isTracing" rtsIsTracing_ :: Int
248
249
250 #else
251
252 hostIsThreaded :: Bool
253 hostIsThreaded = False
254
255 hostIsDebugged :: Bool
256 hostIsDebugged = False
257
258 hostIsTracing :: Bool
259 hostIsTracing = False
260
261 #endif
262
263
264 -- | Host ways.
265 hostWays :: Ways
266 hostWays = Set.unions
267 [ if hostIsDynamic then Set.singleton WayDyn else Set.empty
268 , if hostIsProfiled then Set.singleton WayProf else Set.empty
269 , if hostIsThreaded then Set.singleton WayThreaded else Set.empty
270 , if hostIsDebugged then Set.singleton WayDebug else Set.empty
271 , if hostIsTracing then Set.singleton WayTracing else Set.empty
272 ]
273
274 -- | Host "full" ways (i.e. ways that have an impact on the compilation,
275 -- not RTS only ways).
276 --
277 -- These ways must be used when compiling codes targeting the internal
278 -- interpreter.
279 hostFullWays :: Ways
280 hostFullWays = fullWays hostWays