[commit: base] master: Define monotonic time function for Darwin. (f87f285)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f87f2853fd3c335bfeccd637e09fa933d55d4f2a

>---------------------------------------------------------------

commit f87f2853fd3c335bfeccd637e09fa933d55d4f2a
Author: Paolo Capriotti <p.capriotti at gmail.com>
Date:   Fri Mar 23 17:22:20 2012 +0000

    Define monotonic time function for Darwin.

>---------------------------------------------------------------

 GHC/Event/Clock.hsc |   19 +++++++++++++++++--
 base.cabal          |    1 +
 cbits/DarwinUtils.c |   21 +++++++++++++++++++++
 include/HsBase.h    |    3 +++
 4 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/GHC/Event/Clock.hsc b/GHC/Event/Clock.hsc
index 8da01ae..4dd6d1a 100644
--- a/GHC/Event/Clock.hsc
+++ b/GHC/Event/Clock.hsc
@@ -6,12 +6,15 @@ module GHC.Event.Clock (getMonotonicTime) where
 #include "HsBase.h"
 
 import Foreign
-import Foreign.C.Error (throwErrnoIfMinus1_)
 import Foreign.C.Types
 import GHC.Base
+import GHC.Real
+
+#if !darwin_HOST_OS
+import Foreign.C.Error (throwErrnoIfMinus1_)
 import GHC.Err
 import GHC.Num
-import GHC.Real
+#endif
 
 -- TODO: Implement this for Windows.
 
@@ -51,6 +54,18 @@ instance Storable CTimespec where
 foreign import capi unsafe "HsBase.h clock_gettime" clock_gettime
     :: Int -> Ptr CTimespec -> IO CInt
 
+#elif darwin_HOST_OS
+
+getMonotonicTime = do
+    with 0.0 $ \timeptr -> do
+    absolute_time timeptr
+    ctime <- peek timeptr
+    let !time = realToFrac ctime
+    return time
+
+foreign import capi unsafe "HsBase.h absolute_time" absolute_time ::
+    Ptr CDouble -> IO ()
+
 #else
 
 getMonotonicTime = do
diff --git a/base.cabal b/base.cabal
index 2cbfa11..f0d4186 100644
--- a/base.cabal
+++ b/base.cabal
@@ -217,6 +217,7 @@ Library {
         cbits/PrelIOUtils.c
         cbits/WCsubst.c
         cbits/Win32Utils.c
+        cbits/DarwinUtils.c
         cbits/consUtils.c
         cbits/iconv.c
         cbits/inputReady.c
diff --git a/cbits/DarwinUtils.c b/cbits/DarwinUtils.c
new file mode 100644
index 0000000..851cd04
--- /dev/null
+++ b/cbits/DarwinUtils.c
@@ -0,0 +1,21 @@
+#include "HsBase.h"
+
+#ifdef darwin_HOST_OS
+
+void absolute_time(double *result)
+{
+    uint64_t time = mach_absolute_time();
+    static double scaling_factor = 0.0;
+
+    if (scaling_factor == 0.0)
+    {
+        mach_timebase_info_data_t info;
+        (void) mach_timebase_info(&info);
+        scaling_factor = (double)info.numer / (double)info.denom;
+        scaling_factor *= 1e-9;
+    }
+
+    *result = (double)time * scaling_factor;
+}
+
+#endif
diff --git a/include/HsBase.h b/include/HsBase.h
index b321967..29559d5 100644
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -110,6 +110,9 @@
 # else
 #  define CLOCK_ID CLOCK_REALTIME
 # endif
+#elif defined(darwin_HOST_OS)
+# include <mach/mach.h>
+# include <mach/mach_time.h>
 #endif
 
 #if !defined(__MINGW32__) && !defined(irix_HOST_OS)