[commit: base] master: Use the RTS getMonotonicTime to implement getMonotonicNSec; fixes #7299 (8a3399d)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8a3399d5169af7a82c2c13ca7184fd307f6ea3d8

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

commit 8a3399d5169af7a82c2c13ca7184fd307f6ea3d8
Author: Ian Lynagh <ian at well-typed.com>
Date:   Wed Jan 16 16:35:44 2013 +0000

    Use the RTS getMonotonicTime to implement getMonotonicNSec; fixes #7299
    
    I'm not entirely sure where the segfault was coming from, but it was
    almost certainly related to there being 2 copies of the base package
    around, and the interpreted one not having its timer code initialised.

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

 GHC/Event/Clock.hsc |  105 +++-----------------------------------------------
 GHC/Event/Thread.hs |    2 -
 2 files changed, 7 insertions(+), 100 deletions(-)

diff --git a/GHC/Event/Clock.hsc b/GHC/Event/Clock.hsc
index e3c1218..37e26cd 100644
--- a/GHC/Event/Clock.hsc
+++ b/GHC/Event/Clock.hsc
@@ -1,108 +1,17 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, BangPatterns, ForeignFunctionInterface, CApiFFI #-}
+{-# LANGUAGE NoImplicitPrelude, ForeignFunctionInterface #-}
 
-module GHC.Event.Clock (getMonotonicTime, initializeTimer) where
+module GHC.Event.Clock (getMonotonicTime) where
 
-#include "HsBase.h"
-
-import Foreign
-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
-#endif
-
--- TODO: Implement this for Windows.
-
-initializeTimer :: IO ()
+import Data.Word
 
 -- | Return monotonic time in seconds, since some unspecified starting point
 getMonotonicTime :: IO Double
+getMonotonicTime = do w <- getMonotonicNSec
+                      return (fromIntegral w / 1000000000)
 
-------------------------------------------------------------------------
--- FFI binding
-
-#if HAVE_CLOCK_GETTIME
-
-initializeTimer = return ()
-
-getMonotonicTime = do
-    tv <- with (CTimespec 0 0) $ \tvptr -> do
-        throwErrnoIfMinus1_ "clock_gettime" (clock_gettime (#const CLOCK_ID) tvptr)
-        peek tvptr
-    let !t = realToFrac (sec tv) + realToFrac (nsec tv) / 1000000000.0
-    return t
-
-data CTimespec = CTimespec
-    { sec  :: {-# UNPACK #-} !CTime
-    , nsec :: {-# UNPACK #-} !CLong
-    }
-
-instance Storable CTimespec where
-    sizeOf _ = #size struct timespec
-    alignment _ = alignment (undefined :: CLong)
-
-    peek ptr = do
-        sec' <- #{peek struct timespec, tv_sec} ptr
-        nsec' <- #{peek struct timespec, tv_nsec} ptr
-        return $ CTimespec sec' nsec'
-
-    poke ptr tv = do
-        #{poke struct timespec, tv_sec} ptr (sec tv)
-        #{poke struct timespec, tv_nsec} ptr (nsec tv)
-
-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 ()
-
-foreign import capi unsafe "HsBase.h initialize_timer"
-  initializeTimer :: IO ()
-
-#else
-
-initializeTimer = return ()
-
-getMonotonicTime = do
-    tv <- with (CTimeval 0 0) $ \tvptr -> do
-        throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)
-        peek tvptr
-    let !t = realToFrac (sec tv) + realToFrac (usec tv) / 1000000.0
-    return t
-
-data CTimeval = CTimeval
-    { sec  :: {-# UNPACK #-} !CTime
-    , usec :: {-# UNPACK #-} !CSUSeconds
-    }
-
-instance Storable CTimeval where
-    sizeOf _ = #size struct timeval
-    alignment _ = alignment (undefined :: CLong)
-
-    peek ptr = do
-        sec' <- #{peek struct timeval, tv_sec} ptr
-        usec' <- #{peek struct timeval, tv_usec} ptr
-        return $ CTimeval sec' usec'
-
-    poke ptr tv = do
-        #{poke struct timeval, tv_sec} ptr (sec tv)
-        #{poke struct timeval, tv_usec} ptr (usec tv)
-
-foreign import capi unsafe "HsBase.h gettimeofday" gettimeofday
-    :: Ptr CTimeval -> Ptr () -> IO CInt
+foreign import ccall unsafe "getMonotonicNSec"
+    getMonotonicNSec :: IO Word64
 
-#endif
diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index 35557a4..d7ebd59 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -27,7 +27,6 @@ import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
 import GHC.Event.Internal (eventIs, evtClose)
 import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
                              new, registerFd, unregisterFd_, registerTimeout)
-import GHC.Event.Clock (initializeTimer)
 import qualified GHC.Event.Manager as M
 import System.IO.Unsafe (unsafePerformIO)
 import System.Posix.Types (Fd)
@@ -167,7 +166,6 @@ ensureIOManagerIsRunning :: IO ()
 ensureIOManagerIsRunning
   | not threaded = return ()
   | otherwise = do
-      initializeTimer
       startIOManagerThread
 
 startIOManagerThread :: IO ()