Rts flags cleanup
authorSimon Marlow <marlowsd@gmail.com>
Mon, 23 May 2016 09:42:31 +0000 (10:42 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 10 Jun 2016 20:25:54 +0000 (21:25 +0100)
* Remove unused/old flags from the structs
* Update old comments
* Add missing flags to GHC.RTS
* Simplify GHC.RTS, remove C code and use hsc2hs instead
* Make ParFlags unconditional, and add support to GHC.RTS

includes/rts/Flags.h
includes/rts/storage/GC.h
libraries/base/GHC/RTS/Flags.hsc
libraries/base/base.cabal
libraries/base/cbits/rts.c [deleted file]
rts/sm/GC.c
rts/sm/GCAux.c

index ff303dc..e229aa1 100644 (file)
@@ -50,7 +50,6 @@ typedef struct _GC_FLAGS {
     double  pcFreeHeap;
 
     uint32_t     generations;
-    uint32_t     steps;
     rtsBool squeezeUpdFrames;
 
     rtsBool compact;           /* True <=> "compact all the time" */
@@ -59,7 +58,6 @@ typedef struct _GC_FLAGS {
     rtsBool sweep;             /* use "mostly mark-sweep" instead of copying
                                  * for the oldest generation */
     rtsBool ringBell;
-    rtsBool frontpanel;
 
     Time    idleGCDelayTime;    /* units: TIME_RESOLUTION */
     rtsBool doIdleGC;
@@ -187,7 +185,6 @@ typedef struct _MISC_FLAGS {
                                   * for the linker, NULL ==> off */
 } MISC_FLAGS;
 
-#ifdef THREADED_RTS
 /* See Note [Synchronization of flags and base APIs] */
 typedef struct _PAR_FLAGS {
   uint32_t       nCapabilities;  /* number of threads to run simultaneously */
@@ -216,7 +213,6 @@ typedef struct _PAR_FLAGS {
 
   rtsBool        setAffinity;    /* force thread affinity with CPUs */
 } PAR_FLAGS;
-#endif /* THREADED_RTS */
 
 /* See Note [Synchronization of flags and base APIs] */
 typedef struct _TICKY_FLAGS {
@@ -237,10 +233,7 @@ typedef struct _RTS_FLAGS {
     PROFILING_FLAGS   ProfFlags;
     TRACE_FLAGS       TraceFlags;
     TICKY_FLAGS              TickyFlags;
-
-#if defined(THREADED_RTS)
     PAR_FLAGS        ParFlags;
-#endif
 } RTS_FLAGS;
 
 #ifdef COMPILING_RTS_MAIN
index 04548be..4aa44bd 100644 (file)
 /* -----------------------------------------------------------------------------
  * Generational GC
  *
- * We support an arbitrary number of generations, with an arbitrary number
- * of steps per generation.  Notes (in no particular order):
+ * We support an arbitrary number of generations.  Notes (in no particular
+ * order):
  *
- *       - all generations except the oldest should have the same
- *         number of steps.  Multiple steps gives objects a decent
- *         chance to age before being promoted, and helps ensure that
- *         we don't end up with too many thunks being updated in older
- *         generations.
+ *       - Objects "age" in the nursery for one GC cycle before being promoted
+ *         to the next generation.  There is no aging in other generations.
  *
- *       - the oldest generation has one step.  There's no point in aging
- *         objects in the oldest generation.
- *
- *       - generation 0, step 0 (G0S0) is the allocation area.  It is given
+ *       - generation 0 is the allocation area.  It is given
  *         a fixed set of blocks during initialisation, and these blocks
  *         normally stay in G0S0.  In parallel execution, each
  *         Capability has its own nursery.
  *
- *       - during garbage collection, each step which is an evacuation
- *         destination (i.e. all steps except G0S0) is allocated a to-space.
- *         evacuated objects are allocated into the step's to-space until
- *         GC is finished, when the original step's contents may be freed
- *         and replaced by the to-space.
+ *       - during garbage collection, each generation which is an
+ *         evacuation destination (i.e. all generations except G0) is
+ *         allocated a to-space.  evacuated objects are allocated into
+ *         the generation's to-space until GC is finished, when the
+ *         original generations's contents may be freed and replaced
+ *         by the to-space.
  *
- *       - the mutable-list is per-generation (not per-step).  G0 doesn't
- *         have one (since every garbage collection collects at least G0).
+ *       - the mutable-list is per-generation.  G0 doesn't have one
+ *         (since every garbage collection collects at least G0).
  *
- *       - block descriptors contain pointers to both the step and the
- *         generation that the block belongs to, for convenience.
+ *       - block descriptors contain a pointer to the generation that
+ *         the block belongs to, for convenience.
  *
  *       - static objects are stored in per-generation lists.  See GC.c for
  *         details of how we collect CAFs in the generational scheme.
  *
- *       - large objects are per-step, and are promoted in the same way
- *         as small objects, except that we may allocate large objects into
- *         generation 1 initially.
+ *       - large objects are per-generation, and are promoted in the
+ *         same way as small objects.
  *
  * ------------------------------------------------------------------------- */
 
index b83963e..e067019 100644 (file)
@@ -10,7 +10,6 @@
 --
 module GHC.RTS.Flags
   ( RtsTime
-  , RtsNat
   , RTSFlags (..)
   , GiveGCStats (..)
   , GCFlags (..)
@@ -24,6 +23,7 @@ module GHC.RTS.Flags
   , DoTrace (..)
   , TraceFlags (..)
   , TickyFlags (..)
+  , ParFlags (..)
   , getRTSFlags
   , getGCFlags
   , getConcFlags
@@ -33,6 +33,7 @@ module GHC.RTS.Flags
   , getProfFlags
   , getTraceFlags
   , getTickyFlags
+  , getParFlags
   ) where
 
 #include "Rts.h"
@@ -41,28 +42,20 @@ module GHC.RTS.Flags
 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 Foreign
+import Foreign.C
 
 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@
 --
 -- @since 4.8.2.0
 type RtsTime = Word64
 
--- | @'nat'@ defined in @rts/Types.h@
---
--- @since 4.8.2.0
-type RtsNat = #{type unsigned int}
-
 -- | Should we produce a summary of the garbage collector statistics after the
 -- program has exited?
 --
@@ -96,30 +89,32 @@ instance Enum GiveGCStats where
 data GCFlags = GCFlags
     { statsFile             :: Maybe FilePath
     , giveStats             :: GiveGCStats
-    , maxStkSize            :: RtsNat
-    , initialStkSize        :: RtsNat
-    , stkChunkSize          :: RtsNat
-    , stkChunkBufferSize    :: RtsNat
-    , maxHeapSize           :: RtsNat
-    , minAllocAreaSize      :: RtsNat
-    , minOldGenSize         :: RtsNat
-    , heapSizeSuggestion    :: RtsNat
+    , maxStkSize            :: Word32
+    , initialStkSize        :: Word32
+    , stkChunkSize          :: Word32
+    , stkChunkBufferSize    :: Word32
+    , maxHeapSize           :: Word32
+    , minAllocAreaSize      :: Word32
+    , largeAllocLim         :: Word32
+    , nurseryChunkSize      :: Word32
+    , minOldGenSize         :: Word32
+    , heapSizeSuggestion    :: Word32
     , heapSizeSuggestionAuto :: Bool
     , oldGenFactor          :: Double
     , pcFreeHeap            :: Double
-    , generations           :: RtsNat
-    , steps                 :: RtsNat
+    , generations           :: Word32
     , 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       :: RtsTime
     , doIdleGC              :: Bool
     , heapBase              :: Word -- ^ address to ask the OS for memory
     , allocLimitGrace       :: Word
+    , numa                  :: Bool
+    , nNumaNodes            :: Word32
     } deriving (Show)
 
 -- | Parameters concerning context switching
@@ -294,6 +289,23 @@ data TickyFlags = TickyFlags
     , tickyFile      :: Maybe FilePath
     } deriving (Show)
 
+-- | Parameters pertaining to parallelism
+--
+-- @since 4.8.0.0
+data ParFlags = ParFlags
+    { nCapabilities :: Word32
+    , migrate :: Bool
+    , maxLocalSparks :: Word32
+    , parGcEnabled :: Bool
+    , parGcGen :: Word32
+    , parGcLoadBalancingEnabled :: Bool
+    , parGcLoadBalancingGen :: Word32
+    , parGcNoSyncWithIdle :: Word32
+    , parGcThreads :: Word32
+    , setAffinity :: Bool
+    }
+    deriving (Show)
+
 -- | Parameters of the runtime system
 --
 -- @since 4.8.0.0
@@ -306,30 +318,10 @@ data RTSFlags = RTSFlags
     , profilingFlags  :: ProfFlags
     , traceFlags      :: TraceFlags
     , tickyFlags      :: TickyFlags
+    , parFlags        :: ParFlags
     } 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 ())
+foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr RTSFlags
 
 getRTSFlags :: IO RTSFlags
 getRTSFlags = do
@@ -341,6 +333,7 @@ getRTSFlags = do
            <*> getProfFlags
            <*> getTraceFlags
            <*> getTickyFlags
+           <*> getParFlags
 
 peekFilePath :: Ptr () -> IO (Maybe FilePath)
 peekFilePath ptr
@@ -355,43 +348,60 @@ peekCStringOpt ptr
 
 getGCFlags :: IO GCFlags
 getGCFlags = do
-  ptr <- getGcFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
   GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
           <*> (toEnum . fromIntegral <$>
-                (#{peek GC_FLAGS, giveStats} ptr :: IO RtsNat))
+                (#{peek GC_FLAGS, giveStats} ptr :: IO Word32))
           <*> #{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, largeAllocLim} ptr
+          <*> #{peek GC_FLAGS, nurseryChunkSize} 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
+          <*> #{peek GC_FLAGS, numa} ptr
+          <*> #{peek GC_FLAGS, nNumaNodes} ptr
+
+getParFlags :: IO ParFlags
+getParFlags = do
+  let ptr = (#ptr RTS_FLAGS, ParFlags) rtsFlagsPtr
+  ParFlags
+    <$> #{peek PAR_FLAGS, nCapabilities} ptr
+    <*> #{peek PAR_FLAGS, migrate} ptr
+    <*> #{peek PAR_FLAGS, maxLocalSparks} ptr
+    <*> #{peek PAR_FLAGS, parGcEnabled} ptr
+    <*> #{peek PAR_FLAGS, parGcGen} ptr
+    <*> #{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr
+    <*> #{peek PAR_FLAGS, parGcLoadBalancingGen} ptr
+    <*> #{peek PAR_FLAGS, parGcNoSyncWithIdle} ptr
+    <*> #{peek PAR_FLAGS, parGcThreads} ptr
+    <*> #{peek PAR_FLAGS, setAffinity} ptr
 
 getConcFlags :: IO ConcFlags
 getConcFlags = do
-  ptr <- getConcFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, ConcFlags) rtsFlagsPtr
   ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
             <*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr
 
 getMiscFlags :: IO MiscFlags
 getMiscFlags = do
-  ptr <- getMiscFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, MiscFlags) rtsFlagsPtr
   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
             <*> #{peek MISC_FLAGS, install_signal_handlers} ptr
             <*> #{peek MISC_FLAGS, machineReadable} ptr
@@ -399,7 +409,7 @@ getMiscFlags = do
 
 getDebugFlags :: IO DebugFlags
 getDebugFlags = do
-  ptr <- getDebugFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, DebugFlags) rtsFlagsPtr
   DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
              <*> #{peek DEBUG_FLAGS, interpreter} ptr
              <*> #{peek DEBUG_FLAGS, weak} ptr
@@ -418,15 +428,15 @@ getDebugFlags = do
 
 getCCFlags :: IO CCFlags
 getCCFlags = do
-  ptr <- getCcFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, GcFlags) rtsFlagsPtr
   CCFlags <$> (toEnum . fromIntegral
-                <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO RtsNat))
+                <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Word32))
           <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
           <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
 
 getProfFlags :: IO ProfFlags
 getProfFlags = do
