Use RTS version of getMonotonicNSec on Windows (#6061)

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

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

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