From c5a5a3183ce8e4b36dab2b6cdef6260ce7f41a7e Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Fri, 9 Feb 2007 17:35:10 +0000
Subject: [PATCH] The Windows counterpart to 'wrapround of thread delays'

---
 GHC/Conc.lhs       |   14 ++++++++------
 cbits/Win32Utils.c |   16 +++++++---------
 include/HsBase.h   |    2 +-
 3 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index bd03295..e37619a 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -98,7 +98,7 @@ import Data.Maybe
 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
@@ -707,8 +707,8 @@ data IOReq
 #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]
@@ -736,6 +736,7 @@ insertDelay d1 ds@(d2 : rest)
   | delayTime d1 <= delayTime d2 = d1 : ds
   | otherwise                    = d2 : insertDelay d1 rest
 
+delayTime :: DelayReq -> USecs
 delayTime (Delay t _) = t
 delayTime (DelaySTM t _) = t
 
@@ -836,9 +837,10 @@ getDelay now all@(d : rest)
 	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,
diff --git a/cbits/Win32Utils.c b/cbits/Win32Utils.c
index 942b2c4..0f4eb52 100644
--- a/cbits/Win32Utils.c
+++ b/cbits/Win32Utils.c
@@ -107,18 +107,16 @@ void maperrno (void)
 			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
diff --git a/include/HsBase.h b/include/HsBase.h
index 519adf7..09693cb 100644
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -134,7 +134,7 @@
 #if defined(__MINGW32__)
 /* in Win32Utils.c */
 extern void maperrno (void);
-extern HsInt getUSecOfDay(void);
+extern HsWord64 getUSecOfDay(void);
 #endif
 
 #if defined(__MINGW32__)
-- 
1.7.10.4