-  ptr <- getProfFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, ProfFlags) rtsFlagsPtr
   ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
             <*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
             <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
@@ -444,7 +454,7 @@ getProfFlags = do
 
 getTraceFlags :: IO TraceFlags
 getTraceFlags = do
-  ptr <- getTraceFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
   TraceFlags <$> (toEnum . fromIntegral
                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
              <*> #{peek TRACE_FLAGS, timestamp} ptr
@@ -456,6 +466,6 @@ getTraceFlags = do
 
 getTickyFlags :: IO TickyFlags
 getTickyFlags = do
-  ptr <- getTickyFlagsPtr
+  let ptr = (#ptr RTS_FLAGS, TickyFlags) rtsFlagsPtr
   TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
              <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)
index 2d1a998..e068bbc 100644 (file)
@@ -323,7 +323,6 @@ 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
deleted file mode 100644 (file)
index dcc7365..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-#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;
-}
index 3bfdaa2..5479871 100644 (file)
@@ -303,11 +303,11 @@ GarbageCollect (uint32_t collect_gen,
   // and put them on the g0->large_object list.
   collect_pinned_object_blocks();
 
-  // Initialise all the generations/steps that we're collecting.
+  // Initialise all the generations that we're collecting.
   for (g = 0; g <= N; g++) {
       prepare_collected_gen(&generations[g]);
   }
-  // Initialise all the generations/steps that we're *not* collecting.
+  // Initialise all the generations that we're *not* collecting.
   for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
       prepare_uncollected_gen(&generations[g]);
   }
@@ -479,7 +479,7 @@ GarbageCollect (uint32_t collect_gen,
       }
   }
 
-  // Run through all the generations/steps and tidy up.
+  // Run through all the generations and tidy up.
   // We're going to:
   //   - count the amount of "live" data (live_words, live_blocks)
   //   - count the amount of "copied" data in this GC (copied)
@@ -523,7 +523,7 @@ GarbageCollect (uint32_t collect_gen,
     if (g <= N) {
 
         /* free old memory and shift to-space into from-space for all
-         * the collected steps (except the allocation area).  These
+         * the collected generations (except the allocation area).  These
          * freed blocks will probaby be quickly recycled.
          */
         if (gen->mark)
index 6740cdc..6265bf9 100644 (file)
@@ -70,7 +70,7 @@ isAlive(StgClosure *p)
         return NULL;
     }
 
-    // check the mark bit for compacted steps
+    // check the mark bit for compacted generations
     if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) {
         return p;
     }