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, 227 insertions, 271 deletions

diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c
index efe3a32e8..b82c423cc 100644
--- a/otherlibs/win32unix/select.c
+++ b/otherlibs/win32unix/select.c
@@ -16,9 +16,11 @@
 #include <mlvalues.h>
 #include <alloc.h>
 #include <memory.h>
+#include <fail.h>
 #include <signals.h>
 #include <winsock2.h>
 #include <windows.h>
+#include <stdio.h>
 #include "unixsupport.h"
 #include "windbug.h"
 #include "winworker.h"
@@ -29,7 +31,7 @@
  * It takes the following parameters into account:
  * - limitation on number of objects is mostly due to limitation
  *   a WaitForMultipleObjects
- * - there is always an event "hStop" to watch
+ * - there is always an event "hStop" to watch 
  *
  * This lead to pick the following value as the biggest possible
  * value
@@ -70,9 +72,7 @@ void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl)
     hds->nLast++;
   }
 
-#ifdef DBUG
-  dbug_print("Adding handle %x to set %x", hdl, hds);
-#endif
+  DEBUG_PRINT("Adding handle %x to set %x", hdl, hds);
 }
 
 BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl)
@@ -115,7 +115,7 @@ typedef enum _SELECTHANDLETYPE {
 typedef enum _SELECTMODE {
   SELECT_MODE_NONE = 0,
   SELECT_MODE_READ,
-  SELECT_MODE_WRITE,
+  SELECT_MODE_WRITE, 
   SELECT_MODE_EXCEPT,
 } SELECTMODE;
 
@@ -138,17 +138,18 @@ typedef enum _SELECTTYPE {
 typedef struct _SELECTRESULT {
   LIST       lst;
   SELECTMODE EMode;
-  LPVOID     lpOrig;
+  int        lpOrigIdx;
 } SELECTRESULT;
 
 typedef SELECTRESULT *LPSELECTRESULT;
 
 /* Data structure for query */
 typedef struct _SELECTQUERY {
-  LIST       lst;
-  SELECTMODE EMode;
-  HANDLE     hFileDescr;
-  LPVOID     lpOrig;
+  LIST         lst;
+  SELECTMODE   EMode;
+  HANDLE       hFileDescr;
+  int          lpOrigIdx;
+  unsigned int uFlagsFd; /* Copy of filedescr->flags_fd */
 } SELECTQUERY;
 
 typedef SELECTQUERY *LPSELECTQUERY;
@@ -188,24 +189,18 @@ LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData, SELECTTYPE EType)
   /* Allocate the data structure */
   LPSELECTDATA res;
   DWORD        i;
-
-  if (!HeapLock(GetProcessHeap()))
-  {
-    win32_maperr(GetLastError());
-    uerror("select", Nothing);
-  }
-  res = (LPSELECTDATA)HeapAlloc(GetProcessHeap(), 0, sizeof(SELECTDATA));
-  HeapUnlock(GetProcessHeap());
+  
+  res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA)); 
 
   /* Init common data */
   list_init((LPLIST)res);
   list_next_set((LPLIST)res, (LPLIST)lpSelectData);
   res->EType         = EType;
   res->nResultsCount = 0;
-
+        
 
   /* Data following are dedicated to APC like call, they
-     will be initialized if required. For now they are set to
+     will be initialized if required. For now they are set to 
      invalid values.
      */
   res->funcWorker    = NULL;
@@ -222,9 +217,7 @@ void select_data_free (LPSELECTDATA lpSelectData)
 {
   DWORD i;
 
-#ifdef DBUG
-  dbug_print("Freeing data of %x", lpSelectData);
-#endif
+  DEBUG_PRINT("Freeing data of %x", lpSelectData);
 
   /* Free APC related data, if they exists */
   if (lpSelectData->lpWorker != NULL)
@@ -237,17 +230,11 @@ void select_data_free (LPSELECTDATA lpSelectData)
   lpSelectData->nResultsCount = 0;
   lpSelectData->nQueriesCount = 0;
 
-  if (!HeapLock(GetProcessHeap()))
-  {
-    win32_maperr(GetLastError());
-    uerror("select_data_free", Nothing);
-  };
-  HeapFree(GetProcessHeap(), 0, lpSelectData);
-  HeapUnlock(GetProcessHeap());
+  caml_stat_free(lpSelectData);
 }
 
 /* Add a result to select data, return zero if something goes wrong. */
-DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, LPVOID lpOrig)
+DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, int lpOrigIdx)
 {
   DWORD res;
   DWORD i;
@@ -257,7 +244,7 @@ DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, LPVOI
   {
     i = lpSelectData->nResultsCount;
     lpSelectData->aResults[i].EMode  = EMode;
-    lpSelectData->aResults[i].lpOrig = lpOrig;
+    lpSelectData->aResults[i].lpOrigIdx = lpOrigIdx;
     lpSelectData->nResultsCount++;
     res = 1;
   }
@@ -266,10 +253,14 @@ DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, LPVOI
 }
 
 /* Add a query to select data, return zero if something goes wrong */
-DWORD select_data_query_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
+DWORD select_data_query_add (LPSELECTDATA lpSelectData, 
+                             SELECTMODE EMode, 
+                             HANDLE hFileDescr, 
+                             int lpOrigIdx,
+                             unsigned int uFlagsFd)
 {
   DWORD res;
-  DWORD i;
+  DWORD i; 
 
   res = 0;
   if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
@@ -277,7 +268,8 @@ DWORD select_data_query_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE
     i = lpSelectData->nQueriesCount;
     lpSelectData->aQueries[i].EMode      = EMode;
     lpSelectData->aQueries[i].hFileDescr = hFileDescr;
-    lpSelectData->aQueries[i].lpOrig     = lpOrig;
+    lpSelectData->aQueries[i].lpOrigIdx  = lpOrigIdx;
+    lpSelectData->aQueries[i].uFlagsFd   = uFlagsFd;
     lpSelectData->nQueriesCount++;
     res = 1;
   }
@@ -286,25 +278,22 @@ DWORD select_data_query_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE
 }
 
 /* Search for a job that has available query slots and that match provided type.
- * If none is found, create a new one. Return the corresponding SELECTDATA, and
+ * If none is found, create a new one. Return the corresponding SELECTDATA, and 
  * update provided SELECTDATA head, if required.
  */
-LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData,
-                                     SELECTTYPE EType)
+LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE EType)
 {
   LPSELECTDATA res;
-
+  
   res = NULL;
-
+  
   /* Search for job */
-#ifdef DBUG
-  dbug_print("Searching an available job for type %d", EType);
-#endif
+  DEBUG_PRINT("Searching an available job for type %d", EType);
   res = *lppSelectData;
   while (
       res != NULL
       && !(
-        res->EType == EType
+        res->EType == EType 
         && res->nQueriesCount < MAXIMUM_SELECT_OBJECTS
         )
       )
@@ -315,9 +304,7 @@ LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData,
   /* No matching job found, create one */
   if (res == NULL)
   {
-#ifdef DBUG
-    dbug_print("No job for type %d found, create one", EType);
-#endif
+    DEBUG_PRINT("No job for type %d found, create one", EType);
     res = select_data_new(*lppSelectData, EType);
     *lppSelectData = res;
   }
@@ -337,10 +324,8 @@ void read_console_poll(HANDLE hStop, void *_data)
   DWORD n;
   LPSELECTDATA  lpSelectData;
   LPSELECTQUERY lpQuery;
-
-#ifdef DBUG
-  dbug_print("Waiting for data on console");
-#endif
+  
+  DEBUG_PRINT("Waiting for data on console");
 
   record;
   waitRes = 0;
@@ -351,7 +336,7 @@ void read_console_poll(HANDLE hStop, void *_data)
   events[0] = hStop;
   events[1] = lpQuery->hFileDescr;
   while (lpSelectData->EState == SELECT_STATE_NONE)
-  {
+  {    
     waitRes = WaitForMultipleObjects(2, events, FALSE, INFINITE);
     if (waitRes == WAIT_OBJECT_0 || check_error(lpSelectData, waitRes == WAIT_FAILED))
     {
@@ -368,11 +353,11 @@ void read_console_poll(HANDLE hStop, void *_data)
       record.Event.KeyEvent.bKeyDown &&
       record.Event.KeyEvent.uChar.AsciiChar != 0)
     {
-      select_data_result_add(lpSelectData, lpQuery->EMode, lpQuery->lpOrig);
+      select_data_result_add(lpSelectData, lpQuery->EMode, lpQuery->lpOrigIdx);
       lpSelectData->EState = SELECT_STATE_SIGNALED;
       break;
     }
-    else
+    else 
     {
       /* discard everything else and try again */
       if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0))
@@ -384,13 +369,17 @@ void read_console_poll(HANDLE hStop, void *_data)
 }
 
 /* Add a function to monitor console input */
-LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
+LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, 
+                                    SELECTMODE EMode, 
+                                    HANDLE hFileDescr, 
+                                    int lpOrigIdx,
+                                    unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
 
   res = select_data_new(lpSelectData, SELECT_TYPE_CONSOLE_READ);
   res->funcWorker = read_console_poll;
-  select_data_query_add(res, SELECT_MODE_READ, hFileDescr, lpOrig);
+  select_data_query_add(res, SELECT_MODE_READ, hFileDescr, lpOrigIdx, uFlagsFd);
 
   return res;
 }
