Patch provided by Sylvain Le Gall:

- Fix #4894: Windows (mingw): Unix.select and non-blocking sockets,
  add a filedescr.flags_fd in win32unix/unixsupport.h. It contains the
  non-blocking status of the associated filedescr and helps to restore
  this status after a select.
- Fix #4789: Windows: Unix.select failing with EPIPE error,
  Apply patch provided by J. Vouillon
- Fix #4973: Failure "Unknown handle",
  Be consistent between Windows and Linux, raise an EBADF Unix_error
  for a closed pipe handle.
- Fix #4844: Unix.select bug (triggered if linked against threads),
  Apply patch by C. Bauer, replace lpOrig by lpOrigIdx which can survive
  a GC collection

For otherlibs/win32unix/{select|windbug}.c:
- Remove Heap* fucntions to allocate/free memory and replace it by
  caml_stat_* function, which are more OCaml compliant
- Rework DBUG message, use DEBUG_PRINT rather than #ifdef DBUG... #endif
  and use DEBUG variable (more OCaml compliant), also remove dbug_init
  functions and use a static variable to replace it (subject to race
  condition but this not really important, because every path lead to
  same initialization)
- Use a fast start scheme for pipe polling, rather than always waiting
  10ms, start by 1, 2, 4, 8 and then 10ms. The 4 first times give select
  a chance to a fast answer.



git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10467 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 22 insertions, 40 deletions

diff --git a/otherlibs/win32unix/winworker.c b/otherlibs/win32unix/winworker.c
index aa83684b2..57f95a9ae 100644
--- a/otherlibs/win32unix/winworker.c
+++ b/otherlibs/win32unix/winworker.c
@@ -47,7 +47,6 @@ LPWORKER lpWorkers       = NULL;
 DWORD    nWorkersCurrent = 0;
 DWORD    nWorkersMax     = 0;
 HANDLE   hWorkersMutex   = INVALID_HANDLE_VALUE;
-HANDLE   hWorkerHeap     = INVALID_HANDLE_VALUE;
 
 DWORD WINAPI worker_wait (LPVOID _data)
 {
@@ -57,7 +56,7 @@ DWORD WINAPI worker_wait (LPVOID _data)
   lpWorker = (LPWORKER )_data;
   bExit    = FALSE;
 
-  DBUG_PRINT("Worker %x starting", lpWorker);
+  DEBUG_PRINT("Worker %x starting", lpWorker);
   while (
       !bExit
       && SignalObjectAndWait(
@@ -66,7 +65,7 @@ DWORD WINAPI worker_wait (LPVOID _data)
         INFINITE,
         TRUE) == WAIT_OBJECT_0)
   {
-    DBUG_PRINT("Worker %x running", lpWorker);
+    DEBUG_PRINT("Worker %x running", lpWorker);
     switch (lpWorker->ECommand)
     {
       case WORKER_CMD_NONE:
@@ -86,7 +85,7 @@ DWORD WINAPI worker_wait (LPVOID _data)
         break;
     }
   };
-  DBUG_PRINT("Worker %x exiting", lpWorker);
+  DEBUG_PRINT("Worker %x exiting", lpWorker);
 
   return 0;
 }
@@ -95,13 +94,7 @@ LPWORKER worker_new (void)
 {
   LPWORKER lpWorker = NULL;
 
-  if (!HeapLock(hWorkerHeap))
-  {
-    win32_maperr(GetLastError());
-    uerror("worker_new", Nothing);
-  };
-  lpWorker = (LPWORKER)HeapAlloc(hWorkerHeap, 0, sizeof(WORKER));
-  HeapUnlock(hWorkerHeap);
+  lpWorker = (LPWORKER)caml_stat_alloc(sizeof(WORKER));
   list_init((LPLIST)lpWorker);
   lpWorker->hJobStarted  = CreateEvent(NULL, TRUE, FALSE, NULL);
   lpWorker->hJobStop     = CreateEvent(NULL, TRUE, FALSE, NULL);
@@ -124,14 +117,14 @@ LPWORKER worker_new (void)
 void worker_free (LPWORKER lpWorker)
 {
   /* Wait for termination of the worker */
-  DBUG_PRINT("Shutting down worker %x", lpWorker);
+  DEBUG_PRINT("Shutting down worker %x", lpWorker);
   WaitForSingleObject(lpWorker->hWorkerReady, INFINITE);
   lpWorker->ECommand = WORKER_CMD_STOP;
   SetEvent(lpWorker->hCommandReady);
   WaitForSingleObject(lpWorker->hThread, INFINITE);
 
   /* Free resources */
-  DBUG_PRINT("Freeing resources of worker %x", lpWorker);
+  DEBUG_PRINT("Freeing resources of worker %x", lpWorker);
   if (lpWorker->hThread != INVALID_HANDLE_VALUE)
   {
     CloseHandle(lpWorker->hThread);
@@ -171,13 +164,7 @@ void worker_free (LPWORKER lpWorker)
     lpWorker->hCommandReady = INVALID_HANDLE_VALUE;
   }
 
-  if (!HeapLock(hWorkerHeap))
-  {
-    win32_maperr(GetLastError());
-    uerror("worker_new", Nothing);
-  };
-  HeapFree(hWorkerHeap, 0, lpWorker);
-  HeapUnlock(hWorkerHeap);
+  caml_stat_free(lpWorker);
 };
 
 LPWORKER worker_pop (void)
@@ -193,7 +180,7 @@ LPWORKER worker_pop (void)
   }
   nWorkersCurrent++;
   nWorkersMax = (nWorkersCurrent > nWorkersMax ? nWorkersCurrent : nWorkersMax);
