diff --git a/cbits/cycles.c b/cbits/cycles.c --- a/cbits/cycles.c +++ b/cbits/cycles.c @@ -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 + +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! diff --git a/cbits/time-posix.c b/cbits/time-posix.c --- a/cbits/time-posix.c +++ b/cbits/time-posix.c @@ -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; } diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/criterion-measurement.cabal b/criterion-measurement.cabal --- a/criterion-measurement.cabal +++ b/criterion-measurement.cabal @@ -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 diff --git a/src/Criterion/Measurement.hs b/src/Criterion/Measurement.hs --- a/src/Criterion/Measurement.hs +++ b/src/Criterion/Measurement.hs @@ -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 diff --git a/src/Criterion/Measurement/Types.hs b/src/Criterion/Measurement/Types.hs --- a/src/Criterion/Measurement/Types.hs +++ b/src/Criterion/Measurement/Types.hs @@ -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. diff --git a/src/Criterion/Measurement/Types/Internal.hs b/src/Criterion/Measurement/Types/Internal.hs --- a/src/Criterion/Measurement/Types/Internal.hs +++ b/src/Criterion/Measurement/Types/Internal.hs @@ -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' #-}