[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