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