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

5 files changed, 502 insertions, 30 deletions

diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index ec542701df..b707a20edc 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -18,7 +18,14 @@
 
 /* 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;
     nat	    giveStats;
 #define NO_GC_STATS	 0
@@ -64,9 +71,10 @@ struct GC_FLAGS {
                                  * to handle the exception before we
                                  * 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 */
     rtsBool scheduler;      /* 's' */
     rtsBool interpreter;    /* 'i' */
@@ -83,10 +91,12 @@ struct DEBUG_FLAGS {
     rtsBool squeeze;        /* 'z'  stack squeezing & lazy blackholing */
     rtsBool hpc; 	    /* 'c' coverage */
     rtsBool sparks; 	    /* 'r' */
-};
+} DEBUG_FLAGS;
 
-struct COST_CENTRE_FLAGS {
+/* See Note [Synchronization of flags and base APIs] */
+typedef struct _COST_CENTRE_FLAGS {
     nat	    doCostCentres;
+# define COST_CENTRES_NONE      0
 # define COST_CENTRES_SUMMARY	1
 # define COST_CENTRES_VERBOSE	2 /* incl. serial time profile */
 # define COST_CENTRES_ALL	3
@@ -94,9 +104,10 @@ struct COST_CENTRE_FLAGS {
 
     int	    profilerTicks;   /* derived */
     int	    msecsPerTick;    /* derived */
-};
+} COST_CENTRE_FLAGS;
 
-struct PROFILING_FLAGS {
+/* See Note [Synchronization of flags and base APIs] */
+typedef struct _PROFILING_FLAGS {
     nat	doHeapProfile;
 # define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */
 # define HEAP_BY_CCS		1
@@ -127,13 +138,14 @@ struct PROFILING_FLAGS {
     char*               retainerSelector;
     char*               bioSelector;
 
-};
+} PROFILING_FLAGS;
 
 #define TRACE_NONE      0
 #define TRACE_EVENTLOG  1
 #define TRACE_STDERR    2
 
-struct TRACE_FLAGS {
+/* See Note [Synchronization of flags and base APIs] */
+typedef struct _TRACE_FLAGS {
     int tracing;
     rtsBool timestamp;      /* show timestamp in stderr output */
     rtsBool scheduler;      /* trace scheduler events */
@@ -141,12 +153,13 @@ struct TRACE_FLAGS {
     rtsBool sparks_sampled; /* trace spark events by a sampled method */
     rtsBool sparks_full;    /* trace spark events 100% accurately */
     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 */
     int ctxtSwitchTicks;         /* derived */
-};
+} CONCURRENT_FLAGS;
 
 /*
  * The tickInterval is the time interval between "ticks", ie.
@@ -157,16 +170,18 @@ struct CONCURRENT_FLAGS {
  */
 #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 */
     rtsBool install_signal_handlers;
     rtsBool machineReadable;
     StgWord linkerMemBase;       /* address to ask the OS for memory
                                   * for the linker, NULL ==> off */
-};
+} MISC_FLAGS;
 
 #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 */
   rtsBool        migrate;        /* migrate threads between capabilities */
   nat            maxLocalSparks;
@@ -188,24 +203,26 @@ struct PAR_FLAGS {
                                   * (zero disables) */
 
   rtsBool        setAffinity;    /* force thread affinity with CPUs */
-};
+} PAR_FLAGS;
 #endif /* THREADED_RTS */
 
-struct TICKY_FLAGS {
+/* See Note [Synchronization of flags and base APIs] */
+typedef struct _TICKY_FLAGS {
     rtsBool showTickyStats;
     FILE   *tickyFile;
-};
+} TICKY_FLAGS;
 
 #ifdef USE_PAPI
 #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     numUserEvents;
     char *  userEvents[MAX_PAPI_USER_EVENTS];
     /* Allow user to enter either PAPI preset or native events */
     nat     userEventsKind[MAX_PAPI_USER_EVENTS];
-};
+} PAPI_FLAGS;
 
 #define PAPI_FLAG_CACHE_L1 1
 #define PAPI_FLAG_CACHE_L2 2
