diff options
| -rw-r--r-- | libraries/base/GHC/Conc/Windows.hs | 16 | ||||
| -rw-r--r-- | libraries/base/cbits/Win32Utils.c | 46 | ||||
| -rw-r--r-- | libraries/base/tests/Concurrent/ThreadDelay001.hs | 2 |
3 files changed, 7 insertions, 57 deletions
diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs index 85032d9fcb..764e39e1f6 100644 --- a/libraries/base/GHC/Conc/Windows.hs +++ b/libraries/base/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/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c index 84b6b690ee..c084bd3a75 100644 --- a/libraries/base/cbits/Win32Utils.c +++ b/libraries/base/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/libraries/base/tests/Concurrent/ThreadDelay001.hs b/libraries/base/tests/Concurrent/ThreadDelay001.hs index 6273ba5e51..36aa152b81 100644 --- a/libraries/base/tests/Concurrent/ThreadDelay001.hs +++ b/libraries/base/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 |