@@ -402,81 +391,93 @@ LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode,
 /* Monitor a pipe for input */
 void read_pipe_poll (HANDLE hStop, void *_data)
 {
+  DWORD         res;
   DWORD         event;
   DWORD         n;
   LPSELECTQUERY iterQuery;
   LPSELECTDATA  lpSelectData;
   DWORD         i;
+  DWORD         wait;
 
   /* Poll pipe */
   event = 0;
   n = 0;
   lpSelectData = (LPSELECTDATA)_data;
+  wait = 1;
 
-#ifdef DBUG
-  dbug_print("Checking data pipe");
-#endif
+  DEBUG_PRINT("Checking data pipe");
   while (lpSelectData->EState == SELECT_STATE_NONE)
   {
     for (i = 0; i < lpSelectData->nQueriesCount; i++)
     {
       iterQuery = &(lpSelectData->aQueries[i]);
-      if (check_error(
-            lpSelectData,
-            PeekNamedPipe(
-              iterQuery->hFileDescr,
-              NULL,
-              0,
-              NULL,
-              &n,
-              NULL) == 0))
+      res = PeekNamedPipe(
+          iterQuery->hFileDescr, 
+          NULL, 
+          0, 
+          NULL, 
+          &n, 
+          NULL);
+      if (check_error(lpSelectData, 
+            (res == 0) && 
+            (GetLastError() != ERROR_BROKEN_PIPE)))
       {
         break;
       };
 
-      if (n > 0)
+      if ((n > 0) || (res == 0))
       {
         lpSelectData->EState = SELECT_STATE_SIGNALED;
-        select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig);
+        select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrigIdx);
       };
     };
 
     /* Alas, nothing except polling seems to work for pipes.
-       Check the state & stop_worker_event every 10 ms
+       Check the state & stop_worker_event every 10 ms 
      */
     if (lpSelectData->EState == SELECT_STATE_NONE)
     {
-      event = WaitForSingleObject(hStop, 10);
+      event = WaitForSingleObject(hStop, wait);
+
+      /* Fast start: begin to wait 1, 2, 4, 8 and then 10 ms.
+       * If we are working with the output of a program there is
+       * a chance that one of the 4 first calls succeed.
+       */
+      wait = 2 * wait;
+      if (wait > 10) 
+      {
+        wait = 10;
+      };
       if (event == WAIT_OBJECT_0 || check_error(lpSelectData, event == WAIT_FAILED))
       {
         break;
       }
     }
   }
-#ifdef DBUG
-  dbug_print("Finish checking data on pipe");
-#endif
+  DEBUG_PRINT("Finish checking data on pipe");
 }
 
 /* Add a function to monitor pipe input */
-LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
+LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, 
+                                 SELECTMODE EMode, 
+                                 HANDLE hFileDescr, 
+                                 int lpOrigIdx,
+                                 unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
   LPSELECTDATA hd;
-
+  
   hd = lpSelectData;
   /* Polling pipe is a non blocking operation by default. This means that each
-     worker can handle many pipe. We begin to try to find a worker that is
+     worker can handle many pipe. We begin to try to find a worker that is 
      polling pipe, but for which there is under the limit of pipe per worker.
      */
-#ifdef DBUG
-  dbug_print("Searching an available worker handling pipe");
-#endif
+  DEBUG_PRINT("Searching an available worker handling pipe");
   res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ);
-
+  
   /* Add a new pipe to poll */
   res->funcWorker = read_pipe_poll;
-  select_data_query_add(res, EMode, hFileDescr, lpOrig);
+  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
 
   return hd;
 }
@@ -515,24 +516,25 @@ void socket_poll (HANDLE hStop, void *_data)
         maskEvents = FD_OOB;
         break;
     }
+
     check_error(lpSelectData,
         WSAEventSelect(
-          (SOCKET)(iterQuery->hFileDescr),
-          aEvents[nEvents],
+          (SOCKET)(iterQuery->hFileDescr), 
+          aEvents[nEvents], 
           maskEvents) == SOCKET_ERROR);
   }
-
+  
   /* Add stop event */
   aEvents[nEvents]  = hStop;
   nEvents++;
 
   if (lpSelectData->nError == 0)
   {
-    check_error(lpSelectData,
+    check_error(lpSelectData, 
         WaitForMultipleObjects(
-          nEvents,
-          aEvents,
-          FALSE,
+          nEvents, 
+          aEvents, 
+          FALSE, 
           INFINITE) == WAIT_FAILED);
   };
 
@@ -543,20 +545,27 @@ void socket_poll (HANDLE hStop, void *_data)
       iterQuery = &(lpSelectData->aQueries[i]);
       if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0)
       {
-#ifdef DBUG
-        dbug_print("Socket %d has pending events", (i - 1));
-#endif
+        DEBUG_PRINT("Socket %d has pending events", (i - 1));
         if (iterQuery != NULL)
         {
-          select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig);
+          select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrigIdx);
         }
       }
       /* WSAEventSelect() automatically sets socket to nonblocking mode.
          Restore the blocking one. */
-      iMode = 0;
-      check_error(lpSelectData,
-        WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
-        ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
+      if (iterQuery->uFlagsFd & FLAGS_FD_IS_BLOCKING)
+      {
+        DEBUG_PRINT("Restore a blocking socket");
+        iMode = 1;
+        check_error(lpSelectData,
+          WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
+          ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
+      }
+      else
+      {
+        check_error(lpSelectData,
+          WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0);
+      };
 
       CloseHandle(aEvents[i]);
       aEvents[i] = INVALID_HANDLE_VALUE;
@@ -565,30 +574,28 @@ void socket_poll (HANDLE hStop, void *_data)
 }
 
 /* Add a function to monitor socket */
-LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
+LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, 
+                              SELECTMODE EMode, 
+                              HANDLE hFileDescr, 
+                              int lpOrigIdx,
+                              unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
   LPSELECTDATA hd;
-
+  
   hd = lpSelectData;
   /* Polling socket can be done mulitple handle at the same time. You just
      need one worker to use it. Try to find if there is already a worker
      handling this kind of request.
      */
-#ifdef DBUG
-  dbug_print("Scanning list of worker to find one that already handle socket");
-#endif
+  DEBUG_PRINT("Scanning list of worker to find one that already handle socket");
   res = select_data_job_search(&hd, SELECT_TYPE_SOCKET);
-
+  
   /* Add a new socket to poll */
   res->funcWorker = socket_poll;
-#ifdef DBUG
-  dbug_print("Add socket %x to worker", hFileDescr);
-#endif
-  select_data_query_add(res, EMode, hFileDescr, lpOrig);
-#ifdef DBUG
-  dbug_print("Socket %x added", hFileDescr);
-#endif
+  DEBUG_PRINT("Add socket %x to worker", hFileDescr);
+  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+  DEBUG_PRINT("Socket %x added", hFileDescr);
 
   return hd;
 }
