Commit c031aeca authored by pcapriotti's avatar pcapriotti
Browse files

Use RTS version of getMonotonicNSec on Windows (#6061)

parent 8dda2dfb
......@@ -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
......
......@@ -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
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment