Ajout de setitimer, setsockopt, inet_addr_any.

Suppression de fcntl, ajout de fonctions pour manipuler le mode non
bloquant et le bit close on exec.
Nettoyage des codes d'erreur (plus proches de POSIX).
Nettoyages divers.


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

11 files changed, 541 insertions, 338 deletions

diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend
index b00464468..f6696d545 100644
--- a/otherlibs/unix/.depend
+++ b/otherlibs/unix/.depend
@@ -45,6 +45,7 @@ gettimeofday.o: gettimeofday.c unix.h
 getuid.o: getuid.c unix.h
 gmtime.o: gmtime.c unix.h
 ioctl.o: ioctl.c unix.h
+itimer.o: itimer.c unix.h
 kill.o: kill.c unix.h
 link.o: link.c unix.h
 listen.o: listen.c unix.h
@@ -72,6 +73,7 @@ sleep.o: sleep.c unix.h
 socket.o: socket.c unix.h
 socketaddr.o: socketaddr.c unix.h socketaddr.h
 socketpair.o: socketpair.c unix.h
+sockopt.o: sockopt.c unix.h
 stat.o: stat.c unix.h cst2constr.h
 strofaddr.o: strofaddr.c unix.h socketaddr.h
 symlink.o: symlink.c unix.h
@@ -84,7 +86,6 @@ unixsupport.o: unixsupport.c unix.h cst2constr.h
 unlink.o: unlink.c unix.h
 utimes.o: utimes.c unix.h
 wait.o: wait.c unix.h
-waitpid.o: waitpid.c unix.h
 write.o: write.c unix.h
 unix.cmo: unix.cmi 
 unix.cmx: unix.cmi 
diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile
index 907d80a68..3cb2b1292 100644
--- a/otherlibs/unix/Makefile
+++ b/otherlibs/unix/Makefile
@@ -15,13 +15,13 @@ OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \
   geteuid.o getgid.o getgr.o getgroups.o gethost.o gethostname.o \
   getlogin.o getpeername.o getpid.o getppid.o getproto.o getpw.o \
   gettimeofday.o getserv.o getsockname.o getuid.o \
-  gmtime.o ioctl.o kill.o link.o listen.o lockf.o lseek.o mkdir.o \
+  gmtime.o ioctl.o itimer.o kill.o link.o listen.o lockf.o lseek.o mkdir.o \
   mkfifo.o nice.o open.o opendir.o pause.o pipe.o read.o \
   readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
   setgid.o setuid.o shutdown.o sleep.o socket.o socketaddr.o \
-  socketpair.o stat.o strofaddr.o symlink.o termios.o time.o times.o \
-  truncate.o umask.o unixsupport.o unlink.o utimes.o wait.o waitpid.o \
-  write.o
+  socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \
+  time.o times.o truncate.o umask.o unixsupport.o unlink.o \
+  utimes.o wait.o write.o
 
 all: libunix.a unix.cmi unix.cma
 
diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c
index 2f2c87111..680729d1c 100644
--- a/otherlibs/unix/fcntl.c
+++ b/otherlibs/unix/fcntl.c
@@ -13,21 +13,67 @@
 
 #include <mlvalues.h>
 #include "unix.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
 
-value unix_fcntl_int(fd, request, arg)
-     value fd, request, arg;
+#ifndef O_NONBLOCK
+#define O_NONBLOCK O_NDELAY
+#endif
+
+value unix_set_nonblock(fd)
+     value fd;
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), F_GETFL, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFL, retcode | O_NONBLOCK) == -1)
+    uerror("set_nonblock", Nothing);
+  return Val_unit;
+}
+
+value unix_clear_nonblock(fd)
+     value fd;
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), F_GETFL, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFL, retcode & ~O_NONBLOCK) == -1)
+    uerror("clear_nonblock", Nothing);
+  return Val_unit;
+}
+
+#ifdef FD_CLOEXEC
+
+value unix_set_close_on_exec(fd)
+     value fd;
 {
   int retcode;
-  retcode = fcntl(Int_val(fd), Int_val(request), (char *) Long_val(arg));
-  if (retcode == -1) uerror("fcntl_int", Nothing);
-  return Val_int(retcode);
+  retcode = fcntl(Int_val(fd), F_GETFD, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFD, retcode | FD_CLOEXEC) == -1)
+    uerror("set_close_on_exec", Nothing);
+  return Val_unit;
 }
 
-value unix_fcntl_ptr(fd, request, arg)
-     value fd, request, arg;
+value unix_clear_close_on_exec(fd)
+     value fd;
 {
   int retcode;
-  retcode = fcntl(Int_val(fd), Int_val(request), String_val(arg));
-  if (retcode == -1) uerror("fcntl_ptr", Nothing);
-  return Val_int(retcode);
+  retcode = fcntl(Int_val(fd), F_GETFD, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFD, retcode & ~FD_CLOEXEC) == -1)
+    uerror("clear_close_on_exec", Nothing);
+  return Val_unit;
 }
