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