Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/29ef12e8b6b4fa38d1c70588e902e205b82e9d52 >--------------------------------------------------------------- commit 29ef12e8b6b4fa38d1c70588e902e205b82e9d52 Author: Paolo Capriotti <[email protected]> Date: Tue May 8 13:06:12 2012 +0100 Use RTS version of getMonotonicNSec on Windows (#6061) >--------------------------------------------------------------- GHC/Conc/Windows.hs | 16 ++++-------- cbits/Win32Utils.c | 46 ------------------------------------ tests/Concurrent/ThreadDelay001.hs | 2 +- 3 files changed, 7 insertions(+), 57 deletions(-) diff --git a/GHC/Conc/Windows.hs b/GHC/Conc/Windows.hs index 85032d9..764e39e 100644 --- a/GHC/Conc/Windows.hs +++ b/GHC/Conc/Windows.hs @@ -167,14 +167,9 @@ foreign import ccall unsafe "getOrSetGHCConcWindowsIOManagerThreadStore" ensureIOManagerIsRunning :: IO () ensureIOManagerIsRunning - | threaded = initializeIOManager + | threaded = startIOManagerThread | otherwise = return () -initializeIOManager :: IO () -initializeIOManager = do - initializeTimer - startIOManagerThread - startIOManagerThread :: IO () startIOManagerThread = do modifyMVar_ ioManagerThread $ \old -> do @@ -199,12 +194,13 @@ delayTime (Delay t _) = t delayTime (DelaySTM t _) = t type USecs = Word64 +type NSecs = Word64 -foreign import ccall unsafe "getMonotonicUSec" - getMonotonicUSec :: IO USecs +foreign import ccall unsafe "getMonotonicNSec" + getMonotonicNSec :: IO NSecs -foreign import ccall unsafe "initializeTimer" - initializeTimer :: IO () +getMonotonicUSec :: IO USecs +getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec {-# NOINLINE prodding #-} prodding :: IORef Bool diff --git a/cbits/Win32Utils.c b/cbits/Win32Utils.c index 84b6b69..c084bd3 100644 --- a/cbits/Win32Utils.c +++ b/cbits/Win32Utils.c @@ -110,50 +110,4 @@ void maperrno (void) errno = EINVAL; } -// Number of ticks per second used by the QueryPerformanceFrequency -// implementaiton, represented by a 64-bit union type. -static LARGE_INTEGER qpc_frequency = {.QuadPart = 0}; - -// Initialize qpc_frequency. This function should be called before any call to -// getMonotonicUSec. If QPC is not supported on this system, qpc_frequency is -// set to 0. -void initializeTimer() -{ - BOOL qpc_supported = QueryPerformanceFrequency(&qpc_frequency); - if (!qpc_supported) - { - qpc_frequency.QuadPart = 0; - } -} - -HsWord64 getMonotonicUSec() -{ - if (qpc_frequency.QuadPart) - { - // system_time is a 64-bit union type used to represent the - // tick count returned by QueryPerformanceCounter - LARGE_INTEGER system_time; - - // get the tick count. - QueryPerformanceCounter(&system_time); - - // compute elapsed seconds as double - double secs = (double)system_time.QuadPart / - (double)qpc_frequency.QuadPart; - - // return elapsed time in microseconds - return (HsWord64)(secs * 1e6); - } - else // fallback to GetTickCount - { - // NOTE: GetTickCount is a 32-bit millisecond value, so it wraps around - // every 49 days. - DWORD count = GetTickCount(); - - // getTickCount is in milliseconds, so multiply it by 1000 to get - // microseconds. - return (HsWord64)count * 1000; - } -} - #endif diff --git a/tests/Concurrent/ThreadDelay001.hs b/tests/Concurrent/ThreadDelay001.hs index 6273ba5..36aa152 100644 --- a/tests/Concurrent/ThreadDelay001.hs +++ b/tests/Concurrent/ThreadDelay001.hs @@ -9,7 +9,7 @@ import Control.Monad import System.Time main :: IO () -main = mapM_ delay (0 : take 11 (iterate (*5) 1)) +main = mapM_ delay (0 : take 7 (iterate (*5) 100)) delay :: Int -> IO () delay n = do _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
