criterion-measurement 0.1.4.0 → 0.2.5.0
raw patch · 7 files changed
Files
- cbits/cycles.c +34/−0
- cbits/time-posix.c +4/−0
- changelog.md +27/−0
- criterion-measurement.cabal +12/−15
- src/Criterion/Measurement.hs +13/−14
- src/Criterion/Measurement/Types.hs +13/−9
- src/Criterion/Measurement/Types/Internal.hs +25/−12
cbits/cycles.c view
@@ -9,6 +9,28 @@ return mach_absolute_time(); } +#elif aarch64_HOST_ARCH++StgWord64 criterion_rdtsc(void)+{+ StgWord64 ret;+ __asm__ __volatile__ ("mrs %0, cntvct_el0" : "=r"(ret));+ return ret;+}++#elif powerpc64le_HOST_ARCH || powerpc64_HOST_ARCH++StgWord64 criterion_rdtsc(void)+{+ // Read the PowerPC Time Base: a monotonically-increasing 64-bit counter+ // that is the architectural analogue of x86's TSC. SPR 268 returns the+ // full 64-bit Time Base on 64-bit PowerPC (this is what the deprecated+ // `mftb` mnemonic expanded to).+ StgWord64 ret;+ __asm__ __volatile__ ("mfspr %0, 268" : "=r"(ret));+ return ret;+}+ #elif x86_64_HOST_ARCH || i386_HOST_ARCH StgWord64 criterion_rdtsc(void)@@ -59,6 +81,18 @@ return result; } +#elif wasm32_HOST_ARCH++#include <time.h>++StgWord64 criterion_rdtsc(void)+{+ struct timespec ts;+ StgWord64 result_stg = 0;+ clock_gettime(CLOCK_REALTIME, &ts);+ result_stg = ts.tv_sec * 1000000000LL + ts.tv_nsec;+ return result_stg;+} #else #error Unsupported OS/architecture/compiler!
cbits/time-posix.c view
@@ -18,7 +18,11 @@ { struct timespec ts; +#ifndef __wasi__ clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts);+#else+ clock_gettime(CLOCK_REALTIME, &ts);+#endif return ts.tv_sec + ts.tv_nsec * 1e-9; }
changelog.md view
@@ -1,3 +1,30 @@+0.2.5.0++* Support building on PowerPC.++0.2.4.0++* Support building with `wasm32-wasi`.++0.2.3.0++* Drop support for pre-8.0 versions of GHC.++0.2.2.0++* Supporting building with all AArch64 platforms (not just Linux and macOS).++0.2.1.0++* Make the behavior of the benchmarking functions independent of the+ `-fspec-const-count` limit.++0.2.0.0++* Add a `measPeakMbAllocated` field to `Measured` for reporting maximum+ megabytes allocated. Naturally, this affects the behavior of `Measured`'s+ `{To,From}JSON` and `Binary` instances.+ 0.1.4.0 * Fix a bug that occurred with GHC 9.2.4 or later that would cause incorrect
criterion-measurement.cabal view
@@ -1,5 +1,5 @@ name: criterion-measurement-version: 0.1.4.0+version: 0.2.5.0 synopsis: Criterion measurement functionality and associated types description: Measurement-related functionality extracted from Criterion, with minimal dependencies. The rationale for this is to enable alternative analysis front-ends. homepage: https://github.com/haskell/criterion@@ -13,10 +13,6 @@ extra-source-files: README.md, changelog.md cabal-version: >=1.10 tested-with:- GHC==7.4.2,- GHC==7.6.3,- GHC==7.8.4,- GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4,@@ -24,7 +20,12 @@ GHC==8.8.4, GHC==8.10.7, GHC==9.0.2,- GHC==9.2.2+ GHC==9.2.8,+ GHC==9.4.8,+ GHC==9.6.7,+ GHC==9.8.4,+ GHC==9.10.3,+ GHC==9.12.2 flag fast description: compile without optimizations@@ -36,21 +37,17 @@ exposed-modules: Criterion.Measurement Criterion.Measurement.Types Criterion.Measurement.Types.Internal- build-depends: aeson >= 0.8- , base >= 4.5 && < 5+ build-depends: aeson >= 2 && < 2.4+ , base >= 4.9 && < 5 , base-compat >= 0.9- , binary >= 0.5.1.0+ , binary >= 0.8.3.0 , containers , deepseq >= 1.1.0.0+ , ghc-prim >= 0.5 , vector >= 0.7.1- if impl(ghc < 7.6)- build-depends:- ghc-prim default-language: Haskell2010- ghc-options: -Wall -funbox-strict-fields- if impl(ghc >= 6.8)- ghc-options: -fwarn-tabs+ ghc-options: -Wall -funbox-strict-fields -Wtabs if flag(fast) ghc-options: -O0 else
src/Criterion/Measurement.hs view
@@ -37,7 +37,7 @@ import Criterion.Measurement.Types (Benchmarkable(..), Measured(..)) import Control.DeepSeq (NFData(rnf)) import Control.Exception (finally,evaluate)-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Int (Int64) import Data.List (unfoldr) import Data.Word (Word64)@@ -49,20 +49,12 @@ #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.@@ -111,7 +103,7 @@ , gcStatsCpuSeconds :: !Double -- | Total wall clock time elapsed since start , gcStatsWallSeconds :: !Double- } deriving (Eq, Read, Show, Typeable, Data, Generic)+ } deriving (Eq, Read, Show, Data, Generic) -- | Try to get GC statistics, bearing in mind that the GHC runtime -- will throw an exception if statistics collection was not enabled@@ -182,7 +174,7 @@ measure :: Benchmarkable -- ^ Operation to benchmark. -> Int64 -- ^ Number of iterations. -> IO (Measured, Double)-measure bm iters = runBenchmarkable bm iters addResults $ \ !n act -> do+measure bm iters = runBenchmarkable bm iters combineResults $ \ !n act -> do -- 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.@@ -216,11 +208,15 @@ where -- When combining runs, the Measured value is accumulated over many runs, -- but the Double value is the most recent absolute measurement of time.- addResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)- addResults (!m1, _) (!m2, !d2) = (m3, d2)+ combineResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)+ combineResults (!m1, _) (!m2, !d2) = (m3, d2) where- add f = f m1 + f m2+ combine :: (a -> a -> a) -> (Measured -> a) -> a+ combine g sel = sel m1 `g` sel m2 + add :: Num a => (Measured -> a) -> a+ add = combine (+)+ m3 = Measured { measTime = add measTime , measCpuTime = add measCpuTime@@ -228,6 +224,7 @@ , measIters = add measIters , measAllocated = add measAllocated+ , measPeakMbAllocated = combine max measPeakMbAllocated , measNumGcs = add measNumGcs , measBytesCopied = add measBytesCopied , measMutatorWallSeconds = add measMutatorWallSeconds@@ -334,6 +331,7 @@ , measIters = 0 , measAllocated = minBound+ , measPeakMbAllocated = minBound , measNumGcs = minBound , measBytesCopied = minBound , measMutatorWallSeconds = bad@@ -360,6 +358,7 @@ -- The others (num GCs and GC cpu/wall seconds) must be diffed against -- endPreGC so that the extra performGC does not taint them. measAllocated = diff endPostGC gcStatsBytesAllocated+ , measPeakMbAllocated = gcStatsPeakMegabytesAllocated endPostGC , measNumGcs = diff endPreGC gcStatsNumGcs , measBytesCopied = diff endPostGC gcStatsBytesCopied , measMutatorWallSeconds = diff endPostGC gcStatsMutatorWallSeconds
src/Criterion/Measurement/Types.hs view
@@ -68,7 +68,7 @@ import Criterion.Measurement.Types.Internal (fakeEnvironment, nf', whnf') import Data.Aeson (FromJSON(..), ToJSON(..)) import Data.Binary (Binary(..))-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Int (Int64) import Data.Map (Map, fromList) import GHC.Generics (Generic)@@ -125,6 +125,8 @@ , measAllocated :: !Int64 -- ^ __(GC)__ Number of bytes allocated. Access using 'fromInt'.+ , measPeakMbAllocated :: !Int64+ -- ^ __(GC)__ Max number of megabytes allocated. Access using 'fromInt'. , measNumGcs :: !Int64 -- ^ __(GC)__ Number of garbage collections performed. Access -- using 'fromInt'.@@ -144,15 +146,15 @@ , measGcCpuSeconds :: !Double -- ^ __(GC)__ CPU time spent doing garbage collection. Access -- using 'fromDouble'.- } deriving (Eq, Read, Show, Typeable, Data, Generic)+ } deriving (Eq, Read, Show, Data, Generic) instance FromJSON Measured where parseJSON v = do- (a,b,c,d,e,f,g,h,i,j,k) <- parseJSON v+ (a,b,c,d,e,f,g,h,i,j,k,l) <- parseJSON v -- The first four fields are not subject to the encoding policy: return $ Measured a b c d- (int e) (int f) (int g)- (db h) (db i) (db j) (db k)+ (int e) (int f) (int g) (int h)+ (db i) (db j) (db k) (db l) where int = toInt; db = toDouble -- Here we treat the numeric fields as `Maybe Int64` and `Maybe Double`@@ -161,7 +163,7 @@ instance ToJSON Measured where toJSON Measured{..} = toJSON (measTime, measCpuTime, measCycles, measIters,- i measAllocated, i measNumGcs, i measBytesCopied,+ i measAllocated, i measPeakMbAllocated, i measNumGcs, i measBytesCopied, d measMutatorWallSeconds, d measMutatorCpuSeconds, d measGcWallSeconds, d measGcCpuSeconds) where i = fromInt; d = fromDouble@@ -186,6 +188,8 @@ "loop iterations")) , ("allocated", (fmap fromIntegral . fromInt . measAllocated, "(+RTS -T) bytes allocated"))+ , ("peakMbAllocated", (fmap fromIntegral . fromInt . measPeakMbAllocated,+ "(+RTS -T) peak megabytes allocated")) , ("numGcs", (fmap fromIntegral . fromInt . measNumGcs, "(+RTS -T) number of garbage collections")) , ("bytesCopied", (fmap fromIntegral . fromInt . measBytesCopied,@@ -260,10 +264,10 @@ instance Binary Measured where put Measured{..} = do put measTime; put measCpuTime; put measCycles; put measIters- put measAllocated; put measNumGcs; put measBytesCopied+ put measAllocated; put measPeakMbAllocated; put measNumGcs; put measBytesCopied put measMutatorWallSeconds; put measMutatorCpuSeconds put measGcWallSeconds; put measGcCpuSeconds- get = Measured <$> get <*> get <*> get <*> get+ get = Measured <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get -- | Apply an argument to a function, and evaluate the result to@@ -499,7 +503,7 @@ -- The environment is evaluated to normal form before the benchmark is run. -- -- When using 'whnf', 'whnfIO', etc. Criterion creates a 'Benchmarkable'--- whichs runs a batch of @N@ repeat runs of that expressions. Criterion may+-- which runs a batch of @N@ repeat runs of that expressions. Criterion may -- run any number of these batches to get accurate measurements. Environments -- created by 'env' and 'envWithCleanup', are shared across all these batches -- of runs.
src/Criterion/Measurement/Types/Internal.hs view
@@ -17,16 +17,22 @@ -- Portability : GHC -- -- Exports 'fakeEnvironment'.-module Criterion.Measurement.Types.Internal (fakeEnvironment, nf', whnf') where+module Criterion.Measurement.Types.Internal+ ( fakeEnvironment+ , nf'+ , whnf'+ , SPEC(..)+ ) where import Data.Int (Int64) import Control.Exception+import GHC.Types (SPEC(..)) -- | A dummy environment that is passed to functions that create benchmarks -- from environments when no concrete environment is available. fakeEnvironment :: env fakeEnvironment = error $ unlines- [ "Criterion atttempted to retrieve a non-existent environment!"+ [ "Criterion attempted to retrieve a non-existent environment!" , "\tPerhaps you forgot to use lazy pattern matching in a function which" , "\tconstructs benchmarks from an environment?" , "\t(see the documentation for `env` for details)"@@ -46,6 +52,9 @@ -- benchmark code itself could be changed by the user's optimization level. By -- marking them @NOINLINE@, the core benchmark code is always the same. --+-- To ensure that the behavior of these functions remains independent of+-- -fspec-constr-count, we force SpecConst optimization by passing SPEC.+-- -- Finally, it's important that both branches of the loop depend on the state -- token from the IO action. This is achieved by using `evaluate` rather than `let !y = f x` -- in order to force the value to whnf. `evaluate` is in the IO monad and therefore the state@@ -61,21 +70,25 @@ -- | Generate a function which applies an argument to a function a -- given number of times, reducing the result to normal form. nf' :: (b -> ()) -> (a -> b) -> a -> (Int64 -> IO ())-nf' reduce f x = go+nf' reduce f x = go SPEC where- go n | n <= 0 = return ()- | otherwise = do- y <- evaluate (f x)- reduce y `seq` go (n-1)+ go :: SPEC -> Int64 -> IO ()+ go !_ n+ | n <= 0 = return ()+ | otherwise = do+ y <- evaluate (f x)+ reduce y `seq` go SPEC (n-1) {-# NOINLINE nf' #-} -- | Generate a function which applies an argument to a function a -- given number of times. whnf' :: (a -> b) -> a -> (Int64 -> IO ())-whnf' f x = go+whnf' f x = go SPEC where- go n | n <= 0 = return ()- | otherwise = do- _ <- evaluate (f x)- go (n-1)+ go :: SPEC -> Int64 -> IO ()+ go !_ n+ | n <= 0 = return ()+ | otherwise = do+ _ <- evaluate (f x)+ go SPEC (n-1) {-# NOINLINE whnf' #-}