Suite du portage

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

otherlibs/systhreads/Makefile.nt

@@ -27,7 +27,6 @@ realclean:
 
 install:
 	cp libthreads.lib $(LIBDIR)/libthreads.lib
-	cd $(LIBDIR); $(RANLIB) libthreads.lib
 	cp *.cmi threads.cma $(LIBDIR)
 
 installopt:

otherlibs/systhreads/thread.ml

@@ -54,8 +54,7 @@ let _ =
 
 let wait_read fd = ()
 let wait_write fd = ()
-
+let wait_timed_read fd delay = true
-external wait_timed_read : Unix.file_descr -> float -> bool = "csl_wait_file"
+let wait_timed_write fd delay = true
-external wait_timed_write : Unix.file_descr -> float -> bool = "csl_wait_file"
 
 let wait_pid p = Unix.waitpid [] p

otherlibs/systhreads/thread.mli

@@ -57,16 +57,9 @@ val join : t -> unit
            until the thread [th] has terminated. *)
 val wait_read : Unix.file_descr -> unit
 val wait_write : Unix.file_descr -> unit
-        (* Does nothing in this Win32 implementation. *)
+val wait_timed_read : Unix.file_descr -> float -> bool
-external wait_timed_read : Unix.file_descr -> float -> bool = "csl_wait_file"
+val wait_timed_write : Unix.file_descr -> float -> bool
-external wait_timed_write : Unix.file_descr -> float -> bool = "csl_wait_file"
+        (* These functions do nothing in this Win32 implementation. *)
-        (* Suspend the calling thread until
-           one character is available for reading ([wait_read]) or
-           one character can be written without blocking ([wait_write])
-           on the given Unix file descriptor. Wait for at most the amount
-           of time given as second argument (in seconds).
-           Return [true] if the file descriptor is ready for input/output
-           and [false] if the timeout expired. *)
 val wait_pid : int -> int * Unix.process_status
         (* [wait_pid p] suspends the execution of the calling thread
            until the process specified by the process identifier [p]

otherlibs/systhreads/threadUnix.ml

@@ -45,7 +45,6 @@ let timed_write fd buff ofs len timeout =
 
 let pipe = Unix.pipe
 
-(*
 let open_process_in cmd =
   ThreadIO.add_input_lock(Unix.open_process_in cmd)
 let open_process_out cmd =
@@ -53,12 +52,10 @@ let open_process_out cmd =
 let open_process cmd =
   let (ic, oc) = Unix.open_process cmd in
   (ThreadIO.add_input_lock ic, ThreadIO.add_output_lock oc)
-*)
 
 external sleep : int -> unit = "unix_sleep"
 
 let socket = Unix.socket
-(*let socketpair = Unix.socketpair*)
 let accept = Unix.accept
 external connect : file_descr -> sockaddr -> unit = "unix_connect"
 let recv = Unix.recv
@@ -66,13 +63,6 @@ let recvfrom = Unix.recvfrom
 let send = Unix.send
 let sendto = Unix.sendto
 
-(*
 let open_connection addr =
   let (ic, oc) = Unix.open_connection addr in
   (ThreadIO.add_input_lock ic, ThreadIO.add_output_lock oc)
-let establish_server fn addr =
-  Unix.establish_server
-    (fun ic oc ->
-      fn (ThreadIO.add_input_lock ic) (ThreadIO.add_output_lock oc))
-    addr
-*)

otherlibs/systhreads/threadUnix.mli

@@ -52,11 +52,9 @@ val out_channel_of_descr : Unix.file_descr -> out_channel
 (*** Pipes and redirections *)
 
 val pipe : unit -> Unix.file_descr * Unix.file_descr
-(*
 val open_process_in: string -> in_channel
 val open_process_out: string -> out_channel
 val open_process: string -> in_channel * out_channel
-*)
 
 (*** Time *)
 
@@ -65,10 +63,6 @@ external sleep : int -> unit = "unix_sleep"
 (*** Sockets *)
 
 val socket : Unix.socket_domain -> Unix.socket_type -> int -> Unix.file_descr
-(*
-val socketpair : Unix.socket_domain -> Unix.socket_type -> int ->
-                 Unix.file_descr * Unix.file_descr
-*)
 val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr
 external connect : Unix.file_descr -> Unix.sockaddr -> unit = "unix_connect"
 val recv : Unix.file_descr -> string -> int -> int -> Unix.msg_flag list -> int
@@ -78,8 +72,5 @@ val send : Unix.file_descr -> string -> int -> int ->
            Unix.msg_flag list -> int
 val sendto : Unix.file_descr -> string -> int -> int ->
              Unix.msg_flag list -> Unix.sockaddr -> int
-(*
+
 val open_connection : Unix.sockaddr -> in_channel * out_channel
-val establish_server :
-      (in_channel -> out_channel -> 'a) -> Unix.sockaddr -> unit
-*)

otherlibs/systhreads/win32.c

@@ -241,8 +241,14 @@ value csl_thread_initialize(unit)   /* ML */
                   0, FALSE, DUPLICATE_SAME_ACCESS);
   if (thread_list->win32->thread == NULL ||
       thread_list->win32->wakeup_event == NULL) sys_error("Thread.init");
-  /* The stack-related fields will be filled in at the next
+  /* Fill the stack-related fields */
-     enter_blocking_section */
+  thread_list->stack_low = stack_low;
+  thread_list->stack_high = stack_high;
+  thread_list->stack_threshold = stack_threshold;
+  thread_list->sp = extern_sp;
+  thread_list->trapsp = trapsp;
+  thread_list->external_raise = external_raise;
+  thread_list->local_roots = local_roots;
   /* Associate the thread descriptor with the current thread */
   curr_thread = thread_list;
   /* Set up the hooks */

otherlibs/win32unix/Makefile.nt

@@ -53,9 +53,8 @@ realclean:
 	rm -f io.h
 
 install:
-	cp libthreads.lib $(LIBDIR)/libthreads.lib
+	cp libunix.lib $(LIBDIR)/libunix.lib
-	cd $(LIBDIR); $(RANLIB) libthreads.lib
+	cp unix.cmi unix.cma $(LIBDIR)
-	cp *.cmi threads.cma $(LIBDIR)
 
 installopt:
 

otherlibs/win32unix/unix.mli

@@ -566,6 +566,18 @@ external setsockopt : file_descr -> socket_option -> bool -> unit
                                                           = "unix_setsockopt"
         (* Set or clear an option in the given socket. *)
 
+(*** High-level network connection functions *)
+
+val open_connection : sockaddr -> in_channel * out_channel
+        (* Connect to a server at the given address.
+           Return a pair of buffered channels connected to the server.
+           Remember to call [flush] on the output channel at the right times
+           to ensure correct synchronization. *)
+val shutdown_connection : in_channel -> unit
+        (* ``Shut down'' a connection established with [open_connection];
+           that is, transmit an end-of-file condition to the server reading
+           on the other side of the connection. *)
+
 (*** Host and protocol databases *)
 
 type host_entry =