1. Bryan O'Sullivan
  2. criterion

Commits

Bryan O'Sullivan  committed 1437138

Use a more suitable wallclock time source on each major platform

We now use clock_gettime on most Unix variants, mach_absolute_time
on OS X, and QueryPerformanceCounter on Windows.

Each of these counters provides much better resolution than their
predecessor (getPOSIXTime), and generally at lower cost, too. Nice!

  • Participants
  • Parent commits 4f5eb94
  • Branches default

Comments (0)

Files changed (7)

File Criterion/Environment.hs

View file
 import Control.Monad.Trans (liftIO)
 import Criterion.Analysis (analyseMean)
 import Criterion.IO.Printf (note)
-import Criterion.Measurement (getTime, runForAtLeast, time_)
+import Criterion.Measurement (getTime, initializeTime, runForAtLeast, time_)
 import Criterion.Monad (Criterion)
 import qualified Data.Vector.Unboxed as U
 import Data.Data (Data, Typeable)
 measureEnvironment :: Criterion Environment
 measureEnvironment = do
   _ <- note "warming up\n"
+  liftIO initializeTime
   (_, seed, _) <- liftIO $ runForAtLeast 0.1 10000 resolution
   _ <- note "estimating clock resolution...\n"
   clockRes <- thd3 `fmap` liftIO (runForAtLeast 0.5 seed resolution) >>=

File Criterion/Internal.hs

View file
 {-# LANGUAGE BangPatterns, RecordWildCards #-}
 -- |
 -- Module      : Criterion
--- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan
+-- Copyright   : (c) 2009-2013 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 import Criterion.Environment (Environment(..))
 import Criterion.IO (header, hGetResults)
 import Criterion.IO.Printf (note, prolix, summary)
-import Criterion.Measurement (getTime, runForAtLeast, secs, time_)
+import Criterion.Measurement (getTime, runForAtLeast, secs,
+                              time_)
 import Criterion.Monad (Criterion, getConfig, getConfigItem)
 import Criterion.Report (Report(..), report)
 import Criterion.Types (Benchmark(..), Benchmarkable(..), Payload(..),

File Criterion/Measurement.hs

View file
-{-# LANGUAGE BangPatterns, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE BangPatterns, ForeignFunctionInterface, ScopedTypeVariables,
+    TypeOperators #-}
 
 -- |
 -- Module      : Criterion.Measurement
--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
+-- Copyright   : (c) 2009-2013 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 
 module Criterion.Measurement
     (
-      getTime
+      initializeTime
+    , getTime
     , runForAtLeast
     , secs
     , time
     ) where
 
 import Control.Monad (when)
-import Data.Time.Clock.POSIX (getPOSIXTime)
 import Text.Printf (printf)
 
 time :: IO a -> IO (Double, a)
   end <- getTime
   return $! end - start
 
-getTime :: IO Double
-getTime = realToFrac `fmap` getPOSIXTime
-
 runForAtLeast :: Double -> Int -> (Int -> IO a) -> IO (Double, Int, a)
 runForAtLeast howLong initSeed act = loop initSeed (0::Int) =<< getTime
   where
                | t >= 1e2  = printf "%.4f %s" t u
                | t >= 1e1  = printf "%.5f %s" t u
                | otherwise = printf "%.6f %s" t u
+
+foreign import ccall unsafe "criterion_inittime" initializeTime :: IO ()
+
+-- | Return the current wallclock time, in seconds since some
+-- arbitrary time.
+--
+-- You /must/ call 'initializeTime' once before calling this function!
+foreign import ccall unsafe "criterion_gettime" getTime :: IO Double

File cbits/time-osx.c

View file
+#include <mach/mach.h>
+#include <mach/mach_time.h>
+
+static mach_timebase_info_data_t timebase_info;
+static double timebase_recip;
+
+void criterion_inittime(void)
+{
+    mach_timebase_info(&timebase_info);
+    timebase_recip = (timebase_info.denom / timebase_info.numer) / 1e9;
+}
+
+double criterion_gettime(void)
+{
+    return mach_absolute_time() * timebase_recip;
+}

File cbits/time-posix.c

View file
+#include <time.h>
+
+void criterion_inittime(void)
+{
+}
+
+double criterion_gettime(void)
+{
+    struct timespec ts;
+
+    clock_gettime(CLOCK_MONOTONIC, &ts);
+
+    return ts.tv_sec + ts.tv_nsec * 1e-9;
+}

File cbits/time-windows.c

View file
+/*
+ * Windows has the most amazingly cretinous time measurement APIs you
+ * can possibly imagine.
+ *
+ * Our first possibility is GetSystemTimeAsFileTime, which updates at
+ * roughly 60Hz, and is hence worthless - we'd have to run a
+ * computation for tens or hundreds of seconds to get a trustworthy
+ * number.
+ *
+ * Alternatively, we can use QueryPerformanceCounter, which has
+ * undefined behaviour under almost all interesting circumstances
+ * (e.g. multicore systems, CPU frequency changes). But at least it
+ * increments reasonably often.
+ */
+
+#include <windows.h>
+
+#if 0
+
+void criterion_inittime(void)
+{
+}
+
+double criterion_gettime(void)
+{
+    FILETIME ft;
+    ULARGE_INTEGER li;
+
+    GetSystemTimeAsFileTime(&ft);
+    li.LowPart = ft.dwLowDateTime;
+    li.HighPart = ft.dwHighDateTime;
+
+    return (li.QuadPart - 130000000000000000ull) * 1e-7;
+}
+
+#else
+
+static double freq_recip;
+static LARGE_INTEGER firstClock;
+
+void criterion_inittime(void)
+{
+    LARGE_INTEGER freq;
+
+    QueryPerformanceFrequency(&freq);
+    QueryPerformanceCounter(&firstClock);
+    freq_recip = 1.0 / freq.QuadPart;
+}
+
+double criterion_gettime(void)
+{
+    LARGE_INTEGER li;
+
+    QueryPerformanceCounter(&li);
+
+    return ((double) (li.QuadPart - firstClock.QuadPart)) * freq_recip;
+}
+
+#endif

File criterion.cabal

View file
     Criterion.Report
     Criterion.Types
 
+  if os(darwin)
+    c-sources: cbits/time-osx.c
+  else {
+    if os(windows)
+      c-sources: cbits/time-windows.c
+    else
+      c-sources: cbits/time-posix.c
+  }
+
   other-modules:
     Criterion.Internal
     Paths_criterion