Define monotonic time function for Darwin.

4 files changed, 42 insertions, 2 deletions

diff --git a/libraries/base/GHC/Event/Clock.hsc b/libraries/base/GHC/Event/Clock.hsc
index 8da01ae199..4dd6d1a61d 100644
--- a/libraries/base/GHC/Event/Clock.hsc
+++ b/libraries/base/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/libraries/base/base.cabal b/libraries/base/base.cabal
index 2cbfa11c03..f0d4186472 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/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/libraries/base/cbits/DarwinUtils.c b/libraries/base/cbits/DarwinUtils.c
new file mode 100644
index 0000000000..851cd04113
--- /dev/null
+++ b/libraries/base/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/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
index b321967634..29559d5e43 100644
--- a/libraries/base/include/HsBase.h
+++ b/libraries/base/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)