diff --git a/Criterion/Measurement.hs b/Criterion/Measurement.hs index 1a270e46..9303ce62 100644 --- a/Criterion/Measurement.hs +++ b/Criterion/Measurement.hs @@ -49,12 +49,20 @@ import GHC.Stats (GCStats(..)) #endif import Prelude () import Prelude.Compat +#if MIN_VERSION_base(4,7,0) +import System.Mem (performGC, performMinorGC) +# else import System.Mem (performGC) +#endif import Text.Printf (printf) import qualified Control.Exception as Exc import qualified Data.Vector as V import qualified GHC.Stats as Stats +#if !(MIN_VERSION_base(4,7,0)) +foreign import ccall "performGC" performMinorGC :: IO () +#endif + -- | Statistics about memory usage and the garbage collector. Apart from -- 'gcStatsCurrentBytesUsed' and 'gcStatsCurrentBytesSlop' all are cumulative values since -- the program started. @@ -172,8 +180,14 @@ measure :: Benchmarkable -- ^ Operation to benchmark. -> Int64 -- ^ Number of iterations. -> IO (Measured, Double) measure bm iters = runBenchmarkable bm iters addResults $ \ !n act -> do - -- Ensure the stats from getGCStatistics are up-to-date. - performGC + -- Ensure the stats from getGCStatistics are up-to-date + -- by garbage collecting. performMinorGC does /not/ update all stats, but + -- it does update the ones we need (see applyGCStatistics for details. + -- + -- We use performMinorGC instead of performGC to avoid the cost of copying + -- the live data in the heap potentially hundreds of times in a + -- single benchmark. + performMinorGC startStats <- getGCStatistics startTime <- getTime startCpuTime <- getCPUTime @@ -184,7 +198,7 @@ measure bm iters = runBenchmarkable bm iters addResults $ \ !n act -> do endCycles <- getCycles -- From these we can derive GC-related deltas. endStatsPreGC <- getGCStatistics - performGC + performMinorGC -- From these we can derive all other deltas, and performGC guarantees they -- are up-to-date. endStatsPostGC <- getGCStatistics @@ -250,8 +264,7 @@ runBenchmarkable Benchmarkable{..} i comb f clean `seq` run `seq` evaluate $ rnf env - performGC - f count run `finally` clean <* performGC + f count run `finally` clean {-# INLINE work #-} {-# INLINE runBenchmarkable #-} diff --git a/changelog.md b/changelog.md index c6b9be61..3c02d17f 100644 --- a/changelog.md +++ b/changelog.md @@ -2,10 +2,10 @@ * We now do three samples for statistics: - * `performGC` before the first sample, to ensure it's up to date. - * Take another sample after the action, without a `performGC`, so we can - gather legitimate readings on GC-related statistics. - * Then `performGC` and sample once more, so we can get up-to-date + * `performMinorGC` before the first sample, to ensure it's up to date. + * Take another sample after the action, without a garbage collection, so we + can gather legitimate readings on GC-related statistics. + * Then `performMinorGC` and sample once more, so we can get up-to-date readings on other metrics. The type of `applyGCStatistics` has changed accordingly. Before, it was: @@ -28,6 +28,10 @@ When diffing `GCStatistics` in `applyGCStatistics`, we carefully choose whether to diff against the end stats pre- or post-GC. +* Use `performMinorGC` rather than `performGC` to update garbage collection + statistics. This improves the benchmark performance of fast functions on large + objects. + * Fix a bug in the `ToJSON Measured` instance which duplicated the mutator CPU seconds where GC CPU seconds should go.