-  DBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d",
+  DEBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d",
       nWorkersCurrent,
       nWorkersMax,
       list_length((LPLIST)lpWorkers));
@@ -224,16 +211,16 @@ void worker_push(LPWORKER lpWorker)
   bFreeWorker = TRUE;
 
   WaitForSingleObject(hWorkersMutex, INFINITE);
-  DBUG_PRINT("Testing if we are under the maximum number of running workers");
+  DEBUG_PRINT("Testing if we are under the maximum number of running workers");
   if (list_length((LPLIST)lpWorkers) < THREAD_WORKERS_MAX)
   {
-    DBUG_PRINT("Saving this worker for future use");
-    DBUG_PRINT("Next: %x", ((LPLIST)lpWorker)->lpNext);
+    DEBUG_PRINT("Saving this worker for future use");
+    DEBUG_PRINT("Next: %x", ((LPLIST)lpWorker)->lpNext);
     lpWorkers = (LPWORKER)list_concat((LPLIST)lpWorker, (LPLIST)lpWorkers);
     bFreeWorker = FALSE;
   };
   nWorkersCurrent--;
-  DBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d",
+  DEBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d",
       nWorkersCurrent,
       nWorkersMax,
       list_length((LPLIST)lpWorkers));
@@ -241,7 +228,7 @@ void worker_push(LPWORKER lpWorker)
 
   if (bFreeWorker)
   {
-    DBUG_PRINT("Freeing worker %x", lpWorker);
+    DEBUG_PRINT("Freeing worker %x", lpWorker);
     worker_free(lpWorker);
   }
 }
@@ -253,16 +240,11 @@ void worker_init (void)
   /* Init a shared variable. The only way to ensure that no other
      worker will be at the same point is to use a critical section.
      */
-  DBUG_PRINT("Allocating mutex for workers");
+  DEBUG_PRINT("Allocating mutex for workers");
   if (hWorkersMutex == INVALID_HANDLE_VALUE)
   {
     hWorkersMutex = CreateMutex(NULL, FALSE, NULL);
   }
-
-  if (hWorkerHeap == INVALID_HANDLE_VALUE)
-  {
-    hWorkerHeap = HeapCreate(0, sizeof(WORKER) * THREAD_WORKERS_MAX * 4, 0);
-  }
 }
 
 void worker_cleanup(void)
@@ -276,13 +258,13 @@ void worker_cleanup(void)
   if (hWorkersMutex != INVALID_HANDLE_VALUE)
   {
     WaitForSingleObject(hWorkersMutex, INFINITE);
-    DBUG_PRINT("Freeing global resource of workers");
+    DEBUG_PRINT("Freeing global resource of workers");
     /* Empty the queue of worker worker */
     while (lpWorkers != NULL)
     {
       ReleaseMutex(hWorkersMutex);
       lpWorker = worker_pop();
-      DBUG_PRINT("Freeing worker %x", lpWorker);
+      DEBUG_PRINT("Freeing worker %x", lpWorker);
       WaitForSingleObject(hWorkersMutex, INFINITE);
       worker_free(lpWorker);
     };
@@ -298,18 +280,18 @@ LPWORKER worker_job_submit (WORKERFUNC f, void *user_data)
 {
   LPWORKER lpWorker = worker_pop();
 
-  DBUG_PRINT("Waiting for worker to be ready");
+  DEBUG_PRINT("Waiting for worker to be ready");
   enter_blocking_section();
   WaitForSingleObject(lpWorker->hWorkerReady, INFINITE);
   ResetEvent(lpWorker->hWorkerReady);
   leave_blocking_section();
-  DBUG_PRINT("Worker is ready");
+  DEBUG_PRINT("Worker is ready");
 
   lpWorker->hJobFunc      = f;
   lpWorker->lpJobUserData = user_data;
   lpWorker->ECommand      = WORKER_CMD_EXEC;
 
-  DBUG_PRINT("Call worker (func: %x, worker: %x)", f, lpWorker);
+  DEBUG_PRINT("Call worker (func: %x, worker: %x)", f, lpWorker);
   SetEvent(lpWorker->hCommandReady);
 
   return (LPWORKER)lpWorker;
@@ -322,14 +304,14 @@ HANDLE worker_job_event_done (LPWORKER lpWorker)
 
 void worker_job_stop (LPWORKER lpWorker)
 {
-  DBUG_PRINT("Sending stop signal to worker %x", lpWorker);
+  DEBUG_PRINT("Sending stop signal to worker %x", lpWorker);
   SetEvent(lpWorker->hJobStop);
-  DBUG_PRINT("Signal sent to worker %x", lpWorker);
+  DEBUG_PRINT("Signal sent to worker %x", lpWorker);
 }
 
 void worker_job_finish (LPWORKER lpWorker)
 {
-  DBUG_PRINT("Finishing call of worker %x", lpWorker);
+  DEBUG_PRINT("Finishing call of worker %x", lpWorker);
   enter_blocking_section();
   WaitForSingleObject(lpWorker->hJobDone, INFINITE);
   leave_blocking_section();