+
+#else
+
+value unix_set_close_on_exec()
+{ invalid_argument("set_close_on_exec not implemented"); }
+
+value unix_clear_close_on_exec()
+{ invalid_argument("clear_close_on_exec not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c
new file mode 100644
index 000000000..28a188e73
--- /dev/null
+++ b/otherlibs/unix/itimer.c
@@ -0,0 +1,70 @@
+/***********************************************************************/
+/*                                                                     */
+/*                         Caml Special Light                          */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1995 Institut National de Recherche en Informatique et   */
+/*  Automatique.  Distributed only by permission.                      */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unix.h"
+
+#ifdef HAS_SETITIMER
+
+#include <sys/time.h>
+
+#define Get_timeval(tv) \
+  (double) tv.tv_sec + (double) tv.tv_usec / 1e6
+#define Set_timeval(tv, d) \
+  tv.tv_sec = (int)(d), \
+  tv.tv_usec = (int) (1e6 * ((d) - tv.tv_sec))
+
+static value unix_convert_itimer(tp)
+     struct itimerval * tp;
+{
+  value res;
+  Push_roots(r, 2);
+  r[0] = copy_double(Get_timeval(tp->it_interval));
+  r[1] = copy_double(Get_timeval(tp->it_value));
+  res = alloc_tuple(2);
+  Field(res, 0) = r[0];
+  Field(res, 1) = r[1];
+  Pop_roots();
+  return res;
+}
+
+static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF };
+
+value unix_setitimer(which, newval)
+     value which, newval;
+{
+  struct itimerval new, old;
+  Set_timeval(new.it_interval, Double_val(Field(newval, 0)));
+  Set_timeval(new.it_value, Double_val(Field(newval, 1)));
+  if (setitimer(itimers[Int_val(which)], &new, &old) == -1)
+    uerror("setitimer", Nothing);
+  return unix_convert_itimer(&old);
+}
+     
+value unix_getitimer(which)
+     value which;
+{
+  struct itimerval val;
+  if (getitimer(itimers[Int_val(which)], &val) == -1)
+    uerror("getitimer", Nothing);
+  return unix_convert_itimer(&val);
+}
+
+#else
+
+value unix_setitimer() { invalid_argument("setitimer not implemented"); }
+value unix_getitimer() { invalid_argument("getitimer not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c
index 795a787fa..9c12eedc8 100644
--- a/otherlibs/unix/open.c
+++ b/otherlibs/unix/open.c
@@ -16,8 +16,12 @@
 #include "unix.h"
 #include <fcntl.h>
 
+#ifndef O_NONBLOCK
+#define O_NONBLOCK O_NDELAY
+#endif
+
 static int open_flag_table[] = {
-  O_RDONLY, O_WRONLY, O_RDWR, O_NDELAY, O_APPEND, O_CREAT, O_TRUNC, O_EXCL
+  O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL
 };
 
 value unix_open(path, flags, perm) /* ML */
diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c
new file mode 100644
index 000000000..50dd84875
--- /dev/null
+++ b/otherlibs/unix/sockopt.c
@@ -0,0 +1,52 @@
+/***********************************************************************/
+/*                                                                     */
+/*                         Caml Special Light                          */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1995 Institut National de Recherche en Informatique et   */
+/*  Automatique.  Distributed only by permission.                      */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/types.h>
+#include <sys/socket.h>
+
+static int sockopt[] = {
+  SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE, 
+  SO_DONTROUTE, SO_OOBINLINE };
+
+value unix_getsockopt(socket, option)
+     value socket, option;
+{
+  int optval, optsize;
+  optsize = sizeof(optval);
+  if (getsockopt(Int_val(socket), SOL_SOCKET, sockopt[Int_val(option)],
+                 &optval, &optval) == -1)
+    uerror("getsockopt", Nothing);
+  return Val_int(optval);
+}
+
+value unix_setsockopt(socket, option, status)
+     value socket, option, status;
+{
+  int optval = Int_val(status);
+  if (setsockopt(Int_val(socket), SOL_SOCKET, sockopt[Int_val(option)],
+                 &optval, sizeof(optval)) == -1)
+    uerror("setsockopt", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_getsockopt() { invalid_argument("getsockopt not implemented"); }
+value unix_setsockopt() { invalid_argument("setsockopt not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 298d985ff..c0f52da8f 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -12,41 +12,43 @@
 (* $Id$ *)
 
 type error =
-    ENOERR
-  | EPERM
-  | ENOENT
-  | ESRCH
-  | EINTR
-  | EIO
-  | ENXIO
-  | E2BIG
-  | ENOEXEC
-  | EBADF
-  | ECHILD
+    E2BIG
+  | EACCESS
   | EAGAIN
-  | ENOMEM
-  | EACCES
-  | EFAULT
-  | ENOTBLK
+  | EBADF
   | EBUSY
+  | ECHILD
+  | EDEADLK
+  | EDOM
   | EEXIST
-  | EXDEV
-  | ENODEV
-  | ENOTDIR
-  | EISDIR
+  | EFAULT
+  | EFBIG
+  | EINTR
   | EINVAL
-  | ENFILE
+  | EIO
+  | EISDIR
   | EMFILE
-  | ENOTTY
-  | ETXTBSY
-  | EFBIG
-  | ENOSPC
-  | ESPIPE
-  | EROFS
   | EMLINK
+  | ENAMETOOLONG
+  | ENFILE
+  | ENODEV
+  | ENOENT
+  | ENOEXEC
+  | ENOLCK
+  | ENOMEM
+  | ENOSPC
+  | ENOSYS
+  | ENOTDIR
+  | ENOTEMPTY
+  | ENOTTY
+  | ENXIO
+  | EPERM
   | EPIPE
-  | EDOM
   | ERANGE
+  | EROFS
+  | ESPIPE
+  | ESRCH
+  | EXDEV
   | EWOULDBLOCK
   | EINPROGRESS
   | EALREADY
@@ -74,20 +76,9 @@ type error =
   | ETOOMANYREFS
   | ETIMEDOUT
   | ECONNREFUSED
-  | ELOOP
-  | ENAMETOOLONG
   | EHOSTDOWN
   | EHOSTUNREACH
-  | ENOTEMPTY
-  | EPROCLIM
-  | EUSERS
-  | EDQUOT
-  | ESTALE
-  | EREMOTE
-  | EIDRM
-  | EDEADLK
-  | ENOLCK
-  | ENOSYS
+  | ELOOP
   | EUNKNOWNERR
 
 exception Unix_error of error * string * string
@@ -119,7 +110,7 @@ external environment : unit -> string array = "unix_environment"
 
 type process_status =
     WEXITED of int
-  | WSIGNALED of int * bool
+  | WSIGNALED of int
   | WSTOPPED of int
 
 type wait_flag =
@@ -146,7 +137,7 @@ type open_flag =
     O_RDONLY
   | O_WRONLY
   | O_RDWR
-  | O_NDELAY
+  | O_NONBLOCK
   | O_APPEND
   | O_CREAT
   | O_TRUNC
@@ -226,8 +217,14 @@ external chown : string -> int -> int -> unit = "unix_chown"
 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 fcntl_int : file_descr -> int -> int -> int = "unix_fcntl_int"
-external fcntl_ptr : file_descr -> int -> string -> int = "unix_fcntl_ptr"
+
+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"
+external set_close_on_exec : file_descr -> unit = "unix_set_close_on_exec"
+external clear_close_on_exec : file_descr -> unit = "unix_clear_close_on_exec"
+
 external mkdir : string -> file_perm -> unit = "unix_mkdir"
 external rmdir : string -> unit = "unix_rmdir"
 external chdir : string -> unit = "unix_chdir"
@@ -240,8 +237,6 @@ external readdir : dir_handle -> string = "unix_readdir"
 external rewinddir : dir_handle -> unit = "unix_rewinddir"
 external closedir : dir_handle -> unit = "unix_closedir"
 external pipe : unit -> file_descr * file_descr = "unix_pipe"
-external dup : file_descr -> file_descr = "unix_dup"
-external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
 external symlink : string -> string -> unit = "unix_symlink"
 external readlink : string -> string = "unix_readlink"
 external mkfifo : string -> file_perm -> unit = "unix_mkfifo"
@@ -287,6 +282,21 @@ external sleep : int -> unit = "unix_sleep"
 external times : unit -> process_times =
               "unix_times_bytecode" "unix_times_native"
 external utimes : string -> int -> int -> unit = "unix_utimes"
+
+type interval_timer =
+    ITIMER_REAL
+  | ITIMER_VIRTUAL
+  | ITIMER_PROF
+
+type interval_timer_status =
+  { it_interval: float;                 (* Period *)
+    it_value: float }                   (* Current value of the timer *)
+
+external getitimer: interval_timer -> interval_timer_status = "unix_getitimer"
+external setitimer:
+  interval_timer -> interval_timer_status -> interval_timer_status
+  = "unix_setitimer"
+
 external getuid : unit -> int = "unix_getuid"
 external geteuid : unit -> int = "unix_geteuid"
 external setuid : int -> unit = "unix_setuid"
@@ -323,6 +333,9 @@ external inet_addr_of_string : string -> inet_addr
                                     = "unix_inet_addr_of_string"
 external string_of_inet_addr : inet_addr -> string
                                     = "unix_string_of_inet_addr"
+
+let inet_addr_any = inet_addr_of_string "0.0.0.0"
+
 type socket_domain =
     PF_UNIX
   | PF_INET
@@ -347,6 +360,14 @@ type msg_flag =
   | MSG_DONTROUTE
   | MSG_PEEK
 
+type socket_option =
+    SO_DEBUG
+  | SO_BROADCAST
+  | SO_REUSEADDR
+  | SO_KEEPALIVE
+  | SO_DONTROUTE
+  | SO_OOBINLINE
+
 external socket : socket_domain -> socket_type -> int -> file_descr
                                   = "unix_socket"
 external socketpair :
@@ -390,6 +411,9 @@ 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"
 type host_entry =
   { h_name : string;
     h_aliases : string array;
@@ -490,10 +514,11 @@ type popen_process =
 
 let popen_processes = (Hashtbl.new 7 : (popen_process, int) Hashtbl.t)
 
-let open_proc cmd proc input output =
+let open_proc cmd proc input output toclose =
   match fork() with
      0 -> if input <> stdin then begin dup2 input stdin; close input end;
           if output <> stdout then begin dup2 output stdout; close output end;
+          List.iter close toclose;
           execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |];
           exit 127
   | id -> Hashtbl.add popen_processes proc id
@@ -501,14 +526,14 @@ let open_proc cmd proc input output =
 let open_process_in cmd =
   let (in_read, in_write) = pipe() in
   let inchan = in_channel_of_descr in_read in
-  open_proc cmd (Process_in inchan) stdin in_write;
+  open_proc cmd (Process_in inchan) stdin in_write [in_read];
   close in_write;
   inchan
 
 let open_process_out cmd =
   let (out_read, out_write) = pipe() in
   let outchan = out_channel_of_descr out_write in
-  open_proc cmd (Process_out outchan) out_read stdout;
+  open_proc cmd (Process_out outchan) out_read stdout [out_write];
   close out_read;
   outchan
 
@@ -517,27 +542,32 @@ let open_process cmd =
   let (out_read, out_write) = pipe() in
   let inchan = in_channel_of_descr in_read in
   let outchan = out_channel_of_descr out_write in
-  open_proc cmd (Process(inchan, outchan)) out_read in_write; (inchan, outchan)
+  open_proc cmd (Process(inchan, outchan))
+            out_read in_write [in_read; out_write];
+  (inchan, outchan)
 
-let close_proc fun_name proc =
+let find_proc_id fun_name proc =
   try
-    let (_, status) = waitpid [] (Hashtbl.find popen_processes proc) in
+    let pid = Hashtbl.find popen_processes proc in
     Hashtbl.remove popen_processes proc;
-    status
+    pid
   with Not_found ->
     raise(Unix_error(EBADF, fun_name, ""))
 
 let close_process_in inchan =
-  close_in inchan; 
-  close_proc "close_process_in" (Process_in inchan)
+  let pid = find_proc_id "close_process_in" (Process_in inchan) in
+  close_in inchan;
+  snd(waitpid [] pid)
 
 let close_process_out outchan =
+  let pid = find_proc_id "close_process_out" (Process_out outchan) in
   close_out outchan;
-  close_proc "close_process_out" (Process_out outchan)
+  snd(waitpid [] pid)
 
 let close_process (inchan, outchan) =
-  close_in inchan; close_out outchan; 
-  close_proc "close_process" (Process(inchan, outchan))
+  let pid = find_proc_id "close_process" (Process(inchan, outchan)) in
+  close_in inchan; close_out outchan;
+  snd(waitpid [] pid)
 
 (* High-level network functions *)
 
@@ -564,7 +594,7 @@ let establish_server server_fun sockaddr =
     (* The "double fork" trick, the process which calls server_fun will not
        leave a zombie process *)
     match fork() with
-       0 -> if fork() != 0 then exit 0; (* The son exits, the grandson works *)
+       0 -> if fork() <> 0 then exit 0; (* The son exits, the grandson works *)
             let inchan = in_channel_of_descr s in
             let outchan = out_channel_of_descr s in
             server_fun inchan outchan;
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index b54a93706..ce92951d4 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -16,41 +16,45 @@
 (*** Error report *)
 
 type error =
-    ENOERR
-  | EPERM               (* Not owner *)
-  | ENOENT              (* No such file or directory *)
-  | ESRCH               (* No such process *)
-  | EINTR               (* Interrupted system call *)
-  | EIO                 (* I/O error *)
-  | ENXIO               (* No such device or address *)
-  | E2BIG               (* Arg list too long *)
-  | ENOEXEC             (* Exec format error *)
-  | EBADF               (* Bad file number *)
-  | ECHILD              (* No children *)
-  | EAGAIN              (* No more processes *)
-  | ENOMEM              (* Not enough core *)
-  | EACCES              (* Permission denied *)
-  | EFAULT              (* Bad address *)
-  | ENOTBLK             (* Block device required *)
-  | EBUSY               (* Mount device busy *)
+  (* Errors defined in the POSIX standard *)
+    E2BIG               (* Argument list too long *)
+  | EACCESS             (* Permission denied *)
+  | EAGAIN              (* Resource temporarily unavailable; try again *)
+  | EBADF               (* Bad file descriptor *)
+  | EBUSY               (* Resource unavailable *)
+  | ECHILD              (* No child process *)
+  | EDEADLK             (* Resource deadlock would occur *)
+  | EDOM                (* Domain error for math functions, etc. *)
   | EEXIST              (* File exists *)
-  | EXDEV               (* Cross-device link *)
-  | ENODEV              (* No such device *)
-  | ENOTDIR             (* Not a directory*)
-  | EISDIR              (* Is a directory *)
-  | EINVAL              (* Invalid argument *)
-  | ENFILE              (* File table overflow *)
-  | EMFILE              (* Too many open files *)
-  | ENOTTY              (* Not a typewriter *)
-  | ETXTBSY             (* Text file busy *)
+  | EFAULT              (* Bad address *)
   | EFBIG               (* File too large *)
-  | ENOSPC              (* No space left on device *)
-  | ESPIPE              (* Illegal seek *)
-  | EROFS               (* Read-only file system *)
+  | EINTR               (* Function interrupted by signal *)
+  | EINVAL              (* Invalid argument *)
+  | EIO                 (* Hardware I/O error *)
+  | EISDIR              (* Is a directory *)
+  | EMFILE              (* Too many open files by the process *)
   | EMLINK              (* Too many links *)
+  | ENAMETOOLONG        (* Filename too long *)
+  | ENFILE              (* Too many open files in the system *)
+  | ENODEV              (* No such device *)
+  | ENOENT              (* No such file or directory *)
+  | ENOEXEC             (* Not an executable file *)
+  | ENOLCK              (* No locks available *)
+  | ENOMEM              (* Not enough memory *)
+  | ENOSPC              (* No space left on device *)
+  | ENOSYS              (* Function not supported *)
+  | ENOTDIR             (* Not a directory *)
+  | ENOTEMPTY           (* Directory not empty *)
+  | ENOTTY              (* Inappropriate I/O control operation *)
+  | ENXIO               (* No such device or address *)
+  | EPERM               (* Operation not permitted *)
   | EPIPE               (* Broken pipe *)
-  | EDOM                (* Argument too large *)
   | ERANGE              (* Result too large *)
+  | EROFS               (* Read-only file system *)
+  | ESPIPE              (* Invalid seek e.g. on a pipe *)
+  | ESRCH               (* No such process *)
+  | EXDEV               (* Invalid link *)
+  (* Additional errors, mostly BSD *)
   | EWOULDBLOCK         (* Operation would block *)
   | EINPROGRESS         (* Operation now in progress *)
   | EALREADY            (* Operation already in progress *)
@@ -78,21 +82,11 @@ type error =
   | ETOOMANYREFS        (* Too many references: can't splice *)
   | ETIMEDOUT           (* Connection timed out *)
   | ECONNREFUSED        (* Connection refused *)
-  | ELOOP               (* Too many levels of symbolic links *)
-  | ENAMETOOLONG        (* File name too long *)
   | EHOSTDOWN           (* Host is down *)
   | EHOSTUNREACH        (* No route to host *)
-  | ENOTEMPTY           (* Directory not empty *)
-  | EPROCLIM            (* Too many processes *)
-  | EUSERS              (* Too many users *)
-  | EDQUOT              (* Disc quota exceeded *)
-  | ESTALE              (* Stale NFS file handle *)
-  | EREMOTE             (* Too many levels of remote in path *)
-  | EIDRM               (* Identifier removed *)
-  | EDEADLK             (* Deadlock condition. *)
-  | ENOLCK              (* No record locks available. *)
-  | ENOSYS              (* Function not implemented *)
-  | EUNKNOWNERR
+  | ELOOP               (* Too many levels of symbolic links *)
+  (* All other errors are mapped to EUNKNOWNERR *)
+  | EUNKNOWNERR         (* Unknown error *)
 
         (* The type of error codes. *)
 
@@ -121,14 +115,13 @@ external environment : unit -> string array = "unix_environment"
 
 type process_status =
     WEXITED of int
-  | WSIGNALED of int * bool
+  | WSIGNALED of int
   | WSTOPPED of int
 
         (* The termination status of a process. [WEXITED] means that the
            process terminated normally by [exit]; the argument is the return
            code. [WSIGNALED] means that the process was killed by a signal;
-           the first argument is the signal number, the second argument
-           indicates whether a ``core dump'' was performed. [WSTOPPED] means
+           the argument is the signal number. [WSTOPPED] means
            that the process was stopped by a signal; the argument is the
            signal number. *)
 
@@ -159,7 +152,9 @@ external wait : unit -> int * process_status = "unix_wait"
 external waitpid : wait_flag list -> int -> int * process_status
            = "unix_waitpid"
         (* Same as [wait], but waits for the process whose pid is given.
-	   A pid of  [0] means wait for any child.
+	   A pid of [-1] means wait for any child.
+           A pid of [0] means wait for any child in the same process group
+           as the current process.
            Negative pid arguments represent process groups.
 	   The list of options indicates whether [waitpid] should return
 	   immediately without waiting, or also report stopped children. *)
@@ -195,7 +190,7 @@ type open_flag =
     O_RDONLY                            (* Open for reading *)
   | O_WRONLY                            (* Open for writing *)
   | O_RDWR                              (* Open for reading and writing *)
-  | O_NDELAY                            (* Open in non-blocking mode *)
+  | O_NONBLOCK                          (* Open in non-blocking mode *)
   | O_APPEND                            (* Open for append *)
   | O_CREAT                             (* Create if nonexistent *)
   | O_TRUNC                             (* Truncate to 0 length if existing *)
@@ -330,16 +325,27 @@ external access : string -> access_permission list -> unit = "unix_access"
            file. Raise [Unix_error] otherwise. *)
 
 
-(*** File descriptor hacking *)
+(*** Operations on file descriptors *)
 
-external fcntl_int : file_descr -> int -> int -> int = "unix_fcntl_int"
-        (* Interface to [fcntl] in the case where the argument is an
-           integer. The first integer argument is the command code;
-           the second is the integer parameter. *)
-external fcntl_ptr : file_descr -> int -> string -> int = "unix_fcntl_ptr"
-        (* Interface to [fcntl] in the case where the argument is a pointer.
-           The integer argument is the command code. A pointer to the string
-           argument is passed as argument to the command. *)
+external dup : file_descr -> file_descr = "unix_dup"
+        (* Duplicate a descriptor. *)
+external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
+        (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
+           opened. *)
+external set_nonblock : file_descr -> unit = "unix_set_nonblock"
+external clear_nonblock : file_descr -> unit = "unix_clear_nonblock"
+        (* Set or clear the ``non-blocking'' flag on the given descriptor.
+           When the non-blocking flag is set, reading on a descriptor
+           on which there is temporarily no data available raises the
+           [EAGAIN] or [EWOULDBLOCK] error instead of blocking;
+           writing on a descriptor on which there is temporarily no room
+           for writing also raises [EAGAIN] or [EWOULDBLOCK]. *)
+external set_close_on_exec : file_descr -> unit = "unix_set_close_on_exec"
+external clear_close_on_exec : file_descr -> unit = "unix_clear_close_on_exec"
+        (* Set or clear the ``close-on-exec'' flag on the given descriptor.
+           A descriptor with the close-on-exec flag is automatically
+           closed when the current process starts another program with
+           one of the [exec] functions. *)
 
 
 (*** Directories *)
@@ -376,12 +382,6 @@ 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 entrace to the pipe. *) 
-external dup : file_descr -> file_descr = "unix_dup"
-        (* Duplicate a descriptor. *)
-external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
-        (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
-           opened. *)
-
 
 val open_process_in: string -> in_channel
 val open_process_out: string -> out_channel
@@ -518,6 +518,37 @@ external utimes : string -> int -> int -> unit = "unix_utimes"
            (third arg) for a file. Times are expressed in seconds from
            00:00:00 GMT, Jan. 1, 1970. *)
 
+type interval_timer =
+    ITIMER_REAL
+  | ITIMER_VIRTUAL
+  | ITIMER_PROF
+        (* The three kinds of interval timers.
+           [ITIMER_REAL] decrements in real time, and sends the signal
+           [SIGALRM] when expired.
+           [ITIMER_VIRTUAL] decrements in process virtual time, and sends
+           [SIGVTALRM] when expired.
+           [ITIMER_PROF] (for profiling) decrements both when the process
+           is running and when the system is running on behalf of the
+           process; it sends [SIGPROF] when expired. *)
+
+type interval_timer_status =
+  { 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"
+        (* Return the current status of the given interval timer. *)
+external setitimer:
+  interval_timer -> interval_timer_status -> interval_timer_status
+  = "unix_setitimer"
+        (* [setitimer t s] set the interval timer [t] and return its previous
+           status. The [s] argument is interpreted as follows:
+           [s.it_value], if nonzero, is the time to the next timer expiration;
+           [s.it_interval], if nonzero, specifies a value to
+           be used in reloading it_value when the timer expires.
+           Setting [s.it_value] to zero disable the timer.
+           Setting [s.it_interval] to zero causes the timer to be disabled
+           after its next expiration. *)
 
 (*** User id, group id *)
 
@@ -584,6 +615,9 @@ external string_of_inet_addr : inet_addr -> string
            and Internet addresses. [inet_addr_of_string] raises [Failure]
            when given a string that does not match this format. *)
 
+val inet_addr_any : inet_addr
+        (* A special Internet address, for use only with [bind], representing
+           all the Internet addresses that the host machine possesses. *)
 
 (*** Sockets *)
 
@@ -612,20 +646,6 @@ type sockaddr =
            domain; [addr] is the Internet address of the machine, and
            [port] is the port number. *)
 
-type shutdown_command =
-    SHUTDOWN_RECEIVE                    (* Close for receiving *)
-  | SHUTDOWN_SEND                       (* Close for sending *)
-  | SHUTDOWN_ALL                        (* Close both *)
-
-        (* The type of commands for [shutdown]. *)
-
-type msg_flag =
-    MSG_OOB
-  | MSG_DONTROUTE
-  | MSG_PEEK
-
-        (* The flags for [recv], [recvfrom], [send] and [sendto]. *)
-
 external socket : socket_domain -> socket_type -> int -> file_descr
                                   = "unix_socket"
         (* Create a new socket in the given domain, and with the
@@ -646,16 +666,31 @@ external connect : file_descr -> sockaddr -> unit = "unix_connect"
 external listen : file_descr -> int -> unit = "unix_listen"
         (* Set up a socket for receiving connection requests. The integer
            argument is the maximal number of pending requests. *)
+
+type shutdown_command =
+    SHUTDOWN_RECEIVE                    (* Close for receiving *)
+  | SHUTDOWN_SEND                       (* Close for sending *)
+  | SHUTDOWN_ALL                        (* Close both *)
+        (* The type of commands for [shutdown]. *)
+
 external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown" 
         (* Shutdown a socket connection. [SHUTDOWN_SEND] as second argument
            causes reads on the other end of the connection to return
            an end-of-file condition.
            [SHUTDOWN_RECEIVE] causes writes on the other end of the connection
            to return a closed pipe condition ([SIGPIPE] signal). *)
+
 external getsockname : file_descr -> sockaddr = "unix_getsockname"
         (* Return the address of the given socket. *)
 external getpeername : file_descr -> sockaddr = "unix_getpeername"
         (* Return the address of the host connected to the given socket. *)
+
+type msg_flag =
+    MSG_OOB
+  | MSG_DONTROUTE
+  | MSG_PEEK
+        (* The flags for [recv], [recvfrom], [send] and [sendto]. *)
+
 val recv : file_descr -> string -> int -> int -> msg_flag list -> int
 val recvfrom :
         file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr
@@ -665,6 +700,20 @@ val sendto :
         file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
         (* Send data over an unconnected socket. *)
 
+type socket_option =
+    SO_DEBUG               (* Record debugging information *)
+  | SO_BROADCAST           (* Permit sending of broadcast messages *)
+  | SO_REUSEADDR           (* Allow reuse of local addresses for bind *)
+  | SO_KEEPALIVE           (* Keep connection active *)
+  | SO_DONTROUTE           (* Bypass the standard routing algorithms *)
+  | SO_OOBINLINE           (* Leave out-of-band data in line *)
+        (* The socket options settable with [setsockopt]. *)
+
+external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt"
+        (* Return the current status of an option in the given socket. *)
+external setsockopt : file_descr -> socket_option -> bool -> unit
+                                                          = "unix_setsockopt"
+        (* Set or clear an option in the given socket. *)
 
 (*** High-level network connection functions *)
 
diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c
index 08942454b..50c0b07f4 100644
--- a/otherlibs/unix/unixsupport.c
+++ b/otherlibs/unix/unixsupport.c
@@ -19,108 +19,117 @@
 #include "cst2constr.h"
 #include <errno.h>
 
-#ifndef EPERM
-#define EPERM (-1)
-#endif
-#ifndef ENOENT
-#define ENOENT (-1)
-#endif
-#ifndef ESRCH
-#define ESRCH (-1)
-#endif
-#ifndef EINTR
-#define EINTR (-1)
-#endif
-#ifndef EIO
-#define EIO (-1)
-#endif
-#ifndef ENXIO
-#define ENXIO (-1)
-#endif
 #ifndef E2BIG
 #define E2BIG (-1)
 #endif
-#ifndef ENOEXEC
-#define ENOEXEC (-1)
+#ifndef EACCESS
+#define EACCESS (-1)
+#endif
+#ifndef EAGAIN
+#define EAGAIN (-1)
 #endif
 #ifndef EBADF
 #define EBADF (-1)
 #endif
+#ifndef EBUSY
+#define EBUSY (-1)
+#endif
 #ifndef ECHILD
 #define ECHILD (-1)
 #endif
-#ifndef EAGAIN
-#define EAGAIN (-1)
+#ifndef EDEADLK
+#define EDEADLK (-1)
 #endif
-#ifndef ENOMEM
-#define ENOMEM (-1)
+#ifndef EDOM
+#define EDOM (-1)
 #endif
-#ifndef EACCES
-#define EACCES (-1)
+#ifndef EEXIST
+#define EEXIST (-1)
 #endif
 #ifndef EFAULT
 #define EFAULT (-1)
 #endif
-#ifndef ENOTBLK
-#define ENOTBLK (-1)
-#endif
-#ifndef EBUSY
-#define EBUSY (-1)
-#endif
-#ifndef EEXIST
-#define EEXIST (-1)
+#ifndef EFBIG
+#define EFBIG (-1)
 #endif
-#ifndef EXDEV
-#define EXDEV (-1)
+#ifndef EINTR
+#define EINTR (-1)
 #endif
-#ifndef ENODEV
-#define ENODEV (-1)
+#ifndef EINVAL
+#define EINVAL (-1)
 #endif
-#ifndef ENOTDIR
-#define ENOTDIR (-1)
+#ifndef EIO
+#define EIO (-1)
 #endif
 #ifndef EISDIR
 #define EISDIR (-1)
 #endif
-#ifndef EINVAL
-#define EINVAL (-1)
+#ifndef EMFILE
+#define EMFILE (-1)
+#endif
+#ifndef EMLINK
+#define EMLINK (-1)
+#endif
+#ifndef ENAMETOOLONG
+#define ENAMETOOLONG (-1)
 #endif
 #ifndef ENFILE
 #define ENFILE (-1)
 #endif
-#ifndef EMFILE
-#define EMFILE (-1)
+#ifndef ENODEV
+#define ENODEV (-1)
 #endif
-#ifndef ENOTTY
-#define ENOTTY (-1)
+#ifndef ENOENT
+#define ENOENT (-1)
 #endif
-#ifndef ETXTBSY
-#define ETXTBSY (-1)
+#ifndef ENOEXEC
+#define ENOEXEC (-1)
 #endif
-#ifndef EFBIG
-#define EFBIG (-1)
+#ifndef ENOLCK
+#define ENOLCK (-1)
+#endif
+#ifndef ENOMEM
+#define ENOMEM (-1)
 #endif
 #ifndef ENOSPC
 #define ENOSPC (-1)
 #endif
-#ifndef ESPIPE
-#define ESPIPE (-1)
+#ifndef ENOSYS
+#define ENOSYS (-1)
 #endif
-#ifndef EROFS
-#define EROFS (-1)
+#ifndef ENOTDIR
+#define ENOTDIR (-1)
 #endif
-#ifndef EMLINK
-#define EMLINK (-1)
+#ifndef ENOTEMPTY
+#define ENOTEMPTY (-1)
+#endif
+#ifndef ENOTTY
+#define ENOTTY (-1)
+#endif
+#ifndef ENXIO
+#define ENXIO (-1)
+#endif
+#ifndef EPERM
+#define EPERM (-1)
 #endif
 #ifndef EPIPE
 #define EPIPE (-1)
 #endif
-#ifndef EDOM
-#define EDOM (-1)
-#endif
 #ifndef ERANGE
 #define ERANGE (-1)
 #endif
+#ifndef EROFS
+#define EROFS (-1)
+#endif
+#ifndef ESPIPE
+#define ESPIPE (-1)
+#endif
+#ifndef ESRCH
+#define ESRCH (-1)
+#endif
+#ifndef EXDEV
+#define EXDEV (-1)
+#endif
 #ifndef EWOULDBLOCK
 #define EWOULDBLOCK (-1)
 #endif
@@ -202,12 +211,6 @@
 #ifndef ECONNREFUSED
 #define ECONNREFUSED (-1)
 #endif
-#ifndef ELOOP
-#define ELOOP (-1)
-#endif
-#ifndef ENAMETOOLONG
-#define ENAMETOOLONG (-1)
-#endif
 #ifndef EHOSTDOWN
 #define EHOSTDOWN (-1)
 #endif
@@ -217,47 +220,22 @@
 #ifndef ENOTEMPTY
 #define ENOTEMPTY (-1)
 #endif
-#ifndef EPROCLIM
-#define EPROCLIM (-1)
-#endif
-#ifndef EUSERS
-#define EUSERS (-1)
-#endif
-#ifndef EDQUOT
-#define EDQUOT (-1)
-#endif
-#ifndef ESTALE
-#define ESTALE (-1)
-#endif
-#ifndef EREMOTE
-#define EREMOTE (-1)
-#endif
-#ifndef EIDRM
-#define EIDRM (-1)
-#endif
-#ifndef EDEADLK
-#define EDEADLK (-1)
-#endif
-#ifndef ENOLCK
-#define ENOLCK (-1)
-#endif
-#ifndef ENOSYS
-#define ENOSYS (-1)
+#ifndef ELOOP
+#define ELOOP (-1)
 #endif
 
 int error_table[] = {
-  0, EPERM, ENOENT, ESRCH, EINTR, EIO, ENXIO, E2BIG, ENOEXEC, EBADF,
-  ECHILD, EAGAIN, ENOMEM, EACCES, EFAULT, ENOTBLK, EBUSY, EEXIST, EXDEV,
-  ENODEV, ENOTDIR, EISDIR, EINVAL, ENFILE, EMFILE, ENOTTY, ETXTBSY,
-  EFBIG, ENOSPC, ESPIPE, EROFS, EMLINK, EPIPE, EDOM, ERANGE,
-  EWOULDBLOCK, EINPROGRESS, EALREADY, ENOTSOCK, EDESTADDRREQ, EMSGSIZE,
-  EPROTOTYPE, ENOPROTOOPT, EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP,
-  EPFNOSUPPORT, EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN,
-  ENETUNREACH, ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN,
-  ENOTCONN, ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, ELOOP,
-  ENAMETOOLONG, EHOSTDOWN, EHOSTUNREACH, ENOTEMPTY, EPROCLIM, EUSERS,
-  EDQUOT, ESTALE, EREMOTE, EIDRM, EDEADLK, ENOLCK, ENOSYS
-  /*, EUNKNOWNERROR */
+  E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
+  EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
+  ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
+  ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
+  EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
+  ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
+  EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
+  EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
+  ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
+  ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
+  EHOSTUNREACH, ELOOP /*, EUNKNOWNERR */
 };
 
 static value unix_error_exn;
diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c
index 12579ddac..fa7f77404 100644
--- a/otherlibs/unix/wait.c
+++ b/otherlibs/unix/wait.c
@@ -16,33 +16,71 @@
 #include <memory.h>
 #include "unix.h"
 
-value unix_wait()                /* ML */
+#include <sys/types.h>
+#include <sys/wait.h>
+
+#ifndef WIFEXITED
+#define WIFEXITED(status) ((status) & 0xFF == 0)
+#define WEXITSTATUS(status) (((status) >> 8) & 0xFF)
+#define WIFSTOPPED(status) ((status) & 0xFF == 0xFF)
+#define WSTOPSIG(status) (((status) >> 8) & 0xFF)
+#define WTERMSIG(status) ((status) & 0x3F)
+#endif
+
+static value alloc_process_status(pid, status)
+     int pid, status;
 {
-  value res;
-  int pid, status;
+  value st, res;
   Push_roots(r, 1);
-#define st r[0]
-  pid = wait(&status);
-  if (pid == -1) uerror("wait", Nothing);
-  switch (status & 0xFF) {
-  case 0:
+
+  if (WIFEXITED(status)) {
     st = alloc(1, 0);
-    Field(st, 0) = Val_int((status >> 8) & 0xFF);
-    break;
-  case 0177:
+    Field(st, 0) = Val_int(WEXITSTATUS(status));
+  }
+  else if (WIFSTOPPED(status)) {
     st = alloc(1, 2);
-    Field(st, 0) = Val_int((status >> 8) & 0xFF);
-    break;
-  default:
-    st = alloc(2, 1);
-    Field(st, 0) = Val_int(status & 0x3F);
-    Field(st, 1) = status & 0200 ? Val_true : Val_false;
-    break;
+    Field(st, 0) = Val_int(WSTOPSIG(status));
+  }
+  else {
+    st = alloc(1, 1);
+    Field(st, 0) = Val_int(WTERMSIG(status));
   }
+  r[0] = st;
   res = alloc_tuple(2);
   Field(res, 0) = Val_int(pid);
-  Field(res, 1) = st;
+  Field(res, 1) = r[0];
   Pop_roots();
   return res;
 }
 
+value unix_wait()                /* ML */
+{
+  int pid, status;
+  Push_roots(r, 1);
+  pid = wait(&status);
+  if (pid == -1) uerror("wait", Nothing);
+  return alloc_process_status(pid, status);
+}
+
+#ifdef HAS_WAITPID
+
+static int wait_flag_table[] = {
+  WNOHANG, WUNTRACED
+};
+
+value unix_waitpid(flags, pid_req)
+     value flags, pid_req;
+{
+  int pid, status;
+  
+  pid = waitpid(Int_val(pid_req), &status, 
+                convert_flag_list(flags, wait_flag_table));
+  if (pid == -1) uerror("waitpid", Nothing);
+  return alloc_process_status(pid, status);
+}
+
+#else
+
+value unix_waitpid() { invalid_argument("waitpid not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/waitpid.c b/otherlibs/unix/waitpid.c
deleted file mode 100644
index 934bfc7c2..000000000
--- a/otherlibs/unix/waitpid.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                         Caml Special Light                          */
-/*                                                                     */
-/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
-/*                                                                     */
-/*  Copyright 1995 Institut National de Recherche en Informatique et   */
-/*  Automatique.  Distributed only by permission.                      */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id$ */
-
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include "unix.h"
-
-#ifdef HAS_WAITPID
-
-#include <sys/types.h>
-#include <sys/wait.h>
-
-static int wait_flag_table[] = {
-  WNOHANG, WUNTRACED
-};
-
-value unix_waitpid(flags, pid_req)
-     value flags, pid_req;
-{
-  int pid, status;
-  value res;
-  Push_roots(r, 1);
-#define st r[0]
-  
-  pid = waitpid(Int_val(pid_req), &status, 
-                convert_flag_list(flags, wait_flag_table));
-  if (pid == -1) uerror("waitpid", Nothing);
-  switch (status & 0xFF) {
-  case 0:
-    st = alloc(1, 0);
-    Field(st, 0) = Val_int((status >> 8) & 0xFF);
-    break;
-  case 0177:
-    st = alloc(1, 2);
-    Field(st, 0) = Val_int((status >> 8) & 0xFF);
-    break;
-  default:
-    st = alloc(2, 1);
-    Field(st, 0) = Val_int(status & 0x3F);
-    Field(st, 1) = status & 0200 ? Val_true : Val_false;
-    break;
-  }
-  res = alloc_tuple(2);
-  Field(res, 0) = Val_int(pid);
-  Field(res, 1) = st;
-  Pop_roots();
-  return res;
-}
-
-#else
-
-value unix_waitpid() { invalid_argument("waitpid not implemented"); }
-
-#endif