@@ -598,18 +605,22 @@ LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDL
 /***********************/
 
 /* Add a static result */
-LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
+LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData, 
+                              SELECTMODE EMode, 
+                              HANDLE hFileDescr, 
+                              int lpOrigIdx,
+                              unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
   LPSELECTDATA hd;
-
+  
   /* Look for an already initialized static element */
   hd = lpSelectData;
   res = select_data_job_search(&hd, SELECT_TYPE_STATIC);
-
+  
   /* Add a new query/result */
-  select_data_query_add(res, EMode, hFileDescr, lpOrig);
-  select_data_result_add(res, EMode, lpOrig);
+  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+  select_data_result_add(res, EMode, lpOrigIdx);
 
   return hd;
 }
@@ -637,7 +648,7 @@ static SELECTHANDLETYPE get_handle_type(value fd)
   {
     switch(GetFileType(Handle_val(fd)))
     {
-      case FILE_TYPE_DISK:
+      case FILE_TYPE_DISK: 
         res = SELECT_HANDLE_DISK;
         break;
 
@@ -662,120 +673,99 @@ static SELECTHANDLETYPE get_handle_type(value fd)
 }
 
 /* Choose what to do with given data */
-LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, value fd)
+LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, value fd, int lpOrigIdx)
 {
   LPSELECTDATA    res;
   HANDLE          hFileDescr;
-  void           *lpOrig;
   struct sockaddr sa;
   int             sa_len;
   BOOL            alreadyAdded;
+  unsigned int    uFlagsFd;
 
   CAMLparam1(fd);
 
   res          = lpSelectData;
   hFileDescr   = Handle_val(fd);
-  lpOrig       = (void *)fd;
   sa_len       = sizeof(sa);
   alreadyAdded = FALSE;
+  uFlagsFd     = Flags_fd_val(fd);
 
-#ifdef DBUG
-  dbug_print("Begin dispatching handle %x", hFileDescr);
-#endif
+  DEBUG_PRINT("Begin dispatching handle %x", hFileDescr);
 
-#ifdef DBUG
-  dbug_print("Waiting for %d on handle %x", EMode, hFileDescr);
-#endif
-
-  /* There is only 2 way to have except mode: transmission of OOB data through
+  DEBUG_PRINT("Waiting for %d on handle %x", EMode, hFileDescr);
+  
+  /* There is only 2 way to have except mode: transmission of OOB data through 
      a socket TCP/IP and through a strange interaction with a TTY.
      With windows, we only consider the TCP/IP except condition
   */
   switch(get_handle_type(fd))
   {
     case SELECT_HANDLE_DISK:
-#ifdef DBUG
-      dbug_print("Handle %x is a disk handle", hFileDescr);
-#endif
+      DEBUG_PRINT("Handle %x is a disk handle", hFileDescr);
       /* Disk is always ready in read/write operation */
       if (EMode == SELECT_MODE_READ || EMode == SELECT_MODE_WRITE)
       {
-        res = static_poll_add(res, EMode, hFileDescr, lpOrig);
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       };
       break;
 
     case SELECT_HANDLE_CONSOLE:
-#ifdef DBUG
-      dbug_print("Handle %x is a console handle", hFileDescr);
-#endif
+      DEBUG_PRINT("Handle %x is a console handle", hFileDescr);
       /* Console is always ready in write operation, need to check for read. */
       if (EMode == SELECT_MODE_READ)
       {
-        res = read_console_poll_add(res, EMode, hFileDescr, lpOrig);
+        res = read_console_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       }
       else if (EMode == SELECT_MODE_WRITE)
       {
-        res = static_poll_add(res, EMode, hFileDescr, lpOrig);
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       };
       break;
 
     case SELECT_HANDLE_PIPE:
-#ifdef DBUG
-      dbug_print("Handle %x is a pipe handle", hFileDescr);
-#endif
+      DEBUG_PRINT("Handle %x is a pipe handle", hFileDescr);
       /* Console is always ready in write operation, need to check for read. */
       if (EMode == SELECT_MODE_READ)
       {
-#ifdef DBUG
-        dbug_print("Need to check availability of data on pipe");
-#endif
-        res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrig);
+        DEBUG_PRINT("Need to check availability of data on pipe");
+        res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       }
       else if (EMode == SELECT_MODE_WRITE)
       {
-#ifdef DBUG
-        dbug_print("No need to check availability of data on pipe, write operation always possible");
-#endif
-        res = static_poll_add(res, EMode, hFileDescr, lpOrig);
+        DEBUG_PRINT("No need to check availability of data on pipe, write operation always possible");
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       };
       break;
 
     case SELECT_HANDLE_SOCKET:
-#ifdef DBUG
-      dbug_print("Handle %x is a socket handle", hFileDescr);
-#endif
+      DEBUG_PRINT("Handle %x is a socket handle", hFileDescr);
       if (getsockname((SOCKET)hFileDescr, &sa, &sa_len) == SOCKET_ERROR)
       {
         if (WSAGetLastError() == WSAEINVAL)
         {
           /* Socket is not bound */
-#ifdef DBUG
-          dbug_print("Socket is not connected");
-#endif
+          DEBUG_PRINT("Socket is not connected");
           if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ)
           {
-            res = static_poll_add(res, EMode, hFileDescr, lpOrig);
+            res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
             alreadyAdded = TRUE;
           }
         }
       }
       if (!alreadyAdded)
       {
-        res = socket_poll_add(res, EMode, hFileDescr, lpOrig);
+        res = socket_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
       }
       break;
 
     default:
