7bb10b60cb44b07f367f5f4aa924a54967a32ef3
[ghc.git] / libraries / base / GHC / RTS / Flags.hsc
1 {-# LANGUAGE NoImplicitPrelude #-}
2 {-# LANGUAGE RecordWildCards   #-}
3
4 -- | Accessors to GHC RTS flags.
5 -- Descriptions of flags can be seen in
6 -- <https://www.haskell.org/ghc/docs/latest/html/users_guide/runtime_control.html GHC User's Guide>,
7 -- or by running RTS help message using @+RTS --help@.
8 --
9 -- @since 4.8.0.0
10 --
11 module GHC.RTS.Flags
12   ( RtsTime
13   , RTSFlags (..)
14   , GiveGCStats (..)
15   , GCFlags (..)
16   , ConcFlags (..)
17   , MiscFlags (..)
18   , DebugFlags (..)
19   , DoCostCentres (..)
20   , CCFlags (..)
21   , DoHeapProfile (..)
22   , ProfFlags (..)
23   , DoTrace (..)
24   , TraceFlags (..)
25   , TickyFlags (..)
26   , ParFlags (..)
27   , getRTSFlags
28   , getGCFlags
29   , getConcFlags
30   , getMiscFlags
31   , getDebugFlags
32   , getCCFlags
33   , getProfFlags
34   , getTraceFlags
35   , getTickyFlags
36   , getParFlags
37   ) where
38
39 #include "Rts.h"
40 #include "rts/Flags.h"
41
42 import Control.Applicative
43 import Control.Monad
44
45 import Foreign
46 import Foreign.C
47
48 import GHC.Base
49 import GHC.Enum
50 import GHC.IO
51 import GHC.Real
52 import GHC.Show
53
54 -- | @'Time'@ is defined as a @'StgWord64'@ in @stg/Types.h@
55 --
56 -- @since 4.8.2.0
57 type RtsTime = Word64
58
59 -- | Should we produce a summary of the garbage collector statistics after the
60 -- program has exited?
61 --
62 -- @since 4.8.2.0
63 data GiveGCStats
64     = NoGCStats
65     | CollectGCStats
66     | OneLineGCStats
67     | SummaryGCStats
68     | VerboseGCStats
69     deriving (Show)
70
71 -- | @since 4.8.0.0
72 instance Enum GiveGCStats where
73     fromEnum NoGCStats      = #{const NO_GC_STATS}
74     fromEnum CollectGCStats = #{const COLLECT_GC_STATS}
75     fromEnum OneLineGCStats = #{const ONELINE_GC_STATS}
76     fromEnum SummaryGCStats = #{const SUMMARY_GC_STATS}
77     fromEnum VerboseGCStats = #{const VERBOSE_GC_STATS}
78
79     toEnum #{const NO_GC_STATS}      = NoGCStats
80     toEnum #{const COLLECT_GC_STATS} = CollectGCStats
81     toEnum #{const ONELINE_GC_STATS} = OneLineGCStats
82     toEnum #{const SUMMARY_GC_STATS} = SummaryGCStats
83     toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
84     toEnum e = errorWithoutStackTrace ("invalid enum for GiveGCStats: " ++ show e)
85
86 -- | Parameters of the garbage collector.
87 --
88 -- @since 4.8.0.0
89 data GCFlags = GCFlags
90     { statsFile             :: Maybe FilePath
91     , giveStats             :: GiveGCStats
92     , maxStkSize            :: Word32
93     , initialStkSize        :: Word32
94     , stkChunkSize          :: Word32
95     , stkChunkBufferSize    :: Word32
96     , maxHeapSize           :: Word32
97     , minAllocAreaSize      :: Word32
98     , largeAllocLim         :: Word32
99     , nurseryChunkSize      :: Word32
100     , minOldGenSize         :: Word32
101     , heapSizeSuggestion    :: Word32
102     , heapSizeSuggestionAuto :: Bool
103     , oldGenFactor          :: Double
104     , pcFreeHeap            :: Double
105     , generations           :: Word32
106     , squeezeUpdFrames      :: Bool
107     , compact               :: Bool -- ^ True <=> "compact all the time"
108     , compactThreshold      :: Double
109     , sweep                 :: Bool
110       -- ^ use "mostly mark-sweep" instead of copying for the oldest generation
111     , ringBell              :: Bool
112     , idleGCDelayTime       :: RtsTime
113     , doIdleGC              :: Bool
114     , heapBase              :: Word -- ^ address to ask the OS for memory
115     , allocLimitGrace       :: Word
116     , numa                  :: Bool
117     , numaMask              :: Word
118     } deriving (Show)
119
120 -- | Parameters concerning context switching
121 --
122 -- @since 4.8.0.0
123 data ConcFlags = ConcFlags
124     { ctxtSwitchTime  :: RtsTime
125     , ctxtSwitchTicks :: Int
126     } deriving (Show)
127
128 -- | Miscellaneous parameters
129 --
130 -- @since 4.8.0.0
131 data MiscFlags = MiscFlags
132     { tickInterval          :: RtsTime
133     , installSignalHandlers :: Bool
134     , machineReadable       :: Bool
135     , linkerMemBase         :: Word
136       -- ^ address to ask the OS for memory for the linker, 0 ==> off
137     } deriving (Show)
138
139 -- | Flags to control debugging output & extra checking in various
140 -- subsystems.
141 --
142 -- @since 4.8.0.0
143 data DebugFlags = DebugFlags
144     { scheduler   :: Bool -- ^ 's'
145     , interpreter :: Bool -- ^ 'i'
146     , weak        :: Bool -- ^ 'w'
147     , gccafs      :: Bool -- ^ 'G'
148     , gc          :: Bool -- ^ 'g'
149     , block_alloc :: Bool -- ^ 'b'
150     , sanity      :: Bool -- ^ 'S'
151     , stable      :: Bool -- ^ 't'
152     , prof        :: Bool -- ^ 'p'
153     , linker      :: Bool -- ^ 'l' the object linker
154     , apply       :: Bool -- ^ 'a'
155     , stm         :: Bool -- ^ 'm'
156     , squeeze     :: Bool -- ^ 'z' stack squeezing & lazy blackholing
157     , hpc         :: Bool -- ^ 'c' coverage
158     , sparks      :: Bool -- ^ 'r'
159     } deriving (Show)
160
161 -- | Should the RTS produce a cost-center summary?
162 --
163 -- @since 4.8.2.0
164 data DoCostCentres
165     = CostCentresNone
166     | CostCentresSummary
167     | CostCentresVerbose
168     | CostCentresAll
169     | CostCentresJSON
170     deriving (Show)
171
172 -- | @since 4.8.0.0
173 instance Enum DoCostCentres where
174     fromEnum CostCentresNone    = #{const COST_CENTRES_NONE}
175     fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY}
176     fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE}
177     fromEnum CostCentresAll     = #{const COST_CENTRES_ALL}
178     fromEnum CostCentresJSON    = #{const COST_CENTRES_JSON}
179
180     toEnum #{const COST_CENTRES_NONE}    = CostCentresNone
181     toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary
182     toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
183     toEnum #{const COST_CENTRES_ALL}     = CostCentresAll
184     toEnum #{const COST_CENTRES_JSON}    = CostCentresJSON
185     toEnum e = errorWithoutStackTrace ("invalid enum for DoCostCentres: " ++ show e)
186
187 -- | Parameters pertaining to the cost-center profiler.
188 --
189 -- @since 4.8.0.0
190 data CCFlags = CCFlags
191     { doCostCentres :: DoCostCentres
192     , profilerTicks :: Int
193     , msecsPerTick  :: Int
194     } deriving (Show)
195
196 -- | What sort of heap profile are we collecting?
197 --
198 -- @since 4.8.2.0
199 data DoHeapProfile
200     = NoHeapProfiling
201     | HeapByCCS
202     | HeapByMod
203     | HeapByDescr
204     | HeapByType
205     | HeapByRetainer
206     | HeapByLDV
207     | HeapByClosureType
208     deriving (Show)
209
210 -- | @since 4.8.0.0
211 instance Enum DoHeapProfile where
212     fromEnum NoHeapProfiling   = #{const NO_HEAP_PROFILING}
213     fromEnum HeapByCCS         = #{const HEAP_BY_CCS}
214     fromEnum HeapByMod         = #{const HEAP_BY_MOD}
215     fromEnum HeapByDescr       = #{const HEAP_BY_DESCR}
216     fromEnum HeapByType        = #{const HEAP_BY_TYPE}
217     fromEnum HeapByRetainer    = #{const HEAP_BY_RETAINER}
218     fromEnum HeapByLDV         = #{const HEAP_BY_LDV}
219     fromEnum HeapByClosureType = #{const HEAP_BY_CLOSURE_TYPE}
220
221     toEnum #{const NO_HEAP_PROFILING}    = NoHeapProfiling
222     toEnum #{const HEAP_BY_CCS}          = HeapByCCS
223     toEnum #{const HEAP_BY_MOD}          = HeapByMod
224     toEnum #{const HEAP_BY_DESCR}        = HeapByDescr
225     toEnum #{const HEAP_BY_TYPE}         = HeapByType
226     toEnum #{const HEAP_BY_RETAINER}     = HeapByRetainer
227     toEnum #{const HEAP_BY_LDV}          = HeapByLDV
228     toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
229     toEnum e = errorWithoutStackTrace ("invalid enum for DoHeapProfile: " ++ show e)
230
231 -- | Parameters of the cost-center profiler
232 --
233 -- @since 4.8.0.0
234 data ProfFlags = ProfFlags
235     { doHeapProfile            :: DoHeapProfile
236     , heapProfileInterval      :: RtsTime -- ^ time between samples
237     , heapProfileIntervalTicks :: Word    -- ^ ticks between samples (derived)
238     , includeTSOs              :: Bool
239     , showCCSOnException       :: Bool
240     , maxRetainerSetSize       :: Word
241     , ccsLength                :: Word
242     , modSelector              :: Maybe String
243     , descrSelector            :: Maybe String
244     , typeSelector             :: Maybe String
245     , ccSelector               :: Maybe String
246     , ccsSelector              :: Maybe String
247     , retainerSelector         :: Maybe String
248     , bioSelector              :: Maybe String
249     } deriving (Show)
250
251 -- | Is event tracing enabled?
252 --
253 -- @since 4.8.2.0
254 data DoTrace
255     = TraceNone      -- ^ no tracing
256     | TraceEventLog  -- ^ send tracing events to the event log
257     | TraceStderr    -- ^ send tracing events to @stderr@
258     deriving (Show)
259
260 -- | @since 4.8.0.0
261 instance Enum DoTrace where
262     fromEnum TraceNone     = #{const TRACE_NONE}
263     fromEnum TraceEventLog = #{const TRACE_EVENTLOG}
264     fromEnum TraceStderr   = #{const TRACE_STDERR}
265
266     toEnum #{const TRACE_NONE}     = TraceNone
267     toEnum #{const TRACE_EVENTLOG} = TraceEventLog
268     toEnum #{const TRACE_STDERR}   = TraceStderr
269     toEnum e = errorWithoutStackTrace ("invalid enum for DoTrace: " ++ show e)
270
271 -- | Parameters pertaining to event tracing
272 --
273 -- @since 4.8.0.0
274 data TraceFlags = TraceFlags
275     { tracing        :: DoTrace
276     , timestamp      :: Bool -- ^ show timestamp in stderr output
277     , traceScheduler :: Bool -- ^ trace scheduler events
278     , traceGc        :: Bool -- ^ trace GC events
279     , sparksSampled  :: Bool -- ^ trace spark events by a sampled method
280     , sparksFull     :: Bool -- ^ trace spark events 100% accurately
281     , user           :: Bool -- ^ trace user events (emitted from Haskell code)
282     } deriving (Show)
283
284 -- | Parameters pertaining to ticky-ticky profiler
285 --
286 -- @since 4.8.0.0
287 data TickyFlags = TickyFlags
288     { showTickyStats :: Bool
289     , tickyFile      :: Maybe FilePath
290     } deriving (Show)
291
292 -- | Parameters pertaining to parallelism
293 --
294 -- @since 4.8.0.0
295 data ParFlags = ParFlags
296     { nCapabilities :: Word32
297     , migrate :: Bool
298     , maxLocalSparks :: Word32
299     , parGcEnabled :: Bool
300     , parGcGen :: Word32
301     , parGcLoadBalancingEnabled :: Bool
302     , parGcLoadBalancingGen :: Word32
303     , parGcNoSyncWithIdle :: Word32
304     , parGcThreads :: Word32
305     , setAffinity :: Bool
306     }
307     deriving (Show)
308
309 -- | Parameters of the runtime system
310 --
311 -- @since 4.8.0.0
312 data RTSFlags = RTSFlags
313     { gcFlags         :: GCFlags
314     , concurrentFlags :: ConcFlags
315     , miscFlags       :: MiscFlags
316     , debugFlags      :: DebugFlags
317     , costCentreFlags :: CCFlags
318     , profilingFlags  :: ProfFlags
319     , traceFlags      :: TraceFlags
320     , tickyFlags      :: TickyFlags
321     , parFlags        :: ParFlags
322     } deriving (Show)
323
324 foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr RTSFlags
325
326 getRTSFlags :: IO RTSFlags
327 getRTSFlags = do
328   RTSFlags <$> getGCFlags
329            <*> getConcFlags
330            <*> getMiscFlags
331            <*> getDebugFlags
332            <*> getCCFlags
333            <*> getProfFlags
334            <*> getTraceFlags
335            <*> getTickyFlags
336            <*> getParFlags
337
338 peekFilePath :: Ptr () -> IO (Maybe FilePath)
339 peekFilePath ptr
340   | ptr == nullPtr = return Nothing
341   | otherwise      = return (Just "<filepath>")
342
343 -- | Read a NUL terminated string. Return Nothing in case of a NULL pointer.
344 peekCStringOpt :: Ptr CChar -> IO (Maybe String)
345 peekCStringOpt ptr
346   | ptr == nullPtr = return Nothing
347   | otherwise      = Just <$> peekCString ptr
348
349 getGCFlags :: IO GCFlags
350 getGCFlags = do
351   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
352   GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
353           <*> (toEnum . fromIntegral <$>
354                 (#{peek GC_FLAGS, giveStats} ptr :: IO Word32))
355           <*> #{peek GC_FLAGS, maxStkSize} ptr
356           <*> #{peek GC_FLAGS, initialStkSize} ptr
357           <*> #{peek GC_FLAGS, stkChunkSize} ptr
358           <*> #{peek GC_FLAGS, stkChunkBufferSize} ptr
359           <*> #{peek GC_FLAGS, maxHeapSize} ptr
360           <*> #{peek GC_FLAGS, minAllocAreaSize} ptr
361           <*> #{peek GC_FLAGS, largeAllocLim} ptr
362           <*> #{peek GC_FLAGS, nurseryChunkSize} ptr
363           <*> #{peek GC_FLAGS, minOldGenSize} ptr
364           <*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
365           <*> #{peek GC_FLAGS, heapSizeSuggestionAuto} ptr
366           <*> #{peek GC_FLAGS, oldGenFactor} ptr
367           <*> #{peek GC_FLAGS, pcFreeHeap} ptr
368           <*> #{peek GC_FLAGS, generations} ptr
369           <*> #{peek GC_FLAGS, squeezeUpdFrames} ptr
370           <*> #{peek GC_FLAGS, compact} ptr
371           <*> #{peek GC_FLAGS, compactThreshold} ptr
372           <*> #{peek GC_FLAGS, sweep} ptr
373           <*> #{peek GC_FLAGS, ringBell} ptr
374           <*> #{peek GC_FLAGS, idleGCDelayTime} ptr
375           <*> #{peek GC_FLAGS, doIdleGC} ptr
376           <*> #{peek GC_FLAGS, heapBase} ptr
377           <*> #{peek GC_FLAGS, allocLimitGrace} ptr
378           <*> #{peek GC_FLAGS, numa} ptr
379           <*> #{peek GC_FLAGS, numaMask} ptr
380
381 getParFlags :: IO ParFlags
382 getParFlags = do
383   let ptr = (#ptr RTS_FLAGS, ParFlags) rtsFlagsPtr
384   ParFlags
385     <$> #{peek PAR_FLAGS, nCapabilities} ptr
386     <*> #{peek PAR_FLAGS, migrate} ptr
387     <*> #{peek PAR_FLAGS, maxLocalSparks} ptr
388     <*> #{peek PAR_FLAGS, parGcEnabled} ptr
389     <*> #{peek PAR_FLAGS, parGcGen} ptr
390     <*> #{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr
391     <*> #{peek PAR_FLAGS, parGcLoadBalancingGen} ptr
392     <*> #{peek PAR_FLAGS, parGcNoSyncWithIdle} ptr
393     <*> #{peek PAR_FLAGS, parGcThreads} ptr
394     <*> #{peek PAR_FLAGS, setAffinity} ptr
395
396 getConcFlags :: IO ConcFlags
397 getConcFlags = do
398   let ptr = (#ptr RTS_FLAGS, ConcFlags) rtsFlagsPtr
399   ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
400             <*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr
401
402 getMiscFlags :: IO MiscFlags
403 getMiscFlags = do
404   let ptr = (#ptr RTS_FLAGS, MiscFlags) rtsFlagsPtr
405   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
406             <*> #{peek MISC_FLAGS, install_signal_handlers} ptr
407             <*> #{peek MISC_FLAGS, machineReadable} ptr
408             <*> #{peek MISC_FLAGS, linkerMemBase} ptr
409
410 getDebugFlags :: IO DebugFlags
411 getDebugFlags = do
412   let ptr = (#ptr RTS_FLAGS, DebugFlags) rtsFlagsPtr
413   DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
414              <*> #{peek DEBUG_FLAGS, interpreter} ptr
415              <*> #{peek DEBUG_FLAGS, weak} ptr
416              <*> #{peek DEBUG_FLAGS, gccafs} ptr
417              <*> #{peek DEBUG_FLAGS, gc} ptr
418              <*> #{peek DEBUG_FLAGS, block_alloc} ptr
419              <*> #{peek DEBUG_FLAGS, sanity} ptr
420              <*> #{peek DEBUG_FLAGS, stable} ptr
421              <*> #{peek DEBUG_FLAGS, prof} ptr
422              <*> #{peek DEBUG_FLAGS, linker} ptr
423              <*> #{peek DEBUG_FLAGS, apply} ptr
424              <*> #{peek DEBUG_FLAGS, stm} ptr
425              <*> #{peek DEBUG_FLAGS, squeeze} ptr
426              <*> #{peek DEBUG_FLAGS, hpc} ptr
427              <*> #{peek DEBUG_FLAGS, sparks} ptr
428
429 getCCFlags :: IO CCFlags
430 getCCFlags = do
431   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
432   CCFlags <$> (toEnum . fromIntegral
433                 <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Word32))
434           <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
435           <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
436
437 getProfFlags :: IO ProfFlags
438 getProfFlags = do
439   let ptr = (#ptr RTS_FLAGS, ProfFlags) rtsFlagsPtr
440   ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
441             <*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
442             <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
443             <*> #{peek PROFILING_FLAGS, includeTSOs} ptr
444             <*> #{peek PROFILING_FLAGS, showCCSOnException} ptr
445             <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
446             <*> #{peek PROFILING_FLAGS, ccsLength} ptr
447             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
448             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, descrSelector} ptr)
449             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, typeSelector} ptr)
450             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccSelector} ptr)
451             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccsSelector} ptr)
452             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
453             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
454
455 getTraceFlags :: IO TraceFlags
456 getTraceFlags = do
457   let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
458   TraceFlags <$> (toEnum . fromIntegral
459                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
460              <*> #{peek TRACE_FLAGS, timestamp} ptr
461              <*> #{peek TRACE_FLAGS, scheduler} ptr
462              <*> #{peek TRACE_FLAGS, gc} ptr
463              <*> #{peek TRACE_FLAGS, sparks_sampled} ptr
464              <*> #{peek TRACE_FLAGS, sparks_full} ptr
465              <*> #{peek TRACE_FLAGS, user} ptr
466
467 getTickyFlags :: IO TickyFlags
468 getTickyFlags = do
469   let ptr = (#ptr RTS_FLAGS, TickyFlags) rtsFlagsPtr
470   TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
471              <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)