itimer, unix: on reprend les temps de type float et on implemente specialement

        pour le code natif.
close, unix: suppression de closeall.


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

4 files changed, 63 insertions, 72 deletions

diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c
index 355b27d23..41dfca5e9 100644
--- a/otherlibs/unix/close.c
+++ b/otherlibs/unix/close.c
@@ -20,12 +20,3 @@ value unix_close(fd)             /* ML */
   if (close(Int_val(fd)) == -1) uerror("close", Nothing);
   return Val_unit;
 }
-
-value unix_closeall(last_fd)     /* ML */
-     value last_fd;
-{
-  int fd;
-  for (fd = 3; fd <= Int_val(last_fd); fd++) close(fd);
-  return Val_unit;
-}
-
diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c
index 000238292..b2242ff89 100644
--- a/otherlibs/unix/itimer.c
+++ b/otherlibs/unix/itimer.c
@@ -40,6 +40,15 @@ static value unix_convert_itimer(tp)
   return res;
 }
 
+static value unix_convert_itimer_native(tp)
+     struct itimerval * tp;
+{
+  value res = alloc(Double_wosize * 2, Double_array_tag);
+  Store_double_field(res, 0, Get_timeval(tp->it_interval));
+  Store_double_field(res, 1, Get_timeval(tp->it_value));
+  return res;
+}
+
 static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF };
 
 value unix_setitimer(which, newval)
@@ -53,6 +62,17 @@ value unix_setitimer(which, newval)
   return unix_convert_itimer(&old);
 }
      
+value unix_setitimer_native(which, newval)
+     value which, newval;
+{
+  struct itimerval new, old;
+  Set_timeval(new.it_interval, Double_field(newval, 0));
+  Set_timeval(new.it_value, Double_field(newval, 1));
+  if (setitimer(itimers[Int_val(which)], &new, &old) == -1)
+    uerror("setitimer", Nothing);
+  return unix_convert_itimer_native(&old);
+}
+     
 value unix_getitimer(which)
      value which;
 {
@@ -62,9 +82,24 @@ value unix_getitimer(which)
   return unix_convert_itimer(&val);
 }
 
+value unix_getitimer_native(which)
+     value which;
+{
+  struct itimerval val;
+  if (getitimer(itimers[Int_val(which)], &val) == -1)
+    uerror("getitimer", Nothing);
+  return unix_convert_itimer_native(&val);
+}
+
 #else
 
-value unix_setitimer() { invalid_argument("setitimer not implemented"); }
-value unix_getitimer() { invalid_argument("getitimer not implemented"); }
+value unix_setitimer()
+{ invalid_argument("setitimer not implemented"); }
+value unix_getitimer()
+{ invalid_argument("getitimer not implemented"); }
+value unix_setitimer_native()
+{ invalid_argument("setitimer not implemented"); }
+value unix_getitimer_native()
+{ invalid_argument("getitimer not implemented"); }
 
 #endif
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index ed272af00..7daa12d29 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -133,11 +133,6 @@ let stdin = 0
 let stdout = 1
 let stderr = 2
 
-let max_opened_descr = ref 2
-
-let record_descr fd =
-  if fd > !max_opened_descr then max_opened_descr := fd
-
 type open_flag =
     O_RDONLY
   | O_WRONLY
@@ -151,14 +146,9 @@ type open_flag =
 type file_perm = int
 
 
-external sys_openfile : string -> open_flag list -> file_perm -> file_descr
+external openfile : string -> open_flag list -> file_perm -> file_descr
            = "unix_open"
 
-let openfile name flags perm =
-  let fd = sys_openfile name flags perm in
-  record_descr fd;
-  fd
-
 external close : file_descr -> unit = "unix_close"
 external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read"
 external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write"
@@ -229,11 +219,7 @@ external fchown : file_descr -> int -> int -> unit = "unix_fchown"
 external umask : int -> int = "unix_umask"
 external access : string -> access_permission list -> unit = "unix_access"
 
-external sys_dup : file_descr -> file_descr = "unix_dup"
-
-let dup fd =
-  let newfd = sys_dup fd in record_descr newfd; newfd
-
+external dup : file_descr -> file_descr = "unix_dup"
 external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
 external set_nonblock : file_descr -> unit = "unix_set_nonblock"
 external clear_nonblock : file_descr -> unit = "unix_clear_nonblock"
@@ -252,12 +238,7 @@ external readdir : dir_handle -> string = "unix_readdir"
 external rewinddir : dir_handle -> unit = "unix_rewinddir"
 external closedir : dir_handle -> unit = "unix_closedir"
 
-external sys_pipe : unit -> file_descr * file_descr = "unix_pipe"
-
-let pipe () =
-  let (fd1, fd2 as fdpair) = sys_pipe() in
-  record_descr fd1; record_descr fd2; fdpair
-
+external pipe : unit -> file_descr * file_descr = "unix_pipe"
 external symlink : string -> string -> unit = "unix_symlink"
 external readlink : string -> string = "unix_readlink"
 external mkfifo : string -> file_perm -> unit = "unix_mkfifo"
@@ -310,17 +291,15 @@ type interval_timer =
   | ITIMER_VIRTUAL
   | ITIMER_PROF
 
-type time_value = float
-
 type interval_timer_status =
-  { it_interval: time_value;                 (* Period *)
-    it_value: time_value }                   (* Current value of the timer *)
-        (* The type describing the status of an interval timer *)
+  { it_interval: float;                 (* Period *)
+    it_value: float }                   (* Current value of the timer *)
 
