[commit: base] master: Use RTS version of getMonotonicNSec on Windows (#6061) (29ef12e)

[Paolo Capriotti]

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 <p.capriotti at gmail.com>
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