diff -Naur ocaml-unix-3.10.2/otherlibs/unix/accept.c ocaml-unix-3.11.2/otherlibs/unix/accept.c --- ocaml-unix-3.10.2/otherlibs/unix/accept.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/accept.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: accept.c,v 1.13 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: accept.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/access.c ocaml-unix-3.11.2/otherlibs/unix/access.c --- ocaml-unix-3.10.2/otherlibs/unix/access.c 2007-10-09 16:30:29.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/access.c 2008-01-11 17:13:18.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: access.c,v 1.11.12.1 2007/10/09 14:30:29 xleroy Exp $ */ +/* $Id: access.c 8768 2008-01-11 16:13:18Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/addrofstr.c ocaml-unix-3.11.2/otherlibs/unix/addrofstr.c --- ocaml-unix-3.10.2/otherlibs/unix/addrofstr.c 2004-04-09 15:25:20.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/addrofstr.c 2004-04-09 15:25:23.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: addrofstr.c,v 1.11 2004/04/09 13:25:20 xleroy Exp $ */ +/* $Id: addrofstr.c 6193 2004-04-09 13:25:23Z xleroy $ */ #include <mlvalues.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/alarm.c ocaml-unix-3.11.2/otherlibs/unix/alarm.c --- ocaml-unix-3.10.2/otherlibs/unix/alarm.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/alarm.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: alarm.c,v 1.8 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: alarm.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/bind.c ocaml-unix-3.11.2/otherlibs/unix/bind.c --- ocaml-unix-3.10.2/otherlibs/unix/bind.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/bind.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: bind.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: bind.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/chdir.c ocaml-unix-3.11.2/otherlibs/unix/chdir.c --- ocaml-unix-3.10.2/otherlibs/unix/chdir.c 2001-12-07 14:40:24.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/chdir.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: chdir.c,v 1.8 2001/12/07 13:40:24 xleroy Exp $ */ +/* $Id: chdir.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/chmod.c ocaml-unix-3.11.2/otherlibs/unix/chmod.c --- ocaml-unix-3.10.2/otherlibs/unix/chmod.c 2001-12-07 14:40:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/chmod.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: chmod.c,v 1.9 2001/12/07 13:40:26 xleroy Exp $ */ +/* $Id: chmod.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <sys/types.h> #include <sys/stat.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/chown.c ocaml-unix-3.11.2/otherlibs/unix/chown.c --- ocaml-unix-3.10.2/otherlibs/unix/chown.c 2001-12-07 14:40:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/chown.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: chown.c,v 1.8 2001/12/07 13:40:26 xleroy Exp $ */ +/* $Id: chown.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/chroot.c ocaml-unix-3.11.2/otherlibs/unix/chroot.c --- ocaml-unix-3.10.2/otherlibs/unix/chroot.c 2001-12-07 14:40:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/chroot.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: chroot.c,v 1.8 2001/12/07 13:40:26 xleroy Exp $ */ +/* $Id: chroot.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/close.c ocaml-unix-3.11.2/otherlibs/unix/close.c --- ocaml-unix-3.10.2/otherlibs/unix/close.c 2001-12-07 14:40:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/close.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: close.c,v 1.10 2001/12/07 13:40:26 xleroy Exp $ */ +/* $Id: close.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/closedir.c ocaml-unix-3.11.2/otherlibs/unix/closedir.c --- ocaml-unix-3.10.2/otherlibs/unix/closedir.c 2004-02-14 11:21:22.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/closedir.c 2004-02-14 11:21:23.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: closedir.c,v 1.9 2004/02/14 10:21:22 xleroy Exp $ */ +/* $Id: closedir.c 6113 2004-02-14 10:21:23Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/connect.c ocaml-unix-3.11.2/otherlibs/unix/connect.c --- ocaml-unix-3.10.2/otherlibs/unix/connect.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/connect.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: connect.c,v 1.12 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: connect.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/cst2constr.c ocaml-unix-3.11.2/otherlibs/unix/cst2constr.c --- ocaml-unix-3.10.2/otherlibs/unix/cst2constr.c 2001-12-07 14:40:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/cst2constr.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: cst2constr.c,v 1.7 2001/12/07 13:40:26 xleroy Exp $ */ +/* $Id: cst2constr.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/cst2constr.h ocaml-unix-3.11.2/otherlibs/unix/cst2constr.h --- ocaml-unix-3.10.2/otherlibs/unix/cst2constr.h 2004-04-09 15:25:21.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/cst2constr.h 2004-04-09 15:25:23.000000000 +0200 @@ -11,6 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: cst2constr.h,v 1.7 2004/04/09 13:25:21 xleroy Exp $ */ +/* $Id: cst2constr.h 6193 2004-04-09 13:25:23Z xleroy $ */ extern value cst_to_constr(int n, int * tbl, int size, int deflt); diff -Naur ocaml-unix-3.10.2/otherlibs/unix/cstringv.c ocaml-unix-3.11.2/otherlibs/unix/cstringv.c --- ocaml-unix-3.10.2/otherlibs/unix/cstringv.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/cstringv.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: cstringv.c,v 1.7 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: cstringv.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/.depend ocaml-unix-3.11.2/otherlibs/unix/.depend --- ocaml-unix-3.10.2/otherlibs/unix/.depend 2007-03-02 23:47:05.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/.depend 2008-10-15 15:13:07.000000000 +0200 @@ -656,6 +656,11 @@ ../../byterun/../config/m.h ../../byterun/../config/s.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/memory.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/gc.h ../../byterun/mlvalues.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h ../../byterun/misc.h \ + ../../byterun/mlvalues.h ../../byterun/misc.h ../../byterun/minor_gc.h \ + ../../byterun/misc.h ../../byterun/misc.h ../../byterun/mlvalues.h \ ../../byterun/alloc.h ../../byterun/compatibility.h \ ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/fail.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ @@ -783,6 +788,7 @@ ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/signals.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ ../../byterun/mlvalues.h unixsupport.h +unix.cmi: unixLabels.cmi: unix.cmi unix.cmo: unix.cmi unix.cmx: unix.cmi diff -Naur ocaml-unix-3.10.2/otherlibs/unix/dup2.c ocaml-unix-3.11.2/otherlibs/unix/dup2.c --- ocaml-unix-3.10.2/otherlibs/unix/dup2.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/dup2.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: dup2.c,v 1.9 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: dup2.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/dup.c ocaml-unix-3.11.2/otherlibs/unix/dup.c --- ocaml-unix-3.10.2/otherlibs/unix/dup.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/dup.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: dup.c,v 1.8 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: dup.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/envir.c ocaml-unix-3.11.2/otherlibs/unix/envir.c --- ocaml-unix-3.10.2/otherlibs/unix/envir.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/envir.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: envir.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: envir.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/errmsg.c ocaml-unix-3.11.2/otherlibs/unix/errmsg.c --- ocaml-unix-3.10.2/otherlibs/unix/errmsg.c 2004-05-23 17:53:50.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/errmsg.c 2004-05-23 17:53:50.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: errmsg.c,v 1.12 2004/05/23 15:53:50 xleroy Exp $ */ +/* $Id: errmsg.c 6315 2004-05-23 15:53:50Z xleroy $ */ #include <errno.h> #include <string.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/execv.c ocaml-unix-3.11.2/otherlibs/unix/execv.c --- ocaml-unix-3.10.2/otherlibs/unix/execv.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/execv.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: execv.c,v 1.8 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: execv.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/execve.c ocaml-unix-3.11.2/otherlibs/unix/execve.c --- ocaml-unix-3.10.2/otherlibs/unix/execve.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/execve.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: execve.c,v 1.8 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: execve.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/execvp.c ocaml-unix-3.11.2/otherlibs/unix/execvp.c --- ocaml-unix-3.10.2/otherlibs/unix/execvp.c 2001-12-07 14:40:27.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/execvp.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: execvp.c,v 1.8 2001/12/07 13:40:27 xleroy Exp $ */ +/* $Id: execvp.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/exit.c ocaml-unix-3.11.2/otherlibs/unix/exit.c --- ocaml-unix-3.10.2/otherlibs/unix/exit.c 2001-12-07 14:40:28.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/exit.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: exit.c,v 1.9 2001/12/07 13:40:28 xleroy Exp $ */ +/* $Id: exit.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/fchmod.c ocaml-unix-3.11.2/otherlibs/unix/fchmod.c --- ocaml-unix-3.10.2/otherlibs/unix/fchmod.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/fchmod.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: fchmod.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: fchmod.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <sys/types.h> #include <sys/stat.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/fchown.c ocaml-unix-3.11.2/otherlibs/unix/fchown.c --- ocaml-unix-3.10.2/otherlibs/unix/fchown.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/fchown.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: fchown.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: fchown.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/fcntl.c ocaml-unix-3.11.2/otherlibs/unix/fcntl.c --- ocaml-unix-3.10.2/otherlibs/unix/fcntl.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/fcntl.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: fcntl.c,v 1.12 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: fcntl.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/fork.c ocaml-unix-3.11.2/otherlibs/unix/fork.c --- ocaml-unix-3.10.2/otherlibs/unix/fork.c 2001-12-07 14:40:28.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/fork.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: fork.c,v 1.8 2001/12/07 13:40:28 xleroy Exp $ */ +/* $Id: fork.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/ftruncate.c ocaml-unix-3.11.2/otherlibs/unix/ftruncate.c --- ocaml-unix-3.10.2/otherlibs/unix/ftruncate.c 2007-02-09 14:31:15.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/ftruncate.c 2007-02-09 14:31:15.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: ftruncate.c,v 1.11 2007/02/09 13:31:15 doligez Exp $ */ +/* $Id: ftruncate.c 7849 2007-02-09 13:31:15Z doligez $ */ #include <sys/types.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getaddrinfo.c ocaml-unix-3.11.2/otherlibs/unix/getaddrinfo.c --- ocaml-unix-3.10.2/otherlibs/unix/getaddrinfo.c 2005-08-13 22:59:37.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/getaddrinfo.c 2005-08-13 22:59:37.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getaddrinfo.c,v 1.3 2005/08/13 20:59:37 doligez Exp $ */ +/* $Id: getaddrinfo.c 7019 2005-08-13 20:59:37Z doligez $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getcwd.c ocaml-unix-3.11.2/otherlibs/unix/getcwd.c --- ocaml-unix-3.10.2/otherlibs/unix/getcwd.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getcwd.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getcwd.c,v 1.15 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getcwd.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getegid.c ocaml-unix-3.11.2/otherlibs/unix/getegid.c --- ocaml-unix-3.10.2/otherlibs/unix/getegid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getegid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getegid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getegid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/geteuid.c ocaml-unix-3.11.2/otherlibs/unix/geteuid.c --- ocaml-unix-3.10.2/otherlibs/unix/geteuid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/geteuid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: geteuid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: geteuid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getgid.c ocaml-unix-3.11.2/otherlibs/unix/getgid.c --- ocaml-unix-3.10.2/otherlibs/unix/getgid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getgid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getgid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getgid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getgr.c ocaml-unix-3.11.2/otherlibs/unix/getgr.c --- ocaml-unix-3.10.2/otherlibs/unix/getgr.c 2001-12-07 14:40:29.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getgr.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getgr.c,v 1.12 2001/12/07 13:40:29 xleroy Exp $ */ +/* $Id: getgr.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getgroups.c ocaml-unix-3.11.2/otherlibs/unix/getgroups.c --- ocaml-unix-3.10.2/otherlibs/unix/getgroups.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getgroups.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getgroups.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getgroups.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/gethost.c ocaml-unix-3.11.2/otherlibs/unix/gethost.c --- ocaml-unix-3.10.2/otherlibs/unix/gethost.c 2006-09-20 13:14:37.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/gethost.c 2006-09-20 13:14:37.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: gethost.c,v 1.27 2006/09/20 11:14:37 doligez Exp $ */ +/* $Id: gethost.c 7619 2006-09-20 11:14:37Z doligez $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/gethostname.c ocaml-unix-3.11.2/otherlibs/unix/gethostname.c --- ocaml-unix-3.10.2/otherlibs/unix/gethostname.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/gethostname.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: gethostname.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: gethostname.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getlogin.c ocaml-unix-3.11.2/otherlibs/unix/getlogin.c --- ocaml-unix-3.10.2/otherlibs/unix/getlogin.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getlogin.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getlogin.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getlogin.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getnameinfo.c ocaml-unix-3.11.2/otherlibs/unix/getnameinfo.c --- ocaml-unix-3.10.2/otherlibs/unix/getnameinfo.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getnameinfo.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getnameinfo.c,v 1.2 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getnameinfo.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getpeername.c ocaml-unix-3.11.2/otherlibs/unix/getpeername.c --- ocaml-unix-3.10.2/otherlibs/unix/getpeername.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getpeername.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getpeername.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getpeername.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getpid.c ocaml-unix-3.11.2/otherlibs/unix/getpid.c --- ocaml-unix-3.10.2/otherlibs/unix/getpid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getpid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getpid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getpid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getppid.c ocaml-unix-3.11.2/otherlibs/unix/getppid.c --- ocaml-unix-3.10.2/otherlibs/unix/getppid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getppid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getppid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getppid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getproto.c ocaml-unix-3.11.2/otherlibs/unix/getproto.c --- ocaml-unix-3.10.2/otherlibs/unix/getproto.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getproto.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getproto.c,v 1.13 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getproto.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getpw.c ocaml-unix-3.11.2/otherlibs/unix/getpw.c --- ocaml-unix-3.10.2/otherlibs/unix/getpw.c 2001-12-07 14:40:30.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getpw.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getpw.c,v 1.12 2001/12/07 13:40:30 xleroy Exp $ */ +/* $Id: getpw.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getserv.c ocaml-unix-3.11.2/otherlibs/unix/getserv.c --- ocaml-unix-3.10.2/otherlibs/unix/getserv.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getserv.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getserv.c,v 1.14 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getserv.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getsockname.c ocaml-unix-3.11.2/otherlibs/unix/getsockname.c --- ocaml-unix-3.10.2/otherlibs/unix/getsockname.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getsockname.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getsockname.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getsockname.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/gettimeofday.c ocaml-unix-3.11.2/otherlibs/unix/gettimeofday.c --- ocaml-unix-3.10.2/otherlibs/unix/gettimeofday.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/gettimeofday.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: gettimeofday.c,v 1.8 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: gettimeofday.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/getuid.c ocaml-unix-3.11.2/otherlibs/unix/getuid.c --- ocaml-unix-3.10.2/otherlibs/unix/getuid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/getuid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getuid.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getuid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/gmtime.c ocaml-unix-3.11.2/otherlibs/unix/gmtime.c --- ocaml-unix-3.10.2/otherlibs/unix/gmtime.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/gmtime.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: gmtime.c,v 1.17 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: gmtime.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/isatty.c ocaml-unix-3.11.2/otherlibs/unix/isatty.c --- ocaml-unix-3.10.2/otherlibs/unix/isatty.c 2006-09-21 15:54:26.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/isatty.c 2006-09-21 15:54:26.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: isatty.c,v 1.1 2006/09/21 13:54:26 xleroy Exp $ */ +/* $Id: isatty.c 7632 2006-09-21 13:54:26Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/itimer.c ocaml-unix-3.11.2/otherlibs/unix/itimer.c --- ocaml-unix-3.10.2/otherlibs/unix/itimer.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/itimer.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: itimer.c,v 1.14 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: itimer.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/kill.c ocaml-unix-3.11.2/otherlibs/unix/kill.c --- ocaml-unix-3.10.2/otherlibs/unix/kill.c 2001-12-07 14:40:31.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/kill.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: kill.c,v 1.10 2001/12/07 13:40:31 xleroy Exp $ */ +/* $Id: kill.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/link.c ocaml-unix-3.11.2/otherlibs/unix/link.c --- ocaml-unix-3.10.2/otherlibs/unix/link.c 2001-12-07 14:40:31.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/link.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: link.c,v 1.8 2001/12/07 13:40:31 xleroy Exp $ */ +/* $Id: link.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/listen.c ocaml-unix-3.11.2/otherlibs/unix/listen.c --- ocaml-unix-3.10.2/otherlibs/unix/listen.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/listen.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: listen.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: listen.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/lockf.c ocaml-unix-3.11.2/otherlibs/unix/lockf.c --- ocaml-unix-3.10.2/otherlibs/unix/lockf.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/lockf.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: lockf.c,v 1.14 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: lockf.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <errno.h> #include <fcntl.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/lseek.c ocaml-unix-3.11.2/otherlibs/unix/lseek.c --- ocaml-unix-3.10.2/otherlibs/unix/lseek.c 2002-03-02 10:16:36.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/lseek.c 2002-03-02 10:16:39.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: lseek.c,v 1.10 2002/03/02 09:16:36 xleroy Exp $ */ +/* $Id: lseek.c 4474 2002-03-02 09:16:39Z xleroy $ */ #include <errno.h> #include <sys/types.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/Makefile ocaml-unix-3.11.2/otherlibs/unix/Makefile --- ocaml-unix-3.10.2/otherlibs/unix/Makefile 2007-02-07 16:49:11.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/Makefile 2007-11-06 16:16:56.000000000 +0100 @@ -11,21 +11,15 @@ # # ######################################################################### -# $Id: Makefile,v 1.45 2007/02/07 15:49:11 doligez Exp $ +# $Id: Makefile 8477 2007-11-06 15:16:56Z frisch $ # Makefile for the Unix interface library -include ../../config/Makefile +LIBNAME=unix -# Compilation options -CC=$(BYTECC) -CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -CAMLC=../../ocamlcomp.sh -CAMLOPT=../../ocamlcompopt.sh -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-warn-error A -g +EXTRACAMLFLAGS=-nolabels -OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \ +COBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \ chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \ dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o \ fchmod.o fchown.o fcntl.o fork.o ftruncate.o \ @@ -42,50 +36,11 @@ time.o times.o truncate.o umask.o unixsupport.o unlink.o \ utimes.o wait.o write.o -MLOBJS=unix.cmo unixLabels.cmo +CAMLOBJS=unix.cmo unixLabels.cmo -all: libunix.a unix.cma +HEADERS=unixsupport.h -allopt: libunix.a unix.cmxa - -libunix.a: $(OBJS) - $(MKLIB) -o unix $(OBJS) - -unix.cma: $(MLOBJS) - $(MKLIB) -o unix -ocamlc '$(CAMLC)' -linkall $(MLOBJS) - -unix.cmxa: $(MLOBJS:.cmo=.cmx) - $(MKLIB) -o unix -ocamlopt '$(CAMLOPT)' -linkall $(MLOBJS:.cmo=.cmx) - -unix.cmx: ../../ocamlopt - -partialclean: - rm -f *.cm* - -clean: partialclean - rm -f *.a *.o *.so - -install: - if test -f dllunix.so; then cp dllunix.so $(STUBLIBDIR)/dllunix.so; fi - cp libunix.a $(LIBDIR)/libunix.a - cd $(LIBDIR); $(RANLIB) libunix.a - cp unix.cma $(MLOBJS:.cmo=.cmi) $(MLOBJS:.cmo=.mli) $(LIBDIR) - cp unixsupport.h $(LIBDIR)/caml - -installopt: - cp $(MLOBJS:.cmo=.cmx) unix.cmxa unix.a $(LIBDIR) - cd $(LIBDIR); $(RANLIB) unix.a - -.SUFFIXES: .ml .mli .cmo .cmi .cmx - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) -nolabels $< - -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) -nolabels $< +include ../Makefile depend: gcc -MM $(CFLAGS) *.c > .depend diff -Naur ocaml-unix-3.10.2/otherlibs/unix/mkdir.c ocaml-unix-3.11.2/otherlibs/unix/mkdir.c --- ocaml-unix-3.10.2/otherlibs/unix/mkdir.c 2001-12-07 14:40:31.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/mkdir.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: mkdir.c,v 1.9 2001/12/07 13:40:31 xleroy Exp $ */ +/* $Id: mkdir.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <sys/types.h> #include <sys/stat.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/mkfifo.c ocaml-unix-3.11.2/otherlibs/unix/mkfifo.c --- ocaml-unix-3.10.2/otherlibs/unix/mkfifo.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/mkfifo.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: mkfifo.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: mkfifo.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <sys/types.h> #include <sys/stat.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/nice.c ocaml-unix-3.11.2/otherlibs/unix/nice.c --- ocaml-unix-3.10.2/otherlibs/unix/nice.c 2001-12-07 14:40:32.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/nice.c 2008-08-01 15:14:36.000000000 +0200 @@ -11,32 +11,14 @@ /* */ /***********************************************************************/ -/* $Id: nice.c,v 1.10 2001/12/07 13:40:32 xleroy Exp $ */ +/* $Id: nice.c 8967 2008-08-01 13:14:36Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" #include <errno.h> - -#ifdef HAS_GETPRIORITY - -#include <sys/types.h> -#include <sys/time.h> -#include <sys/resource.h> - -CAMLprim value unix_nice(value incr) -{ - int prio; - errno = 0; - prio = getpriority(PRIO_PROCESS, 0); - if (prio == -1 && errno != 0) - uerror("nice", Nothing); - prio += Int_val(incr); - if (setpriority(PRIO_PROCESS, 0, prio) == -1) - uerror("nice", Nothing); - return Val_int(prio); -} - -#else +#ifdef HAS_UNISTD +#include <unistd.h> +#endif CAMLprim value unix_nice(value incr) { @@ -46,5 +28,3 @@ if (ret == -1 && errno != 0) uerror("nice", Nothing); return Val_int(ret); } - -#endif diff -Naur ocaml-unix-3.10.2/otherlibs/unix/open.c ocaml-unix-3.11.2/otherlibs/unix/open.c --- ocaml-unix-3.10.2/otherlibs/unix/open.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/open.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: open.c,v 1.12 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: open.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/opendir.c ocaml-unix-3.11.2/otherlibs/unix/opendir.c --- ocaml-unix-3.10.2/otherlibs/unix/opendir.c 2004-02-14 11:21:22.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/opendir.c 2004-02-14 11:21:23.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: opendir.c,v 1.9 2004/02/14 10:21:22 xleroy Exp $ */ +/* $Id: opendir.c 6113 2004-02-14 10:21:23Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/pipe.c ocaml-unix-3.11.2/otherlibs/unix/pipe.c --- ocaml-unix-3.10.2/otherlibs/unix/pipe.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/pipe.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: pipe.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: pipe.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/putenv.c ocaml-unix-3.11.2/otherlibs/unix/putenv.c --- ocaml-unix-3.10.2/otherlibs/unix/putenv.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/putenv.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: putenv.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: putenv.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <stdlib.h> #include <string.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/read.c ocaml-unix-3.11.2/otherlibs/unix/read.c --- ocaml-unix-3.10.2/otherlibs/unix/read.c 2001-12-07 14:40:32.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/read.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: read.c,v 1.13 2001/12/07 13:40:32 xleroy Exp $ */ +/* $Id: read.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/readdir.c ocaml-unix-3.11.2/otherlibs/unix/readdir.c --- ocaml-unix-3.10.2/otherlibs/unix/readdir.c 2004-02-14 11:21:23.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/readdir.c 2004-02-14 11:21:23.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: readdir.c,v 1.12 2004/02/14 10:21:23 xleroy Exp $ */ +/* $Id: readdir.c 6113 2004-02-14 10:21:23Z xleroy $ */ #include <mlvalues.h> #include <fail.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/readlink.c ocaml-unix-3.11.2/otherlibs/unix/readlink.c --- ocaml-unix-3.10.2/otherlibs/unix/readlink.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/readlink.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: readlink.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: readlink.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/rename.c ocaml-unix-3.11.2/otherlibs/unix/rename.c --- ocaml-unix-3.10.2/otherlibs/unix/rename.c 2001-12-07 14:40:33.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/rename.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: rename.c,v 1.10 2001/12/07 13:40:33 xleroy Exp $ */ +/* $Id: rename.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <stdio.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/rewinddir.c ocaml-unix-3.11.2/otherlibs/unix/rewinddir.c --- ocaml-unix-3.10.2/otherlibs/unix/rewinddir.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/rewinddir.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: rewinddir.c,v 1.12 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: rewinddir.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/rmdir.c ocaml-unix-3.11.2/otherlibs/unix/rmdir.c --- ocaml-unix-3.10.2/otherlibs/unix/rmdir.c 2001-12-07 14:40:33.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/rmdir.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: rmdir.c,v 1.9 2001/12/07 13:40:33 xleroy Exp $ */ +/* $Id: rmdir.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/select.c ocaml-unix-3.11.2/otherlibs/unix/select.c --- ocaml-unix-3.10.2/otherlibs/unix/select.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/select.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: select.c,v 1.22 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: select.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/sendrecv.c ocaml-unix-3.11.2/otherlibs/unix/sendrecv.c --- ocaml-unix-3.10.2/otherlibs/unix/sendrecv.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/sendrecv.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: sendrecv.c,v 1.19 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: sendrecv.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/setgid.c ocaml-unix-3.11.2/otherlibs/unix/setgid.c --- ocaml-unix-3.10.2/otherlibs/unix/setgid.c 2001-12-07 14:40:33.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/setgid.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: setgid.c,v 1.8 2001/12/07 13:40:33 xleroy Exp $ */ +/* $Id: setgid.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/setsid.c ocaml-unix-3.11.2/otherlibs/unix/setsid.c --- ocaml-unix-3.10.2/otherlibs/unix/setsid.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/setsid.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: setsid.c,v 1.6 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: setsid.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/setuid.c ocaml-unix-3.11.2/otherlibs/unix/setuid.c --- ocaml-unix-3.10.2/otherlibs/unix/setuid.c 2001-12-07 14:40:33.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/setuid.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: setuid.c,v 1.8 2001/12/07 13:40:33 xleroy Exp $ */ +/* $Id: setuid.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/shutdown.c ocaml-unix-3.11.2/otherlibs/unix/shutdown.c --- ocaml-unix-3.10.2/otherlibs/unix/shutdown.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/shutdown.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: shutdown.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: shutdown.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/signals.c ocaml-unix-3.11.2/otherlibs/unix/signals.c --- ocaml-unix-3.10.2/otherlibs/unix/signals.c 2007-11-01 17:42:29.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/signals.c 2008-01-11 17:13:18.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: signals.c,v 1.10.12.1 2007/11/01 16:42:29 xleroy Exp $ */ +/* $Id: signals.c 8768 2008-01-11 16:13:18Z doligez $ */ #include <errno.h> #include <signal.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/sleep.c ocaml-unix-3.11.2/otherlibs/unix/sleep.c --- ocaml-unix-3.10.2/otherlibs/unix/sleep.c 2001-12-07 14:40:35.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/sleep.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: sleep.c,v 1.9 2001/12/07 13:40:35 xleroy Exp $ */ +/* $Id: sleep.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <signals.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/socketaddr.c ocaml-unix-3.11.2/otherlibs/unix/socketaddr.c --- ocaml-unix-3.10.2/otherlibs/unix/socketaddr.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/socketaddr.c 2009-10-18 11:36:13.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socketaddr.c,v 1.23 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: socketaddr.c 9377 2009-10-18 09:36:13Z xleroy $ */ #include <string.h> #include <mlvalues.h> @@ -80,6 +80,9 @@ adr->s_inet6.sin6_family = AF_INET6; adr->s_inet6.sin6_addr = GET_INET6_ADDR(Field(mladr, 0)); adr->s_inet6.sin6_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet6.sin6_len = sizeof(struct sockaddr_in6); +#endif *adr_len = sizeof(struct sockaddr_in6); break; } @@ -88,6 +91,9 @@ adr->s_inet.sin_family = AF_INET; adr->s_inet.sin_addr = GET_INET_ADDR(Field(mladr, 0)); adr->s_inet.sin_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet.sin_len = sizeof(struct sockaddr_in); +#endif *adr_len = sizeof(struct sockaddr_in); break; } diff -Naur ocaml-unix-3.10.2/otherlibs/unix/socketaddr.h ocaml-unix-3.11.2/otherlibs/unix/socketaddr.h --- ocaml-unix-3.10.2/otherlibs/unix/socketaddr.h 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/socketaddr.h 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socketaddr.h,v 1.16 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: socketaddr.h 6824 2005-03-24 17:20:54Z doligez $ */ #include <misc.h> #include <sys/types.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/socket.c ocaml-unix-3.11.2/otherlibs/unix/socket.c --- ocaml-unix-3.10.2/otherlibs/unix/socket.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/socket.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socket.c,v 1.11 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: socket.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/socketpair.c ocaml-unix-3.11.2/otherlibs/unix/socketpair.c --- ocaml-unix-3.10.2/otherlibs/unix/socketpair.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/socketpair.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socketpair.c,v 1.12 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: socketpair.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/sockopt.c ocaml-unix-3.11.2/otherlibs/unix/sockopt.c --- ocaml-unix-3.10.2/otherlibs/unix/sockopt.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/sockopt.c 2008-08-01 15:46:08.000000000 +0200 @@ -11,18 +11,21 @@ /* */ /***********************************************************************/ -/* $Id: sockopt.c,v 1.19 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: sockopt.c 8968 2008-08-01 13:46:08Z xleroy $ */ #include <mlvalues.h> +#include <memory.h> #include <alloc.h> #include <fail.h> #include "unixsupport.h" #ifdef HAS_SOCKETS +#include <errno.h> #include <sys/time.h> #include <sys/types.h> #include <sys/socket.h> +#include <netinet/tcp.h> #include "socketaddr.h" @@ -74,164 +77,224 @@ #ifndef SO_SNDTIMEO #define SO_SNDTIMEO (-1) #endif +#ifndef TCP_NODELAY +#define TCP_NODELAY (-1) +#endif +#ifndef SO_ERROR +#define SO_ERROR (-1) +#endif +#ifndef IPPROTO_IPV6 +#define IPPROTO_IPV6 (-1) +#endif +#ifndef IPV6_V6ONLY +#define IPV6_V6ONLY (-1) +#endif -static int sockopt_bool[] = { - SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE, - SO_DONTROUTE, SO_OOBINLINE, SO_ACCEPTCONN }; - -static int sockopt_int[] = { - SO_SNDBUF, SO_RCVBUF, SO_ERROR, SO_TYPE, SO_RCVLOWAT, SO_SNDLOWAT }; - -static int sockopt_optint[] = { SO_LINGER }; - -static int sockopt_float[] = { SO_RCVTIMEO, SO_SNDTIMEO }; +enum option_type { + TYPE_BOOL = 0, + TYPE_INT = 1, + TYPE_LINGER = 2, + TYPE_TIMEVAL = 3, + TYPE_UNIX_ERROR = 4 +}; + +struct socket_option { + int level; + int option; +}; + +/* Table of options, indexed by type */ + +static struct socket_option sockopt_bool[] = { + { SOL_SOCKET, SO_DEBUG }, + { SOL_SOCKET, SO_BROADCAST }, + { SOL_SOCKET, SO_REUSEADDR }, + { SOL_SOCKET, SO_KEEPALIVE }, + { SOL_SOCKET, SO_DONTROUTE }, + { SOL_SOCKET, SO_OOBINLINE }, + { SOL_SOCKET, SO_ACCEPTCONN }, + { IPPROTO_TCP, TCP_NODELAY }, + { IPPROTO_IPV6, IPV6_V6ONLY} +}; + +static struct socket_option sockopt_int[] = { + { SOL_SOCKET, SO_SNDBUF }, + { SOL_SOCKET, SO_RCVBUF }, + { SOL_SOCKET, SO_ERROR }, + { SOL_SOCKET, SO_TYPE }, + { SOL_SOCKET, SO_RCVLOWAT }, + { SOL_SOCKET, SO_SNDLOWAT } }; + +static struct socket_option sockopt_linger[] = { + { SOL_SOCKET, SO_LINGER } +}; + +static struct socket_option sockopt_timeval[] = { + { SOL_SOCKET, SO_RCVTIMEO }, + { SOL_SOCKET, SO_SNDTIMEO } +}; + +static struct socket_option sockopt_unix_error[] = { + { SOL_SOCKET, SO_ERROR } +}; + +static struct socket_option * sockopt_table[] = { + sockopt_bool, + sockopt_int, + sockopt_linger, + sockopt_timeval, + sockopt_unix_error +}; + +static char * getsockopt_fun_name[] = { + "getsockopt", + "getsockopt_int", + "getsockopt_optint", + "getsockopt_float", + "getsockopt_error" +}; + +static char * setsockopt_fun_name[] = { + "setsockopt", + "setsockopt_int", + "setsockopt_optint", + "setsockopt_float", + "setsockopt_error" +}; + +union option_value { + int i; + struct linger lg; + struct timeval tv; +}; -CAMLexport value getsockopt_int(int *sockopt, value socket, - int level, value option) +CAMLexport value +unix_getsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket) { - int optval; + union option_value optval; socklen_param_type optsize; - optsize = sizeof(optval); - if (getsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &optval, &optsize) == -1) - uerror("getsockopt", Nothing); - return Val_int(optval); -} - -CAMLexport value setsockopt_int(int *sockopt, value socket, int level, - value option, value status) -{ - int optval = Int_val(status); - if (setsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &optval, sizeof(optval)) == -1) - uerror("setsockopt", Nothing); - return Val_unit; -} - -CAMLprim value unix_getsockopt_bool(value socket, value option) { - value res = getsockopt_int(sockopt_bool, socket, SOL_SOCKET, option); - return Val_bool(Int_val(res)); -} - -CAMLprim value unix_setsockopt_bool(value socket, value option, value status) -{ - return setsockopt_int(sockopt_bool, socket, SOL_SOCKET, option, status); -} - -CAMLprim value unix_getsockopt_int(value socket, value option) { - return getsockopt_int(sockopt_int, socket, SOL_SOCKET, option); -} -CAMLprim value unix_setsockopt_int(value socket, value option, value status) -{ - return setsockopt_int(sockopt_int, socket, SOL_SOCKET, option, status); -} - -CAMLexport value getsockopt_optint(int *sockopt, value socket, - int level, value option) -{ - struct linger optval; - socklen_param_type optsize; - value res = Val_int(0); /* None */ - - optsize = sizeof(optval); - if (getsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &optval, &optsize) == -1) - uerror("getsockopt_optint", Nothing); - if (optval.l_onoff != 0) { - res = alloc_small(1, 0); - Field(res, 0) = Val_int(optval.l_linger); + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + case TYPE_UNIX_ERROR: + optsize = sizeof(optval.i); break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); break; + case TYPE_TIMEVAL: + optsize = sizeof(optval.tv); break; + default: + unix_error(EINVAL, name, Nothing); } - return res; -} - -CAMLexport value setsockopt_optint(int *sockopt, value socket, int level, - value option, value status) -{ - struct linger optval; - - optval.l_onoff = Is_block (status); - if (optval.l_onoff) - optval.l_linger = Int_val (Field (status, 0)); - if (setsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &optval, sizeof(optval)) == -1) - uerror("setsockopt_optint", Nothing); - return Val_unit; -} -CAMLprim value unix_getsockopt_optint(value socket, value option) -{ - return getsockopt_optint(sockopt_optint, socket, SOL_SOCKET, option); -} + if (getsockopt(Int_val(socket), level, option, + (void *) &optval, &optsize) == -1) + uerror(name, Nothing); -CAMLprim value unix_setsockopt_optint(value socket, value option, value status) -{ - return setsockopt_optint(sockopt_optint, socket, SOL_SOCKET, option, status); + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + return Val_int(optval.i); + case TYPE_LINGER: + if (optval.lg.l_onoff == 0) { + return Val_int(0); /* None */ + } else { + value res = alloc_small(1, 0); /* Some */ + Field(res, 0) = Val_int(optval.lg.l_linger); + return res; + } + case TYPE_TIMEVAL: + return copy_double((double) optval.tv.tv_sec + + (double) optval.tv.tv_usec / 1e6); + case TYPE_UNIX_ERROR: + if (optval.i == 0) { + return Val_int(0); /* None */ + } else { + value err, res; + err = unix_error_of_code(optval.i); + Begin_root(err); + res = alloc_small(1, 0); /* Some */ + Field(res, 0) = err; + End_roots(); + return res; + } + default: + unix_error(EINVAL, name, Nothing); + } } -CAMLexport value getsockopt_float(int *sockopt, value socket, - int level, value option) +CAMLexport value +unix_setsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket, value val) { - struct timeval tv; + union option_value optval; socklen_param_type optsize; + double f; - optsize = sizeof(tv); - if (getsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &tv, &optsize) == -1) - uerror("getsockopt_float", Nothing); - return copy_double((double) tv.tv_sec + (double) tv.tv_usec / 1e6); -} + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + optsize = sizeof(optval.i); + optval.i = Int_val(val); + break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); + optval.lg.l_onoff = Is_block (val); + if (optval.lg.l_onoff) + optval.lg.l_linger = Int_val (Field (val, 0)); + break; + case TYPE_TIMEVAL: + f = Double_val(val); + optsize = sizeof(optval.tv); + optval.tv.tv_sec = (int) f; + optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec)); + break; + case TYPE_UNIX_ERROR: + default: + unix_error(EINVAL, name, Nothing); + } -CAMLexport value setsockopt_float(int *sockopt, value socket, int level, - value option, value status) -{ - struct timeval tv; - double tv_f; + if (setsockopt(Int_val(socket), level, option, + (void *) &optval, optsize) == -1) + uerror(name, Nothing); - tv_f = Double_val(status); - tv.tv_sec = (int)tv_f; - tv.tv_usec = (int) (1e6 * (tv_f - tv.tv_sec)); - if (setsockopt(Int_val(socket), level, sockopt[Int_val(option)], - (void *) &tv, sizeof(tv)) == -1) - uerror("setsockopt_float", Nothing); return Val_unit; } -CAMLprim value unix_getsockopt_float(value socket, value option) -{ - return getsockopt_float(sockopt_float, socket, SOL_SOCKET, option); -} - -CAMLprim value unix_setsockopt_float(value socket, value option, value status) +CAMLprim value unix_getsockopt(value vty, value vsocket, value voption) { - return setsockopt_float(sockopt_float, socket, SOL_SOCKET, option, status); + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_getsockopt_aux(getsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket); +} + +CAMLprim value unix_setsockopt(value vty, value vsocket, value voption, + value val) +{ + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_setsockopt_aux(setsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket, + val); } #else -CAMLprim value unix_getsockopt_bool(value socket, value option) +CAMLprim value unix_getsockopt(value vty, value socket, value option) { invalid_argument("getsockopt not implemented"); } -CAMLprim value unix_setsockopt_bool(value socket, value option, value status) +CAMLprim value unix_setsockopt(value vty, value socket, value option, value val) { invalid_argument("setsockopt not implemented"); } -CAMLprim value unix_getsockopt_int(value socket, value option) -{ invalid_argument("getsockopt_int not implemented"); } - -CAMLprim value unix_setsockopt_int(value socket, value option, value status) -{ invalid_argument("setsockopt_int not implemented"); } - -CAMLprim value unix_getsockopt_optint(value socket, value option) -{ invalid_argument("getsockopt_optint not implemented"); } - -CAMLprim value unix_setsockopt_optint(value socket, value option, value status) -{ invalid_argument("setsockopt_optint not implemented"); } - -CAMLprim value unix_getsockopt_float(value socket, value option) -{ invalid_argument("getsockopt_float not implemented"); } - -CAMLprim value unix_setsockopt_float(value socket, value option, value status) -{ invalid_argument("setsockopt_float not implemented"); } - #endif diff -Naur ocaml-unix-3.10.2/otherlibs/unix/stat.c ocaml-unix-3.11.2/otherlibs/unix/stat.c --- ocaml-unix-3.10.2/otherlibs/unix/stat.c 2003-05-05 16:20:58.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/stat.c 2003-05-05 16:20:58.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: stat.c,v 1.15 2003/05/05 14:20:58 xleroy Exp $ */ +/* $Id: stat.c 5540 2003-05-05 14:20:58Z xleroy $ */ #include <errno.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/strofaddr.c ocaml-unix-3.11.2/otherlibs/unix/strofaddr.c --- ocaml-unix-3.10.2/otherlibs/unix/strofaddr.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/strofaddr.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: strofaddr.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: strofaddr.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/symlink.c ocaml-unix-3.11.2/otherlibs/unix/symlink.c --- ocaml-unix-3.10.2/otherlibs/unix/symlink.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/symlink.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: symlink.c,v 1.9 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: symlink.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/termios.c ocaml-unix-3.11.2/otherlibs/unix/termios.c --- ocaml-unix-3.10.2/otherlibs/unix/termios.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/termios.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: termios.c,v 1.15 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: termios.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/time.c ocaml-unix-3.11.2/otherlibs/unix/time.c --- ocaml-unix-3.10.2/otherlibs/unix/time.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/time.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: time.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: time.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <time.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/times.c ocaml-unix-3.11.2/otherlibs/unix/times.c --- ocaml-unix-3.10.2/otherlibs/unix/times.c 2006-04-17 01:28:21.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/times.c 2006-04-17 01:28:22.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: times.c,v 1.16 2006/04/16 23:28:21 doligez Exp $ */ +/* $Id: times.c 7382 2006-04-16 23:28:22Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/truncate.c ocaml-unix-3.11.2/otherlibs/unix/truncate.c --- ocaml-unix-3.10.2/otherlibs/unix/truncate.c 2007-02-09 14:31:15.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/truncate.c 2007-02-09 14:31:15.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: truncate.c,v 1.11 2007/02/09 13:31:15 doligez Exp $ */ +/* $Id: truncate.c 7849 2007-02-09 13:31:15Z doligez $ */ #include <sys/types.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/umask.c ocaml-unix-3.11.2/otherlibs/unix/umask.c --- ocaml-unix-3.10.2/otherlibs/unix/umask.c 2001-12-07 14:40:37.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/umask.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: umask.c,v 1.9 2001/12/07 13:40:37 xleroy Exp $ */ +/* $Id: umask.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <sys/types.h> #include <sys/stat.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unixLabels.ml ocaml-unix-3.11.2/otherlibs/unix/unixLabels.ml --- ocaml-unix-3.10.2/otherlibs/unix/unixLabels.ml 2001-12-07 14:40:38.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/unixLabels.ml 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(* $Id: unixLabels.ml,v 1.3 2001/12/07 13:40:38 xleroy Exp $ *) +(* $Id: unixLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *) (* Module [UnixLabels]: labelled Unix module *) diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unixLabels.mli ocaml-unix-3.11.2/otherlibs/unix/unixLabels.mli --- ocaml-unix-3.10.2/otherlibs/unix/unixLabels.mli 2007-11-19 22:27:56.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/unixLabels.mli 2008-08-01 15:46:08.000000000 +0200 @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(* $Id: unixLabels.mli,v 1.15.4.1 2007/11/19 21:27:56 doligez Exp $ *) +(* $Id: unixLabels.mli 8968 2008-08-01 13:46:08Z xleroy $ *) (** Interface to the Unix system. To use as replacement to default {!Unix} module, @@ -153,7 +153,7 @@ WNOHANG (** do not block if no child has died yet, but immediately return with a pid equal to 0.*) | WUNTRACED (** report also the children that receive stop signals. *) -(** Flags for {!Unix.waitpid}. *) +(** Flags for {!UnixLabels.waitpid}. *) val execv : prog:string -> args:string array -> 'a (** [execv prog args] execute the program in file [prog], with @@ -1009,6 +1009,8 @@ | SO_DONTROUTE (** Bypass the standard routing algorithms *) | SO_OOBINLINE (** Leave out-of-band data in line *) | SO_ACCEPTCONN (** Report whether socket listening is enabled *) + | TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *) + | IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *) (** The socket options that can be consulted with {!UnixLabels.getsockopt} and modified with {!UnixLabels.setsockopt}. These options have a boolean ([true]/[false]) value. *) @@ -1016,7 +1018,7 @@ type socket_int_option = SO_SNDBUF (** Size of send buffer *) | SO_RCVBUF (** Size of received buffer *) - | SO_ERROR (** Report the error status and clear it *) + | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *) | SO_TYPE (** Report the socket type *) | SO_RCVLOWAT (** Minimum number of bytes to process for input operations *) | SO_SNDLOWAT (** Minimum number of bytes to process for output operations *) @@ -1047,31 +1049,28 @@ val setsockopt : file_descr -> socket_bool_option -> bool -> unit (** Set or clear a boolean-valued option in the given socket. *) -external getsockopt_int : - file_descr -> socket_int_option -> int = "unix_getsockopt_int" -(** Same as {!UnixLabels.getsockopt} for an integer-valued socket option. *) - -external setsockopt_int : - file_descr -> socket_int_option -> int -> unit = "unix_setsockopt_int" -(** Same as {!UnixLabels.setsockopt} for an integer-valued socket option. *) - -external getsockopt_optint : - file_descr -> socket_optint_option -> int option = "unix_getsockopt_optint" -(** Same as {!UnixLabels.getsockopt} for a socket option whose value is an [int option]. *) - -external setsockopt_optint : - file_descr -> socket_optint_option -> int option -> - unit = "unix_setsockopt_optint" -(** Same as {!UnixLabels.setsockopt} for a socket option whose value is an [int option]. *) - -external getsockopt_float : - file_descr -> socket_float_option -> float = "unix_getsockopt_float" -(** Same as {!UnixLabels.getsockopt} for a socket option whose value is a floating-point number. *) - -external setsockopt_float : - file_descr -> socket_float_option -> float -> unit = "unix_setsockopt_float" -(** Same as {!UnixLabels.setsockopt} for a socket option whose value is a floating-point number. *) +val getsockopt_int : file_descr -> socket_int_option -> int +(** Same as {!Unix.getsockopt} for an integer-valued socket option. *) +val setsockopt_int : file_descr -> socket_int_option -> int -> unit +(** Same as {!Unix.setsockopt} for an integer-valued socket option. *) + +val getsockopt_optint : file_descr -> socket_optint_option -> int option +(** Same as {!Unix.getsockopt} for a socket option whose value is an [int option]. *) + +val setsockopt_optint : + file_descr -> socket_optint_option -> int option -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is an [int option]. *) + +val getsockopt_float : file_descr -> socket_float_option -> float +(** Same as {!Unix.getsockopt} for a socket option whose value is a floating-point number. *) + +val setsockopt_float : file_descr -> socket_float_option -> float -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is a floating-point number. *) + +val getsockopt_error : file_descr -> error option +(** Return the error condition associated with the given socket, + and clear it. *) (** {6 High-level network connection functions} *) diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unix.ml ocaml-unix-3.11.2/otherlibs/unix/unix.ml --- ocaml-unix-3.10.2/otherlibs/unix/unix.ml 2006-09-21 15:54:26.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/unix.ml 2008-08-01 15:46:08.000000000 +0200 @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(* $Id: unix.ml,v 1.66 2006/09/21 13:54:26 xleroy Exp $ *) +(* $Id: unix.ml 8968 2008-08-01 13:46:08Z xleroy $ *) type error = E2BIG @@ -433,29 +433,6 @@ | MSG_DONTROUTE | MSG_PEEK -type socket_bool_option = - SO_DEBUG - | SO_BROADCAST - | SO_REUSEADDR - | SO_KEEPALIVE - | SO_DONTROUTE - | SO_OOBINLINE - | SO_ACCEPTCONN - -type socket_int_option = - SO_SNDBUF - | SO_RCVBUF - | SO_ERROR - | SO_TYPE - | SO_RCVLOWAT - | SO_SNDLOWAT - -type socket_optint_option = SO_LINGER - -type socket_float_option = - SO_RCVTIMEO - | SO_SNDTIMEO - external socket : socket_domain -> socket_type -> int -> file_descr = "unix_socket" external socketpair : @@ -499,22 +476,68 @@ then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr -external getsockopt : file_descr -> socket_bool_option -> bool - = "unix_getsockopt_bool" -external setsockopt : file_descr -> socket_bool_option -> bool -> unit - = "unix_setsockopt_bool" -external getsockopt_int : file_descr -> socket_int_option -> int - = "unix_getsockopt_int" -external setsockopt_int : file_descr -> socket_int_option -> int -> unit - = "unix_setsockopt_int" -external getsockopt_optint : file_descr -> socket_optint_option -> int option - = "unix_getsockopt_optint" -external setsockopt_optint : file_descr -> socket_optint_option -> int option -> unit - = "unix_setsockopt_optint" -external getsockopt_float : file_descr -> socket_float_option -> float - = "unix_getsockopt_float" -external setsockopt_float : file_descr -> socket_float_option -> float -> unit - = "unix_setsockopt_float" +type socket_bool_option = + SO_DEBUG + | SO_BROADCAST + | SO_REUSEADDR + | SO_KEEPALIVE + | SO_DONTROUTE + | SO_OOBINLINE + | SO_ACCEPTCONN + | TCP_NODELAY + | IPV6_ONLY + +type socket_int_option = + SO_SNDBUF + | SO_RCVBUF + | SO_ERROR + | SO_TYPE + | SO_RCVLOWAT + | SO_SNDLOWAT + +type socket_optint_option = SO_LINGER + +type socket_float_option = + SO_RCVTIMEO + | SO_SNDTIMEO + +type socket_error_option = SO_ERROR + +module SO: sig + type ('opt, 'v) t + val bool: (socket_bool_option, bool) t + val int: (socket_int_option, int) t + val optint: (socket_optint_option, int option) t + val float: (socket_float_option, float) t + val error: (socket_error_option, error option) t + val get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + val set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit +end = struct + type ('opt, 'v) t = int + let bool = 0 + let int = 1 + let optint = 2 + let float = 3 + let error = 4 + external get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + = "unix_getsockopt" + external set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit + = "unix_setsockopt" +end + +let getsockopt fd opt = SO.get SO.bool fd opt +let setsockopt fd opt v = SO.set SO.bool fd opt v + +let getsockopt_int fd opt = SO.get SO.int fd opt +let setsockopt_int fd opt v = SO.set SO.int fd opt v + +let getsockopt_optint fd opt = SO.get SO.optint fd opt +let setsockopt_optint fd opt v = SO.set SO.optint fd opt v + +let getsockopt_float fd opt = SO.get SO.float fd opt +let setsockopt_float fd opt v = SO.set SO.float fd opt v + +let getsockopt_error fd = SO.get SO.error fd SO_ERROR type host_entry = { h_name : string; diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unix.mli ocaml-unix-3.11.2/otherlibs/unix/unix.mli --- ocaml-unix-3.10.2/otherlibs/unix/unix.mli 2007-11-10 13:43:13.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/unix.mli 2009-03-28 17:58:56.000000000 +0100 @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(* $Id: unix.mli,v 1.85.4.1 2007/11/10 12:43:13 xleroy Exp $ *) +(* $Id: unix.mli 9200 2009-03-28 16:58:56Z xleroy $ *) (** Interface to the Unix system *) @@ -144,7 +144,9 @@ | WSTOPPED of int (** The process was stopped by a signal; the argument is the signal number. *) -(** The termination status of a process. *) +(** The termination status of a process. See module {!Sys} for the + definitions of the standard signal numbers. Note that they are + not the numbers used by the OS. *) type wait_flag = @@ -898,7 +900,8 @@ PF_UNIX (** Unix domain *) | PF_INET (** Internet domain (IPv4) *) | PF_INET6 (** Internet domain (IPv6) *) -(** The type of socket domains. *) +(** The type of socket domains. Not all platforms support + IPv6 sockets (type [PF_INET6]). *) type socket_type = SOCK_STREAM (** Stream socket *) @@ -996,6 +999,8 @@ | SO_DONTROUTE (** Bypass the standard routing algorithms *) | SO_OOBINLINE (** Leave out-of-band data in line *) | SO_ACCEPTCONN (** Report whether socket listening is enabled *) + | TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *) + | IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *) (** The socket options that can be consulted with {!Unix.getsockopt} and modified with {!Unix.setsockopt}. These options have a boolean ([true]/[false]) value. *) @@ -1003,7 +1008,7 @@ type socket_int_option = SO_SNDBUF (** Size of send buffer *) | SO_RCVBUF (** Size of received buffer *) - | SO_ERROR (** Report the error status and clear it *) + | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *) | SO_TYPE (** Report the socket type *) | SO_RCVLOWAT (** Minimum number of bytes to process for input operations *) | SO_SNDLOWAT (** Minimum number of bytes to process for output operations *) @@ -1034,31 +1039,29 @@ val setsockopt : file_descr -> socket_bool_option -> bool -> unit (** Set or clear a boolean-valued option in the given socket. *) -external getsockopt_int : - file_descr -> socket_int_option -> int = "unix_getsockopt_int" +val getsockopt_int : file_descr -> socket_int_option -> int (** Same as {!Unix.getsockopt} for an integer-valued socket option. *) -external setsockopt_int : - file_descr -> socket_int_option -> int -> unit = "unix_setsockopt_int" +val setsockopt_int : file_descr -> socket_int_option -> int -> unit (** Same as {!Unix.setsockopt} for an integer-valued socket option. *) -external getsockopt_optint : - file_descr -> socket_optint_option -> int option = "unix_getsockopt_optint" +val getsockopt_optint : file_descr -> socket_optint_option -> int option (** Same as {!Unix.getsockopt} for a socket option whose value is an [int option]. *) -external setsockopt_optint : - file_descr -> socket_optint_option -> int option -> - unit = "unix_setsockopt_optint" +val setsockopt_optint : + file_descr -> socket_optint_option -> int option -> unit (** Same as {!Unix.setsockopt} for a socket option whose value is an [int option]. *) -external getsockopt_float : - file_descr -> socket_float_option -> float = "unix_getsockopt_float" +val getsockopt_float : file_descr -> socket_float_option -> float (** Same as {!Unix.getsockopt} for a socket option whose value is a floating-point number. *) -external setsockopt_float : - file_descr -> socket_float_option -> float -> unit = "unix_setsockopt_float" +val setsockopt_float : file_descr -> socket_float_option -> float -> unit (** Same as {!Unix.setsockopt} for a socket option whose value is a floating-point number. *) +val getsockopt_error : file_descr -> error option +(** Return the error condition associated with the given socket, + and clear it. *) + (** {6 High-level network connection functions} *) diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unixsupport.c ocaml-unix-3.11.2/otherlibs/unix/unixsupport.c --- ocaml-unix-3.10.2/otherlibs/unix/unixsupport.c 2005-09-06 14:38:32.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/unixsupport.c 2005-09-06 14:38:32.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unixsupport.c,v 1.18 2005/09/06 12:38:32 doligez Exp $ */ +/* $Id: unixsupport.c 7045 2005-09-06 12:38:32Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unixsupport.h ocaml-unix-3.11.2/otherlibs/unix/unixsupport.h --- ocaml-unix-3.10.2/otherlibs/unix/unixsupport.h 2005-09-06 14:38:32.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/unixsupport.h 2005-09-06 14:38:32.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unixsupport.h,v 1.8 2005/09/06 12:38:32 doligez Exp $ */ +/* $Id: unixsupport.h 7045 2005-09-06 12:38:32Z doligez $ */ #ifdef HAS_UNISTD #include <unistd.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/unlink.c ocaml-unix-3.11.2/otherlibs/unix/unlink.c --- ocaml-unix-3.10.2/otherlibs/unix/unlink.c 2001-12-07 14:40:39.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/unlink.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unlink.c,v 1.8 2001/12/07 13:40:39 xleroy Exp $ */ +/* $Id: unlink.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/unix/utimes.c ocaml-unix-3.11.2/otherlibs/unix/utimes.c --- ocaml-unix-3.10.2/otherlibs/unix/utimes.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/unix/utimes.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: utimes.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: utimes.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <fail.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/wait.c ocaml-unix-3.11.2/otherlibs/unix/wait.c --- ocaml-unix-3.10.2/otherlibs/unix/wait.c 2005-04-17 10:23:51.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/wait.c 2005-04-17 10:23:51.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: wait.c,v 1.19 2005/04/17 08:23:51 xleroy Exp $ */ +/* $Id: wait.c 6845 2005-04-17 08:23:51Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/unix/write.c ocaml-unix-3.11.2/otherlibs/unix/write.c --- ocaml-unix-3.10.2/otherlibs/unix/write.c 2004-07-13 14:25:15.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/unix/write.c 2004-07-13 14:25:21.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: write.c,v 1.14 2004/07/13 12:25:15 xleroy Exp $ */ +/* $Id: write.c 6553 2004-07-13 12:25:21Z xleroy $ */ #include <errno.h> #include <string.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/accept.c ocaml-unix-3.11.2/otherlibs/win32unix/accept.c --- ocaml-unix-3.10.2/otherlibs/win32unix/accept.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/accept.c 2006-10-18 10:26:54.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: accept.c,v 1.21 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: accept.c 7697 2006-10-18 08:26:54Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/bind.c ocaml-unix-3.11.2/otherlibs/win32unix/bind.c --- ocaml-unix-3.10.2/otherlibs/win32unix/bind.c 2002-04-30 17:00:45.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/bind.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: bind.c,v 1.10 2002/04/30 15:00:45 xleroy Exp $ */ +/* $Id: bind.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/channels.c ocaml-unix-3.11.2/otherlibs/win32unix/channels.c --- ocaml-unix-3.10.2/otherlibs/win32unix/channels.c 2006-09-21 11:41:04.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/channels.c 2009-12-07 11:39:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: channels.c,v 1.12 2006/09/21 09:41:04 xleroy Exp $ */ +/* $Id: channels.c 9450 2009-12-07 10:39:54Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> @@ -82,7 +82,10 @@ CAMLprim value win_handle_fd(value vfd) { int crt_fd = Int_val(vfd); - value res = win_alloc_handle_or_socket((HANDLE) _get_osfhandle(crt_fd)); + /* PR#4750: do not use the _or_socket variant as it can cause performance + degradation and this function is only used with the standard + handles 0, 1, 2, which are not sockets. */ + value res = win_alloc_handle((HANDLE) _get_osfhandle(crt_fd)); CRT_fd_val(res) = crt_fd; return res; } diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/close.c ocaml-unix-3.11.2/otherlibs/win32unix/close.c --- ocaml-unix-3.10.2/otherlibs/win32unix/close.c 2002-04-30 17:00:46.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/close.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: close.c,v 1.5 2002/04/30 15:00:46 xleroy Exp $ */ +/* $Id: close.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/close_on.c ocaml-unix-3.11.2/otherlibs/win32unix/close_on.c --- ocaml-unix-3.10.2/otherlibs/win32unix/close_on.c 2001-12-07 14:40:43.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/close_on.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: close_on.c,v 1.8 2001/12/07 13:40:43 xleroy Exp $ */ +/* $Id: close_on.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include <windows.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/connect.c ocaml-unix-3.11.2/otherlibs/win32unix/connect.c --- ocaml-unix-3.10.2/otherlibs/win32unix/connect.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/connect.c 2006-10-18 10:26:54.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: connect.c,v 1.13 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: connect.c 7697 2006-10-18 08:26:54Z xleroy $ */ #include <mlvalues.h> #include <signals.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/createprocess.c ocaml-unix-3.11.2/otherlibs/win32unix/createprocess.c --- ocaml-unix-3.10.2/otherlibs/win32unix/createprocess.c 2007-10-25 10:32:42.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/createprocess.c 2009-06-02 15:12:53.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: createprocess.c,v 1.13.20.1 2007/10/25 08:32:42 xleroy Exp $ */ +/* $Id: createprocess.c 9284 2009-06-02 13:12:53Z xleroy $ */ #include <windows.h> #include <mlvalues.h> @@ -35,15 +35,14 @@ envp = NULL; } /* Prepare stdin/stdout/stderr redirection */ - GetStartupInfo(&si); - si.dwFlags |= STARTF_USESTDHANDLES; + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = Handle_val(fd1); si.hStdOutput = Handle_val(fd2); si.hStdError = Handle_val(fd3); /* If we do not have a console window, then we must create one before running the process (keep it hidden for apparence). - Also one must suppress spurious flags in si.dwFlags. - Otherwise the redirections are ignored. If we are starting a GUI application, the newly created console should not matter. */ if (win_has_console()) diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/dllunix.dlib ocaml-unix-3.11.2/otherlibs/win32unix/dllunix.dlib --- ocaml-unix-3.10.2/otherlibs/win32unix/dllunix.dlib 2007-02-07 10:52:28.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/dllunix.dlib 2008-07-29 10:31:41.000000000 +0200 @@ -7,6 +7,7 @@ select.d.o sendrecv.d.o shutdown.d.o sleep.d.o socket.d.o sockopt.d.o startup.d.o stat.d.o system.d.o unixsupport.d.o windir.d.o winwait.d.o write.d.o +winlist.d.o winworker.d.o windbug.d.o # Files from the ../unix directory access.d.o addrofstr.d.o chdir.d.o chmod.d.o cst2constr.d.o diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/dup2.c ocaml-unix-3.11.2/otherlibs/win32unix/dup2.c --- ocaml-unix-3.10.2/otherlibs/win32unix/dup2.c 2006-09-21 11:43:58.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/dup2.c 2006-09-21 11:43:58.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: dup2.c,v 1.9 2006/09/21 09:43:58 xleroy Exp $ */ +/* $Id: dup2.c 7630 2006-09-21 09:43:58Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/dup.c ocaml-unix-3.11.2/otherlibs/win32unix/dup.c --- ocaml-unix-3.10.2/otherlibs/win32unix/dup.c 2002-04-30 17:00:46.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/dup.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: dup.c,v 1.6 2002/04/30 15:00:46 xleroy Exp $ */ +/* $Id: dup.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/errmsg.c ocaml-unix-3.11.2/otherlibs/win32unix/errmsg.c --- ocaml-unix-3.10.2/otherlibs/win32unix/errmsg.c 2003-12-31 01:00:14.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/errmsg.c 2003-12-31 01:00:57.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: errmsg.c,v 1.5 2003/12/31 00:00:14 doligez Exp $ */ +/* $Id: errmsg.c 6043 2003-12-31 00:00:57Z doligez $ */ #include <stdio.h> #include <errno.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/getpeername.c ocaml-unix-3.11.2/otherlibs/win32unix/getpeername.c --- ocaml-unix-3.10.2/otherlibs/win32unix/getpeername.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/getpeername.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getpeername.c,v 1.10 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getpeername.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/getpid.c ocaml-unix-3.11.2/otherlibs/win32unix/getpid.c --- ocaml-unix-3.10.2/otherlibs/win32unix/getpid.c 2001-12-07 14:40:44.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/getpid.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getpid.c,v 1.4 2001/12/07 13:40:44 xleroy Exp $ */ +/* $Id: getpid.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/getsockname.c ocaml-unix-3.11.2/otherlibs/win32unix/getsockname.c --- ocaml-unix-3.10.2/otherlibs/win32unix/getsockname.c 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/getsockname.c 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: getsockname.c,v 1.8 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: getsockname.c 6824 2005-03-24 17:20:54Z doligez $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/gettimeofday.c ocaml-unix-3.11.2/otherlibs/win32unix/gettimeofday.c --- ocaml-unix-3.10.2/otherlibs/win32unix/gettimeofday.c 2007-03-01 14:51:24.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/gettimeofday.c 2007-03-01 14:51:24.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: gettimeofday.c,v 1.7 2007/03/01 13:51:24 xleroy Exp $ */ +/* $Id: gettimeofday.c 7946 2007-03-01 13:51:24Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/libunix.clib ocaml-unix-3.11.2/otherlibs/win32unix/libunix.clib --- ocaml-unix-3.10.2/otherlibs/win32unix/libunix.clib 2007-02-07 10:52:28.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/libunix.clib 2008-07-29 10:31:41.000000000 +0200 @@ -7,6 +7,7 @@ select.o sendrecv.o shutdown.o sleep.o socket.o sockopt.o startup.o stat.o system.o unixsupport.o windir.o winwait.o write.o +winlist.o winworker.o windbug.o # Files from the ../unix directory access.o addrofstr.o chdir.o chmod.o cst2constr.o diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/link.c ocaml-unix-3.11.2/otherlibs/win32unix/link.c --- ocaml-unix-3.10.2/otherlibs/win32unix/link.c 2001-12-07 14:40:44.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/link.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: link.c,v 1.3 2001/12/07 13:40:44 xleroy Exp $ */ +/* $Id: link.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <windows.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/listen.c ocaml-unix-3.11.2/otherlibs/win32unix/listen.c --- ocaml-unix-3.10.2/otherlibs/win32unix/listen.c 2002-04-30 17:00:46.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/listen.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: listen.c,v 1.9 2002/04/30 15:00:46 xleroy Exp $ */ +/* $Id: listen.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/lockf.c ocaml-unix-3.11.2/otherlibs/win32unix/lockf.c --- ocaml-unix-3.10.2/otherlibs/win32unix/lockf.c 2005-09-22 16:21:50.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/lockf.c 2008-10-08 15:05:48.000000000 +0200 @@ -3,6 +3,7 @@ /* Objective Caml */ /* */ /* Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com> */ +/* Further improvements by Reed Wilson */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ @@ -12,195 +13,148 @@ /* */ /***********************************************************************/ -/* $Id: lockf.c,v 1.4 2005/09/22 14:21:50 xleroy Exp $ */ +/* $Id: lockf.c 9078 2008-10-08 13:05:48Z xleroy $ */ #include <errno.h> #include <fcntl.h> #include <mlvalues.h> +#include <memory.h> #include <fail.h> #include "unixsupport.h" #include <stdio.h> - -/* - -Commands for Unix.lockf: - -type lock_command = - - | F_ULOCK (* Unlock a region *) - - | F_LOCK (* Lock a region for writing, and block if already locked *) - - | F_TLOCK (* Lock a region for writing, or fail if already locked *) - - | F_TEST (* Test a region for other process locks *) - - | F_RLOCK (* Lock a region for reading, and block if already locked *) - - | F_TRLOCK (* Lock a region for reading, or fail if already locked *) - - -val lockf : file_descr -> lock_command -> int -> unitlockf fd cmd size - -puts a lock on a region of the file opened as fd. The region starts at the current - read/write position for fd (as set by Unix.lseek), and extends size bytes - forward if size is positive, size bytes backwards if size is negative, or - to the end of the file if size is zero. A write lock (set with F_LOCK or - F_TLOCK) prevents any other process from acquiring a read or write lock on - the region. A read lock (set with F_RLOCK or F_TRLOCK) prevents any other - process from acquiring a write lock on the region, but lets other processes - acquire read locks on it. -*/ +#include <signals.h> #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER (-1) #endif -static void set_file_pointer(HANDLE h, LARGE_INTEGER dest, - PLARGE_INTEGER cur, DWORD method) +/* Sets handle h to a position based on gohere */ +/* output, if set, is changed to the new location */ + +static void set_file_pointer(HANDLE h, LARGE_INTEGER gohere, + PLARGE_INTEGER output, DWORD method) { - LONG high = dest.HighPart; - DWORD ret = SetFilePointer(h, dest.LowPart, &high, method); - if (ret == INVALID_SET_FILE_POINTER) { + LONG high = gohere.HighPart; + DWORD ret = SetFilePointer(h, gohere.LowPart, &high, method); + if(ret == INVALID_SET_FILE_POINTER) { DWORD err = GetLastError(); - if (err != NO_ERROR) { win32_maperr(err); uerror("lockf", Nothing); } + if(err != NO_ERROR) { + win32_maperr(err); + uerror("lockf", Nothing); + } + } + if(output != NULL) { + output->LowPart = ret; + output->HighPart = high; } - if (cur != NULL) { cur->LowPart = ret; cur->HighPart = high; } } CAMLprim value unix_lockf(value fd, value cmd, value span) { - int ret; - OVERLAPPED overlap; - DWORD l_start; - DWORD l_len; - HANDLE h; - OSVERSIONINFO VersionInfo; - LARGE_INTEGER cur_position; - LARGE_INTEGER end_position; - LARGE_INTEGER offset_position; - - VersionInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - if(GetVersionEx(&VersionInfo) == 0) - { - invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform."); - } -/* file locking only exists on NT versions */ - if(VersionInfo.dwPlatformId != VER_PLATFORM_WIN32_NT) - { - invalid_argument("lockf only supported on WIN32_NT platforms"); - } - - h = Handle_val(fd); - - overlap.Offset = 0; - overlap.OffsetHigh = 0; - overlap.hEvent = 0; - l_len = Long_val(span); - - offset_position.HighPart = 0; - cur_position.HighPart = 0; - end_position.HighPart = 0; - offset_position.LowPart = 0; - cur_position.LowPart = 0; - end_position.LowPart = 0; - - if(l_len == 0) - { -/* save current pointer */ - set_file_pointer(h,offset_position,&cur_position,FILE_CURRENT); -/* set to end and query */ - set_file_pointer(h,offset_position,&end_position,FILE_END); - l_len = end_position.LowPart; -/* restore previous current pointer */ - set_file_pointer(h,cur_position,NULL,FILE_BEGIN); - } - else - { - if (l_len < 0) - { - set_file_pointer(h,offset_position,&cur_position,FILE_CURRENT); - l_len = abs(l_len); - if(l_len > cur_position.LowPart) - { - errno = EINVAL; - uerror("lockf", Nothing); - return Val_unit; - } - overlap.Offset = cur_position.LowPart - l_len; - } - } - switch (Int_val(cmd)) - { - case 0: /* F_ULOCK */ - if(UnlockFileEx(h, 0, l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - break; - case 1: /* F_LOCK */ -/* this should block until write lock is obtained */ - if(LockFileEx(h,LOCKFILE_EXCLUSIVE_LOCK,0,l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - break; - case 2: /* F_TLOCK */ -/* - * this should return immediately if write lock can-not - * be obtained. - */ - if(LockFileEx(h,LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK,0,l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - break; - case 3: /* F_TEST */ -/* - * I'm doing this by aquiring an immediate write - * lock and then releasing it. It is not clear that - * this behavior matches anything in particular, but - * it is not clear the nature of the lock test performed - * by ocaml (unix) currently. - */ - if(LockFileEx(h,LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK,0,l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - else - { - UnlockFileEx(h, 0, l_len,0,&overlap); - ret = 0; - } - break; - case 4: /* F_RLOCK */ -/* this should block until read lock is obtained */ - if(LockFileEx(h,0,0,l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - break; - case 5: /* F_TRLOCK */ -/* - * this should return immediately if read lock can-not - * be obtained. - */ - if(LockFileEx(h,LOCKFILE_FAIL_IMMEDIATELY,0,l_len,0,&overlap) == 0) - { - errno = EACCES; - ret = -1; - } - break; - default: - errno = EINVAL; - ret = -1; - } - if (ret == -1) uerror("lockf", Nothing); - return Val_unit; -} + CAMLparam3(fd, cmd, span); + OVERLAPPED overlap; + intnat l_len; + HANDLE h; + OSVERSIONINFO version; + LARGE_INTEGER cur_position; + LARGE_INTEGER beg_position; + LARGE_INTEGER lock_len; + LARGE_INTEGER zero; + DWORD err = NO_ERROR; + + version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + if(GetVersionEx(&version) == 0) { + invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform."); + } + if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) { + invalid_argument("lockf only supported on WIN32_NT platforms"); + } + + h = Handle_val(fd); + + l_len = Long_val(span); + + /* No matter what, we need the current position in the file */ + zero.HighPart = zero.LowPart = 0; + set_file_pointer(h, zero, &cur_position, FILE_CURRENT); + + /* All unused fields must be set to zero */ + memset(&overlap, 0, sizeof(overlap)); + + if(l_len == 0) { + /* Lock from cur to infinity */ + lock_len.QuadPart = -1; + overlap.OffsetHigh = cur_position.HighPart; + overlap.Offset = cur_position.LowPart ; + } + else if(l_len > 0) { + /* Positive file offset */ + lock_len.QuadPart = l_len; + overlap.OffsetHigh = cur_position.HighPart; + overlap.Offset = cur_position.LowPart ; + } + else { + /* Negative file offset */ + lock_len.QuadPart = - l_len; + if (lock_len.QuadPart > cur_position.QuadPart) { + errno = EINVAL; + uerror("lockf", Nothing); + } + beg_position.QuadPart = cur_position.QuadPart - lock_len.QuadPart; + overlap.OffsetHigh = beg_position.HighPart; + overlap.Offset = beg_position.LowPart ; + } + switch(Int_val(cmd)) { + case 0: /* F_ULOCK - unlock */ + if (! UnlockFileEx(h, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) + err = GetLastError(); + break; + case 1: /* F_LOCK - blocking write lock */ + enter_blocking_section(); + if (! LockFileEx(h, LOCKFILE_EXCLUSIVE_LOCK, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) + err = GetLastError(); + leave_blocking_section(); + break; + case 2: /* F_TLOCK - non-blocking write lock */ + if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) + err = GetLastError(); + break; + case 3: /* F_TEST - check whether a write lock can be obtained */ + /* I'm doing this by aquiring an immediate write + * lock and then releasing it. It is not clear that + * this behavior matches anything in particular, but + * it is not clear the nature of the lock test performed + * by ocaml (unix) currently. */ + if (LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) { + UnlockFileEx(h, 0, lock_len.LowPart, lock_len.HighPart, &overlap); + } else { + err = GetLastError(); + } + break; + case 4: /* F_RLOCK - blocking read lock */ + enter_blocking_section(); + if (! LockFileEx(h, 0, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) + err = GetLastError(); + leave_blocking_section(); + break; + case 5: /* F_TRLOCK - non-blocking read lock */ + if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY, 0, + lock_len.LowPart, lock_len.HighPart, &overlap)) + err = GetLastError(); + break; + default: + errno = EINVAL; + uerror("lockf", Nothing); + } + if (err != NO_ERROR) { + win32_maperr(err); + uerror("lockf", Nothing); + } + CAMLreturn(Val_unit); +} diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/lseek.c ocaml-unix-3.11.2/otherlibs/win32unix/lseek.c --- ocaml-unix-3.10.2/otherlibs/win32unix/lseek.c 2005-02-02 16:52:26.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/lseek.c 2005-02-02 16:52:26.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: lseek.c,v 1.7 2005/02/02 15:52:26 xleroy Exp $ */ +/* $Id: lseek.c 6774 2005-02-02 15:52:26Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/Makefile.nt ocaml-unix-3.11.2/otherlibs/win32unix/Makefile.nt --- ocaml-unix-3.10.2/otherlibs/win32unix/Makefile.nt 2007-02-07 16:49:11.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/Makefile.nt 2008-07-29 10:31:41.000000000 +0200 @@ -11,16 +11,7 @@ # # ######################################################################### -# $Id: Makefile.nt,v 1.35 2007/02/07 15:49:11 doligez Exp $ - -include ../../config/Makefile - -# Compilation options -CC=$(BYTECC) -CFLAGS=-I../../byterun -I../unix -CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -COMPFLAGS=-warn-error A -g +# $Id: Makefile.nt 8955 2008-07-29 08:31:41Z xleroy $ # Files in this directory WIN_FILES = accept.c bind.c channels.c close.c \ @@ -30,7 +21,8 @@ mkdir.c open.c pipe.c read.c rename.c \ select.c sendrecv.c \ shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \ - system.c unixsupport.c windir.c winwait.c write.c + system.c unixsupport.c windir.c winwait.c write.c \ + winlist.c winworker.c windbug.c # Files from the ../unix directory UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \ @@ -39,83 +31,31 @@ getserv.c gmtime.c putenv.c rmdir.c \ socketaddr.c strofaddr.c time.c unlink.c utimes.c -ALL_FILES=$(WIN_FILES) $(UNIX_FILES) - -DOBJS=$(ALL_FILES:.c=.$(DO)) -SOBJS=$(ALL_FILES:.c=.$(SO)) - -LIBS=$(call SYSLIB,wsock32) - -CAML_OBJS=unix.cmo unixLabels.cmo -CAMLOPT_OBJS=$(CAML_OBJS:.cmo=.cmx) - UNIX_CAML_FILES = unix.mli unixLabels.mli unixLabels.ml -all: dllunix.dll libunix.$(A) unix.cma - -allopt: libunix.$(A) unix.cmxa - -dllunix.dll: $(DOBJS) - $(call MKDLL,dllunix.dll,tmp.$(A),$(DOBJS) ../../byterun/ocamlrun.$(A) $(LIBS)) - rm tmp.* - -libunix.$(A): $(SOBJS) - $(call MKLIB,libunix.$(A),$(SOBJS)) - -$(DOBJS) $(SOBJS): unixsupport.h +ALL_FILES=$(WIN_FILES) $(UNIX_FILES) +WSOCKLIB=$(call SYSLIB,ws2_32) -unix.cma: $(CAML_OBJS) - $(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \ - -dllib -lunix -cclib -lunix -cclib $(LIBS) +LIBNAME=unix +COBJS=$(ALL_FILES:.c=.$(O)) +CAMLOBJS=unix.cmo unixLabels.cmo +LINKOPTS=-cclib $(WSOCKLIB) +LDOPTS=-ldopt $(WSOCKLIB) +EXTRACAMLFLAGS=-nolabels +EXTRACFLAGS=-I../unix +HEADERS=unixsupport.h -unix.cmxa: $(CAMLOPT_OBJS) - $(CAMLOPT) -a -linkall -o unix.cmxa $(CAMLOPT_OBJS) \ - -cclib -lunix -cclib $(LIBS) -partialclean: - rm -f *.cm* +include ../Makefile.nt -clean: partialclean - rm -f *.$(A) *.dll *.$(O) +clean:: rm -f $(UNIX_FILES) $(UNIX_CAML_FILES) -install: - cp dllunix.dll $(STUBLIBDIR)/dllunix.dll - cp libunix.$(A) $(LIBDIR)/libunix.$(A) - cp $(CAML_OBJS:.cmo=.cmi) unix.cma $(CAML_OBJS:.cmo=.mli) $(LIBDIR) - cp unixsupport.h $(LIBDIR)/caml - -installopt: - cp unix.cmxa $(CAML_OBJS:.cmo=.cmx) unix.$(A) $(LIBDIR) - -unixLabels.cmo: unixLabels.ml - $(CAMLC) -c $(COMPFLAGS) -nolabels unixLabels.ml - -unixLabels.cmx: unixLabels.ml - $(CAMLOPT) -c $(COMPFLAGS) -nolabels unixLabels.ml - $(UNIX_FILES) $(UNIX_CAML_FILES): %: ../unix/% cp ../unix/$* $* -.SUFFIXES: .ml .mli .cmo .cmi .cmx .$(DO) .$(SO) - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) $< - -.c.$(DO): - $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< - mv $*.$(O) $*.$(DO) - -.c.$(SO): - $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< - mv $*.$(O) $*.$(SO) - depend: +$(COBJS): unixsupport.h + include .depend diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/mkdir.c ocaml-unix-3.11.2/otherlibs/win32unix/mkdir.c --- ocaml-unix-3.10.2/otherlibs/win32unix/mkdir.c 2001-12-07 14:40:45.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/mkdir.c 2001-12-07 14:41:02.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: mkdir.c,v 1.5 2001/12/07 13:40:45 xleroy Exp $ */ +/* $Id: mkdir.c 4144 2001-12-07 13:41:02Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/nonblock.c ocaml-unix-3.11.2/otherlibs/win32unix/nonblock.c --- ocaml-unix-3.10.2/otherlibs/win32unix/nonblock.c 2003-01-06 17:44:21.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/nonblock.c 2003-01-06 17:44:21.000000000 +0100 @@ -1,42 +1,42 @@ -/***********************************************************************/^M -/* */^M -/* Objective Caml */^M -/* */^M -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */^M -/* */^M -/* Copyright 2002 Institut National de Recherche en Informatique et */^M -/* en Automatique. All rights reserved. This file is distributed */^M -/* under the terms of the GNU Library General Public License, with */^M -/* the special exception on linking described in file ../../LICENSE. */^M -/* */^M -/***********************************************************************/^M -^M -/* $Id: nonblock.c,v 1.1 2003/01/06 16:44:21 xleroy Exp $ */^M -^M -#include <mlvalues.h>^M -#include <signals.h>^M -#include "unixsupport.h"^M -^M -CAMLprim value unix_set_nonblock(socket)^M - value socket;^M -{^M - u_long non_block = 1;^M -^M - if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {^M - win32_maperr(WSAGetLastError());^M - uerror("unix_set_nonblock", Nothing);^M - }^M - return Val_unit;^M -}^M -^M -CAMLprim value unix_clear_nonblock(socket)^M - value socket;^M -{^M - u_long non_block = 0;^M -^M - if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {^M - win32_maperr(WSAGetLastError());^M - uerror("unix_clear_nonblock", Nothing);^M - }^M - return Val_unit;^M -}^M +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: nonblock.c 5375 2003-01-06 16:44:21Z xleroy $ */ + +#include <mlvalues.h> +#include <signals.h> +#include "unixsupport.h" + +CAMLprim value unix_set_nonblock(socket) + value socket; +{ + u_long non_block = 1; + + if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) { + win32_maperr(WSAGetLastError()); + uerror("unix_set_nonblock", Nothing); + } + return Val_unit; +} + +CAMLprim value unix_clear_nonblock(socket) + value socket; +{ + u_long non_block = 0; + + if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) { + win32_maperr(WSAGetLastError()); + uerror("unix_clear_nonblock", Nothing); + } + return Val_unit; +} diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/open.c ocaml-unix-3.11.2/otherlibs/win32unix/open.c --- ocaml-unix-3.10.2/otherlibs/win32unix/open.c 2007-10-25 09:42:48.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/open.c 2008-01-11 17:13:18.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: open.c,v 1.9.20.1 2007/10/25 07:42:48 xleroy Exp $ */ +/* $Id: open.c 8768 2008-01-11 16:13:18Z doligez $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/pipe.c ocaml-unix-3.11.2/otherlibs/win32unix/pipe.c --- ocaml-unix-3.10.2/otherlibs/win32unix/pipe.c 2001-12-07 14:40:45.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/pipe.c 2009-03-28 16:30:08.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: pipe.c,v 1.7 2001/12/07 13:40:45 xleroy Exp $ */ +/* $Id: pipe.c 9196 2009-03-28 15:30:08Z xleroy $ */ #include <mlvalues.h> #include <memory.h> @@ -19,7 +19,8 @@ #include "unixsupport.h" #include <fcntl.h> -#define SIZEBUF 1024 +/* PR#4749: pick a size that matches that of I/O buffers */ +#define SIZEBUF 4096 CAMLprim value unix_pipe(value unit) { diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/read.c ocaml-unix-3.11.2/otherlibs/win32unix/read.c --- ocaml-unix-3.10.2/otherlibs/win32unix/read.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/read.c 2006-10-18 10:26:54.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: read.c,v 1.9 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: read.c 7697 2006-10-18 08:26:54Z xleroy $ */ #include <string.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/rename.c ocaml-unix-3.11.2/otherlibs/win32unix/rename.c --- ocaml-unix-3.10.2/otherlibs/win32unix/rename.c 2004-07-13 14:25:15.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/rename.c 2004-07-13 14:25:21.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: rename.c,v 1.3 2004/07/13 12:25:15 xleroy Exp $ */ +/* $Id: rename.c 6553 2004-07-13 12:25:21Z xleroy $ */ #include <stdio.h> #include <mlvalues.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/select.c ocaml-unix-3.11.2/otherlibs/win32unix/select.c --- ocaml-unix-3.10.2/otherlibs/win32unix/select.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/select.c 2008-11-26 14:27:21.000000000 +0100 @@ -2,100 +2,1154 @@ /* */ /* Objective Caml */ /* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* Contributed by Sylvain Le Gall for Lexifi */ /* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file ../../LICENSE. */ /* */ /***********************************************************************/ -/* $Id: select.c,v 1.12 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: select.c 9143 2008-11-26 13:27:21Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> #include <memory.h> #include <signals.h> +#include <winsock2.h> +#include <windows.h> #include "unixsupport.h" +#include "windbug.h" +#include "winworker.h" +#include "winlist.h" -static void fdlist_to_fdset(value fdlist, fd_set *fdset) +/* This constant define the maximum number of objects that + * can be handle by a SELECTDATA. + * 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 + * + * This lead to pick the following value as the biggest possible + * value + */ +#define MAXIMUM_SELECT_OBJECTS (MAXIMUM_WAIT_OBJECTS - 1) + +/* Manage set of handle */ +typedef struct _SELECTHANDLESET { + LPHANDLE lpHdl; + DWORD nMax; + DWORD nLast; +} SELECTHANDLESET; + +typedef SELECTHANDLESET *LPSELECTHANDLESET; + +void handle_set_init (LPSELECTHANDLESET hds, LPHANDLE lpHdl, DWORD max) +{ + DWORD i; + + hds->lpHdl = lpHdl; + hds->nMax = max; + hds->nLast = 0; + + /* Set to invalid value every entry of the handle */ + for (i = 0; i < hds->nMax; i++) + { + hds->lpHdl[i] = INVALID_HANDLE_VALUE; + }; +} + +void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl) +{ + LPSELECTHANDLESET res; + + if (hds->nLast < hds->nMax) + { + hds->lpHdl[hds->nLast] = hdl; + hds->nLast++; + } + +#ifdef DBUG + dbug_print("Adding handle %x to set %x", hdl, hds); +#endif +} + +BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl) { - value l; - FD_ZERO(fdset); - for (l = fdlist; l != Val_int(0); l = Field(l, 1)) { - FD_SET(Socket_val(Field(l, 0)), fdset); + BOOL res; + DWORD i; + + res = FALSE; + for (i = 0; !res && i < hds->nLast; i++) + { + res = (hds->lpHdl[i] == hdl); } + + return res; } -static value fdset_to_fdlist(value fdlist, fd_set *fdset) +void handle_set_reset (LPSELECTHANDLESET hds) { - value res = Val_int(0); - Begin_roots2(fdlist, res) - for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) { - value s = Field(fdlist, 0); - if (FD_ISSET(Socket_val(s), fdset)) { - value newres = alloc_small(2, 0); - Field(newres, 0) = s; - Field(newres, 1) = res; - res = newres; + DWORD i; + + for (i = 0; i < hds->nMax; i++) + { + hds->lpHdl[i] = INVALID_HANDLE_VALUE; + } + hds->nMax = 0; + hds->nLast = 0; + hds->lpHdl = NULL; +} + +/* Data structure for handling select */ + +typedef enum _SELECTHANDLETYPE { + SELECT_HANDLE_NONE = 0, + SELECT_HANDLE_DISK, + SELECT_HANDLE_CONSOLE, + SELECT_HANDLE_PIPE, + SELECT_HANDLE_SOCKET, +} SELECTHANDLETYPE; + +typedef enum _SELECTMODE { + SELECT_MODE_NONE = 0, + SELECT_MODE_READ, + SELECT_MODE_WRITE, + SELECT_MODE_EXCEPT, +} SELECTMODE; + +typedef enum _SELECTSTATE { + SELECT_STATE_NONE = 0, + SELECT_STATE_INITFAILED, + SELECT_STATE_ERROR, + SELECT_STATE_SIGNALED +} SELECTSTATE; + +typedef enum _SELECTTYPE { + SELECT_TYPE_NONE = 0, + SELECT_TYPE_STATIC, /* Result is known without running anything */ + SELECT_TYPE_CONSOLE_READ, /* Reading data on console */ + SELECT_TYPE_PIPE_READ, /* Reading data on pipe */ + SELECT_TYPE_SOCKET /* Classic select */ +} SELECTTYPE; + +/* Data structure for results */ +typedef struct _SELECTRESULT { + LIST lst; + SELECTMODE EMode; + LPVOID lpOrig; +} SELECTRESULT; + +typedef SELECTRESULT *LPSELECTRESULT; + +/* Data structure for query */ +typedef struct _SELECTQUERY { + LIST lst; + SELECTMODE EMode; + HANDLE hFileDescr; + LPVOID lpOrig; +} SELECTQUERY; + +typedef SELECTQUERY *LPSELECTQUERY; + +typedef struct _SELECTDATA { + LIST lst; + SELECTTYPE EType; + SELECTRESULT aResults[MAXIMUM_SELECT_OBJECTS]; + DWORD nResultsCount; + /* Data following are dedicated to APC like call, they + will be initialized if required. + */ + WORKERFUNC funcWorker; + SELECTQUERY aQueries[MAXIMUM_SELECT_OBJECTS]; + DWORD nQueriesCount; + SELECTSTATE EState; + DWORD nError; + LPWORKER lpWorker; +} SELECTDATA; + +typedef SELECTDATA *LPSELECTDATA; + +/* Get error status if associated condition is false */ +static BOOL check_error(LPSELECTDATA lpSelectData, BOOL bFailed) +{ + if (bFailed && lpSelectData->nError == 0) + { + lpSelectData->EState = SELECT_STATE_ERROR; + lpSelectData->nError = GetLastError(); + } + return bFailed; +} + +/* Create data associated with a select operation */ +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()); + + /* 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 + invalid values. + */ + res->funcWorker = NULL; + res->nQueriesCount = 0; + res->EState = SELECT_STATE_NONE; + res->nError = 0; + res->lpWorker = NULL; + + return res; +} + +/* Free select data */ +void select_data_free (LPSELECTDATA lpSelectData) +{ + DWORD i; + +#ifdef DBUG + dbug_print("Freeing data of %x", lpSelectData); +#endif + + /* Free APC related data, if they exists */ + if (lpSelectData->lpWorker != NULL) + { + worker_job_finish(lpSelectData->lpWorker); + lpSelectData->lpWorker = NULL; + }; + + /* Make sure results/queries cannot be accessed */ + lpSelectData->nResultsCount = 0; + lpSelectData->nQueriesCount = 0; + + if (!HeapLock(GetProcessHeap())) + { + win32_maperr(GetLastError()); + uerror("select_data_free", Nothing); + }; + HeapFree(GetProcessHeap(), 0, lpSelectData); + HeapUnlock(GetProcessHeap()); +} + +/* Add a result to select data, return zero if something goes wrong. */ +DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, LPVOID lpOrig) +{ + DWORD res; + DWORD i; + + res = 0; + if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS) + { + i = lpSelectData->nResultsCount; + lpSelectData->aResults[i].EMode = EMode; + lpSelectData->aResults[i].lpOrig = lpOrig; + lpSelectData->nResultsCount++; + res = 1; + } + + return res; +} + +/* 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 res; + DWORD i; + + res = 0; + if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS) + { + i = lpSelectData->nQueriesCount; + lpSelectData->aQueries[i].EMode = EMode; + lpSelectData->aQueries[i].hFileDescr = hFileDescr; + lpSelectData->aQueries[i].lpOrig = lpOrig; + lpSelectData->nQueriesCount++; + res = 1; + } + + return res; +} + +/* 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 + * update provided SELECTDATA head, if required. + */ +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 + res = *lppSelectData; + while ( + res != NULL + && !( + res->EType == EType + && res->nQueriesCount < MAXIMUM_SELECT_OBJECTS + ) + ) + { + res = LIST_NEXT(LPSELECTDATA, res); + } + + /* No matching job found, create one */ + if (res == NULL) + { +#ifdef DBUG + dbug_print("No job for type %d found, create one", EType); +#endif + res = select_data_new(*lppSelectData, EType); + *lppSelectData = res; + } + + return res; +} + +/***********************/ +/* Console */ +/***********************/ + +void read_console_poll(HANDLE hStop, void *_data) +{ + HANDLE events[2]; + INPUT_RECORD record; + DWORD waitRes; + DWORD n; + LPSELECTDATA lpSelectData; + LPSELECTQUERY lpQuery; + +#ifdef DBUG + dbug_print("Waiting for data on console"); +#endif + + record; + waitRes = 0; + n = 0; + lpSelectData = (LPSELECTDATA)_data; + lpQuery = &(lpSelectData->aQueries[0]); + + 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)) + { + /* stop worker event or error */ + break; + } + /* console event */ + if (check_error(lpSelectData, PeekConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0)) + { + break; + } + /* check for ASCII keypress only */ + if (record.EventType == KEY_EVENT && + record.Event.KeyEvent.bKeyDown && + record.Event.KeyEvent.uChar.AsciiChar != 0) + { + select_data_result_add(lpSelectData, lpQuery->EMode, lpQuery->lpOrig); + lpSelectData->EState = SELECT_STATE_SIGNALED; + break; + } + else + { + /* discard everything else and try again */ + if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0)) + { + break; } } - End_roots(); - return res; + }; } -CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout) +/* Add a function to monitor console input */ +LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig) { - fd_set read, write, except; - double tm; - struct timeval tv; - struct timeval * tvp; - int retcode; - value res; - value read_list = Val_unit, write_list = Val_unit, except_list = Val_unit; - DWORD err = 0; - - Begin_roots3 (readfds, writefds, exceptfds) - Begin_roots3 (read_list, write_list, except_list) - tm = Double_val(timeout); - if (readfds == Val_int(0) - && writefds == Val_int(0) - && exceptfds == Val_int(0)) { - if ( tm > 0.0 ) { - enter_blocking_section(); - Sleep( (int)(tm * 1000)); - leave_blocking_section(); - } - read_list = write_list = except_list = Val_int(0); - } else { - fdlist_to_fdset(readfds, &read); - fdlist_to_fdset(writefds, &write); - fdlist_to_fdset(exceptfds, &except); - if (tm < 0.0) - tvp = (struct timeval *) NULL; - else { - tv.tv_sec = (int) tm; - tv.tv_usec = (int) (1e6 * (tm - (int) tm)); - tvp = &tv; - } - enter_blocking_section(); - if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) - err = WSAGetLastError(); - leave_blocking_section(); - if (err) { - win32_maperr(err); - uerror("select", Nothing); - } - read_list = fdset_to_fdlist(readfds, &read); - write_list = fdset_to_fdlist(writefds, &write); - except_list = fdset_to_fdlist(exceptfds, &except); - } - res = alloc_small(3, 0); - Field(res, 0) = read_list; - Field(res, 1) = write_list; - Field(res, 2) = except_list; - End_roots(); - End_roots(); + 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); + return res; } + +/***********************/ +/* Pipe */ +/***********************/ + +/* Monitor a pipe for input */ +void read_pipe_poll (HANDLE hStop, void *_data) +{ + DWORD event; + DWORD n; + LPSELECTQUERY iterQuery; + LPSELECTDATA lpSelectData; + DWORD i; + + /* Poll pipe */ + event = 0; + n = 0; + lpSelectData = (LPSELECTDATA)_data; + +#ifdef DBUG + dbug_print("Checking data pipe"); +#endif + 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)) + { + break; + }; + + if (n > 0) + { + lpSelectData->EState = SELECT_STATE_SIGNALED; + select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig); + }; + }; + + /* Alas, nothing except polling seems to work for pipes. + Check the state & stop_worker_event every 10 ms + */ + if (lpSelectData->EState == SELECT_STATE_NONE) + { + event = WaitForSingleObject(hStop, 10); + if (event == WAIT_OBJECT_0 || check_error(lpSelectData, event == WAIT_FAILED)) + { + break; + } + } + } +#ifdef DBUG + dbug_print("Finish checking data on pipe"); +#endif +} + +/* Add a function to monitor pipe input */ +LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig) +{ + 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 + 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 + 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); + + return hd; +} + +/***********************/ +/* Socket */ +/***********************/ + +/* Monitor socket */ +void socket_poll (HANDLE hStop, void *_data) +{ + LPSELECTDATA lpSelectData; + LPSELECTQUERY iterQuery; + HANDLE aEvents[MAXIMUM_SELECT_OBJECTS]; + DWORD nEvents; + long maskEvents; + DWORD i; + u_long iMode; + + lpSelectData = (LPSELECTDATA)_data; + + for (nEvents = 0; nEvents < lpSelectData->nQueriesCount; nEvents++) + { + iterQuery = &(lpSelectData->aQueries[nEvents]); + aEvents[nEvents] = CreateEvent(NULL, TRUE, FALSE, NULL); + maskEvents = 0; + switch (iterQuery->EMode) + { + case SELECT_MODE_READ: + maskEvents = FD_READ | FD_ACCEPT | FD_CLOSE; + break; + case SELECT_MODE_WRITE: + maskEvents = FD_WRITE | FD_CONNECT | FD_CLOSE; + break; + case SELECT_MODE_EXCEPT: + maskEvents = FD_OOB; + break; + } + check_error(lpSelectData, + WSAEventSelect( + (SOCKET)(iterQuery->hFileDescr), + aEvents[nEvents], + maskEvents) == SOCKET_ERROR); + } + + /* Add stop event */ + aEvents[nEvents] = hStop; + nEvents++; + + if (lpSelectData->nError == 0) + { + check_error(lpSelectData, + WaitForMultipleObjects( + nEvents, + aEvents, + FALSE, + INFINITE) == WAIT_FAILED); + }; + + if (lpSelectData->nError == 0) + { + for (i = 0; i < lpSelectData->nQueriesCount; i++) + { + iterQuery = &(lpSelectData->aQueries[i]); + if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0) + { +#ifdef DBUG + dbug_print("Socket %d has pending events", (i - 1)); +#endif + if (iterQuery != NULL) + { + select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig); + } + } + /* 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); + + CloseHandle(aEvents[i]); + aEvents[i] = INVALID_HANDLE_VALUE; + } + } +} + +/* Add a function to monitor socket */ +LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig) +{ + 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 + 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 + + return hd; +} + +/***********************/ +/* Static */ +/***********************/ + +/* Add a static result */ +LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig) +{ + 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); + + return hd; +} + +/********************************/ +/* Generic select data handling */ +/********************************/ + +/* Guess handle type */ +static SELECTHANDLETYPE get_handle_type(value fd) +{ + DWORD mode; + SELECTHANDLETYPE res; + + CAMLparam1(fd); + + mode = 0; + res = SELECT_HANDLE_NONE; + + if (Descr_kind_val(fd) == KIND_SOCKET) + { + res = SELECT_HANDLE_SOCKET; + } + else + { + switch(GetFileType(Handle_val(fd))) + { + case FILE_TYPE_DISK: + res = SELECT_HANDLE_DISK; + break; + + case FILE_TYPE_CHAR: /* character file or a console */ + if (GetConsoleMode(Handle_val(fd), &mode) != 0) + { + res = SELECT_HANDLE_CONSOLE; + } + else + { + res = SELECT_HANDLE_NONE; + }; + break; + + case FILE_TYPE_PIPE: /* a named or an anonymous pipe (socket already handled) */ + res = SELECT_HANDLE_PIPE; + break; + }; + }; + + CAMLreturnT(SELECTHANDLETYPE, res); +} + +/* Choose what to do with given data */ +LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, value fd) +{ + LPSELECTDATA res; + HANDLE hFileDescr; + void *lpOrig; + struct sockaddr sa; + int sa_len; + BOOL alreadyAdded; + + CAMLparam1(fd); + + res = lpSelectData; + hFileDescr = Handle_val(fd); + lpOrig = (void *)fd; + sa_len = sizeof(sa); + alreadyAdded = FALSE; + +#ifdef DBUG + dbug_print("Begin dispatching handle %x", hFileDescr); +#endif + +#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 + 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 + /* 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); + }; + break; + + case SELECT_HANDLE_CONSOLE: +#ifdef DBUG + dbug_print("Handle %x is a console handle", hFileDescr); +#endif + /* 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); + } + else if (EMode == SELECT_MODE_WRITE) + { + res = static_poll_add(res, EMode, hFileDescr, lpOrig); + }; + break; + + case SELECT_HANDLE_PIPE: +#ifdef DBUG + dbug_print("Handle %x is a pipe handle", hFileDescr); +#endif + /* 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); + } + 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); + }; + break; + + case SELECT_HANDLE_SOCKET: +#ifdef DBUG + dbug_print("Handle %x is a socket handle", hFileDescr); +#endif + 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 + if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ) + { + res = static_poll_add(res, EMode, hFileDescr, lpOrig); + alreadyAdded = TRUE; + } + } + } + if (!alreadyAdded) + { + res = socket_poll_add(res, EMode, hFileDescr, lpOrig); + } + break; + + default: +#ifdef DBUG + dbug_print("Handle %x is unknown", hFileDescr); +#endif + caml_failwith("Unknown handle"); + break; + }; + +#ifdef DBUG + dbug_print("Finish dispatching handle %x", hFileDescr); +#endif + + CAMLreturnT(LPSELECTDATA, res); +} + +static DWORD caml_list_length (value lst) +{ + DWORD res; + + CAMLparam1 (lst); + CAMLlocal1 (l); + + for (res = 0, l = lst; l != Val_int(0); l = Field(l, 1), res++) + { } + + CAMLreturnT(DWORD, res); +} + +#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; + + /* Iterator for results */ + LPSELECTRESULT iterResult; + + /* Iterator */ + DWORD i; + + /* Error status */ + DWORD err; + + /* Time to wait */ + DWORD milliseconds; + + /* Is there static select data */ + BOOL hasStaticData = FALSE; + + /* Wait return */ + DWORD waitRet; + + /* Set of handle */ + SELECTHANDLESET hds; + DWORD hdsMax; + LPHANDLE hdsData; + + /* Length of each list */ + DWORD readfds_len; + DWORD writefds_len; + DWORD exceptfds_len; + + CAMLparam4 (readfds, writefds, exceptfds, timeout); + CAMLlocal5 (read_list, write_list, except_list, res, l); + CAMLlocal1 (fd); + +#ifdef DBUG + dbug_print("in select"); +#endif + + nEventsCount = 0; + nEventsMax = 0; + lpEventsDone = NULL; + lpSelectData = NULL; + iterSelectData = NULL; + iterResult = NULL; + err = 0; + hasStaticData = 0; + waitRet = 0; + readfds_len = caml_list_length(readfds); + writefds_len = caml_list_length(writefds); + 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()); + + if (Double_val(timeout) >= 0.0) + { + milliseconds = 1000 * Double_val(timeout); +#ifdef DBUG + dbug_print("Will wait %d ms", milliseconds); +#endif + } + else + { + milliseconds = INFINITE; + } + + + /* Create list of select data, based on the different list of fd to watch */ +#ifdef DBUG + dbug_print("Dispatch read fd"); +#endif + handle_set_init(&hds, hdsData, hdsMax); + 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); + } + else + { +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for read", Handle_val(fd)); +#endif + } + } + handle_set_reset(&hds); + +#ifdef DBUG + dbug_print("Dispatch write fd"); +#endif + handle_set_init(&hds, hdsData, hdsMax); + 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); + } + else + { +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for write", Handle_val(fd)); +#endif + } + } + handle_set_reset(&hds); + +#ifdef DBUG + dbug_print("Dispatch exceptional fd"); +#endif + handle_set_init(&hds, hdsData, hdsMax); + 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); + } + else + { +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for exceptional", Handle_val(fd)); +#endif + } + } + handle_set_reset(&hds); + + /* Building the list of handle to wait for */ +#ifdef DBUG + dbug_print("Building events done array"); +#endif + 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()); + + iterSelectData = lpSelectData; + while (iterSelectData != NULL) + { + /* Check if it is static data. If this is the case, launch everything + * but don't wait for events. It helps to test if there are events on + * any other fd (which are not static), knowing that there is at least + * one result (the static data). + */ + if (iterSelectData->EType == SELECT_TYPE_STATIC) + { + hasStaticData = TRUE; + }; + + /* Execute APC */ + if (iterSelectData->funcWorker != NULL) + { + iterSelectData->lpWorker = + worker_job_submit( + iterSelectData->funcWorker, + (void *)iterSelectData); +#ifdef DBUG + dbug_print("Job submitted to worker %x", iterSelectData->lpWorker); +#endif + 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 + + /* Processing select itself */ + enter_blocking_section(); + /* There are worker started, waiting to be monitored */ + if (nEventsCount > 0) + { + /* Waiting for event */ + if (err == 0 && !hasStaticData) + { +#ifdef DBUG + dbug_print("Waiting for one select worker to be done"); +#endif + switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds)) + { + case WAIT_FAILED: + err = GetLastError(); + break; + + case WAIT_TIMEOUT: +#ifdef DBUG + dbug_print("Select timeout"); +#endif + break; + + default: +#ifdef DBUG + dbug_print("One worker is done"); +#endif + break; + }; + } + + /* Ordering stop to every worker */ +#ifdef DBUG + dbug_print("Sending stop signal to every select workers"); +#endif + iterSelectData = lpSelectData; + while (iterSelectData != NULL) + { + if (iterSelectData->lpWorker != NULL) + { + worker_job_stop(iterSelectData->lpWorker); + }; + iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData); + }; + +#ifdef DBUG + dbug_print("Waiting for every select worker to be done"); +#endif + switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE)) + { + case WAIT_FAILED: + err = GetLastError(); + break; + + default: +#ifdef DBUG + dbug_print("Every worker is done"); +#endif + break; + } + } + /* Nothing to monitor but some time to wait. */ + else if (!hasStaticData) + { + Sleep(milliseconds); + } + leave_blocking_section(); + +#ifdef DBUG + dbug_print("Error status: %d (0 is ok)", err); +#endif + /* Build results */ + if (err == 0) + { +#ifdef DBUG + dbug_print("Building result"); +#endif + read_list = Val_unit; + write_list = Val_unit; + except_list = Val_unit; + + iterSelectData = lpSelectData; + while (iterSelectData != NULL) + { + for (i = 0; i < iterSelectData->nResultsCount; i++) + { + iterResult = &(iterSelectData->aResults[i]); + l = alloc_small(2, 0); + Store_field(l, 0, (value)iterResult->lpOrig); + switch (iterResult->EMode) + { + case SELECT_MODE_READ: + Store_field(l, 1, read_list); + read_list = l; + break; + case SELECT_MODE_WRITE: + Store_field(l, 1, write_list); + write_list = l; + break; + case SELECT_MODE_EXCEPT: + Store_field(l, 1, except_list); + except_list = l; + break; + } + } + /* We try to only process the first error, bypass other errors */ + if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR) + { + err = iterSelectData->nError; + } + iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData); + } + } + + /* Free resources */ +#ifdef DBUG + dbug_print("Free selectdata resources"); +#endif + iterSelectData = lpSelectData; + while (iterSelectData != NULL) + { + lpSelectData = iterSelectData; + iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData); + 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()); + +#ifdef DBUG + dbug_print("Raise error if required"); +#endif + if (err != 0) + { + win32_maperr(err); + uerror("select", Nothing); + } + +#ifdef DBUG + dbug_print("Build final result"); +#endif + 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 + + CAMLreturn(res); +} diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/sendrecv.c ocaml-unix-3.11.2/otherlibs/win32unix/sendrecv.c --- ocaml-unix-3.10.2/otherlibs/win32unix/sendrecv.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/sendrecv.c 2006-10-18 10:26:54.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: sendrecv.c,v 1.21 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: sendrecv.c 7697 2006-10-18 08:26:54Z xleroy $ */ #include <mlvalues.h> #include <alloc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/shutdown.c ocaml-unix-3.11.2/otherlibs/win32unix/shutdown.c --- ocaml-unix-3.10.2/otherlibs/win32unix/shutdown.c 2002-04-30 17:00:47.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/shutdown.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: shutdown.c,v 1.9 2002/04/30 15:00:47 xleroy Exp $ */ +/* $Id: shutdown.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/sleep.c ocaml-unix-3.11.2/otherlibs/win32unix/sleep.c --- ocaml-unix-3.10.2/otherlibs/win32unix/sleep.c 2002-06-07 11:49:41.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/sleep.c 2002-06-07 11:49:45.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: sleep.c,v 1.5 2002/06/07 09:49:41 xleroy Exp $ */ +/* $Id: sleep.c 4899 2002-06-07 09:49:45Z xleroy $ */ #include <mlvalues.h> #include <signals.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/socketaddr.h ocaml-unix-3.11.2/otherlibs/win32unix/socketaddr.h --- ocaml-unix-3.10.2/otherlibs/win32unix/socketaddr.h 2005-03-24 18:20:53.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/socketaddr.h 2005-03-24 18:20:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socketaddr.h,v 1.8 2005/03/24 17:20:53 doligez Exp $ */ +/* $Id: socketaddr.h 6824 2005-03-24 17:20:54Z doligez $ */ #include <misc.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/socket.c ocaml-unix-3.11.2/otherlibs/win32unix/socket.c --- ocaml-unix-3.10.2/otherlibs/win32unix/socket.c 2002-04-30 17:00:47.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/socket.c 2002-04-30 17:00:48.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: socket.c,v 1.12 2002/04/30 15:00:47 xleroy Exp $ */ +/* $Id: socket.c 4765 2002-04-30 15:00:48Z xleroy $ */ #include <mlvalues.h> #include "unixsupport.h" diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/sockopt.c ocaml-unix-3.11.2/otherlibs/win32unix/sockopt.c --- ocaml-unix-3.10.2/otherlibs/win32unix/sockopt.c 2002-07-23 16:12:01.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/sockopt.c 2008-08-01 15:46:08.000000000 +0200 @@ -11,147 +11,219 @@ /* */ /***********************************************************************/ -/* $Id: sockopt.c,v 1.15 2002/07/23 14:12:01 doligez Exp $ */ +/* $Id: sockopt.c 8968 2008-08-01 13:46:08Z xleroy $ */ +#include <errno.h> #include <mlvalues.h> +#include <memory.h> #include <alloc.h> +#include <fail.h> #include "unixsupport.h" +#include "socketaddr.h" -static int sockopt_bool[] = { - SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE, - SO_DONTROUTE, SO_OOBINLINE, SO_ACCEPTCONN }; - -static int sockopt_int[] = { - SO_SNDBUF, SO_RCVBUF, SO_ERROR, SO_TYPE, SO_RCVLOWAT, SO_SNDLOWAT }; - -static int sockopt_optint[] = { SO_LINGER }; - -static int sockopt_float[] = { SO_RCVTIMEO, SO_SNDTIMEO }; +#ifndef IPPROTO_IPV6 +#define IPPROTO_IPV6 (-1) +#endif +#ifndef IPV6_V6ONLY +#define IPV6_V6ONLY (-1) +#endif + +enum option_type { + TYPE_BOOL = 0, + TYPE_INT = 1, + TYPE_LINGER = 2, + TYPE_TIMEVAL = 3, + TYPE_UNIX_ERROR = 4 +}; + +struct socket_option { + int level; + int option; +}; + +/* Table of options, indexed by type */ + +static struct socket_option sockopt_bool[] = { + { SOL_SOCKET, SO_DEBUG }, + { SOL_SOCKET, SO_BROADCAST }, + { SOL_SOCKET, SO_REUSEADDR }, + { SOL_SOCKET, SO_KEEPALIVE }, + { SOL_SOCKET, SO_DONTROUTE }, + { SOL_SOCKET, SO_OOBINLINE }, + { SOL_SOCKET, SO_ACCEPTCONN }, + { IPPROTO_TCP, TCP_NODELAY }, + { IPPROTO_IPV6, IPV6_V6ONLY} +}; + +static struct socket_option sockopt_int[] = { + { SOL_SOCKET, SO_SNDBUF }, + { SOL_SOCKET, SO_RCVBUF }, + { SOL_SOCKET, SO_ERROR }, + { SOL_SOCKET, SO_TYPE }, + { SOL_SOCKET, SO_RCVLOWAT }, + { SOL_SOCKET, SO_SNDLOWAT } }; + +static struct socket_option sockopt_linger[] = { + { SOL_SOCKET, SO_LINGER } +}; + +static struct socket_option sockopt_timeval[] = { + { SOL_SOCKET, SO_RCVTIMEO }, + { SOL_SOCKET, SO_SNDTIMEO } +}; + +static struct socket_option sockopt_unix_error[] = { + { SOL_SOCKET, SO_ERROR } +}; + +static struct socket_option * sockopt_table[] = { + sockopt_bool, + sockopt_int, + sockopt_linger, + sockopt_timeval, + sockopt_unix_error +}; + +static char * getsockopt_fun_name[] = { + "getsockopt", + "getsockopt_int", + "getsockopt_optint", + "getsockopt_float", + "getsockopt_error" +}; + +static char * setsockopt_fun_name[] = { + "setsockopt", + "setsockopt_int", + "setsockopt_optint", + "setsockopt_float", + "setsockopt_error" +}; + +union option_value { + int i; + struct linger lg; + struct timeval tv; +}; -CAMLprim value getsockopt_int(int *sockopt, value socket, - int level, value option) -{ - int optval; - int optsize; +CAMLexport value +unix_getsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket) +{ + union option_value optval; + socklen_param_type optsize; + + + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + case TYPE_UNIX_ERROR: + optsize = sizeof(optval.i); break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); break; + case TYPE_TIMEVAL: + optsize = sizeof(optval.tv); break; + default: + unix_error(EINVAL, name, Nothing); + } - optsize = sizeof(optval); - if (getsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], + if (getsockopt(Socket_val(socket), level, option, (void *) &optval, &optsize) == -1) - uerror("getsockopt", Nothing); - return Val_int(optval); -} - -CAMLprim value setsockopt_int(int *sockopt, value socket, int level, - value option, value status) -{ - int optval = Int_val(status); - if (setsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], - (void *) &optval, sizeof(optval)) == -1) - uerror("setsockopt", Nothing); - return Val_unit; -} + uerror(name, Nothing); -CAMLprim value unix_getsockopt_bool(value socket, value option) { - return getsockopt_int(sockopt_bool, socket, SOL_SOCKET, option); -} - -CAMLprim value unix_setsockopt_bool(value socket, value option, value status) -{ - return setsockopt_int(sockopt_bool, socket, SOL_SOCKET, option, status); -} - -CAMLprim value unix_getsockopt_int(value socket, value option) { - return getsockopt_int(sockopt_int, socket, SOL_SOCKET, option); -} - -CAMLprim value unix_setsockopt_int(value socket, value option, value status) -{ - return setsockopt_int(sockopt_int, socket, SOL_SOCKET, option, status); -} - -CAMLprim value getsockopt_optint(int *sockopt, value socket, - int level, value option) -{ - struct linger optval; - int optsize; - value res = Val_int(0); /* None */ - - optsize = sizeof(optval); - if (getsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], - (void *) &optval, &optsize) == -1) - uerror("getsockopt_optint", Nothing); - if (optval.l_onoff != 0) { - res = alloc_small(1, 0); - Field(res, 0) = Val_int(optval.l_linger); + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + return Val_int(optval.i); + case TYPE_LINGER: + if (optval.lg.l_onoff == 0) { + return Val_int(0); /* None */ + } else { + value res = alloc_small(1, 0); /* Some */ + Field(res, 0) = Val_int(optval.lg.l_linger); + return res; + } + case TYPE_TIMEVAL: + return copy_double((double) optval.tv.tv_sec + + (double) optval.tv.tv_usec / 1e6); + case TYPE_UNIX_ERROR: + if (optval.i == 0) { + return Val_int(0); /* None */ + } else { + value err, res; + err = unix_error_of_code(optval.i); + Begin_root(err); + res = alloc_small(1, 0); /* Some */ + Field(res, 0) = err; + End_roots(); + return res; + } + default: + unix_error(EINVAL, name, Nothing); + return Val_unit; /* Avoid warning */ } - return res; } -CAMLprim value setsockopt_optint(int *sockopt, value socket, int level, - value option, value status) -{ - struct linger optval; - - optval.l_onoff = Is_block (status); - if (optval.l_onoff) - optval.l_linger = Int_val (Field (status, 0)); - if (setsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], - (void *) &optval, sizeof(optval)) == -1) - uerror("setsockopt_optint", Nothing); - return Val_unit; -} - -CAMLprim value unix_getsockopt_optint(value socket, value option) -{ - return getsockopt_optint(sockopt_optint, socket, SOL_SOCKET, option); -} - -CAMLprim value unix_setsockopt_optint(value socket, value option, value status) -{ - return setsockopt_optint(sockopt_optint, socket, SOL_SOCKET, option, status); -} - -CAMLprim value getsockopt_float(int *sockopt, value socket, - int level, value option) -{ - struct timeval tv; - int optsize; +CAMLexport value +unix_setsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket, value val) +{ + union option_value optval; + socklen_param_type optsize; + double f; + + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + optsize = sizeof(optval.i); + optval.i = Int_val(val); + break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); + optval.lg.l_onoff = Is_block (val); + if (optval.lg.l_onoff) + optval.lg.l_linger = Int_val (Field (val, 0)); + break; + case TYPE_TIMEVAL: + f = Double_val(val); + optsize = sizeof(optval.tv); + optval.tv.tv_sec = (int) f; + optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec)); + break; + case TYPE_UNIX_ERROR: + default: + unix_error(EINVAL, name, Nothing); + } - optsize = sizeof(tv); - if (getsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], - (void *) &tv, &optsize) == -1) - uerror("getsockopt_float", Nothing); - return copy_double((double) tv.tv_sec + (double) tv.tv_usec / 1e6); -} + if (setsockopt(Socket_val(socket), level, option, + (void *) &optval, optsize) == -1) + uerror(name, Nothing); -CAMLprim value setsockopt_float(int *sockopt, value socket, int level, - value option, value status) -{ - struct timeval tv; - double tv_f; - - tv_f = Double_val(status); - tv.tv_sec = (int)tv_f; - tv.tv_usec = (int) (1e6 * (tv_f - tv.tv_sec)); - if (setsockopt(Socket_val(socket), - level, sockopt[Int_val(option)], - (void *) &tv, sizeof(tv)) == -1) - uerror("setsockopt_float", Nothing); return Val_unit; } -CAMLprim value unix_getsockopt_float(value socket, value option) +CAMLprim value unix_getsockopt(value vty, value vsocket, value voption) { - return getsockopt_float(sockopt_float, socket, SOL_SOCKET, option); + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_getsockopt_aux(getsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket); +} + +CAMLprim value unix_setsockopt(value vty, value vsocket, value voption, + value val) +{ + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_setsockopt_aux(setsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket, + val); } - -CAMLprim value unix_setsockopt_float(value socket, value option, value status) -{ - return setsockopt_float(sockopt_float, socket, SOL_SOCKET, option, status); -} - diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/startup.c ocaml-unix-3.11.2/otherlibs/win32unix/startup.c --- ocaml-unix-3.10.2/otherlibs/win32unix/startup.c 2003-01-06 15:52:57.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/startup.c 2008-07-29 10:31:41.000000000 +0200 @@ -16,6 +16,8 @@ #include <stdlib.h> #include <mlvalues.h> #include "unixsupport.h" +#include "winworker.h" +#include "windbug.h" value val_process_id; @@ -26,18 +28,27 @@ int i; HANDLE h; + DBUG_INIT; + (void) WSAStartup(MAKEWORD(2, 0), &wsaData); DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(), GetCurrentProcess(), &h, 0, TRUE, DUPLICATE_SAME_ACCESS); val_process_id = Val_int(h); + worker_init(); + return Val_unit; } CAMLprim value win_cleanup(unit) value unit; { + worker_cleanup(); + (void) WSACleanup(); + + DBUG_CLEANUP; + return Val_unit; } diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/stat.c ocaml-unix-3.11.2/otherlibs/win32unix/stat.c --- ocaml-unix-3.10.2/otherlibs/win32unix/stat.c 2006-09-21 15:57:34.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/stat.c 2009-03-28 17:39:50.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: stat.c,v 1.3 2006/09/21 13:57:34 xleroy Exp $ */ +/* $Id: stat.c 9199 2009-03-28 16:39:50Z xleroy $ */ #include <errno.h> #include <mlvalues.h> @@ -107,9 +107,5 @@ ret = _fstati64(win_CRT_fd_of_filedescr(handle), &buf); if (ret == -1) uerror("fstat", Nothing); - if (buf.st_size > Max_long) { - win32_maperr(ERROR_ARITHMETIC_OVERFLOW); - uerror("fstat", Nothing); - } return stat_aux(1, &buf); } diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/system.c ocaml-unix-3.11.2/otherlibs/win32unix/system.c --- ocaml-unix-3.10.2/otherlibs/win32unix/system.c 2006-09-21 10:03:56.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/system.c 2006-09-21 10:03:56.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: system.c,v 1.9 2006/09/21 08:03:56 xleroy Exp $ */ +/* $Id: system.c 7626 2006-09-21 08:03:56Z xleroy $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/unix.ml ocaml-unix-3.11.2/otherlibs/win32unix/unix.ml --- ocaml-unix-3.10.2/otherlibs/win32unix/unix.ml 2007-02-25 15:38:11.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/unix.ml 2008-08-01 15:46:08.000000000 +0200 @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(* $Id: unix.ml,v 1.46 2007/02/25 14:38:11 xleroy Exp $ *) +(* $Id: unix.ml 8968 2008-08-01 13:46:08Z xleroy $ *) (* Initialization *) @@ -506,29 +506,6 @@ | MSG_DONTROUTE | MSG_PEEK -type socket_bool_option = - SO_DEBUG - | SO_BROADCAST - | SO_REUSEADDR - | SO_KEEPALIVE - | SO_DONTROUTE - | SO_OOBINLINE - | SO_ACCEPTCONN - -type socket_int_option = - SO_SNDBUF - | SO_RCVBUF - | SO_ERROR - | SO_TYPE - | SO_RCVLOWAT - | SO_SNDLOWAT - -type socket_optint_option = SO_LINGER - -type socket_float_option = - SO_RCVTIMEO - | SO_SNDTIMEO - external socket : socket_domain -> socket_type -> int -> file_descr = "unix_socket" let socketpair dom ty proto = invalid_arg "Unix.socketpair not implemented" @@ -570,22 +547,68 @@ then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr -external getsockopt : file_descr -> socket_bool_option -> bool - = "unix_getsockopt_bool" -external setsockopt : file_descr -> socket_bool_option -> bool -> unit - = "unix_setsockopt_bool" -external getsockopt_int : file_descr -> socket_int_option -> int - = "unix_getsockopt_int" -external setsockopt_int : file_descr -> socket_int_option -> int -> unit - = "unix_setsockopt_int" -external getsockopt_optint : file_descr -> socket_optint_option -> int option - = "unix_getsockopt_optint" -external setsockopt_optint : file_descr -> socket_optint_option -> int option -> unit - = "unix_setsockopt_optint" -external getsockopt_float : file_descr -> socket_float_option -> float - = "unix_getsockopt_float" -external setsockopt_float : file_descr -> socket_float_option -> float -> unit - = "unix_setsockopt_float" +type socket_bool_option = + SO_DEBUG + | SO_BROADCAST + | SO_REUSEADDR + | SO_KEEPALIVE + | SO_DONTROUTE + | SO_OOBINLINE + | SO_ACCEPTCONN + | TCP_NODELAY + | IPV6_ONLY + +type socket_int_option = + SO_SNDBUF + | SO_RCVBUF + | SO_ERROR + | SO_TYPE + | SO_RCVLOWAT + | SO_SNDLOWAT + +type socket_optint_option = SO_LINGER + +type socket_float_option = + SO_RCVTIMEO + | SO_SNDTIMEO + +type socket_error_option = SO_ERROR + +module SO: sig + type ('opt, 'v) t + val bool: (socket_bool_option, bool) t + val int: (socket_int_option, int) t + val optint: (socket_optint_option, int option) t + val float: (socket_float_option, float) t + val error: (socket_error_option, error option) t + val get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + val set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit +end = struct + type ('opt, 'v) t = int + let bool = 0 + let int = 1 + let optint = 2 + let float = 3 + let error = 4 + external get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + = "unix_getsockopt" + external set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit + = "unix_setsockopt" +end + +let getsockopt fd opt = SO.get SO.bool fd opt +let setsockopt fd opt v = SO.set SO.bool fd opt v + +let getsockopt_int fd opt = SO.get SO.int fd opt +let setsockopt_int fd opt v = SO.set SO.int fd opt v + +let getsockopt_optint fd opt = SO.get SO.optint fd opt +let setsockopt_optint fd opt v = SO.set SO.optint fd opt v + +let getsockopt_float fd opt = SO.get SO.float fd opt +let setsockopt_float fd opt v = SO.set SO.float fd opt v + +let getsockopt_error fd = SO.get SO.error fd SO_ERROR (* Host and protocol databases *) diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/unixsupport.c ocaml-unix-3.11.2/otherlibs/win32unix/unixsupport.c --- ocaml-unix-3.10.2/otherlibs/win32unix/unixsupport.c 2007-02-07 15:45:46.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/unixsupport.c 2009-12-07 11:39:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unixsupport.c,v 1.21 2007/02/07 14:45:46 doligez Exp $ */ +/* $Id: unixsupport.c 9450 2009-12-07 10:39:54Z xleroy $ */ #include <stddef.h> #include <mlvalues.h> @@ -65,6 +65,8 @@ return res; } +#if 0 +/* PR#4750: this function is no longer used */ value win_alloc_handle_or_socket(HANDLE h) { value res = win_alloc_handle(h); @@ -74,6 +76,7 @@ Descr_kind_val(res) = KIND_SOCKET; return res; } +#endif /* Mapping of Windows error codes to POSIX error codes */ @@ -108,6 +111,7 @@ { ERROR_NO_PROC_SLOTS, 0, EAGAIN}, { ERROR_DRIVE_LOCKED, 0, EACCES}, { ERROR_BROKEN_PIPE, 0, EPIPE}, + { ERROR_NO_DATA, 0, EPIPE}, { ERROR_DISK_FULL, 0, ENOSPC}, { ERROR_INVALID_TARGET_HANDLE, 0, EBADF}, { ERROR_INVALID_HANDLE, 0, EINVAL}, diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/unixsupport.h ocaml-unix-3.11.2/otherlibs/win32unix/unixsupport.h --- ocaml-unix-3.10.2/otherlibs/win32unix/unixsupport.h 2007-02-07 15:45:46.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/unixsupport.h 2009-12-07 11:39:54.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unixsupport.h,v 1.19 2007/02/07 14:45:46 doligez Exp $ */ +/* $Id: unixsupport.h 9450 2009-12-07 10:39:54Z xleroy $ */ #define WIN32_LEAN_AND_MEAN #include <wtypes.h> @@ -36,7 +36,7 @@ #define Descr_kind_val(v) (((struct filedescr *) Data_custom_val(v))->kind) #define CRT_fd_val(v) (((struct filedescr *) Data_custom_val(v))->crt_fd) -extern value win_alloc_handle_or_socket(HANDLE); +/* extern value win_alloc_handle_or_socket(HANDLE); */ extern value win_alloc_handle(HANDLE); extern value win_alloc_socket(SOCKET); extern int win_CRT_fd_of_filedescr(value handle); diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/windbug.c ocaml-unix-3.11.2/otherlibs/win32unix/windbug.c --- ocaml-unix-3.10.2/otherlibs/win32unix/windbug.c 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/windbug.c 2008-11-26 14:41:01.000000000 +0100 @@ -0,0 +1,51 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: windbug.c 9144 2008-11-26 13:41:01Z xleroy $ */ + +#include <windows.h> +#include <stdio.h> +#include <stdarg.h> +#include "windbug.h" + +#ifdef DBUG + +static int dbug = 0; + +void dbug_init (void) +{ + dbug = (getenv("OCAMLDBUG") != NULL); +} + +void dbug_cleanup (void) +{ +} + +int dbug_test (void) +{ + return dbug; +} + +void dbug_print(const char * fmt, ...) +{ + va_list ap; + if (dbug) { + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + fprintf(stderr, "\n"); + fflush(stderr); + va_end(ap); + } +} + +#endif diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/windbug.h ocaml-unix-3.11.2/otherlibs/win32unix/windbug.h --- ocaml-unix-3.10.2/otherlibs/win32unix/windbug.h 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/windbug.h 2008-11-26 14:27:21.000000000 +0100 @@ -0,0 +1,37 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: windbug.h 9143 2008-11-26 13:27:21Z xleroy $ */ + +/*#define DBUG*/ + +#ifdef DBUG + +/* Initialize and cleanup dbug variable */ +void dbug_init (void); +void dbug_cleanup (void); + +/* Test if we are in dbug mode */ +int dbug_test (void); + +/* Print if we are in dbug mode */ +void dbug_print (const char * fmt, ...); + +#define DBUG_INIT dbug_init() +#define DBUG_CLEANUP dbug_cleanup() + +#else +#define DBUG_INIT +#define DBUG_CLEANUP +#endif + diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/windir.c ocaml-unix-3.11.2/otherlibs/win32unix/windir.c --- ocaml-unix-3.10.2/otherlibs/win32unix/windir.c 2002-07-23 16:12:01.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/windir.c 2002-07-23 16:12:03.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: windir.c,v 1.13 2002/07/23 14:12:01 doligez Exp $ */ +/* $Id: windir.c 5029 2002-07-23 14:12:03Z doligez $ */ #include <mlvalues.h> #include <memory.h> diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/winlist.c ocaml-unix-3.11.2/otherlibs/win32unix/winlist.c --- ocaml-unix-3.10.2/otherlibs/win32unix/winlist.c 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/winlist.c 2008-07-31 14:09:18.000000000 +0200 @@ -0,0 +1,80 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: winlist.c 8961 2008-07-31 12:09:18Z xleroy $ */ + +/* Basic list function in C. */ + +#include "winlist.h" +#include <windows.h> + +void list_init (LPLIST lst) +{ + lst->lpNext = NULL; +} + +void list_cleanup (LPLIST lst) +{ + lst->lpNext = NULL; +} + +void list_next_set (LPLIST lst, LPLIST next) +{ + lst->lpNext = next; +} + +LPLIST list_next (LPLIST lst) +{ + return lst->lpNext; +} + +int list_length (LPLIST lst) +{ + int length = 0; + LPLIST iter = lst; + while (iter != NULL) + { + length++; + iter = list_next(iter); + }; + return length; +} + +LPLIST list_concat (LPLIST lsta, LPLIST lstb) +{ + LPLIST res = NULL; + LPLIST iter = NULL; + LPLIST iterPrev = NULL; + + if (lsta == NULL) + { + res = lstb; + } + else if (lstb == NULL) + { + res = lsta; + } + else + { + res = lsta; + iter = lsta; + while (iter != NULL) + { + iterPrev = iter; + iter = list_next(iter); + }; + iterPrev->lpNext = lstb; + }; + + return res; +} diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/winlist.h ocaml-unix-3.11.2/otherlibs/win32unix/winlist.h --- ocaml-unix-3.10.2/otherlibs/win32unix/winlist.h 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/winlist.h 2008-07-31 14:09:18.000000000 +0200 @@ -0,0 +1,54 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: winlist.h 8961 2008-07-31 12:09:18Z xleroy $ */ +#ifndef _WINLIST_H +#define _WINLIST_H + +/* Basic list function in C. */ + +/* Singly-linked list data structure. + * To transform a C struct into a list structure, you must include + * at first position of your C struct a "LIST lst" and call list_init + * on this data structure. + * + * See winworker.c for example. + */ +typedef struct _LIST LIST; +typedef LIST *LPLIST; + +struct _LIST { + LPLIST lpNext; +}; + +/* Initialize list data structure */ +void list_init (LPLIST lst); + +/* Cleanup list data structure */ +void list_cleanup (LPLIST lst); + +/* Set next element */ +void list_next_set (LPLIST lst, LPLIST next); + +/* Return next element */ +LPLIST list_next (LPLIST); + +#define LIST_NEXT(T, e) ((T)(list_next((LPLIST)(e)))) + +/* Get number of element */ +int list_length (LPLIST); + +/* Concat two list. */ +LPLIST list_concat (LPLIST, LPLIST); + +#endif /* _WINLIST_H */ diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/winwait.c ocaml-unix-3.11.2/otherlibs/win32unix/winwait.c --- ocaml-unix-3.10.2/otherlibs/win32unix/winwait.c 2007-10-25 10:31:58.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/winwait.c 2008-01-11 17:13:18.000000000 +0100 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: winwait.c,v 1.18.6.1 2007/10/25 08:31:58 xleroy Exp $ */ +/* $Id: winwait.c 8768 2008-01-11 16:13:18Z doligez $ */ #include <windows.h> #include <mlvalues.h> @@ -19,6 +19,7 @@ #include <memory.h> #include "unixsupport.h" #include <sys/types.h> +#include <signals.h> static value alloc_process_status(HANDLE pid, int status) { diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/winworker.c ocaml-unix-3.11.2/otherlibs/win32unix/winworker.c --- ocaml-unix-3.10.2/otherlibs/win32unix/winworker.c 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/winworker.c 2008-11-26 14:41:01.000000000 +0100 @@ -0,0 +1,378 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: winworker.c 9144 2008-11-26 13:41:01Z xleroy $ */ + +#include "winworker.h" +#include "winlist.h" +#include "windbug.h" +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" + +typedef enum { + WORKER_CMD_NONE = 0, + WORKER_CMD_EXEC, + WORKER_CMD_STOP +} WORKERCMD; + +struct _WORKER { + LIST lst; /* This structure is used as a list. */ + HANDLE hJobStarted; /* Event representing that the function has begun. */ + HANDLE hJobStop; /* Event that can be used to notify the function that it + should stop processing. */ + HANDLE hJobDone; /* Event representing that the function has finished. */ + void *lpJobUserData; /* User data for the job. */ + WORKERFUNC hJobFunc; /* Function to be called during APC */ + HANDLE hWorkerReady; /* Worker is ready. */ + HANDLE hCommandReady; /* Worker should execute command. */ + WORKERCMD ECommand; /* Command to execute */ + HANDLE hThread; /* Thread handle of the worker. */ +}; + +#define THREAD_WORKERS_MAX 16 +#define THREAD_WORKERS_MEM 4000 + +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) +{ + BOOL bExit; + LPWORKER lpWorker; + + lpWorker = (LPWORKER )_data; + bExit = FALSE; + +#ifdef DBUG + dbug_print("Worker %x starting", lpWorker); +#endif + while ( + !bExit + && SignalObjectAndWait( + lpWorker->hWorkerReady, + lpWorker->hCommandReady, + INFINITE, + TRUE) == WAIT_OBJECT_0) + { +#ifdef DBUG + dbug_print("Worker %x running", lpWorker); +#endif + switch (lpWorker->ECommand) + { + case WORKER_CMD_NONE: + break; + + case WORKER_CMD_EXEC: + if (lpWorker->hJobFunc != NULL) + { + SetEvent(lpWorker->hJobStarted); + lpWorker->hJobFunc(lpWorker->hJobStop, lpWorker->lpJobUserData); + SetEvent(lpWorker->hJobDone); + }; + break; + + case WORKER_CMD_STOP: + bExit = TRUE; + break; + } + }; +#ifdef DBUG + dbug_print("Worker %x exiting", lpWorker); +#endif + + return 0; +} + +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); + list_init((LPLIST)lpWorker); + lpWorker->hJobStarted = CreateEvent(NULL, TRUE, FALSE, NULL); + lpWorker->hJobStop = CreateEvent(NULL, TRUE, FALSE, NULL); + lpWorker->hJobDone = CreateEvent(NULL, TRUE, FALSE, NULL); + lpWorker->lpJobUserData = NULL; + lpWorker->hWorkerReady = CreateEvent(NULL, FALSE, FALSE, NULL); + lpWorker->hCommandReady = CreateEvent(NULL, FALSE, FALSE, NULL); + lpWorker->ECommand = WORKER_CMD_NONE; + lpWorker->hThread = CreateThread( + NULL, + THREAD_WORKERS_MEM, + worker_wait, + (LPVOID)lpWorker, + 0, + NULL); + + return lpWorker; +}; + +void worker_free (LPWORKER lpWorker) +{ + /* Wait for termination of the worker */ +#ifdef DBUG + dbug_print("Shutting down worker %x", lpWorker); +#endif + WaitForSingleObject(lpWorker->hWorkerReady, INFINITE); + lpWorker->ECommand = WORKER_CMD_STOP; + SetEvent(lpWorker->hCommandReady); + WaitForSingleObject(lpWorker->hThread, INFINITE); + + /* Free resources */ +#ifdef DBUG + dbug_print("Freeing resources of worker %x", lpWorker); +#endif + if (lpWorker->hThread != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hThread); + lpWorker->hThread = INVALID_HANDLE_VALUE; + } + + if (lpWorker->hJobStarted != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hJobStarted); + lpWorker->hJobStarted = INVALID_HANDLE_VALUE; + } + + if (lpWorker->hJobStop != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hJobStop); + lpWorker->hJobStop = INVALID_HANDLE_VALUE; + } + + if (lpWorker->hJobDone != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hJobDone); + lpWorker->hJobDone = INVALID_HANDLE_VALUE; + } + + lpWorker->lpJobUserData = NULL; + lpWorker->hJobFunc = NULL; + + if (lpWorker->hWorkerReady != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hWorkerReady); + lpWorker->hWorkerReady = INVALID_HANDLE_VALUE; + } + + if (lpWorker->hCommandReady != INVALID_HANDLE_VALUE) + { + CloseHandle(lpWorker->hCommandReady); + lpWorker->hCommandReady = INVALID_HANDLE_VALUE; + } + + if (!HeapLock(hWorkerHeap)) + { + win32_maperr(GetLastError()); + uerror("worker_new", Nothing); + }; + HeapFree(hWorkerHeap, 0, lpWorker); + HeapUnlock(hWorkerHeap); +}; + +LPWORKER worker_pop (void) +{ + LPWORKER lpWorkerFree = NULL; + + WaitForSingleObject(hWorkersMutex, INFINITE); + /* Get the first worker of the list */ + if (lpWorkers != NULL) + { + lpWorkerFree = lpWorkers; + lpWorkers = LIST_NEXT(LPWORKER, lpWorkers); + } + nWorkersCurrent++; + nWorkersMax = (nWorkersCurrent > nWorkersMax ? nWorkersCurrent : nWorkersMax); +#ifdef DBUG + dbug_print("Workers running current/runnning max/waiting: %d/%d/%d", + nWorkersCurrent, + nWorkersMax, + list_length((LPLIST)lpWorkers)); +#endif + ReleaseMutex(hWorkersMutex); + + if (lpWorkerFree == NULL) + { + /* We cannot find a free worker, create one. */ + lpWorkerFree = worker_new(); + } + + /* Ensure that we don't get dangling pointer to old data. */ + list_init((LPLIST)lpWorkerFree); + lpWorkerFree->lpJobUserData = NULL; + + /* Reset events */ + ResetEvent(lpWorkerFree->hJobStarted); + ResetEvent(lpWorkerFree->hJobStop); + ResetEvent(lpWorkerFree->hJobDone); + + return lpWorkerFree; +} + +void worker_push(LPWORKER lpWorker) +{ + BOOL bFreeWorker; + + bFreeWorker = TRUE; + + WaitForSingleObject(hWorkersMutex, INFINITE); +#ifdef DBUG + dbug_print("Testing if we are under the maximum number of running workers"); +#endif + if (list_length((LPLIST)lpWorkers) < THREAD_WORKERS_MAX) + { +#ifdef DBUG + dbug_print("Saving this worker for future use"); +#endif +#ifdef DBUG + dbug_print("Next: %x", ((LPLIST)lpWorker)->lpNext); +#endif + lpWorkers = (LPWORKER)list_concat((LPLIST)lpWorker, (LPLIST)lpWorkers); + bFreeWorker = FALSE; + }; + nWorkersCurrent--; +#ifdef DBUG + dbug_print("Workers running current/runnning max/waiting: %d/%d/%d", + nWorkersCurrent, + nWorkersMax, + list_length((LPLIST)lpWorkers)); +#endif + ReleaseMutex(hWorkersMutex); + + if (bFreeWorker) + { +#ifdef DBUG + dbug_print("Freeing worker %x", lpWorker); +#endif + worker_free(lpWorker); + } +} + +void worker_init (void) +{ + int i = 0; + + /* 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. + */ +#ifdef DBUG + dbug_print("Allocating mutex for workers"); +#endif + 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) +{ + LPWORKER lpWorker = NULL; + + /* WARNING: we can have a race condition here, if while this code + is executed another worker is waiting to access hWorkersMutex, + he will never be able to get it... + */ + if (hWorkersMutex != INVALID_HANDLE_VALUE) + { + WaitForSingleObject(hWorkersMutex, INFINITE); +#ifdef DBUG + dbug_print("Freeing global resource of workers"); +#endif + /* Empty the queue of worker worker */ + while (lpWorkers != NULL) + { + ReleaseMutex(hWorkersMutex); + lpWorker = worker_pop(); +#ifdef DBUG + dbug_print("Freeing worker %x", lpWorker); +#endif + WaitForSingleObject(hWorkersMutex, INFINITE); + worker_free(lpWorker); + }; + ReleaseMutex(hWorkersMutex); + + /* Destroy associated mutex */ + CloseHandle(hWorkersMutex); + hWorkersMutex = INVALID_HANDLE_VALUE; + }; +} + +LPWORKER worker_job_submit (WORKERFUNC f, void *user_data) +{ + LPWORKER lpWorker = worker_pop(); + +#ifdef DBUG + dbug_print("Waiting for worker to be ready"); +#endif + enter_blocking_section(); + WaitForSingleObject(lpWorker->hWorkerReady, INFINITE); + ResetEvent(lpWorker->hWorkerReady); + leave_blocking_section(); +#ifdef DBUG + dbug_print("Worker is ready"); +#endif + + lpWorker->hJobFunc = f; + lpWorker->lpJobUserData = user_data; + lpWorker->ECommand = WORKER_CMD_EXEC; + +#ifdef DBUG + dbug_print("Call worker (func: %x, worker: %x)", f, lpWorker); +#endif + SetEvent(lpWorker->hCommandReady); + + return (LPWORKER)lpWorker; +} + +HANDLE worker_job_event_done (LPWORKER lpWorker) +{ + return lpWorker->hJobDone; +} + +void worker_job_stop (LPWORKER lpWorker) +{ +#ifdef DBUG + dbug_print("Sending stop signal to worker %x", lpWorker); +#endif + SetEvent(lpWorker->hJobStop); +#ifdef DBUG + dbug_print("Signal sent to worker %x", lpWorker); +#endif +} + +void worker_job_finish (LPWORKER lpWorker) +{ +#ifdef DBUG + dbug_print("Finishing call of worker %x", lpWorker); +#endif + enter_blocking_section(); + WaitForSingleObject(lpWorker->hJobDone, INFINITE); + leave_blocking_section(); + + worker_push(lpWorker); +} diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/winworker.h ocaml-unix-3.11.2/otherlibs/win32unix/winworker.h --- ocaml-unix-3.10.2/otherlibs/win32unix/winworker.h 1970-01-01 01:00:00.000000000 +0100 +++ ocaml-unix-3.11.2/otherlibs/win32unix/winworker.h 2008-07-31 14:09:18.000000000 +0200 @@ -0,0 +1,70 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Sylvain Le Gall for Lexifi */ +/* */ +/* Copyright 2008 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: winworker.h 8961 2008-07-31 12:09:18Z xleroy $ */ +#ifndef _WINWORKER_H +#define _WINWORKER_H + +#define _WIN32_WINNT 0x0400 +#include <windows.h> + +/* Pool of worker threads. + * + * These functions help to manage a pool of worker thread and submit task to + * the pool. It helps to reduce the number of thread creation. + * + * Each worker are started in alertable wait state and jobs are submitted as + * APC (asynchronous procedure call). + */ + +/* Data associated with submitted job */ +typedef struct _WORKER WORKER; +typedef WORKER *LPWORKER; + +/* Function type of submitted job: + * void worker_call (HANDLE hStop, void *data) + * + * This function will be called using the data following: + * - hStop must be watched for change, since it represents an external command + * to stop the call. This event is shared through the WORKER structure, which + * can be access throuhg worker_job_event_done. + * - data is user provided data for the function. + */ +typedef void (*WORKERFUNC) (HANDLE, void *); + +/* Initialize global data structure for worker + */ +void worker_init (void); + +/* Free global data structure for worker + */ +void worker_cleanup (void); + +/* Submit a job to worker. Use returned data to synchronize with the procedure + * submitted. + */ +LPWORKER worker_job_submit (WORKERFUNC f, void *data); + +/* Get event to know when a job is done. + */ +HANDLE worker_job_event_done (LPWORKER); + +/* Ask a job to stop processing. + */ +void worker_job_stop (LPWORKER); + +/* End a job submitted to worker. + */ +void worker_job_finish (LPWORKER); + +#endif /* _WINWORKER_H */ diff -Naur ocaml-unix-3.10.2/otherlibs/win32unix/write.c ocaml-unix-3.11.2/otherlibs/win32unix/write.c --- ocaml-unix-3.10.2/otherlibs/win32unix/write.c 2006-10-18 10:26:54.000000000 +0200 +++ ocaml-unix-3.11.2/otherlibs/win32unix/write.c 2009-07-15 14:19:12.000000000 +0200 @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: write.c,v 1.11 2006/10/18 08:26:54 xleroy Exp $ */ +/* $Id: write.c 9315 2009-07-15 12:19:12Z xleroy $ */ #include <errno.h> #include <string.h> @@ -66,7 +66,7 @@ intnat ofs, len, written; DWORD numbytes, numwritten; char iobuf[UNIX_BUFFER_SIZE]; - DWORD err; + DWORD err = 0; Begin_root (buf); ofs = Long_val(vofs);