62b79ed064ca3041dc1ad9e4134b3d39dfe3d90e
[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     , installSEHHandlers    :: Bool
135     , generateCrashDumpFile :: Bool
136     , machineReadable       :: Bool
137     , linkerMemBase         :: Word
138       -- ^ address to ask the OS for memory for the linker, 0 ==> off
139     } deriving (Show)
140
141 -- | Flags to control debugging output & extra checking in various
142 -- subsystems.
143 --
144 -- @since 4.8.0.0
145 data DebugFlags = DebugFlags
146     { scheduler   :: Bool -- ^ 's'
147     , interpreter :: Bool -- ^ 'i'
148     , weak        :: Bool -- ^ 'w'
149     , gccafs      :: Bool -- ^ 'G'
150     , gc          :: Bool -- ^ 'g'
151     , block_alloc :: Bool -- ^ 'b'
152     , sanity      :: Bool -- ^ 'S'
153     , stable      :: Bool -- ^ 't'
154     , prof        :: Bool -- ^ 'p'
155     , linker      :: Bool -- ^ 'l' the object linker
156     , apply       :: Bool -- ^ 'a'
157     , stm         :: Bool -- ^ 'm'
158     , squeeze     :: Bool -- ^ 'z' stack squeezing & lazy blackholing
159     , hpc         :: Bool -- ^ 'c' coverage
160     , sparks      :: Bool -- ^ 'r'
161     } deriving (Show)
162
163 -- | Should the RTS produce a cost-center summary?
164 --
165 -- @since 4.8.2.0
166 data DoCostCentres
167     = CostCentresNone
168     | CostCentresSummary
169     | CostCentresVerbose
170     | CostCentresAll
171     | CostCentresJSON
172     deriving (Show)
173
174 -- | @since 4.8.0.0
175 instance Enum DoCostCentres where
176     fromEnum CostCentresNone    = #{const COST_CENTRES_NONE}
177     fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY}
178     fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE}
179     fromEnum CostCentresAll     = #{const COST_CENTRES_ALL}
180     fromEnum CostCentresJSON    = #{const COST_CENTRES_JSON}
181
182     toEnum #{const COST_CENTRES_NONE}    = CostCentresNone
183     toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary
184     toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
185     toEnum #{const COST_CENTRES_ALL}     = CostCentresAll
186     toEnum #{const COST_CENTRES_JSON}    = CostCentresJSON
187     toEnum e = errorWithoutStackTrace ("invalid enum for DoCostCentres: " ++ show e)
188
189 -- | Parameters pertaining to the cost-center profiler.
190 --
191 -- @since 4.8.0.0
192 data CCFlags = CCFlags
193     { doCostCentres :: DoCostCentres
194     , profilerTicks :: Int
195     , msecsPerTick  :: Int
196     } deriving (Show)
197
198 -- | What sort of heap profile are we collecting?
199 --
200 -- @since 4.8.2.0
201 data DoHeapProfile
202     = NoHeapProfiling
203     | HeapByCCS
204     | HeapByMod
205     | HeapByDescr
206     | HeapByType
207     | HeapByRetainer
208     | HeapByLDV
209     | HeapByClosureType
210     deriving (Show)
211
212 -- | @since 4.8.0.0
213 instance Enum DoHeapProfile where
214     fromEnum NoHeapProfiling   = #{const NO_HEAP_PROFILING}
215     fromEnum HeapByCCS         = #{const HEAP_BY_CCS}
216     fromEnum HeapByMod         = #{const HEAP_BY_MOD}
217     fromEnum HeapByDescr       = #{const HEAP_BY_DESCR}
218     fromEnum HeapByType        = #{const HEAP_BY_TYPE}
219     fromEnum HeapByRetainer    = #{const HEAP_BY_RETAINER}
220     fromEnum HeapByLDV         = #{const HEAP_BY_LDV}
221     fromEnum HeapByClosureType = #{const HEAP_BY_CLOSURE_TYPE}
222
223     toEnum #{const NO_HEAP_PROFILING}    = NoHeapProfiling
224     toEnum #{const HEAP_BY_CCS}          = HeapByCCS
225     toEnum #{const HEAP_BY_MOD}          = HeapByMod
226     toEnum #{const HEAP_BY_DESCR}        = HeapByDescr
227     toEnum #{const HEAP_BY_TYPE}         = HeapByType
228     toEnum #{const HEAP_BY_RETAINER}     = HeapByRetainer
229     toEnum #{const HEAP_BY_LDV}          = HeapByLDV
230     toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
231     toEnum e = errorWithoutStackTrace ("invalid enum for DoHeapProfile: " ++ show e)
232
233 -- | Parameters of the cost-center profiler
234 --
235 -- @since 4.8.0.0
236 data ProfFlags = ProfFlags
237     { doHeapProfile            :: DoHeapProfile
238     , heapProfileInterval      :: RtsTime -- ^ time between samples
239     , heapProfileIntervalTicks :: Word    -- ^ ticks between samples (derived)
240     , includeTSOs              :: Bool
241     , showCCSOnException       :: Bool
242     , maxRetainerSetSize       :: Word
243     , ccsLength                :: Word
244     , modSelector              :: Maybe String
245     , descrSelector            :: Maybe String
246     , typeSelector             :: Maybe String
247     , ccSelector               :: Maybe String
248     , ccsSelector              :: Maybe String
249     , retainerSelector         :: Maybe String
250     , bioSelector              :: Maybe String
251     } deriving (Show)
252
253 -- | Is event tracing enabled?
254 --
255 -- @since 4.8.2.0
256 data DoTrace
257     = TraceNone      -- ^ no tracing
258     | TraceEventLog  -- ^ send tracing events to the event log
259     | TraceStderr    -- ^ send tracing events to @stderr@
260     deriving (Show)
261
262 -- | @since 4.8.0.0
263 instance Enum DoTrace where
264     fromEnum TraceNone     = #{const TRACE_NONE}
265     fromEnum TraceEventLog = #{const TRACE_EVENTLOG}
266     fromEnum TraceStderr   = #{const TRACE_STDERR}
267
268     toEnum #{const TRACE_NONE}     = TraceNone
269     toEnum #{const TRACE_EVENTLOG} = TraceEventLog
270     toEnum #{const TRACE_STDERR}   = TraceStderr
271     toEnum e = errorWithoutStackTrace ("invalid enum for DoTrace: " ++ show e)
272
273 -- | Parameters pertaining to event tracing
274 --
275 -- @since 4.8.0.0
276 data TraceFlags = TraceFlags
277     { tracing        :: DoTrace
278     , timestamp      :: Bool -- ^ show timestamp in stderr output
279     , traceScheduler :: Bool -- ^ trace scheduler events
280     , traceGc        :: Bool -- ^ trace GC events
281     , sparksSampled  :: Bool -- ^ trace spark events by a sampled method
282     , sparksFull     :: Bool -- ^ trace spark events 100% accurately
283     , user           :: Bool -- ^ trace user events (emitted from Haskell code)
284     } deriving (Show)
285
286 -- | Parameters pertaining to ticky-ticky profiler
287 --
288 -- @since 4.8.0.0
289 data TickyFlags = TickyFlags
290     { showTickyStats :: Bool
291     , tickyFile      :: Maybe FilePath
292     } deriving (Show)
293
294 -- | Parameters pertaining to parallelism
295 --
296 -- @since 4.8.0.0
297 data ParFlags = ParFlags
298     { nCapabilities :: Word32
299     , migrate :: Bool
300     , maxLocalSparks :: Word32
301     , parGcEnabled :: Bool
302     , parGcGen :: Word32
303     , parGcLoadBalancingEnabled :: Bool
304     , parGcLoadBalancingGen :: Word32
305     , parGcNoSyncWithIdle :: Word32
306     , parGcThreads :: Word32
307     , setAffinity :: Bool
308     }
309     deriving (Show)
310
311 -- | Parameters of the runtime system
312 --
313 -- @since 4.8.0.0
314 data RTSFlags = RTSFlags
315     { gcFlags         :: GCFlags
316     , concurrentFlags :: ConcFlags
317     , miscFlags       :: MiscFlags
318     , debugFlags      :: DebugFlags
319     , costCentreFlags :: CCFlags
320     , profilingFlags  :: ProfFlags
321     , traceFlags      :: TraceFlags
322     , tickyFlags      :: TickyFlags
323     , parFlags        :: ParFlags
324     } deriving (Show)
325
326 foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr RTSFlags
327
328 getRTSFlags :: IO RTSFlags
329 getRTSFlags = do
330   RTSFlags <$> getGCFlags
331            <*> getConcFlags
332            <*> getMiscFlags
333            <*> getDebugFlags
334            <*> getCCFlags
335            <*> getProfFlags
336            <*> getTraceFlags
337            <*> getTickyFlags
338            <*> getParFlags
339
340 peekFilePath :: Ptr () -> IO (Maybe FilePath)
341 peekFilePath ptr
342   | ptr == nullPtr = return Nothing
343   | otherwise      = return (Just "<filepath>")
344
345 -- | Read a NUL terminated string. Return Nothing in case of a NULL pointer.
346 peekCStringOpt :: Ptr CChar -> IO (Maybe String)
347 peekCStringOpt ptr
348   | ptr == nullPtr = return Nothing
349   | otherwise      = Just <$> peekCString ptr
350
351 getGCFlags :: IO GCFlags
352 getGCFlags = do
353   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
354   GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
355           <*> (toEnum . fromIntegral <$>
356                 (#{peek GC_FLAGS, giveStats} ptr :: IO Word32))
357           <*> #{peek GC_FLAGS, maxStkSize} ptr
358           <*> #{peek GC_FLAGS, initialStkSize} ptr
359           <*> #{peek GC_FLAGS, stkChunkSize} ptr
360           <*> #{peek GC_FLAGS, stkChunkBufferSize} ptr
361           <*> #{peek GC_FLAGS, maxHeapSize} ptr
362           <*> #{peek GC_FLAGS, minAllocAreaSize} ptr
363           <*> #{peek GC_FLAGS, largeAllocLim} ptr
364           <*> #{peek GC_FLAGS, nurseryChunkSize} ptr
365           <*> #{peek GC_FLAGS, minOldGenSize} ptr
366           <*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
367           <*> #{peek GC_FLAGS, heapSizeSuggestionAuto} ptr
368           <*> #{peek GC_FLAGS, oldGenFactor} ptr
369           <*> #{peek GC_FLAGS, pcFreeHeap} ptr
370           <*> #{peek GC_FLAGS, generations} ptr
371           <*> #{peek GC_FLAGS, squeezeUpdFrames} ptr
372           <*> #{peek GC_FLAGS, compact} ptr
373           <*> #{peek GC_FLAGS, compactThreshold} ptr
374           <*> #{peek GC_FLAGS, sweep} ptr
375           <*> #{peek GC_FLAGS, ringBell} ptr
376           <*> #{peek GC_FLAGS, idleGCDelayTime} ptr
377           <*> #{peek GC_FLAGS, doIdleGC} ptr
378           <*> #{peek GC_FLAGS, heapBase} ptr
379           <*> #{peek GC_FLAGS, allocLimitGrace} ptr
380           <*> #{peek GC_FLAGS, numa} ptr
381           <*> #{peek GC_FLAGS, numaMask} ptr
382
383 getParFlags :: IO ParFlags
384 getParFlags = do
385   let ptr = (#ptr RTS_FLAGS, ParFlags) rtsFlagsPtr
386   ParFlags
387     <$> #{peek PAR_FLAGS, nCapabilities} ptr
388     <*> #{peek PAR_FLAGS, migrate} ptr
389     <*> #{peek PAR_FLAGS, maxLocalSparks} ptr
390     <*> #{peek PAR_FLAGS, parGcEnabled} ptr
391     <*> #{peek PAR_FLAGS, parGcGen} ptr
392     <*> #{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr
393     <*> #{peek PAR_FLAGS, parGcLoadBalancingGen} ptr
394     <*> #{peek PAR_FLAGS, parGcNoSyncWithIdle} ptr
395     <*> #{peek PAR_FLAGS, parGcThreads} ptr
396     <*> #{peek PAR_FLAGS, setAffinity} ptr
397
398 getConcFlags :: IO ConcFlags
399 getConcFlags = do
400   let ptr = (#ptr RTS_FLAGS, ConcFlags) rtsFlagsPtr
401   ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
402             <*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr
403
404 getMiscFlags :: IO MiscFlags
405 getMiscFlags = do
406   let ptr = (#ptr RTS_FLAGS, MiscFlags) rtsFlagsPtr
407   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
408             <*> #{peek MISC_FLAGS, install_signal_handlers} ptr
409             <*> #{peek MISC_FLAGS, install_seh_handlers} ptr
410             <*> #{peek MISC_FLAGS, generate_dump_file} ptr
411             <*> #{peek MISC_FLAGS, machineReadable} ptr
412             <*> #{peek MISC_FLAGS, linkerMemBase} ptr
413
414 getDebugFlags :: IO DebugFlags
415 getDebugFlags = do
416   let ptr = (#ptr RTS_FLAGS, DebugFlags) rtsFlagsPtr
417   DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
418              <*> #{peek DEBUG_FLAGS, interpreter} ptr
419              <*> #{peek DEBUG_FLAGS, weak} ptr
420              <*> #{peek DEBUG_FLAGS, gccafs} ptr
421              <*> #{peek DEBUG_FLAGS, gc} ptr
422              <*> #{peek DEBUG_FLAGS, block_alloc} ptr
423              <*> #{peek DEBUG_FLAGS, sanity} ptr
424              <*> #{peek DEBUG_FLAGS, stable} ptr
425              <*> #{peek DEBUG_FLAGS, prof} ptr
426              <*> #{peek DEBUG_FLAGS, linker} ptr
427              <*> #{peek DEBUG_FLAGS, apply} ptr
428              <*> #{peek DEBUG_FLAGS, stm} ptr
429              <*> #{peek DEBUG_FLAGS, squeeze} ptr
430              <*> #{peek DEBUG_FLAGS, hpc} ptr
431              <*> #{peek DEBUG_FLAGS, sparks} ptr
432
433 getCCFlags :: IO CCFlags
434 getCCFlags = do
435   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
436   CCFlags <$> (toEnum . fromIntegral
437                 <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Word32))
438           <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
439           <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
440
441 getProfFlags :: IO ProfFlags
442 getProfFlags = do
443   let ptr = (#ptr RTS_FLAGS, ProfFlags) rtsFlagsPtr
444   ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
445             <*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
446             <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
447             <*> #{peek PROFILING_FLAGS, includeTSOs} ptr
448             <*> #{peek PROFILING_FLAGS, showCCSOnException} ptr
449             <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
450             <*> #{peek PROFILING_FLAGS, ccsLength} ptr
451             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
452             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, descrSelector} ptr)
453             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, typeSelector} ptr)
454             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccSelector} ptr)
455             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccsSelector} ptr)
456             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
457             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
458
459 getTraceFlags :: IO TraceFlags
460 getTraceFlags = do
461   let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
462   TraceFlags <$> (toEnum . fromIntegral
463                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
464              <*> #{peek TRACE_FLAGS, timestamp} ptr
465              <*> #{peek TRACE_FLAGS, scheduler} ptr
466              <*> #{peek TRACE_FLAGS, gc} ptr
467              <*> #{peek TRACE_FLAGS, sparks_sampled} ptr
468              <*> #{peek TRACE_FLAGS, sparks_full} ptr
469              <*> #{peek TRACE_FLAGS, user} ptr
470
471 getTickyFlags :: IO TickyFlags
472 getTickyFlags = do
473   let ptr = (#ptr RTS_FLAGS, TickyFlags) rtsFlagsPtr
474   TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
475              <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)