Commit 1617a10a authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Austin Seipp
Browse files

accessors to RTS flag values -- #5364

Summary: Implementation of #5364. Mostly boilerplate, reading FILE fields is missing.

Test Plan:
- Get some feedback on missing parts. (FILE fields)
- Get some feedback on module name.
- Get some feedback on other things.
- Get code reviewed.
- Make sure test suite is passing. (I haven't run it myself)

Reviewers: hvr, austin, ezyang

Reviewed By: ezyang

Subscribers: ekmett, simonmar, ezyang, carter, thomie

Differential Revision: https://phabricator.haskell.org/D306

GHC Trac Issues: #5364

Conflicts:
	includes/rts/Flags.h
parent a7c29721
...@@ -18,7 +18,14 @@ ...@@ -18,7 +18,14 @@
/* For defaults, see the @initRtsFlagsDefaults@ routine. */ /* For defaults, see the @initRtsFlagsDefaults@ routine. */
struct GC_FLAGS { /* Note [Synchronization of flags and base APIs]
*
* We provide accessors to RTS flags in base. (GHC.RTS module)
* The API should be updated whenever RTS flags are modified.
*/
/* See Note [Synchronization of flags and base APIs] */
typedef struct _GC_FLAGS {
FILE *statsFile; FILE *statsFile;
nat giveStats; nat giveStats;
#define NO_GC_STATS 0 #define NO_GC_STATS 0
...@@ -64,9 +71,10 @@ struct GC_FLAGS { ...@@ -64,9 +71,10 @@ struct GC_FLAGS {
* to handle the exception before we * to handle the exception before we
* raise it again. * raise it again.
*/ */
}; } GC_FLAGS;
struct DEBUG_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _DEBUG_FLAGS {
/* flags to control debugging output & extra checking in various subsystems */ /* flags to control debugging output & extra checking in various subsystems */
rtsBool scheduler; /* 's' */ rtsBool scheduler; /* 's' */
rtsBool interpreter; /* 'i' */ rtsBool interpreter; /* 'i' */
...@@ -83,10 +91,12 @@ struct DEBUG_FLAGS { ...@@ -83,10 +91,12 @@ struct DEBUG_FLAGS {
rtsBool squeeze; /* 'z' stack squeezing & lazy blackholing */ rtsBool squeeze; /* 'z' stack squeezing & lazy blackholing */
rtsBool hpc; /* 'c' coverage */ rtsBool hpc; /* 'c' coverage */
rtsBool sparks; /* 'r' */ rtsBool sparks; /* 'r' */
}; } DEBUG_FLAGS;
struct COST_CENTRE_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _COST_CENTRE_FLAGS {
nat doCostCentres; nat doCostCentres;
# define COST_CENTRES_NONE 0
# define COST_CENTRES_SUMMARY 1 # define COST_CENTRES_SUMMARY 1
# define COST_CENTRES_VERBOSE 2 /* incl. serial time profile */ # define COST_CENTRES_VERBOSE 2 /* incl. serial time profile */
# define COST_CENTRES_ALL 3 # define COST_CENTRES_ALL 3
...@@ -94,9 +104,10 @@ struct COST_CENTRE_FLAGS { ...@@ -94,9 +104,10 @@ struct COST_CENTRE_FLAGS {
int profilerTicks; /* derived */ int profilerTicks; /* derived */
int msecsPerTick; /* derived */ int msecsPerTick; /* derived */
}; } COST_CENTRE_FLAGS;
struct PROFILING_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _PROFILING_FLAGS {
nat doHeapProfile; nat doHeapProfile;
# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */ # define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */
# define HEAP_BY_CCS 1 # define HEAP_BY_CCS 1
...@@ -127,13 +138,14 @@ struct PROFILING_FLAGS { ...@@ -127,13 +138,14 @@ struct PROFILING_FLAGS {
char* retainerSelector; char* retainerSelector;
char* bioSelector; char* bioSelector;
}; } PROFILING_FLAGS;
#define TRACE_NONE 0 #define TRACE_NONE 0
#define TRACE_EVENTLOG 1 #define TRACE_EVENTLOG 1
#define TRACE_STDERR 2 #define TRACE_STDERR 2
struct TRACE_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _TRACE_FLAGS {
int tracing; int tracing;
rtsBool timestamp; /* show timestamp in stderr output */ rtsBool timestamp; /* show timestamp in stderr output */
rtsBool scheduler; /* trace scheduler events */ rtsBool scheduler; /* trace scheduler events */
...@@ -141,12 +153,13 @@ struct TRACE_FLAGS { ...@@ -141,12 +153,13 @@ struct TRACE_FLAGS {
rtsBool sparks_sampled; /* trace spark events by a sampled method */ rtsBool sparks_sampled; /* trace spark events by a sampled method */
rtsBool sparks_full; /* trace spark events 100% accurately */ rtsBool sparks_full; /* trace spark events 100% accurately */
rtsBool user; /* trace user events (emitted from Haskell code) */ rtsBool user; /* trace user events (emitted from Haskell code) */
}; } TRACE_FLAGS;
struct CONCURRENT_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _CONCURRENT_FLAGS {
Time ctxtSwitchTime; /* units: TIME_RESOLUTION */ Time ctxtSwitchTime; /* units: TIME_RESOLUTION */
int ctxtSwitchTicks; /* derived */ int ctxtSwitchTicks; /* derived */
}; } CONCURRENT_FLAGS;
/* /*
* The tickInterval is the time interval between "ticks", ie. * The tickInterval is the time interval between "ticks", ie.
...@@ -157,16 +170,18 @@ struct CONCURRENT_FLAGS { ...@@ -157,16 +170,18 @@ struct CONCURRENT_FLAGS {
*/ */
#define DEFAULT_TICK_INTERVAL USToTime(10000) #define DEFAULT_TICK_INTERVAL USToTime(10000)
struct MISC_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _MISC_FLAGS {
Time tickInterval; /* units: TIME_RESOLUTION */ Time tickInterval; /* units: TIME_RESOLUTION */
rtsBool install_signal_handlers; rtsBool install_signal_handlers;
rtsBool machineReadable; rtsBool machineReadable;
StgWord linkerMemBase; /* address to ask the OS for memory StgWord linkerMemBase; /* address to ask the OS for memory
* for the linker, NULL ==> off */ * for the linker, NULL ==> off */
}; } MISC_FLAGS;
#ifdef THREADED_RTS #ifdef THREADED_RTS
struct PAR_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _PAR_FLAGS {
nat nNodes; /* number of threads to run simultaneously */ nat nNodes; /* number of threads to run simultaneously */
rtsBool migrate; /* migrate threads between capabilities */ rtsBool migrate; /* migrate threads between capabilities */
nat maxLocalSparks; nat maxLocalSparks;
...@@ -188,24 +203,26 @@ struct PAR_FLAGS { ...@@ -188,24 +203,26 @@ struct PAR_FLAGS {
* (zero disables) */ * (zero disables) */
rtsBool setAffinity; /* force thread affinity with CPUs */ rtsBool setAffinity; /* force thread affinity with CPUs */
}; } PAR_FLAGS;
#endif /* THREADED_RTS */ #endif /* THREADED_RTS */
struct TICKY_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _TICKY_FLAGS {
rtsBool showTickyStats; rtsBool showTickyStats;
FILE *tickyFile; FILE *tickyFile;
}; } TICKY_FLAGS;
#ifdef USE_PAPI #ifdef USE_PAPI
#define MAX_PAPI_USER_EVENTS 8 #define MAX_PAPI_USER_EVENTS 8
struct PAPI_FLAGS { /* See Note [Synchronization of flags and base APIs] */
typedef struct _PAPI_FLAGS {
nat eventType; /* The type of events to count */ nat eventType; /* The type of events to count */
nat numUserEvents; nat numUserEvents;
char * userEvents[MAX_PAPI_USER_EVENTS]; char * userEvents[MAX_PAPI_USER_EVENTS];
/* Allow user to enter either PAPI preset or native events */ /* Allow user to enter either PAPI preset or native events */
nat userEventsKind[MAX_PAPI_USER_EVENTS]; nat userEventsKind[MAX_PAPI_USER_EVENTS];
}; } PAPI_FLAGS;
#define PAPI_FLAG_CACHE_L1 1 #define PAPI_FLAG_CACHE_L1 1
#define PAPI_FLAG_CACHE_L2 2 #define PAPI_FLAG_CACHE_L2 2
...@@ -220,22 +237,23 @@ struct PAPI_FLAGS { ...@@ -220,22 +237,23 @@ struct PAPI_FLAGS {
/* Put them together: */ /* Put them together: */
/* See Note [Synchronization of flags and base APIs] */
typedef struct _RTS_FLAGS { typedef struct _RTS_FLAGS {
/* The first portion of RTS_FLAGS is invariant. */ /* The first portion of RTS_FLAGS is invariant. */
struct GC_FLAGS GcFlags; GC_FLAGS GcFlags;
struct CONCURRENT_FLAGS ConcFlags; CONCURRENT_FLAGS ConcFlags;
struct MISC_FLAGS MiscFlags; MISC_FLAGS MiscFlags;
struct DEBUG_FLAGS DebugFlags; DEBUG_FLAGS DebugFlags;
struct COST_CENTRE_FLAGS CcFlags; COST_CENTRE_FLAGS CcFlags;
struct PROFILING_FLAGS ProfFlags; PROFILING_FLAGS ProfFlags;
struct TRACE_FLAGS TraceFlags; TRACE_FLAGS TraceFlags;
struct TICKY_FLAGS TickyFlags; TICKY_FLAGS TickyFlags;
#if defined(THREADED_RTS) #if defined(THREADED_RTS)
struct PAR_FLAGS ParFlags; PAR_FLAGS ParFlags;
#endif #endif
#ifdef USE_PAPI #ifdef USE_PAPI
struct PAPI_FLAGS PapiFlags; PAPI_FLAGS PapiFlags;
#endif #endif
} RTS_FLAGS; } RTS_FLAGS;
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
-- | Accessors to GHC RTS flags.
-- Descriptions of flags can be seen in
-- <https://www.haskell.org/ghc/docs/latest/html/users_guide/runtime-control.html GHC User's Guide>,
-- or by running RTS help message using @+RTS --help@.
--
-- /Since: 4.8.0.0/
--
module GHC.RTS.Flags
( RTSFlags (..)
, GCFlags (..)
, ConcFlags (..)
, MiscFlags (..)
, DebugFlags (..)
, CCFlags (..)
, ProfFlags (..)
, TraceFlags (..)
, TickyFlags (..)
, getRTSFlags
, getGCFlags
, getConcFlags
, getMiscFlags
, getDebugFlags
, getCCFlags
, getProfFlags
, getTraceFlags
, getTickyFlags
) where
#include "Rts.h"
#include "rts/Flags.h"
import Control.Applicative
import Control.Monad
import Foreign.C.String (peekCString)
import Foreign.C.Types (CChar, CInt)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peekByteOff)
import GHC.Base
import GHC.Enum
import GHC.IO
import GHC.Real
import GHC.Show
import GHC.Word
-- | @'Time'@ is defined as a @'StgWord64'@ in @stg/Types.h@
type Time = Word64
-- | @'nat'@ defined in @rts/Types.h@
type Nat = #{type unsigned int}
data GiveGCStats
= NoGCStats
| CollectGCStats
| OneLineGCStats
| SummaryGCStats
| VerboseGCStats
deriving (Show)
instance Enum GiveGCStats where
fromEnum NoGCStats = #{const NO_GC_STATS}
fromEnum CollectGCStats = #{const COLLECT_GC_STATS}
fromEnum OneLineGCStats = #{const ONELINE_GC_STATS}
fromEnum SummaryGCStats = #{const SUMMARY_GC_STATS}
fromEnum VerboseGCStats = #{const VERBOSE_GC_STATS}
toEnum #{const NO_GC_STATS} = NoGCStats
toEnum #{const COLLECT_GC_STATS} = CollectGCStats
toEnum #{const ONELINE_GC_STATS} = OneLineGCStats
toEnum #{const SUMMARY_GC_STATS} = SummaryGCStats
toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
toEnum e = error ("invalid enum for GiveGCStats: " ++ show e)
data GCFlags = GCFlags
{ statsFile :: Maybe FilePath
, giveStats :: GiveGCStats
, maxStkSize :: Nat
, initialStkSize :: Nat
, stkChunkSize :: Nat
, stkChunkBufferSize :: Nat
, maxHeapSize :: Nat
, minAllocAreaSize :: Nat
, minOldGenSize :: Nat
, heapSizeSuggestion :: Nat
, heapSizeSuggesionAuto :: Bool
, oldGenFactor :: Double
, pcFreeHeap :: Double
, generations :: Nat
, steps :: Nat
, squeezeUpdFrames :: Bool
, compact :: Bool -- ^ True <=> "compact all the time"
, compactThreshold :: Double
, sweep :: Bool
-- ^ use "mostly mark-sweep" instead of copying for the oldest generation
, ringBell :: Bool
, frontpanel :: Bool
, idleGCDelayTime :: Time
, doIdleGC :: Bool
, heapBase :: Word -- ^ address to ask the OS for memory
, allocLimitGrace :: Word
} deriving (Show)
data ConcFlags = ConcFlags
{ ctxtSwitchTime :: Time
, ctxtSwitchTicks :: Int
} deriving (Show)
data MiscFlags = MiscFlags
{ tickInterval :: Time
, installSignalHandlers :: Bool
, machineReadable :: Bool
, linkerMemBase :: Word
-- ^ address to ask the OS for memory for the linker, 0 ==> off
} deriving (Show)
-- | Flags to control debugging output & extra checking in various
-- subsystems.
data DebugFlags = DebugFlags
{ scheduler :: Bool -- ^ 's'
, interpreter :: Bool -- ^ 'i'
, weak :: Bool -- ^ 'w'
, gccafs :: Bool -- ^ 'G'
, gc :: Bool -- ^ 'g'
, block_alloc :: Bool -- ^ 'b'
, sanity :: Bool -- ^ 'S'
, stable :: Bool -- ^ 't'
, prof :: Bool -- ^ 'p'
, linker :: Bool -- ^ 'l' the object linker
, apply :: Bool -- ^ 'a'
, stm :: Bool -- ^ 'm'
, squeeze :: Bool -- ^ 'z' stack squeezing & lazy blackholing
, hpc :: Bool -- ^ 'c' coverage
, sparks :: Bool -- ^ 'r'
} deriving (Show)
data DoCostCentres
= CostCentresNone
| CostCentresSummary
| CostCentresVerbose
| CostCentresAll
| CostCentresXML
deriving (Show)
instance Enum DoCostCentres where
fromEnum CostCentresNone = #{const COST_CENTRES_NONE}
fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY}
fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE}
fromEnum CostCentresAll = #{const COST_CENTRES_ALL}
fromEnum CostCentresXML = #{const COST_CENTRES_XML}
toEnum #{const COST_CENTRES_NONE} = CostCentresNone
toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary
toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
toEnum #{const COST_CENTRES_ALL} = CostCentresAll
toEnum #{const COST_CENTRES_XML} = CostCentresXML
toEnum e = error ("invalid enum for DoCostCentres: " ++ show e)
data CCFlags = CCFlags
{ doCostCentres :: DoCostCentres
, profilerTicks :: Int
, msecsPerTick :: Int
} deriving (Show)
data DoHeapProfile
= NoHeapProfiling
| HeapByCCS
| HeapByMod
| HeapByDescr
| HeapByType
| HeapByRetainer
| HeapByLDV
| HeapByClosureType
deriving (Show)
instance Enum DoHeapProfile where
fromEnum NoHeapProfiling = #{const NO_HEAP_PROFILING}
fromEnum HeapByCCS = #{const HEAP_BY_CCS}
fromEnum HeapByMod = #{const HEAP_BY_MOD}
fromEnum HeapByDescr = #{const HEAP_BY_DESCR}
fromEnum HeapByType = #{const HEAP_BY_TYPE}
fromEnum HeapByRetainer = #{const HEAP_BY_RETAINER}
fromEnum HeapByLDV = #{const HEAP_BY_LDV}
fromEnum HeapByClosureType = #{const HEAP_BY_CLOSURE_TYPE}
toEnum #{const NO_HEAP_PROFILING} = NoHeapProfiling
toEnum #{const HEAP_BY_CCS} = HeapByCCS
toEnum #{const HEAP_BY_MOD} = HeapByMod
toEnum #{const HEAP_BY_DESCR} = HeapByDescr
toEnum #{const HEAP_BY_TYPE} = HeapByType
toEnum #{const HEAP_BY_RETAINER} = HeapByRetainer
toEnum #{const HEAP_BY_LDV} = HeapByLDV
toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
toEnum e = error ("invalid enum for DoHeapProfile: " ++ show e)
data ProfFlags = ProfFlags
{ doHeapProfile :: DoHeapProfile
, heapProfileInterval :: Time -- ^ time between samples
, heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived)
, includeTSOs :: Bool
, showCCSOnException :: Bool
, maxRetainerSetSize :: Word
, ccsLength :: Word
, modSelector :: Maybe String
, descrSelector :: Maybe String
, typeSelector :: Maybe String
, ccSelector :: Maybe String
, ccsSelector :: Maybe String
, retainerSelector :: Maybe String
, bioSelector :: Maybe String
} deriving (Show)
data DoTrace
= TraceNone
| TraceEventLog
| TraceStderr
deriving (Show)
instance Enum DoTrace where
fromEnum TraceNone = #{const TRACE_NONE}
fromEnum TraceEventLog = #{const TRACE_EVENTLOG}
fromEnum TraceStderr = #{const TRACE_STDERR}
toEnum #{const TRACE_NONE} = TraceNone
toEnum #{const TRACE_EVENTLOG} = TraceEventLog
toEnum #{const TRACE_STDERR} = TraceStderr
toEnum e = error ("invalid enum for DoTrace: " ++ show e)
data TraceFlags = TraceFlags
{ tracing :: DoTrace
, timestamp :: Bool -- ^ show timestamp in stderr output
, traceScheduler :: Bool -- ^ trace scheduler events
, traceGc :: Bool -- ^ trace GC events
, sparksSampled :: Bool -- ^ trace spark events by a sampled method
, sparksFull :: Bool -- ^ trace spark events 100% accurately
, user :: Bool -- ^ trace user events (emitted from Haskell code)
} deriving (Show)
data TickyFlags = TickyFlags
{ showTickyStats :: Bool
, tickyFile :: Maybe FilePath
} deriving (Show)
data RTSFlags = RTSFlags
{ gcFlags :: GCFlags
, concurrentFlags :: ConcFlags
, miscFlags :: MiscFlags
, debugFlags :: DebugFlags
, costCentreFlags :: CCFlags
, profilingFlags :: ProfFlags
, traceFlags :: TraceFlags
, tickyFlags :: TickyFlags
} deriving (Show)
foreign import ccall safe "getGcFlags"
getGcFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getConcFlags"
getConcFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getMiscFlags"
getMiscFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getDebugFlags"
getDebugFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getCcFlags"
getCcFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getProfFlags" getProfFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getTraceFlags"
getTraceFlagsPtr :: IO (Ptr ())
foreign import ccall safe "getTickyFlags"
getTickyFlagsPtr :: IO (Ptr ())
getRTSFlags :: IO RTSFlags
getRTSFlags = do
RTSFlags <$> getGCFlags
<*> getConcFlags
<*> getMiscFlags
<*> getDebugFlags
<*> getCCFlags
<*> getProfFlags
<*> getTraceFlags
<*> getTickyFlags
peekFilePath :: Ptr () -> IO (Maybe FilePath)
peekFilePath ptr
| ptr == nullPtr = return Nothing
| otherwise = return (Just "<filepath>")
-- | Read a NUL terminated string. Return Nothing in case of a NULL pointer.
peekCStringOpt :: Ptr CChar -> IO (Maybe String)
peekCStringOpt ptr
| ptr == nullPtr = return Nothing
| otherwise = Just <$> peekCString ptr
getGCFlags :: IO GCFlags
getGCFlags = do
ptr <- getGcFlagsPtr
GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
<*> (toEnum . fromIntegral <$>
(#{peek GC_FLAGS, giveStats} ptr :: IO Nat))
<*> #{peek GC_FLAGS, maxStkSize} ptr
<*> #{peek GC_FLAGS, initialStkSize} ptr
<*> #{peek GC_FLAGS, stkChunkSize} ptr
<*> #{peek GC_FLAGS, stkChunkBufferSize} ptr
<*> #{peek GC_FLAGS, maxHeapSize} ptr
<*> #{peek GC_FLAGS, minAllocAreaSize} ptr
<*> #{peek GC_FLAGS, minOldGenSize} ptr
<*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
<*> #{peek GC_FLAGS, heapSizeSuggestionAuto} ptr
<*> #{peek GC_FLAGS, oldGenFactor} ptr
<*> #{peek GC_FLAGS, pcFreeHeap} ptr
<*> #{peek GC_FLAGS, generations} ptr
<*> #{peek GC_FLAGS, steps} ptr
<*> #{peek GC_FLAGS, squeezeUpdFrames} ptr
<*> #{peek GC_FLAGS, compact} ptr
<*> #{peek GC_FLAGS, compactThreshold} ptr
<*> #{peek GC_FLAGS, sweep} ptr
<*> #{peek GC_FLAGS, ringBell} ptr
<*> #{peek GC_FLAGS, frontpanel} ptr
<*> #{peek GC_FLAGS, idleGCDelayTime} ptr
<*> #{peek GC_FLAGS, doIdleGC} ptr
<*> #{peek GC_FLAGS, heapBase} ptr
<*> #{peek GC_FLAGS, allocLimitGrace} ptr
getConcFlags :: IO ConcFlags
getConcFlags = do
ptr <- getConcFlagsPtr
ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
<*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr
getMiscFlags :: IO MiscFlags
getMiscFlags = do
ptr <- getMiscFlagsPtr
MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
<*> #{peek MISC_FLAGS, install_signal_handlers} ptr
<*> #{peek MISC_FLAGS, machineReadable} ptr
<*> #{peek MISC_FLAGS, linkerMemBase} ptr
getDebugFlags :: IO DebugFlags
getDebugFlags = do
ptr <- getDebugFlagsPtr
DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
<*> #{peek DEBUG_FLAGS, interpreter} ptr
<*> #{peek DEBUG_FLAGS, weak} ptr
<*> #{peek DEBUG_FLAGS, gccafs} ptr
<*> #{peek DEBUG_FLAGS, gc} ptr
<*> #{peek DEBUG_FLAGS, block_alloc} ptr
<*> #{peek DEBUG_FLAGS, sanity} ptr
<*> #{peek DEBUG_FLAGS, stable} ptr
<*> #{peek DEBUG_FLAGS, prof} ptr
<*> #{peek DEBUG_FLAGS, linker} ptr
<*> #{peek DEBUG_FLAGS, apply} ptr
<*> #{peek DEBUG_FLAGS, stm} ptr
<*> #{peek DEBUG_FLAGS, squeeze} ptr
<*> #{peek DEBUG_FLAGS, hpc} ptr
<*> #{peek DEBUG_FLAGS, sparks} ptr
getCCFlags :: IO CCFlags
getCCFlags = do
ptr <- getCcFlagsPtr
CCFlags <$> (toEnum . fromIntegral
<$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Nat))
<*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
<*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
getProfFlags :: IO ProfFlags
getProfFlags = do
ptr <- getProfFlagsPtr
ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
<*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
<*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
<*> #{peek PROFILING_FLAGS, includeTSOs} ptr
<*> #{peek PROFILING_FLAGS, showCCSOnException} ptr
<*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
<*> #{peek PROFILING_FLAGS, ccsLength} ptr
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, descrSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, typeSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccsSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
getTraceFlags :: IO TraceFlags
getTraceFlags = do
ptr <- getTraceFlagsPtr
TraceFlags <$> (toEnum . fromIntegral
<$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
<*> #{peek TRACE_FLAGS, timestamp} ptr
<*> #{peek TRACE_FLAGS, scheduler} ptr
<*> #{peek TRACE_FLAGS, gc} ptr
<*> #{peek TRACE_FLAGS, sparks_sampled} ptr
<*> #{peek TRACE_FLAGS, sparks_full} ptr
<*> #{peek TRACE_FLAGS, user} ptr
getTickyFlags :: IO TickyFlags
getTickyFlags = do
pt