[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: use clock_gettime to implement getPOSIXTime if available (1b74336)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:54:21 UTC 2017


Repository : ssh://git@git.haskell.org/time

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/1b74336b646b6bd3e36eee3efa00f41b915f02c7

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

commit 1b74336b646b6bd3e36eee3efa00f41b915f02c7
Author: Marios Titas <redneb at gmx.com>
Date:   Sun Aug 23 00:23:02 2015 +0100

    use clock_gettime to implement getPOSIXTime if available


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

1b74336b646b6bd3e36eee3efa00f41b915f02c7
 configure.ac                      |  2 ++
 lib/Data/Time/Clock/CTimespec.hsc | 41 +++++++++++++++++++++++++++++++++++++++
 lib/Data/Time/Clock/POSIX.hs      | 14 +++++++++++++
 time.cabal                        |  1 +
 4 files changed, 58 insertions(+)

diff --git a/configure.ac b/configure.ac
index 2b2149a..4be2aff 100644
--- a/configure.ac
+++ b/configure.ac
@@ -15,6 +15,8 @@ AC_CONFIG_HEADERS([lib/include/HsTimeConfig.h])
 AC_CHECK_HEADERS([time.h])
 AC_CHECK_FUNCS([gmtime_r localtime_r])
 
+AC_CHECK_FUNCS([clock_gettime])
+
 AC_STRUCT_TM
 AC_STRUCT_TIMEZONE
 
diff --git a/lib/Data/Time/Clock/CTimespec.hsc b/lib/Data/Time/Clock/CTimespec.hsc
new file mode 100644
index 0000000..fb9aaa3
--- /dev/null
+++ b/lib/Data/Time/Clock/CTimespec.hsc
@@ -0,0 +1,41 @@
+-- #hide
+module Data.Time.Clock.CTimespec where
+
+#include "HsTimeConfig.h"
+
+#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME
+
+#if __GLASGOW_HASKELL__ >= 709
+import Foreign
+#else
+import Foreign.Safe
+#endif
+import Foreign.C
+
+#include <time.h>
+
+data CTimespec = MkCTimespec CTime CLong
+
+instance Storable CTimespec where
+    sizeOf _ = #{size struct timespec}
+    alignment _ = alignment (undefined :: CLong)
+    peek p = do
+        s  <- #{peek struct timespec, tv_sec } p
+        ns <- #{peek struct timespec, tv_nsec} p
+        return (MkCTimespec s ns)
+    poke p (MkCTimespec s ns) = do
+        #{poke struct timespec, tv_sec } p s
+        #{poke struct timespec, tv_nsec} p ns
+
+foreign import ccall unsafe "time.h clock_gettime"
+    clock_gettime :: #{type clockid_t} -> Ptr CTimespec -> IO CInt
+
+-- | Get the current POSIX time from the system clock.
+getCTimespec :: IO CTimespec
+getCTimespec = alloca (\ptspec -> do
+    throwErrnoIfMinus1_ "clock_gettime" $
+        clock_gettime #{const CLOCK_REALTIME} ptspec
+    peek ptspec
+    )
+
+#endif
diff --git a/lib/Data/Time/Clock/POSIX.hs b/lib/Data/Time/Clock/POSIX.hs
index 91f22e0..a7a3737 100644
--- a/lib/Data/Time/Clock/POSIX.hs
+++ b/lib/Data/Time/Clock/POSIX.hs
@@ -10,9 +10,14 @@ import Data.Time.Calendar.Days
 import Data.Fixed
 import Control.Monad
 
+#include "HsTimeConfig.h"
+
 #ifdef mingw32_HOST_OS
 import Data.Word    ( Word64)
 import System.Win32.Time
+#elif HAVE_CLOCK_GETTIME
+import Data.Time.Clock.CTimespec
+import Foreign.C.Types (CTime(..))
 #else
 import Data.Time.Clock.CTimeval
 #endif
@@ -55,6 +60,15 @@ getPOSIXTime = do
 win32_epoch_adjust :: Word64
 win32_epoch_adjust = 116444736000000000
 
+#elif HAVE_CLOCK_GETTIME
+
+-- Use hi-res POSIX time
+ctimespecToPosixSeconds :: CTimespec -> POSIXTime
+ctimespecToPosixSeconds (MkCTimespec (CTime s) ns) =
+    (fromIntegral s) + (fromIntegral ns) / 1000000000
+
+getPOSIXTime = liftM ctimespecToPosixSeconds getCTimespec
+
 #else
 
 -- Use POSIX time
diff --git a/time.cabal b/time.cabal
index ed6479e..0115a47 100644
--- a/time.cabal
+++ b/time.cabal
@@ -75,6 +75,7 @@ library
         Data.Time.Clock.Scale,
         Data.Time.Clock.UTC,
         Data.Time.Clock.CTimeval,
+        Data.Time.Clock.CTimespec,
         Data.Time.Clock.UTCDiff,
         Data.Time.LocalTime.TimeZone,
         Data.Time.LocalTime.TimeOfDay,



More information about the ghc-commits mailing list