diff options
author | Simon Marlow <marlowsd@gmail.com> | 2016-05-23 10:42:31 +0100 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2016-06-10 21:25:54 +0100 |
commit | c88f31a08943764217b69adb1085ba423c9bcf91 (patch) | |
tree | c6bab224ac6646e12b693036d87013c8349f29cf | |
parent | 9e5ea67e268be2659cd30ebaed7044d298198ab0 (diff) | |
download | haskell-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.h | 7 | ||||
-rw-r--r-- | includes/rts/storage/GC.h | 40 | ||||
-rw-r--r-- | libraries/base/GHC/RTS/Flags.hsc | 122 | ||||
-rw-r--r-- | libraries/base/base.cabal | 1 | ||||
-rw-r--r-- | libraries/base/cbits/rts.c | 42 | ||||
-rw-r--r-- | rts/sm/GC.c | 8 | ||||
-rw-r--r-- | rts/sm/GCAux.c | 2 |
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; } |