Commit c88f31a0 authored by Simon Marlow's avatar Simon Marlow

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
parent 9e5ea67e
......@@ -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
......
......@@ -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.
*
* ------------------------------------------------------------------------- */
......
......@@ -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)
......@@ -323,7 +323,6 @@ Library
cbits/inputReady.c
cbits/md5.c
cbits/primFloat.c
cbits/rts.c
cbits/sysconf.c
include-dirs: include
......
#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;
}
......@@ -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)
......
......@@ -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;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment