NonmovingCensus: Emit samples to eventlog
[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 -- | 'RtsTime' 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 -- ^ @since 4.8.0.0
70              )
71
72 -- | @since 4.8.0.0
73 instance Enum GiveGCStats where
74     fromEnum NoGCStats      = #{const NO_GC_STATS}
75     fromEnum CollectGCStats = #{const COLLECT_GC_STATS}
76     fromEnum OneLineGCStats = #{const ONELINE_GC_STATS}
77     fromEnum SummaryGCStats = #{const SUMMARY_GC_STATS}
78     fromEnum VerboseGCStats = #{const VERBOSE_GC_STATS}
79
80     toEnum #{const NO_GC_STATS}      = NoGCStats
81     toEnum #{const COLLECT_GC_STATS} = CollectGCStats
82     toEnum #{const ONELINE_GC_STATS} = OneLineGCStats
83     toEnum #{const SUMMARY_GC_STATS} = SummaryGCStats
84     toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
85     toEnum e = errorWithoutStackTrace ("invalid enum for GiveGCStats: " ++ show e)
86
87 -- | Parameters of the garbage collector.
88 --
89 -- @since 4.8.0.0
90 data GCFlags = GCFlags
91     { statsFile             :: Maybe FilePath
92     , giveStats             :: GiveGCStats
93     , maxStkSize            :: Word32
94     , initialStkSize        :: Word32
95     , stkChunkSize          :: Word32
96     , stkChunkBufferSize    :: Word32
97     , maxHeapSize           :: Word32
98     , minAllocAreaSize      :: Word32
99     , largeAllocLim         :: Word32
100     , nurseryChunkSize      :: Word32
101     , minOldGenSize         :: Word32
102     , heapSizeSuggestion    :: Word32
103     , heapSizeSuggestionAuto :: Bool
104     , oldGenFactor          :: Double
105     , pcFreeHeap            :: Double
106     , generations           :: Word32
107     , squeezeUpdFrames      :: Bool
108     , compact               :: Bool -- ^ True <=> "compact all the time"
109     , compactThreshold      :: Double
110     , sweep                 :: Bool
111       -- ^ use "mostly mark-sweep" instead of copying for the oldest generation
112     , ringBell              :: Bool
113     , idleGCDelayTime       :: RtsTime
114     , doIdleGC              :: Bool
115     , heapBase              :: Word -- ^ address to ask the OS for memory
116     , allocLimitGrace       :: Word
117     , numa                  :: Bool
118     , numaMask              :: Word
119     } deriving ( Show -- ^ @since 4.8.0.0
120                )
121
122 -- | Parameters concerning context switching
123 --
124 -- @since 4.8.0.0
125 data ConcFlags = ConcFlags
126     { ctxtSwitchTime  :: RtsTime
127     , ctxtSwitchTicks :: Int
128     } deriving ( Show -- ^ @since 4.8.0.0
129                )
130
131 -- | Miscellaneous parameters
132 --
133 -- @since 4.8.0.0
134 data MiscFlags = MiscFlags
135     { tickInterval          :: RtsTime
136     , installSignalHandlers :: Bool
137     , installSEHHandlers    :: Bool
138     , generateCrashDumpFile :: Bool
139     , generateStackTrace    :: Bool
140     , machineReadable       :: Bool
141     , internalCounters      :: Bool
142     , linkerMemBase         :: Word
143       -- ^ address to ask the OS for memory for the linker, 0 ==> off
144     } deriving ( Show -- ^ @since 4.8.0.0
145                )
146
147 -- | Flags to control debugging output & extra checking in various
148 -- subsystems.
149 --
150 -- @since 4.8.0.0
151 data DebugFlags = DebugFlags
152     { scheduler      :: Bool -- ^ @s@
153     , interpreter    :: Bool -- ^ @i@
154     , weak           :: Bool -- ^ @w@
155     , gccafs         :: Bool -- ^ @G@
156     , gc             :: Bool -- ^ @g@
157     , nonmoving_gc   :: Bool -- ^ @n@
158     , block_alloc    :: Bool -- ^ @b@
159     , sanity         :: Bool -- ^ @S@
160     , stable         :: Bool -- ^ @t@
161     , prof           :: Bool -- ^ @p@
162     , linker         :: Bool -- ^ @l@ the object linker
163     , apply          :: Bool -- ^ @a@
164     , stm            :: Bool -- ^ @m@
165     , squeeze        :: Bool -- ^ @z@ stack squeezing & lazy blackholing
166     , hpc            :: Bool -- ^ @c@ coverage
167     , sparks         :: Bool -- ^ @r@
168     } deriving ( Show -- ^ @since 4.8.0.0
169                )
170
171 -- | Should the RTS produce a cost-center summary?
172 --
173 -- @since 4.8.2.0
174 data DoCostCentres
175     = CostCentresNone
176     | CostCentresSummary
177     | CostCentresVerbose
178     | CostCentresAll
179     | CostCentresJSON
180     deriving ( Show -- ^ @since 4.8.0.0
181              )
182
183 -- | @since 4.8.0.0
184 instance Enum DoCostCentres where
185     fromEnum CostCentresNone    = #{const COST_CENTRES_NONE}
186     fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY}
187     fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE}
188     fromEnum CostCentresAll     = #{const COST_CENTRES_ALL}
189     fromEnum CostCentresJSON    = #{const COST_CENTRES_JSON}
190
191     toEnum #{const COST_CENTRES_NONE}    = CostCentresNone
192     toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary
193     toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
194     toEnum #{const COST_CENTRES_ALL}     = CostCentresAll
195     toEnum #{const COST_CENTRES_JSON}    = CostCentresJSON
196     toEnum e = errorWithoutStackTrace ("invalid enum for DoCostCentres: " ++ show e)
197
198 -- | Parameters pertaining to the cost-center profiler.
199 --
200 -- @since 4.8.0.0
201 data CCFlags = CCFlags
202     { doCostCentres :: DoCostCentres
203     , profilerTicks :: Int
204     , msecsPerTick  :: Int
205     } deriving ( Show -- ^ @since 4.8.0.0
206                )
207
208 -- | What sort of heap profile are we collecting?
209 --
210 -- @since 4.8.2.0
211 data DoHeapProfile
212     = NoHeapProfiling
213     | HeapByCCS
214     | HeapByMod
215     | HeapByDescr
216     | HeapByType
217     | HeapByRetainer
218     | HeapByLDV
219     | HeapByClosureType
220     deriving ( Show -- ^ @since 4.8.0.0
221              )
222
223 -- | @since 4.8.0.0
224 instance Enum DoHeapProfile where
225     fromEnum NoHeapProfiling   = #{const NO_HEAP_PROFILING}
226     fromEnum HeapByCCS         = #{const HEAP_BY_CCS}
227     fromEnum HeapByMod         = #{const HEAP_BY_MOD}
228     fromEnum HeapByDescr       = #{const HEAP_BY_DESCR}
229     fromEnum HeapByType        = #{const HEAP_BY_TYPE}
230     fromEnum HeapByRetainer    = #{const HEAP_BY_RETAINER}
231     fromEnum HeapByLDV         = #{const HEAP_BY_LDV}
232     fromEnum HeapByClosureType = #{const HEAP_BY_CLOSURE_TYPE}
233
234     toEnum #{const NO_HEAP_PROFILING}    = NoHeapProfiling
235     toEnum #{const HEAP_BY_CCS}          = HeapByCCS
236     toEnum #{const HEAP_BY_MOD}          = HeapByMod
237     toEnum #{const HEAP_BY_DESCR}        = HeapByDescr
238     toEnum #{const HEAP_BY_TYPE}         = HeapByType
239     toEnum #{const HEAP_BY_RETAINER}     = HeapByRetainer
240     toEnum #{const HEAP_BY_LDV}          = HeapByLDV
241     toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
242     toEnum e = errorWithoutStackTrace ("invalid enum for DoHeapProfile: " ++ show e)
243
244 -- | Parameters of the cost-center profiler
245 --
246 -- @since 4.8.0.0
247 data ProfFlags = ProfFlags
248     { doHeapProfile            :: DoHeapProfile
249     , heapProfileInterval      :: RtsTime -- ^ time between samples
250     , heapProfileIntervalTicks :: Word    -- ^ ticks between samples (derived)
251     , includeTSOs              :: Bool
252     , showCCSOnException       :: Bool
253     , maxRetainerSetSize       :: Word
254     , ccsLength                :: Word
255     , modSelector              :: Maybe String
256     , descrSelector            :: Maybe String
257     , typeSelector             :: Maybe String
258     , ccSelector               :: Maybe String
259     , ccsSelector              :: Maybe String
260     , retainerSelector         :: Maybe String
261     , bioSelector              :: Maybe String
262     } deriving ( Show -- ^ @since 4.8.0.0
263                )
264
265 -- | Is event tracing enabled?
266 --
267 -- @since 4.8.2.0
268 data DoTrace
269     = TraceNone      -- ^ no tracing
270     | TraceEventLog  -- ^ send tracing events to the event log
271     | TraceStderr    -- ^ send tracing events to @stderr@
272     deriving ( Show -- ^ @since 4.8.0.0
273              )
274
275 -- | @since 4.8.0.0
276 instance Enum DoTrace where
277     fromEnum TraceNone     = #{const TRACE_NONE}
278     fromEnum TraceEventLog = #{const TRACE_EVENTLOG}
279     fromEnum TraceStderr   = #{const TRACE_STDERR}
280
281     toEnum #{const TRACE_NONE}     = TraceNone
282     toEnum #{const TRACE_EVENTLOG} = TraceEventLog
283     toEnum #{const TRACE_STDERR}   = TraceStderr
284     toEnum e = errorWithoutStackTrace ("invalid enum for DoTrace: " ++ show e)
285
286 -- | Parameters pertaining to event tracing
287 --
288 -- @since 4.8.0.0
289 data TraceFlags = TraceFlags
290     { tracing        :: DoTrace
291     , timestamp      :: Bool -- ^ show timestamp in stderr output
292     , traceScheduler :: Bool -- ^ trace scheduler events
293     , traceGc        :: Bool -- ^ trace GC events
294     , traceNonmovingGc
295                      :: Bool -- ^ trace nonmoving GC heap census samples
296     , sparksSampled  :: Bool -- ^ trace spark events by a sampled method
297     , sparksFull     :: Bool -- ^ trace spark events 100% accurately
298     , user           :: Bool -- ^ trace user events (emitted from Haskell code)
299     } deriving ( Show -- ^ @since 4.8.0.0
300                )
301
302 -- | Parameters pertaining to ticky-ticky profiler
303 --
304 -- @since 4.8.0.0
305 data TickyFlags = TickyFlags
306     { showTickyStats :: Bool
307     , tickyFile      :: Maybe FilePath
308     } deriving ( Show -- ^ @since 4.8.0.0
309                )
310
311 -- | Parameters pertaining to parallelism
312 --
313 -- @since 4.8.0.0
314 data ParFlags = ParFlags
315     { nCapabilities :: Word32
316     , migrate :: Bool
317     , maxLocalSparks :: Word32
318     , parGcEnabled :: Bool
319     , parGcGen :: Word32
320     , parGcLoadBalancingEnabled :: Bool
321     , parGcLoadBalancingGen :: Word32
322     , parGcNoSyncWithIdle :: Word32
323     , parGcThreads :: Word32
324     , setAffinity :: Bool
325     }
326     deriving ( Show -- ^ @since 4.8.0.0
327              )
328
329 -- | Parameters of the runtime system
330 --
331 -- @since 4.8.0.0
332 data RTSFlags = RTSFlags
333     { gcFlags         :: GCFlags
334     , concurrentFlags :: ConcFlags
335     , miscFlags       :: MiscFlags
336     , debugFlags      :: DebugFlags
337     , costCentreFlags :: CCFlags
338     , profilingFlags  :: ProfFlags
339     , traceFlags      :: TraceFlags
340     , tickyFlags      :: TickyFlags
341     , parFlags        :: ParFlags
342     } deriving ( Show -- ^ @since 4.8.0.0
343                )
344
345 foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr RTSFlags
346
347 getRTSFlags :: IO RTSFlags
348 getRTSFlags = do
349   RTSFlags <$> getGCFlags
350            <*> getConcFlags
351            <*> getMiscFlags
352            <*> getDebugFlags
353            <*> getCCFlags
354            <*> getProfFlags
355            <*> getTraceFlags
356            <*> getTickyFlags
357            <*> getParFlags
358
359 peekFilePath :: Ptr () -> IO (Maybe FilePath)
360 peekFilePath ptr
361   | ptr == nullPtr = return Nothing
362   | otherwise      = return (Just "<filepath>")
363
364 -- | Read a NUL terminated string. Return Nothing in case of a NULL pointer.
365 peekCStringOpt :: Ptr CChar -> IO (Maybe String)
366 peekCStringOpt ptr
367   | ptr == nullPtr = return Nothing
368   | otherwise      = Just <$> peekCString ptr
369
370 getGCFlags :: IO GCFlags
371 getGCFlags = do
372   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
373   GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
374           <*> (toEnum . fromIntegral <$>
375                 (#{peek GC_FLAGS, giveStats} ptr :: IO Word32))
376           <*> #{peek GC_FLAGS, maxStkSize} ptr
377           <*> #{peek GC_FLAGS, initialStkSize} ptr
378           <*> #{peek GC_FLAGS, stkChunkSize} ptr
379           <*> #{peek GC_FLAGS, stkChunkBufferSize} ptr
380           <*> #{peek GC_FLAGS, maxHeapSize} ptr
381           <*> #{peek GC_FLAGS, minAllocAreaSize} ptr
382           <*> #{peek GC_FLAGS, largeAllocLim} ptr
383           <*> #{peek GC_FLAGS, nurseryChunkSize} ptr
384           <*> #{peek GC_FLAGS, minOldGenSize} ptr
385           <*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
386           <*> (toBool <$>
387                 (#{peek GC_FLAGS, heapSizeSuggestionAuto} ptr :: IO CBool))
388           <*> #{peek GC_FLAGS, oldGenFactor} ptr
389           <*> #{peek GC_FLAGS, pcFreeHeap} ptr
390           <*> #{peek GC_FLAGS, generations} ptr
391           <*> (toBool <$>
392                 (#{peek GC_FLAGS, squeezeUpdFrames} ptr :: IO CBool))
393           <*> (toBool <$>
394                 (#{peek GC_FLAGS, compact} ptr :: IO CBool))
395           <*> #{peek GC_FLAGS, compactThreshold} ptr
396           <*> (toBool <$>
397                 (#{peek GC_FLAGS, sweep} ptr :: IO CBool))
398           <*> (toBool <$>
399                 (#{peek GC_FLAGS, ringBell} ptr :: IO CBool))
400           <*> #{peek GC_FLAGS, idleGCDelayTime} ptr
401           <*> (toBool <$>
402                 (#{peek GC_FLAGS, doIdleGC} ptr :: IO CBool))
403           <*> #{peek GC_FLAGS, heapBase} ptr
404           <*> #{peek GC_FLAGS, allocLimitGrace} ptr
405           <*> (toBool <$>
406                 (#{peek GC_FLAGS, numa} ptr :: IO CBool))
407           <*> #{peek GC_FLAGS, numaMask} ptr
408
409 getParFlags :: IO ParFlags
410 getParFlags = do
411   let ptr = (#ptr RTS_FLAGS, ParFlags) rtsFlagsPtr
412   ParFlags
413     <$> #{peek PAR_FLAGS, nCapabilities} ptr
414     <*> (toBool <$>
415           (#{peek PAR_FLAGS, migrate} ptr :: IO CBool))
416     <*> #{peek PAR_FLAGS, maxLocalSparks} ptr
417     <*> (toBool <$>
418           (#{peek PAR_FLAGS, parGcEnabled} ptr :: IO CBool))
419     <*> #{peek PAR_FLAGS, parGcGen} ptr
420     <*> (toBool <$>
421           (#{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr :: IO CBool))
422     <*> #{peek PAR_FLAGS, parGcLoadBalancingGen} ptr
423     <*> #{peek PAR_FLAGS, parGcNoSyncWithIdle} ptr
424     <*> #{peek PAR_FLAGS, parGcThreads} ptr
425     <*> (toBool <$>
426           (#{peek PAR_FLAGS, setAffinity} ptr :: IO CBool))
427
428 getConcFlags :: IO ConcFlags
429 getConcFlags = do
430   let ptr = (#ptr RTS_FLAGS, ConcFlags) rtsFlagsPtr
431   ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
432             <*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr
433
434 getMiscFlags :: IO MiscFlags
435 getMiscFlags = do
436   let ptr = (#ptr RTS_FLAGS, MiscFlags) rtsFlagsPtr
437   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
438             <*> (toBool <$>
439                   (#{peek MISC_FLAGS, install_signal_handlers} ptr :: IO CBool))
440             <*> (toBool <$>
441                   (#{peek MISC_FLAGS, install_seh_handlers} ptr :: IO CBool))
442             <*> (toBool <$>
443                   (#{peek MISC_FLAGS, generate_dump_file} ptr :: IO CBool))
444             <*> (toBool <$>
445                   (#{peek MISC_FLAGS, generate_stack_trace} ptr :: IO CBool))
446             <*> (toBool <$>
447                   (#{peek MISC_FLAGS, machineReadable} ptr :: IO CBool))
448             <*> (toBool <$>
449                   (#{peek MISC_FLAGS, internalCounters} ptr :: IO CBool))
450             <*> #{peek MISC_FLAGS, linkerMemBase} ptr
451
452 getDebugFlags :: IO DebugFlags
453 getDebugFlags = do
454   let ptr = (#ptr RTS_FLAGS, DebugFlags) rtsFlagsPtr
455   DebugFlags <$> (toBool <$>
456                    (#{peek DEBUG_FLAGS, scheduler} ptr :: IO CBool))
457              <*> (toBool <$>
458                    (#{peek DEBUG_FLAGS, interpreter} ptr :: IO CBool))
459              <*> (toBool <$>
460                    (#{peek DEBUG_FLAGS, weak} ptr :: IO CBool))
461              <*> (toBool <$>
462                    (#{peek DEBUG_FLAGS, gccafs} ptr :: IO CBool))
463              <*> (toBool <$>
464                    (#{peek DEBUG_FLAGS, gc} ptr :: IO CBool))
465              <*> (toBool <$>
466                    (#{peek DEBUG_FLAGS, nonmoving_gc} ptr :: IO CBool))
467              <*> (toBool <$>
468                    (#{peek DEBUG_FLAGS, block_alloc} ptr :: IO CBool))
469              <*> (toBool <$>
470                    (#{peek DEBUG_FLAGS, sanity} ptr :: IO CBool))
471              <*> (toBool <$>
472                    (#{peek DEBUG_FLAGS, stable} ptr :: IO CBool))
473              <*> (toBool <$>
474                    (#{peek DEBUG_FLAGS, prof} ptr :: IO CBool))
475              <*> (toBool <$>
476                    (#{peek DEBUG_FLAGS, linker} ptr :: IO CBool))
477              <*> (toBool <$>
478                    (#{peek DEBUG_FLAGS, apply} ptr :: IO CBool))
479              <*> (toBool <$>
480                    (#{peek DEBUG_FLAGS, stm} ptr :: IO CBool))
481              <*> (toBool <$>
482                    (#{peek DEBUG_FLAGS, squeeze} ptr :: IO CBool))
483              <*> (toBool <$>
484                    (#{peek DEBUG_FLAGS, hpc} ptr :: IO CBool))
485              <*> (toBool <$>
486                    (#{peek DEBUG_FLAGS, sparks} ptr :: IO CBool))
487
488 getCCFlags :: IO CCFlags
489 getCCFlags = do
490   let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
491   CCFlags <$> (toEnum . fromIntegral
492                 <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Word32))
493           <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
494           <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
495
496 getProfFlags :: IO ProfFlags
497 getProfFlags = do
498   let ptr = (#ptr RTS_FLAGS, ProfFlags) rtsFlagsPtr
499   ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
500             <*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
501             <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
502             <*> (toBool <$>
503                   (#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool))
504             <*> (toBool <$>
505                   (#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool))
506             <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
507             <*> #{peek PROFILING_FLAGS, ccsLength} ptr
508             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
509             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, descrSelector} ptr)
510             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, typeSelector} ptr)
511             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccSelector} ptr)
512             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccsSelector} ptr)
513             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
514             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
515
516 getTraceFlags :: IO TraceFlags
517 getTraceFlags = do
518   let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
519   TraceFlags <$> (toEnum . fromIntegral
520                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
521              <*> (toBool <$>
522                    (#{peek TRACE_FLAGS, timestamp} ptr :: IO CBool))
523              <*> (toBool <$>
524                    (#{peek TRACE_FLAGS, scheduler} ptr :: IO CBool))
525              <*> (toBool <$>
526                    (#{peek TRACE_FLAGS, gc} ptr :: IO CBool))
527              <*> (toBool <$>
528                    (#{peek TRACE_FLAGS, nonmoving_gc} ptr :: IO CBool))
529              <*> (toBool <$>
530                    (#{peek TRACE_FLAGS, sparks_sampled} ptr :: IO CBool))
531              <*> (toBool <$>
532                    (#{peek TRACE_FLAGS, sparks_full} ptr :: IO CBool))
533              <*> (toBool <$>
534                    (#{peek TRACE_FLAGS, user} ptr :: IO CBool))
535
536 getTickyFlags :: IO TickyFlags
537 getTickyFlags = do
538   let ptr = (#ptr RTS_FLAGS, TickyFlags) rtsFlagsPtr
539   TickyFlags <$> (toBool <$>
540                    (#{peek TICKY_FLAGS, showTickyStats} ptr :: IO CBool))
541              <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)