-external getitimer: interval_timer -> interval_timer_status = "unix_getitimer"
+external getitimer: interval_timer -> interval_timer_status
+   = "unix_getitimer" "unix_getitimer_native"
 external setitimer:
   interval_timer -> interval_timer_status -> interval_timer_status
-  = "unix_setitimer"
+  = "unix_setitimer" "unix_setitimer_native"
 
 external getuid : unit -> int = "unix_getuid"
 external geteuid : unit -> int = "unix_geteuid"
@@ -393,24 +372,12 @@ type socket_option =
   | SO_DONTROUTE
   | SO_OOBINLINE
 
-external sys_socket : socket_domain -> socket_type -> int -> file_descr
+external socket : socket_domain -> socket_type -> int -> file_descr
                                   = "unix_socket"
-let socket domain typ proto =
-  let fd = sys_socket domain typ proto in
-  record_descr fd; fd
-
-external sys_socketpair :
+external socketpair :
         socket_domain -> socket_type -> int -> file_descr * file_descr
                                   = "unix_socketpair"
-let socketpair domain typ proto =
-  let (fd1, fd2 as fdpair) = sys_socketpair domain typ proto in
-  record_descr fd1; record_descr fd2; fdpair
-
-external sys_accept : file_descr -> file_descr * sockaddr = "unix_accept"
-
-let accept fd =
-  let (newfd, addr as result) = sys_accept fd in
-  record_descr newfd; result
+external accept : file_descr -> file_descr * sockaddr = "unix_accept"
 
 external bind : file_descr -> sockaddr -> unit = "unix_bind"
 external connect : file_descr -> sockaddr -> unit = "unix_connect"
@@ -540,12 +507,9 @@ external tcflow: file_descr -> flow_action -> unit = "unix_tcflow"
 
 (* High-level process management (system, popen) *)
 
-external closeall : int -> unit = "unix_closeall"
-
 let system cmd =
   match fork() with
-     0 -> closeall !max_opened_descr;
-          execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |];
+     0 -> execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |];
           exit 127
   | id -> snd(waitpid [] id)
 
@@ -555,7 +519,6 @@ let create_process cmd args new_stdin new_stdout new_stderr =
       if new_stdin  <> stdin  then dup2 new_stdin stdin;
       if new_stdout <> stdout then dup2 new_stdout stdout;
       if new_stderr <> stderr then dup2 new_stderr stderr;
-      closeall !max_opened_descr;
       execvp cmd args;
       exit 127
   | id -> id
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index de4920be2..722e7a6cc 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -201,7 +201,8 @@ type open_flag =
 type file_perm = int
         (* The type of file access rights. *)
 
-val openfile : string -> open_flag list -> file_perm -> file_descr
+external openfile : string -> open_flag list -> file_perm -> file_descr
+   = "unix_open"
         (* Open the named file with the given flags. Third argument is
            the permissions to give to the file if it is created. Return
            a file descriptor on the named file. *)
@@ -326,7 +327,7 @@ external access : string -> access_permission list -> unit = "unix_access"
 
 (*** Operations on file descriptors *)
 
-val dup : file_descr -> file_descr
+external dup : file_descr -> file_descr = "unix_dup"
         (* Return a new file descriptor referencing the same file as
            the given descriptor. *)
 external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
@@ -378,7 +379,7 @@ external closedir : dir_handle -> unit = "unix_closedir"
 
 (*** Pipes and redirections *)
 
-val pipe : unit -> file_descr * file_descr
+external pipe : unit -> file_descr * file_descr = "unix_pipe"
         (* Create a pipe. The first component of the result is opened
            for reading, that's the exit to the pipe. The second component is
            opened for writing, that's the entrance to the pipe. *) 
@@ -553,18 +554,17 @@ type interval_timer =
            is running and when the system is running on behalf of the
            process; it sends [SIGPROF] when expired. *)
 
-type time_value = float
-
 type interval_timer_status =
-  { it_interval: time_value;                 (* Period *)
-    it_value: time_value }                   (* Current value of the timer *)
+  { it_interval: float;                 (* Period *)
+    it_value: float }                   (* Current value of the timer *)
         (* The type describing the status of an interval timer *)
 
-external getitimer: interval_timer -> interval_timer_status = "unix_getitimer"
+external getitimer: interval_timer -> interval_timer_status
+   = "unix_getitimer" "unix_getitimer_native"
         (* Return the current status of the given interval timer. *)
 external setitimer:
   interval_timer -> interval_timer_status -> interval_timer_status
-  = "unix_setitimer"
+  = "unix_setitimer" "unix_setitimer_native"
         (* [setitimer t s] sets the interval timer [t] and returns
            its previous status. The [s] argument is interpreted as follows:
            [s.it_value], if nonzero, is the time to the next timer expiration;
@@ -670,14 +670,16 @@ type sockaddr =
            domain; [addr] is the Internet address of the machine, and
            [port] is the port number. *)
 
-val socket : socket_domain -> socket_type -> int -> file_descr
+external socket : socket_domain -> socket_type -> int -> file_descr
+        = "unix_socket"
         (* Create a new socket in the given domain, and with the
            given kind. The third argument is the protocol type; 0 selects
            the default protocol for that kind of sockets. *)
-val socketpair :
+external socketpair :
         socket_domain -> socket_type -> int -> file_descr * file_descr
+        = "unix_socketpair"
         (* Create a pair of unnamed sockets, connected together. *)
-val accept : file_descr -> file_descr * sockaddr
+external accept : file_descr -> file_descr * sockaddr = "unix_accept"
         (* Accept connections on the given socket. The returned descriptor
            is a socket connected to the client; the returned address is
            the address of the connecting client. *)