summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2016-05-23 10:42:31 +0100
committerSimon Marlow <marlowsd@gmail.com>2016-06-10 21:25:54 +0100
commitc88f31a08943764217b69adb1085ba423c9bcf91 (patch)
treec6bab224ac6646e12b693036d87013c8349f29cf
parent9e5ea67e268be2659cd30ebaed7044d298198ab0 (diff)
downloadhaskell-c88f31a08943764217b69adb1085ba423c9bcf91.tar.gz
Rts flags cleanup
* 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
-rw-r--r--includes/rts/Flags.h7
-rw-r--r--includes/rts/storage/GC.h40
-rw-r--r--libraries/base/GHC/RTS/Flags.hsc122
-rw-r--r--libraries/base/base.cabal1
-rw-r--r--libraries/base/cbits/rts.c42
-rw-r--r--rts/sm/GC.c8
-rw-r--r--rts/sm/GCAux.c2
7 files changed, 88 insertions, 134 deletions
diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index ff303dc5e6..e229aa12b1 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -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
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index 04548be379..4aa44bd344 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -15,41 +15,35 @@
/* -----------------------------------------------------------------------------
* 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.
*
* ------------------------------------------------------------------------- */
diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc
index b83963ec4f..e067019a8c 100644
--- a/libraries/base/GHC/RTS/Flags.hsc
+++ b/libraries/base/GHC/RTS/Flags.hsc
@@ -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)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 2d1a998c95..e068bbc9a1 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -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
index dcc7365fb3..0000000000
--- a/libraries/base/cbits/rts.c
+++ /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;
-}
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 3bfdaa25ff..54798719a4 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -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)
diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c
index 6740cdc99c..6265bf9ca1 100644
--- a/rts/sm/GCAux.c
+++ b/rts/sm/GCAux.c
@@ -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;
}