[commit: ghc] master: Fix threadDelay on Windows; fixes ThreadDelay001 failures (8c8e959)

Ian Lynagh igloo at earth.li
Wed Feb 6 15:08:20 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8c8e959fdf86281c01e3392a3860ab64524d37df

>---------------------------------------------------------------

commit 8c8e959fdf86281c01e3392a3860ab64524d37df
Author: Ian Lynagh <igloo at earth.li>
Date:   Wed Feb 6 13:14:55 2013 +0000

    Fix threadDelay on Windows; fixes ThreadDelay001 failures
    
    MSDN says of Sleep:
        If dwMilliseconds is greater than one tick but less than two, the
        wait can be anywhere between one and two ticks, and so on.
    so we need to add (milliseconds-per-tick - 1) to the amount of time we
    sleep for.

>---------------------------------------------------------------

 rts/win32/IOManager.c |   24 +++++++++++++++++++++++-
 1 files changed, 23 insertions(+), 1 deletions(-)

diff --git a/rts/win32/IOManager.c b/rts/win32/IOManager.c
index 8490ed2..65f5d4c 100644
--- a/rts/win32/IOManager.c
+++ b/rts/win32/IOManager.c
@@ -32,6 +32,7 @@ typedef struct IOManagerState {
     /* fields for keeping track of active WorkItems */
     CritSection      active_work_lock;
     WorkItem*        active_work_items;
+    UINT             sleepResolution;
 } IOManagerState;
 
 /* ToDo: wrap up this state via a IOManager handle instead? */
@@ -199,7 +200,7 @@ IOWorkerProc(PVOID param)
 		     * 
 		     * Note: Sleep() is in milliseconds, not micros.
 		     */
-		    Sleep((work->workData.delayData.usecs + 999) / 1000);
+		    Sleep(((work->workData.delayData.usecs + 999) / 1000) + iom->sleepResolution - 1);
 		    len = work->workData.delayData.usecs;
 		    complData = NULL;
 		    fd = 0;
@@ -266,6 +267,19 @@ StartIOManager(void)
 {
     HANDLE hExit;
     WorkQueue* wq;
+    UINT sleepResolution;
+    TIMECAPS timecaps;
+    MMRESULT mmresult;
+
+    mmresult = timeGetDevCaps(&timecaps, sizeof(timecaps));
+    if (mmresult != MMSYSERR_NOERROR) {
+        return FALSE;
+    }
+    sleepResolution = timecaps.wPeriodMin;
+    mmresult = timeBeginPeriod(sleepResolution);
+    if (mmresult != MMSYSERR_NOERROR) {
+        return FALSE;
+    }
 
     wq = NewWorkQueue();
     if ( !wq ) return FALSE;  
@@ -294,6 +308,7 @@ StartIOManager(void)
     ioMan->requestID   = 1;
     InitializeCriticalSection(&ioMan->active_work_lock);
     ioMan->active_work_items = NULL;
+    ioMan->sleepResolution = sleepResolution;
  
     return TRUE;
 }
@@ -455,6 +470,7 @@ AddProcRequest ( void* proc,
 void ShutdownIOManager ( rtsBool wait_threads )
 {
     int num;
+    MMRESULT mmresult;
 
     SetEvent(ioMan->hExitEvent);
   
@@ -472,6 +488,12 @@ void ShutdownIOManager ( rtsBool wait_threads )
         CloseHandle(ioMan->hExitEvent);
         DeleteCriticalSection(&ioMan->active_work_lock);
         DeleteCriticalSection(&ioMan->manLock);
+
+        mmresult = timeEndPeriod(ioMan->sleepResolution);
+        if (mmresult != MMSYSERR_NOERROR) {
+            barf("timeEndPeriod failed");
+        }
+
         free(ioMan);
         ioMan = NULL;
     }





More information about the ghc-commits mailing list