@@ -220,22 +237,23 @@ struct PAPI_FLAGS {
 
 /* Put them together: */
 
+/* See Note [Synchronization of flags and base APIs] */
 typedef struct _RTS_FLAGS {
     /* The first portion of RTS_FLAGS is invariant. */
-    struct GC_FLAGS	     GcFlags;
-    struct CONCURRENT_FLAGS  ConcFlags;
-    struct MISC_FLAGS        MiscFlags;
-    struct DEBUG_FLAGS	     DebugFlags;
-    struct COST_CENTRE_FLAGS CcFlags;
-    struct PROFILING_FLAGS   ProfFlags;
-    struct TRACE_FLAGS       TraceFlags;
-    struct TICKY_FLAGS	     TickyFlags;
+    GC_FLAGS	      GcFlags;
+    CONCURRENT_FLAGS  ConcFlags;
+    MISC_FLAGS        MiscFlags;
+    DEBUG_FLAGS	      DebugFlags;
+    COST_CENTRE_FLAGS CcFlags;
+    PROFILING_FLAGS   ProfFlags;
+    TRACE_FLAGS       TraceFlags;
+    TICKY_FLAGS	      TickyFlags;
 
 #if defined(THREADED_RTS)
-    struct PAR_FLAGS	ParFlags;
+    PAR_FLAGS	      ParFlags;
 #endif
 #ifdef USE_PAPI
-    struct PAPI_FLAGS   PapiFlags;
+    PAPI_FLAGS        PapiFlags;
 #endif
 } RTS_FLAGS;
 
diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc
new file mode 100644
index 0000000000..1d75568061
--- /dev/null
+++ b/libraries/base/GHC/RTS/Flags.hsc
@@ -0,0 +1,408 @@
+{-# 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
+  ptr <- getTickyFlagsPtr
+  TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
+             <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index b6b5a5983f..e39a08d401 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -253,6 +253,7 @@ Library
         GHC.Ptr
         GHC.Read
         GHC.Real
+        GHC.RTS.Flags
         GHC.ST
         GHC.STRef
         GHC.Show
@@ -309,6 +310,7 @@ Library
         cbits/inputReady.c
         cbits/md5.c
         cbits/primFloat.c
+        cbits/rts.c
         cbits/sysconf.c
 
     include-dirs: include
diff --git a/libraries/base/cbits/rts.c b/libraries/base/cbits/rts.c
new file mode 100644
index 0000000000..dcc7365fb3
--- /dev/null
+++ b/libraries/base/cbits/rts.c
@@ -0,0 +1,42 @@
+#include "Rts.h"
+#include "rts/Flags.h"
+
+GC_FLAGS *getGcFlags()
+{
+    return &RtsFlags.GcFlags;
+}
+
+CONCURRENT_FLAGS *getConcFlags()
+{
+    return &RtsFlags.ConcFlags;
+}
+
+MISC_FLAGS *getMiscFlags()
+{
+    return &RtsFlags.MiscFlags;
+}
+
+DEBUG_FLAGS *getDebugFlags()
+{
+    return &RtsFlags.DebugFlags;
+}
+
+COST_CENTRE_FLAGS *getCcFlags()
+{
+    return &RtsFlags.CcFlags;
+}
+
+PROFILING_FLAGS *getProfFlags()
+{
+    return &RtsFlags.ProfFlags;
+}
+
+TRACE_FLAGS *getTraceFlags()
+{
+    return &RtsFlags.TraceFlags;
+}
+
+TICKY_FLAGS *getTickyFlags()
+{
+    return &RtsFlags.TickyFlags;
+}
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index c7de12e55a..df3d9d4e9c 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -117,6 +117,8 @@
 
   * Add `Storable a => Storable (Complex a)` instance (#9826)
 
+  * New module `GHC.RTS.Flags` that provides accessors to runtime flags.
+
 ## 4.7.0.1  *Jul 2014*
 
   * Bundled with GHC 7.8.3