-#ifdef DBUG
-      dbug_print("Handle %x is unknown", hFileDescr);
-#endif
-      caml_failwith("Unknown handle");
+      DEBUG_PRINT("Handle %x is unknown", hFileDescr);
+      win32_maperr(ERROR_INVALID_HANDLE);
+      uerror("select", Nothing);
       break;
   };
 
-#ifdef DBUG
-  dbug_print("Finish dispatching handle %x", hFileDescr);
-#endif
+  DEBUG_PRINT("Finish dispatching handle %x", hFileDescr);
 
   CAMLreturnT(LPSELECTDATA, res);
 }
@@ -793,15 +783,47 @@ static DWORD caml_list_length (value lst)
   CAMLreturnT(DWORD, res);
 }
 
+static value find_handle(LPSELECTRESULT iterResult, value readfds, value writefds, value exceptfds)
+{
+  CAMLparam3(readfds, writefds, exceptfds);
+  CAMLlocal2(result, list);
+  int i;
+
+  switch( iterResult->EMode )  
+  {
+    case SELECT_MODE_READ:
+      list = readfds;
+      break;
+    case SELECT_MODE_WRITE:
+      list = writefds;
+      break;
+    case SELECT_MODE_EXCEPT:
+      list = exceptfds;
+      break;
+  };
+
+  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i ) 
+  {
+    list = Field(list, 1);
+  }
+
+  if (list == Val_unit) 
+    failwith ("select.c: original file handle not found");
+
+  result = Field(list, 0);
+
+  CAMLreturn( result );
+}
+
 #define MAX(a, b) ((a) > (b) ? (a) : (b))
 
 CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
