import GHC.Base
import GHC.IOBase
import GHC.Num ( Num(..) )
-import GHC.Real ( fromIntegral, quot )
+import GHC.Real ( fromIntegral, div )
#ifndef mingw32_HOST_OS
import GHC.Base ( Int(..) )
#endif
#endif
data DelayReq
- = Delay {-# UNPACK #-} !Word64 {-# UNPACK #-} !(MVar ())
- | DelaySTM {-# UNPACK #-} !Word64 {-# UNPACK #-} !(TVar Bool)
+ = Delay {-# UNPACK #-} !USecs {-# UNPACK #-} !(MVar ())
+ | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool)
#ifndef mingw32_HOST_OS
pendingEvents :: IORef [IOReq]
| delayTime d1 <= delayTime d2 = d1 : ds
| otherwise = d2 : insertDelay d1 rest
+delayTime :: DelayReq -> USecs
delayTime (Delay t _) = t
delayTime (DelaySTM t _) = t
atomically $ writeTVar t True
getDelay now rest
_otherwise ->
- return (all, (fromIntegral (delayTime d - now) *
- fromIntegral tick_msecs))
- -- delay is in millisecs for WaitForSingleObject
+ -- delay is in millisecs for WaitForSingleObject
+ let micro_seconds = delayTime d - now
+ milli_seconds = (micro_seconds + 999) `div` 1000
+ in return (all, fromIntegral milli_seconds)
-- ToDo: this just duplicates part of System.Win32.Types, which isn't
-- available yet. We should move some Win32 functionality down here,
errno = EINVAL;
}
-#define TICKS_PER_SECOND 50
-// must match GHC.Conc.tick_freq
-
-HsInt getTicksOfDay(void)
+HsWord64 getUSecOfDay(void)
{
- HsInt64 t;
+ HsWord64 t;
FILETIME ft;
GetSystemTimeAsFileTime(&ft);
- t = ((HsInt64)ft.dwHighDateTime << 32) | ft.dwLowDateTime;
- t = (t * TICKS_PER_SECOND) / 10000000LL;
- /* FILETIMES are in units of 100ns */
- return (HsInt)t;
+ t = ((HsWord64)ft.dwHighDateTime << 32) | ft.dwLowDateTime;
+ t = t / 10LL;
+ /* FILETIMES are in units of 100ns,
+ so we divide by 10 to get microseconds */
+ return t;
}
#endif