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!

Comments (0)

Files changed (7)

Criterion/Environment.hs

 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) >>=

Criterion/Internal.hs

 {-# 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(..),

Criterion/Measurement.hs

-{-# 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
+#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;
+}

cbits/time-posix.c

+#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;
+}

cbits/time-windows.c

+/*
+ * 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
     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