-{
+{  
   /* Event associated to handle */
   DWORD   nEventsCount;
   DWORD   nEventsMax;
   HANDLE *lpEventsDone;
-
+  
   /* Data for all handles */
   LPSELECTDATA lpSelectData;
   LPSELECTDATA iterSelectData;
@@ -838,9 +860,7 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
   CAMLlocal5 (read_list, write_list, except_list, res, l);
   CAMLlocal1 (fd);
 
-#ifdef DBUG
-  dbug_print("in select");
-#endif
+  DEBUG_PRINT("in select");
 
   nEventsCount   = 0;
   nEventsMax     = 0;
@@ -856,23 +876,12 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
   exceptfds_len  = caml_list_length(exceptfds);
   hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
 
-  if (!HeapLock(GetProcessHeap()))
-  {
-    win32_maperr(GetLastError());
-    uerror("select", Nothing);
-  }
-  hdsData = (HANDLE *)HeapAlloc(
-      GetProcessHeap(),
-      0,
-      sizeof(HANDLE) * hdsMax);
-  HeapUnlock(GetProcessHeap());
+  hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
 
   if (Double_val(timeout) >= 0.0)
   {
     milliseconds = 1000 * Double_val(timeout);
-#ifdef DBUG
-    dbug_print("Will wait %d ms", milliseconds);
-#endif
+    DEBUG_PRINT("Will wait %d ms", milliseconds);
   }
   else
   {
@@ -881,82 +890,65 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
 
 
   /* Create list of select data, based on the different list of fd to watch */
-#ifdef DBUG
-  dbug_print("Dispatch read fd");
-#endif
+  DEBUG_PRINT("Dispatch read fd");
   handle_set_init(&hds, hdsData, hdsMax);
+  i=0;
   for (l = readfds; l != Val_int(0); l = Field(l, 1))
   {
     fd = Field(l, 0);
     if (!handle_set_mem(&hds, Handle_val(fd)))
     {
       handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd);
+      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
     }
     else
     {
-#ifdef DBUG
-      dbug_print("Discarding handle %x which is already monitor for read", Handle_val(fd));
-#endif
+      DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
     }
   }
   handle_set_reset(&hds);
 
-#ifdef DBUG
-  dbug_print("Dispatch write fd");
-#endif
+  DEBUG_PRINT("Dispatch write fd");
   handle_set_init(&hds, hdsData, hdsMax);
+  i=0;
   for (l = writefds; l != Val_int(0); l = Field(l, 1))
   {
     fd = Field(l, 0);
     if (!handle_set_mem(&hds, Handle_val(fd)))
     {
       handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd);
+      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
     }
     else
     {
-#ifdef DBUG
-      dbug_print("Discarding handle %x which is already monitor for write", Handle_val(fd));
-#endif
+      DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
     }
   }
   handle_set_reset(&hds);
 
-#ifdef DBUG
-  dbug_print("Dispatch exceptional fd");
-#endif
+  DEBUG_PRINT("Dispatch exceptional fd");
   handle_set_init(&hds, hdsData, hdsMax);
+  i=0;
   for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
   {
     fd = Field(l, 0);
     if (!handle_set_mem(&hds, Handle_val(fd)))
     {
       handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd);
+      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
     }
     else
     {
-#ifdef DBUG
-      dbug_print("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
-#endif
+      DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
     }
   }
   handle_set_reset(&hds);
 
   /* Building the list of handle to wait for */
-#ifdef DBUG
-  dbug_print("Building events done array");
-#endif
+  DEBUG_PRINT("Building events done array");
   nEventsMax   = list_length((LPLIST)lpSelectData);
   nEventsCount = 0;
-  if (!HeapLock(GetProcessHeap()))
-  {
-    win32_maperr(GetLastError());
-    uerror("select", Nothing);
-  }
-  lpEventsDone = (HANDLE *)HeapAlloc(GetProcessHeap(), 0, sizeof(HANDLE) * nEventsMax);
-  HeapUnlock(GetProcessHeap());
+  lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
 
   iterSelectData = lpSelectData;
   while (iterSelectData != NULL)
@@ -974,22 +966,18 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
     /* Execute APC */
     if (iterSelectData->funcWorker != NULL)
     {
-      iterSelectData->lpWorker =
+      iterSelectData->lpWorker = 
         worker_job_submit(
-            iterSelectData->funcWorker,
+            iterSelectData->funcWorker, 
             (void *)iterSelectData);
-#ifdef DBUG
-      dbug_print("Job submitted to worker %x", iterSelectData->lpWorker);
-#endif
+      DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker); 
       lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
       nEventsCount++;
     };
     iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
   };
 
-#ifdef DBUG
-  dbug_print("Need to watch %d workers", nEventsCount);
-#endif
+  DEBUG_PRINT("Need to watch %d workers", nEventsCount);
 
   /* Processing select itself */
   enter_blocking_section();
