MAJ pour version 3.02

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

4 files changed, 163 insertions, 24 deletions

diff --git a/README.win32 b/README.win32
index a414b5709..1b2b34992 100644
--- a/README.win32
+++ b/README.win32
@@ -82,8 +82,8 @@ MASM can be downloaded for free from Microsoft's Web site;
 see the comp.lang.asm.x86 FAQ for directions, or
 http://www.cs.uu.nl/wais/html/na-dir/assembly-language/x86/microsoft.html
 
-The LablTk GUI requires Tcl/Tk 8.0.  Windows binaries are
-available from ftp://ftp.scriptics.com/pub/tcl/tcl8_0/tcl805.exe
+The LablTk GUI requires Tcl/Tk 8.3.  Windows binaries are
+available from ftp://ftp.scriptics.com/pub/tcl/tcl8_3/.
 
 
 INSTALLATION:
@@ -114,6 +114,12 @@ Installing the command-line tools:
   append to the PATH variable).  For Windows NT and 2000, you'll have to
   edit the environment variables yourself.
 
+  To use the LablTK GUI, the directory where the libraries tk83.lib
+  and tcl83.lib were installed (by the Tcl/Tk installer)
+  must be added to the library search path in the LIB environment variable.
+  E.g. if Tcl/Tk was installed in C:\tcl, add "C:\tcl\lib" to the LIB
+  environment variable.
+
 
 RECOMPILATION FROM THE SOURCES:
 
@@ -140,7 +146,7 @@ available to the general public.  Contact us if you think you need them.
 RANDOM NOTES:
 
 * The VC++ compiler does a poor job on byterun/interp.c. Consequently,
-the performance of bytecode programs is 50-70% of that obtained under
+the performance of bytecode programs is about 2/3 of that obtained under
 Unix/GCC or Cygwin on similar hardware.
 
 * Libraries available in this port: "num", "str", "threads", "graph",
diff --git a/config/Makefile.nt b/config/Makefile.nt
index e6f669db7..183d7285c 100644
--- a/config/Makefile.nt
+++ b/config/Makefile.nt
@@ -42,7 +42,8 @@ BYTECCCOMPOPTS=/Ox /MT
 BYTECCLINKOPTS=/MT
 
 ### Libraries needed
-CCLIBS=wsock32.lib
+BYTECCLIBS=wsock32.lib
+NATIVECCLIBS=wsock32.lib
 
 ### How to invoke the C preprocessor
 CPP=cl /nologo /EP
@@ -83,7 +84,7 @@ BIGNUM_ARCH=C
 
 ### Configuration for LablTk
 TK_DEFS=-Ic:\Tcl\include
-TK_LINK=c:\Tcl\lib\tk83.lib c:\Tcl\lib\tcl83.lib
+TK_LINK=tk83.lib tcl83.lib
 
 ############# Aliases for common commands
 
diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c
index 79ec7122f..4e77c09d5 100644
--- a/otherlibs/win32unix/sockopt.c
+++ b/otherlibs/win32unix/sockopt.c
@@ -17,28 +17,132 @@
 #include <winsock.h>
 #include <sys/types.h>
 
-static int sockopt[] = {
-  SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE, 
-  SO_DONTROUTE, SO_OOBINLINE };
+static int sockopt_bool[] = {
+  SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE,
+  SO_DONTROUTE, SO_OOBINLINE, SO_ACCEPTCONN };
 
-value unix_getsockopt(socket, option) /* ML */
-     value socket, option;
+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 };
+
+value getsockopt_int(int *sockopt, value socket, value level, value option)
 {
-  int optval, optsize;
+  int optval;
+  int optsize;
+
   optsize = sizeof(optval);
-  if (getsockopt((SOCKET) Handle_val(socket), SOL_SOCKET, 
-                 sockopt[Int_val(option)], (char *) &optval, &optsize) == -1)
-    unix_error(WSAGetLastError(), "getsockopt", Nothing);
+  if (getsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
+		 (void *) &optval, &optsize) == -1)
+    uerror("getsockopt", Nothing);
   return Val_int(optval);
 }
 
-value unix_setsockopt(socket, option, status) /* ML */
-     value socket, option, status;
+value setsockopt_int(int *sockopt, value socket, value level,
+                     value option, value status)
 {
   int optval = Int_val(status);
-  if (setsockopt((SOCKET) Handle_val(socket), SOL_SOCKET,
-                 sockopt[Int_val(option)],
-                 (char *) &optval, sizeof(optval)) == -1)
-    unix_error(WSAGetLastError(), "setsockopt", Nothing);
+  if (setsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
+		 (void *) &optval, sizeof(optval)) == -1)
+    uerror("setsockopt", Nothing);
+  return Val_unit;
+}
+
+value unix_getsockopt_bool(value socket, value option) { /* ML */
+  return getsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option);
+}
+
+value unix_setsockopt_bool(value socket, value option, value status) /* ML */
+{
+ return setsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option, status);
+}
+
+value unix_getsockopt_int(value socket, value option) { /* ML */
+  return getsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option);
+}
+
+value unix_setsockopt_int(value socket, value option, value status) /* ML */
+{
+ return setsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option, status);
+}
+
+value getsockopt_optint(int *sockopt, value socket, value level, value option)
+{
+  struct linger optval;
+  int optsize;
+  value res = Val_int(0);			/* None */
+
+  optsize = sizeof(optval);
+  if (getsockopt(Int_val(socket), Int_val(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);
+  }
+  return res;
+}
+
+value setsockopt_optint(int *sockopt, value socket, value 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), Int_val(level), sockopt[Int_val(option)],
+		 (void *) &optval, sizeof(optval)) == -1)
+    uerror("setsockopt_optint", Nothing);
   return Val_unit;
 }
+
+value unix_getsockopt_optint(value socket, value option) /* ML */
+{
+  return getsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option);
+}
+
+value unix_setsockopt_optint(value socket, value option, value status) /* ML */
+{
+  return setsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option, status);
+}
+
+value getsockopt_float(int *sockopt, value socket, value level, value option)
+{
+  struct timeval tv;
+  int optsize;
+
+  optsize = sizeof(tv);
+  if (getsockopt(Int_val(socket), Int_val(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);
+}
+
+value setsockopt_float(int *sockopt, value socket, value 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(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
+		 (void *) &tv, sizeof(tv)) == -1)
+    uerror("setsockopt_float", Nothing);
+  return Val_unit;
+}
+
+value unix_getsockopt_float(value socket, value option) /* ML */
+{
+  return getsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option);
+}
+
+value unix_setsockopt_float(value socket, value option, value status) /* ML */
+{
+  return setsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option, status);
+}
+
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index a92848ee7..6cbcdc160 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -469,14 +469,28 @@ type msg_flag =
   | MSG_DONTROUTE
   | MSG_PEEK
 
-type socket_option =
+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"
@@ -519,9 +533,23 @@ let sendto fd buf ofs len flags addr =
   then invalid_arg "Unix.sendto"
   else unsafe_sendto fd buf ofs len flags addr
 
-external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt"
-external setsockopt : file_descr -> socket_option -> bool -> unit
-                                                          = "unix_setsockopt"
+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"
+
 (* Host and protocol databases *)
 
 type host_entry =