Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a865c6cfc12afd59760a1993eff51f801e27eea1 >--------------------------------------------------------------- commit a865c6cfc12afd59760a1993eff51f801e27eea1 Author: Paolo Capriotti <[email protected]> Date: Mon Apr 16 14:47:36 2012 +0100 Add timer initialization for darwin. >--------------------------------------------------------------- GHC/Event/Clock.hsc | 11 ++++++++++- GHC/Event/Thread.hs | 8 +++++++- cbits/DarwinUtils.c | 20 ++++++++++---------- 3 files changed, 27 insertions(+), 12 deletions(-) diff --git a/GHC/Event/Clock.hsc b/GHC/Event/Clock.hsc index 4dd6d1a..e3c1218 100644 --- a/GHC/Event/Clock.hsc +++ b/GHC/Event/Clock.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, BangPatterns, ForeignFunctionInterface, CApiFFI #-} -module GHC.Event.Clock (getMonotonicTime) where +module GHC.Event.Clock (getMonotonicTime, initializeTimer) where #include "HsBase.h" @@ -18,6 +18,8 @@ import GHC.Num -- TODO: Implement this for Windows. +initializeTimer :: IO () + -- | Return monotonic time in seconds, since some unspecified starting point getMonotonicTime :: IO Double @@ -26,6 +28,8 @@ getMonotonicTime :: IO Double #if HAVE_CLOCK_GETTIME +initializeTimer = return () + getMonotonicTime = do tv <- with (CTimespec 0 0) $ \tvptr -> do throwErrnoIfMinus1_ "clock_gettime" (clock_gettime (#const CLOCK_ID) tvptr) @@ -66,8 +70,13 @@ getMonotonicTime = do 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) diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs index 2643950..237cb45 100644 --- a/GHC/Event/Thread.hs +++ b/GHC/Event/Thread.hs @@ -25,6 +25,7 @@ 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) @@ -122,7 +123,12 @@ ioManager = unsafePerformIO $ do ensureIOManagerIsRunning :: IO () ensureIOManagerIsRunning | not threaded = return () - | otherwise = modifyMVar_ ioManager $ \old -> do + | otherwise = do + initializeTimer + startIOManagerThread + +startIOManagerThread :: IO () +startIOManagerThread = modifyMVar_ ioManager $ \old -> do let create = do !mgr <- new writeIORef eventManager $ Just mgr diff --git a/cbits/DarwinUtils.c b/cbits/DarwinUtils.c index 851cd04..de1f352 100644 --- a/cbits/DarwinUtils.c +++ b/cbits/DarwinUtils.c @@ -2,19 +2,19 @@ #ifdef darwin_HOST_OS +static double scaling_factor = 0.0; + +void initialize_timer() +{ + mach_timebase_info_data_t info; + (void) mach_timebase_info(&info); + scaling_factor = (double)info.numer / (double)info.denom; + scaling_factor *= 1e-9; +} + 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; } _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