@@ -999,9 +987,7 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
     /* Waiting for event */
     if (err == 0 && !hasStaticData)
     {
-#ifdef DBUG
-      dbug_print("Waiting for one select worker to be done");
-#endif
+      DEBUG_PRINT("Waiting for one select worker to be done");
       switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
       {
         case WAIT_FAILED:
@@ -1009,23 +995,17 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
           break;
 
         case WAIT_TIMEOUT:
-#ifdef DBUG
-          dbug_print("Select timeout");
-#endif
+          DEBUG_PRINT("Select timeout");
           break;
 
         default:
-#ifdef DBUG
-          dbug_print("One worker is done");
-#endif
+          DEBUG_PRINT("One worker is done");
           break;
       };
     }
 
     /* Ordering stop to every worker */
-#ifdef DBUG
-    dbug_print("Sending stop signal to every select workers");
-#endif
+    DEBUG_PRINT("Sending stop signal to every select workers");
     iterSelectData = lpSelectData;
     while (iterSelectData != NULL)
     {
@@ -1035,10 +1015,8 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
       };
       iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
     };
-
-#ifdef DBUG
-    dbug_print("Waiting for every select worker to be done");
-#endif
+      
+    DEBUG_PRINT("Waiting for every select worker to be done");
     switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
     {
       case WAIT_FAILED:
@@ -1046,9 +1024,7 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
         break;
 
       default:
-#ifdef DBUG
-        dbug_print("Every worker is done");
-#endif
+        DEBUG_PRINT("Every worker is done");
         break;
     }
   }
@@ -1059,16 +1035,12 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
   }
   leave_blocking_section();
 
-#ifdef DBUG
-  dbug_print("Error status: %d (0 is ok)", err);
-#endif
+  DEBUG_PRINT("Error status: %d (0 is ok)", err);
   /* Build results */
   if (err == 0)
   {
-#ifdef DBUG
-    dbug_print("Building result");
-#endif
-    read_list = Val_unit;
+    DEBUG_PRINT("Building result");
+    read_list = Val_unit; 
     write_list = Val_unit;
     except_list = Val_unit;
 
@@ -1079,7 +1051,7 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
       {
         iterResult = &(iterSelectData->aResults[i]);
         l = alloc_small(2, 0);
-        Store_field(l, 0, (value)iterResult->lpOrig);
+        Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
         switch (iterResult->EMode)
         {
         case SELECT_MODE_READ:
@@ -1106,9 +1078,7 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
   }
 
   /* Free resources */
-#ifdef DBUG
-  dbug_print("Free selectdata resources");
-#endif
+  DEBUG_PRINT("Free selectdata resources");
   iterSelectData = lpSelectData;
   while (iterSelectData != NULL)
   {
@@ -1117,40 +1087,26 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
     select_data_free(lpSelectData);
   }
   lpSelectData = NULL;
-
+  
   /* Free allocated events/handle set array */
-#ifdef DBUG
-  dbug_print("Free local allocated resources");
-#endif
-  if (!HeapLock(GetProcessHeap()))
-  {
-    win32_maperr(GetLastError());
-    uerror("select", Nothing);
-  }
-  HeapFree(GetProcessHeap(), 0, lpEventsDone);
-  HeapFree(GetProcessHeap(), 0, hdsData);
-  HeapUnlock(GetProcessHeap());
+  DEBUG_PRINT("Free local allocated resources");
+  caml_stat_free(lpEventsDone);
+  caml_stat_free(hdsData);
 
-#ifdef DBUG
-  dbug_print("Raise error if required");
-#endif
+  DEBUG_PRINT("Raise error if required");
   if (err != 0)
   {
     win32_maperr(err);
     uerror("select", Nothing);
   }
 
-#ifdef DBUG
-  dbug_print("Build final result");
-#endif
+  DEBUG_PRINT("Build final result");
   res = alloc_small(3, 0);
   Store_field(res, 0, read_list);
   Store_field(res, 1, write_list);
   Store_field(res, 2, except_list);
 
-#ifdef DBUG
-  dbug_print("out select");
-#endif
+  DEBUG_PRINT("out select");
 
   CAMLreturn(res);
 }