Tentative fix for PR#4098. Need testing.

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

byterun/io.c

@@ -69,6 +69,7 @@ CAMLexport struct channel * caml_open_descriptor_in(int fd)
   channel->revealed = 0;
   channel->old_revealed = 0;
   channel->refcount = 0;
+  channel->flags = 0;
   channel->next = caml_all_opened_channels;
   channel->prev = NULL;
   if (caml_all_opened_channels != NULL)

byterun/io.h

@@ -47,9 +47,14 @@ struct channel {
   int revealed;                 /* For Cash only */
   int old_revealed;             /* For Cash only */
   int refcount;                 /* For flush_all and for Cash */
+  int flags;                    /* Bitfield */
   char buff[IO_BUFFER_SIZE];    /* The buffer itself */
 };
 
+enum {
+  CHANNEL_FLAG_FROM_SOCKET = 1,   /* For Windows */
+};
+
 /* For an output channel:
      [offset] is the absolute position of the beginning of the buffer [buff].
    For an input channel:
@@ -73,6 +78,7 @@ CAMLextern struct channel * caml_open_descriptor_in (int);
 CAMLextern struct channel * caml_open_descriptor_out (int);
 CAMLextern void caml_close_channel (struct channel *);
 CAMLextern int caml_channel_binary_mode (struct channel *);
+CAMLextern value caml_alloc_channel(struct channel *chan);
 
 CAMLextern int caml_flush_partial (struct channel *);
 CAMLextern void caml_flush (struct channel *);

otherlibs/win32unix/channels.c

@@ -15,23 +15,67 @@
 
 #include <mlvalues.h>
 #include <alloc.h>
+#include <io.h>
 #include "unixsupport.h"
 #include <fcntl.h>
 
 extern long _get_osfhandle(int);
 extern int _open_osfhandle(long, int);
 
-CAMLprim value win_fd_handle(value handle)
+static int CRT_fd_of_filedescr(value handle)
 {
-  int fd;
   if (CRT_fd_val(handle) != NO_CRT_FD) {
-    fd = CRT_fd_val(handle);
+    return CRT_fd_val(handle);
   } else {
-    fd = _open_osfhandle((long) Handle_val(handle), O_BINARY);
+    int fd = _open_osfhandle((long) Handle_val(handle), O_BINARY);
     if (fd == -1) uerror("channel_of_descr", Nothing);
-    CRT_fd_val(handle) = fd;
+    return fd;
   }
-  return Val_int(fd);
+}
+
+CAMLprim value win_inchannel_of_filedescr(value handle)
+{
+  CAMLparam1(handle);
+  CAMLlocal1(vchan);
+  struct channel * chan;
+
+  chan = caml_open_descriptor_in(CRT_fd_of_filedescr(handle));
+  if (Descr_kind_val(handle) == KIND_SOCKET)
+    chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
+  vchan = caml_alloc_channel(chan);
+  CAMLreturn(vchan); 
+}
+
+CAMLprim value win_outchannel_of_filedescr(value handle)
+{
+  CAMLparam1(handle);
+  CAMLlocal1(vchan);
+  int fd;
+  struct channel * chan;
+
+  chan = caml_open_descriptor_out(CRT_fd_of_filedescr(handle));
+  if (Descr_kind_val(handle) == KIND_SOCKET)
+    chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
+  vchan = caml_alloc_channel(chan);
+  CAMLreturn(vchan); 
+}
+
+CAMLprim value win_filedescr_of_channel(value vchan)
+{
+  CAMLparam1(vchan);
+  CAMLlocal1(fd);
+  struct channel * chan;
+  HANDLE h;
+
+  chan = Channel(vchan);
+  if (channel->fd == -1) uerror("descr_of_channel", Nothing);
+  h = (HANDLE) _get_osfhandle(channel->fd);
+  if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
+    fd = win_alloc_socket(h);
+  else
+    fd = win_alloc_handle(h);
+  CRT_fd_val(fd) = channel->fd;
+  CAMLreturn(fd);
 }
 
 CAMLprim value win_handle_fd(value vfd)

otherlibs/win32unix/unix.ml

@@ -198,23 +198,10 @@ let single_write fd buf ofs len =
 
 (* Interfacing with the standard input/output library *)
 
-external open_read_descriptor : int -> in_channel = "caml_ml_open_descriptor_in"
-external open_write_descriptor : int -> out_channel
-                               = "caml_ml_open_descriptor_out"
-external fd_of_in_channel : in_channel -> int = "caml_channel_descriptor"
-external fd_of_out_channel : out_channel -> int = "caml_channel_descriptor"
-
-external open_handle : file_descr -> int = "win_fd_handle"
-
-let in_channel_of_descr handle =
-  open_read_descriptor(open_handle handle)
-let out_channel_of_descr handle =
-  open_write_descriptor(open_handle handle)
-
-let descr_of_in_channel inchan =
-  filedescr_of_fd(fd_of_in_channel inchan)
-let descr_of_out_channel outchan =
-  filedescr_of_fd(fd_of_out_channel outchan)
+external in_channel_of_descr: file_descr -> in_channel = "win_inchannel_of_filedescr"
+external out_channel_of_descr: file_descr -> out_channel = "win_outchannel_of_filedescr"
+external descr_of_in_channel : in_channel -> file_descr = "win_filedescr_of_channel"
+external descr_of_out_channel : out_channel -> file_descr = "win_filedescr_of_channel"
 
 (* Seeking and truncating *)
 

otherlibs/win32unix/unixsupport.h

@@ -17,9 +17,6 @@
 #include <wtypes.h>
 #include <winbase.h>
 #include <stdlib.h>
-/* Include io.h in current dir, which is a copy of the system's io.h,
-   not io.h from ../../byterun */
-/*#include "io.h"*/
 #include <direct.h>
 #include <process.h>
 #include <sys/types.h>