Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8143f249a2f591c188425f6326571bd659cdc3a6 >--------------------------------------------------------------- commit 8143f249a2f591c188425f6326571bd659cdc3a6 Author: Edward Z. Yang <[email protected]> Date: Sat Aug 6 11:19:09 2011 -0400 Unbox all GCStats fields, also add cpu_seconds and wall_seconds. Signed-off-by: Edward Z. Yang <[email protected]> >--------------------------------------------------------------- GHC/Stats.hsc | 41 +++++++++++++++++++++++------------------ 1 files changed, 23 insertions(+), 18 deletions(-) diff --git a/GHC/Stats.hsc b/GHC/Stats.hsc index 676caf6..3f12137 100644 --- a/GHC/Stats.hsc +++ b/GHC/Stats.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} module GHC.Stats ( GCStats(..) @@ -20,44 +21,46 @@ foreign import ccall "getGCStats" getGCStats_ :: Ptr () -> IO () -- | Global garbage collection and memory statistics. data GCStats = GCStats - { bytes_allocated :: Int64 -- ^ Total number of bytes allocated - , num_gcs :: Int64 -- ^ Number of garbage collections performed - , max_bytes_used :: Int64 -- ^ Maximum number of live bytes seen so far - , num_byte_usage_samples :: Int64 -- ^ Number of byte usage samples taken + { bytes_allocated :: !Int64 -- ^ Total number of bytes allocated + , num_gcs :: !Int64 -- ^ Number of garbage collections performed + , max_bytes_used :: !Int64 -- ^ Maximum number of live bytes seen so far + , num_byte_usage_samples :: !Int64 -- ^ Number of byte usage samples taken -- | Sum of all byte usage samples, can be used with -- 'num_byte_usage_samples' to calculate averages with -- arbitrary weighting (if you are sampling this record multiple -- times). - , cumulative_bytes_used :: Int64 - , bytes_copied :: Int64 -- ^ Number of bytes copied during GC - , current_bytes_used :: Int64 -- ^ Current number of live bytes - , current_bytes_slop :: Int64 -- ^ Current number of bytes lost to slop - , max_bytes_slop :: Int64 -- ^ Maximum number of bytes lost to slop at any one time so far - , peak_megabytes_allocated :: Int64 -- ^ Maximum number of megabytes allocated + , cumulative_bytes_used :: !Int64 + , bytes_copied :: !Int64 -- ^ Number of bytes copied during GC + , current_bytes_used :: !Int64 -- ^ Current number of live bytes + , current_bytes_slop :: !Int64 -- ^ Current number of bytes lost to slop + , max_bytes_slop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far + , peak_megabytes_allocated :: !Int64 -- ^ Maximum number of megabytes allocated -- | CPU time spent running mutator threads. This does not include -- any profiling overhead or initialization. - , mutator_cpu_seconds :: Double + , mutator_cpu_seconds :: !Double -- | Wall clock time spent running mutator threads. This does not -- include initialization. - , mutator_wall_seconds :: Double - , gc_cpu_seconds :: Double -- ^ CPU time spent running GC - , gc_wall_seconds :: Double -- ^ Wall clock time spent running GC + , mutator_wall_seconds :: !Double + , gc_cpu_seconds :: !Double -- ^ CPU time spent running GC + , gc_wall_seconds :: !Double -- ^ Wall clock time spent running GC + , cpu_seconds :: !Double -- ^ Total CPU time elapsed since program start + , wall_seconds :: !Double -- ^ Total wall clock time elapsed since start -- | Number of bytes copied during GC, minus space held by mutable -- lists held by the capabilities. Can be used with -- 'par_max_bytes_copied' to determine how well parallel GC utilized -- all cores. - , par_avg_bytes_copied :: Int64 + , par_avg_bytes_copied :: !Int64 -- | Sum of number of bytes copied each GC by the most active GC -- thread each GC. The ratio of 'par_avg_bytes_copied' divided by -- 'par_max_bytes_copied' approaches 1 for a maximally sequential -- run and approaches the number of threads (set by the RTS flag -- @-N@) for a maximally parallel run. - , par_max_bytes_copied :: Int64 + , par_max_bytes_copied :: !Int64 } deriving (Show, Read) {- - , g_init_cpu_seconds :: Double - , g_init_wall_seconds :: Double + , g_init_cpu_seconds :: !Double + , g_init_wall_seconds :: !Double -} -- | Retrieves garbage collection and memory statistics as of the last @@ -84,6 +87,8 @@ getGCStats = allocaBytes (#size GCStats) $ \p -> do mutator_wall_seconds <- (# peek GCStats, mutator_wall_seconds) p gc_cpu_seconds <- (# peek GCStats, gc_cpu_seconds) p gc_wall_seconds <- (# peek GCStats, gc_wall_seconds) p + cpu_seconds <- (# peek GCStats, cpu_seconds) p + wall_seconds <- (# peek GCStats, wall_seconds) p par_avg_bytes_copied <- (# peek GCStats, par_avg_bytes_copied) p par_max_bytes_copied <- (# peek GCStats, par_max_bytes_copied) p return GCStats { .. } _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
