Commits

Anonymous committed ae57399

Recuperation de libunix de CL0.7

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

  • Participants
  • Parent commits d696190

Comments (0)

Files changed (91)

File otherlibs/unix/Makefile

+# Makefile for the Unix interface library
+
+include ../../Makefile.config
+
+# Compilation options
+CFLAGS=-I../../byterun -O $(CCCOMPOPTS)
+CAMLC=../../boot/camlrun ../../boot/camlc -I ../../boot
+
+OBJS=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 getcwd.o getegid.o \
+  geteuid.o getgid.o getgr.o getgroups.o gethost.o gethostname.o \
+  getlogin.o getpid.o getppid.o getproto.o getpw.o getserv.o getuid.o \
+  gmtime.o ioctl.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 unix.o unlink.o utimes.o wait.o waitpid.o \
+  write.o
+
+INTF= unix.cmi
+IMPL= unix.cmo
+LIB= unix.cma
+
+all: libunix.a $(INTF) $(LIB)
+
+libunix.a: $(OBJS)
+	rm -f libunix.a
+	ar rc libunix.a $(OBJS)
+	$(RANLIB) libunix.a
+
+unix.cma: $(IMPL)
+	$(CAMLC) -a -o unix.cma $(IMPL)
+
+clean:
+	rm -f libunix.a *.o *.cm[ioa]
+
+install:
+	cp libunix.a $(LIBDIR)/libunix.a
+	cd $(LIBDIR); $(RANLIB) libunix.a
+	cp $(INTF) $(LIB) $(LIBDIR)
+
+.SUFFIXES: .ml .mli .cmo .cmi
+
+.mli.cmi:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmo:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+depend:
+	gcc -MM $(CFLAGS) *.c > .depend
+	../../tools/camldep *.mli *.ml >> .depend
+
+include .depend

File otherlibs/unix/accept.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+value unix_accept(sock)          /* ML */
+     value sock;
+{
+  int retcode;
+  value res;
+  Push_roots(a,1);
+
+  sock_addr_len = sizeof(sock_addr);
+  enter_blocking_section();
+  retcode = accept(Int_val(sock), &sock_addr.s_gen, &sock_addr_len);
+  leave_blocking_section();
+  if (retcode == -1) uerror("accept", Nothing);
+  a[0] = alloc_sockaddr();
+  res = alloc_tuple(2);
+  Field(res, 0) = Val_int(retcode);
+  Field(res, 1) = a[0];
+  Pop_roots();
+  return res;
+}
+
+#else
+
+value unix_accept() { invalid_argument("accept not implemented"); }
+  
+#endif

File otherlibs/unix/access.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#include <sys/file.h>
+#ifndef R_OK
+#define R_OK    4/* test for read permission */
+#define W_OK    2/* test for write permission */
+#define X_OK    1/* test for execute (search) permission */
+#define F_OK    0/* test for presence of file */
+#endif
+#endif
+
+static int access_permission_table[] = {
+  R_OK, W_OK, X_OK, F_OK
+};
+
+value unix_access(path, perms)   /* ML */
+     value path, perms;
+{
+  int ret;
+  ret = access(String_val(path),
+               convert_flag_list(perms, access_permission_table));
+  if (ret == -1)
+    uerror("access", path);
+  return Val_unit;
+}

File otherlibs/unix/addrofstr.c

+#include <mlvalues.h>
+#include <fail.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+extern unsigned long inet_addr();
+
+value unix_inet_addr_of_string(s) /* ML */
+     value s;
+{
+  unsigned long address;
+  address = inet_addr(String_val(s));
+  if (address == (unsigned long) -1) failwith("inet_addr_of_string");
+  return alloc_inet_addr(address);
+}
+
+#else
+
+value unix_inet_addr_of_string()
+{ invalid_argument("inet_addr_of_string not implemented"); }
+  
+#endif

File otherlibs/unix/alarm.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_alarm(t)              /* ML */
+     value t;
+{
+  return Val_int(alarm((unsigned int) Long_val(t)));
+}

File otherlibs/unix/bind.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+  
+value unix_bind(socket, address)      /* ML */
+     value socket, address;
+{
+  int ret;
+  get_sockaddr(address);
+  ret = bind(Int_val(socket), &sock_addr.s_gen, sock_addr_len);
+  if (ret == -1) uerror("bind", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_bind() { invalid_argument("bind not implemented"); }
+  
+#endif

File otherlibs/unix/chdir.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_chdir(path)           /* ML */
+     value path;
+{
+  int ret;
+  ret = chdir(String_val(path));
+  if (ret == -1) uerror("chdir", path);
+  return Val_unit;
+}

File otherlibs/unix/chmod.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_chmod(path, perm)     /* ML */
+     value path, perm;
+{
+  int ret;
+  ret = chmod(String_val(path), Int_val(perm));
+  if (ret == -1) uerror("chmod", path);
+  return Val_unit;
+}

File otherlibs/unix/chown.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_chown(path, uid, gid) /* ML */
+     value path, uid, gid;
+{
+  int ret;
+  ret = chown(String_val(path), Int_val(uid), Int_val(gid));
+  if (ret == -1) uerror("chown", path);
+  return Val_unit;
+}

File otherlibs/unix/chroot.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_chroot(path)           /* ML */
+     value path;
+{
+  int ret;
+  ret = chroot(String_val(path));
+  if (ret == -1) uerror("chroot", path);
+  return Val_unit;
+}

File otherlibs/unix/close.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_close(fd)             /* ML */
+     value fd;
+{
+  if (close(Int_val(fd)) == -1) uerror("close", Nothing);
+  return Val_unit;
+}

File otherlibs/unix/closedir.c

+#include <mlvalues.h>
+#include "unix.h"
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+value unix_closedir(d)           /* ML */
+     value d;
+{
+  closedir((DIR *) d);
+  return Val_unit;
+}

File otherlibs/unix/connect.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+value unix_connect(socket, address)   /* ML */
+     value socket, address;
+{
+  get_sockaddr(address);
+  if (connect(Int_val(socket), &sock_addr.s_gen, sock_addr_len) == -1)
+    uerror("connect", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_connect() { invalid_argument("connect not implemented"); }
+  
+#endif

File otherlibs/unix/cst2constr.c

+#include <mlvalues.h>
+#include <fail.h>
+#include "cst2constr.h"
+
+value cst_to_constr(n, tbl, size, deflt)
+     int n;
+     int * tbl;
+     int size;
+     int deflt;
+{
+  int i;
+  for (i = 0; i < size; i++)
+    if (n == tbl[i]) return Atom(i);
+  return Atom(deflt);
+}

File otherlibs/unix/cst2constr.h

+#ifdef ANSI
+value cst_to_constr(int, int *, int, int);
+#else
+value cst_to_constr();
+#endif

File otherlibs/unix/cstringv.c

+#include <mlvalues.h>
+#include <memory.h>
+#include "unix.h"
+
+char ** cstringvect(arg)
+     value arg;
+{
+  char ** res;
+  mlsize_t size, i;
+
+  size = Wosize_val(arg);
+  res = (char **) stat_alloc((size + 1) * sizeof(char *));
+  for (i = 0; i < size; i++) res[i] = String_val(Field(arg, i));
+  res[size] = NULL;
+  return res;
+}
+
+  

File otherlibs/unix/dup.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_dup(fd)               /* ML */
+     value fd;
+{
+  int ret;
+  ret = dup(Int_val(fd));
+  if (ret == -1) uerror("dup", Nothing);
+  return Val_int(ret);
+}

File otherlibs/unix/dup2.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_DUP2
+
+value unix_dup2(fd1, fd2)        /* ML */
+     value fd1, fd2;
+{
+  if (dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing);
+  return Val_unit;
+}
+
+#else
+
+static int do_dup2(fd1, fd2)
+     int fd1, fd2;
+{
+  int fd;
+  int res;
+
+  fd = dup(fd1);
+  if (fd == -1) return -1;
+  if (fd == fd2) return 0;
+  res = do_dup2(fd1, fd2);
+  close(fd);
+  return res;
+}
+
+value unix_dup2(fd1, fd2)        /* ML */
+     value fd1, fd2;
+{
+  close(Int_val(fd2));
+  if (do_dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing);
+  return Val_unit;
+}
+
+#endif

File otherlibs/unix/envir.c

+#include <mlvalues.h>
+#include <alloc.h>
+
+extern char ** environ;
+
+value unix_environment()
+{
+  return copy_string_array(environ);
+}

File otherlibs/unix/errmsg.c

+#include <errno.h>
+#include <mlvalues.h>
+#include <alloc.h>
+
+extern int error_table[];
+
+#ifdef HAS_STRERROR
+
+#include <string.h>
+
+value unix_error_message(err)
+     value err;
+{
+  int errnum;
+  errnum = error_table[Tag_val(err)];
+  return copy_string(strerror(errno));
+}
+
+#else
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+value unix_error_message(err)
+     value err;
+{
+  int errnum;
+  errnum = error_table[Tag_val(err)];
+  if (errnum < 0 || errnum >= sys_nerr) {
+    return copy_string("Unknown error");
+  } else {
+    return copy_string(sys_errlist[errnum]);
+  }
+}
+
+#endif

File otherlibs/unix/execv.c

+#include <mlvalues.h>
+#include <memory.h>
+#include "unix.h"
+
+extern char ** cstringvect();
+
+value unix_execv(path, args)     /* ML */
+     value path, args;
+{
+  char ** argv;
+  argv = cstringvect(args);
+  (void) execv(String_val(path), argv);
+  stat_free((char *) argv);
+  uerror("execv", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
+

File otherlibs/unix/execve.c

+#include <mlvalues.h>
+#include <memory.h>
+#include "unix.h"
+
+extern char ** cstringvect();
+
+value unix_execve(path, args, env)     /* ML */
+     value path, args, env;
+{
+  char ** argv;
+  char ** envp;
+  argv = cstringvect(args);
+  envp = cstringvect(env);
+  (void) execve(String_val(path), argv, envp);
+  stat_free((char *) argv);
+  stat_free((char *) envp);
+  uerror("execve", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
+

File otherlibs/unix/execvp.c

+#include <mlvalues.h>
+#include <memory.h>
+#include "unix.h"
+
+extern char ** cstringvect();
+
+value unix_execvp(path, args)     /* ML */
+     value path, args;
+{
+  char ** argv;
+  argv = cstringvect(args);
+  (void) execvp(String_val(path), argv);
+  stat_free((char *) argv);
+  uerror("execvp", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
+

File otherlibs/unix/exit.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_exit(n)               /* ML */
+     value n;
+{
+  _exit(Int_val(n));
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
+
+

File otherlibs/unix/fchmod.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_FCHMOD
+
+value unix_fchmod(fd, perm)      /* ML */
+     value fd, perm;
+{
+  if (fchmod(Int_val(fd), Int_val(perm)) == -1) uerror("fchmod", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_fchmod() { invalid_argument("fchmod not implemented"); }
+  
+#endif

File otherlibs/unix/fchown.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_FCHMOD
+
+value unix_fchown(fd, uid, gid)  /* ML */
+     value fd, uid, gid;
+{
+  if (fchown(Int_val(fd), Int_val(uid), Int_val(gid)) == -1)
+    uerror("fchown", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_fchown() { invalid_argument("fchown not implemented"); }
+  
+#endif

File otherlibs/unix/fcntl.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_fcntl_int(fd, request, arg)
+     value fd, request, arg;
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), Int_val(request), (char *) Int_val(arg));
+  if (retcode == -1) uerror("fcntl_int", Nothing);
+  return Val_int(retcode);
+}
+
+value unix_fcntl_ptr(fd, request, arg)
+     value fd, request, arg;
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), Int_val(request), String_val(arg));
+  if (retcode == -1) uerror("fcntl_ptr", Nothing);
+  return Val_int(retcode);
+}

File otherlibs/unix/fork.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_fork(unit)               /* ML */
+     value unit;
+{
+  int ret;
+  ret = fork();
+  if (ret == -1) uerror("fork", Nothing);
+  return Val_int(ret);
+}
+

File otherlibs/unix/ftruncate.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_TRUNCATE
+
+value unix_ftruncate(fd, len)    /* ML */
+     value fd, len;
+{
+  if (ftruncate(Int_val(fd), Long_val(len)) == -1)
+    uerror("ftruncate", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_ftruncate() { invalid_argument("ftruncate not implemented"); }
+
+#endif

File otherlibs/unix/getcwd.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+
+#ifdef HAS_GETCWD
+
+#include <sys/param.h>
+
+value unix_getcwd()     /* ML */
+{
+  char buff[MAXPATHLEN];
+  if (getcwd(buff, sizeof(buff)) == 0) uerror("getcwd", NULL);
+  return copy_string(buff);
+}
+
+#else
+#ifdef HAS_GETWD
+
+#include <sys/param.h>
+
+value unix_getcwd()
+{
+  char buff[MAXPATHLEN];
+  if (getwd(buff) == 0) uerror("getcwd", buff);
+  return copy_string(buff);
+}
+
+#else
+
+value unix_getcwd() { invalid_argument("getcwd not implemented"); }
+
+#endif
+#endif

File otherlibs/unix/getegid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_getegid()             /* ML */
+{
+  return Val_int(getegid());
+}

File otherlibs/unix/geteuid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_geteuid()             /* ML */
+{
+  return Val_int(geteuid());
+}

File otherlibs/unix/getgid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_getgid()              /* ML */
+{
+  return Val_int(getgid());
+}

File otherlibs/unix/getgr.c

+#include <mlvalues.h>
+#include <fail.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unix.h"
+#include <stdio.h>
+#include <grp.h>
+
+static value alloc_group_entry(entry)
+     struct group * entry;
+{
+  value res;
+  Push_roots(s, 3);
+
+  s[0] = copy_string(entry->gr_name);
+  s[1] = copy_string(entry->gr_passwd);
+  s[2] = copy_string_array(entry->gr_mem);
+  res = alloc_tuple(4);
+  Field(res,0) = s[0];
+  Field(res,1) = s[1];
+  Field(res,2) = Val_int(entry->gr_gid);
+  Field(res,3) = s[2];
+  Pop_roots();
+  return res;
+}
+
+value unix_getgrnam(name)        /* ML */
+     value name;
+{
+  struct group * entry;
+  entry = getgrnam(String_val(name));
+  if (entry == NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_group_entry(entry);
+}
+
+value unix_getgrgid(gid)         /* ML */
+     value gid;
+{
+  struct group * entry;
+  entry = getgrgid(Int_val(gid));
+  if (entry == NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_group_entry(entry);
+}

File otherlibs/unix/getgroups.c

+#include <mlvalues.h>
+#include <alloc.h>
+
+#ifdef HAS_GETGROUPS
+
+#include <sys/types.h>
+#include <sys/param.h>
+#include "unix.h"
+
+value unix_getgroups()           /* ML */
+{
+  int gidset[NGROUPS];
+  int n;
+  value res;
+  int i;
+
+  n = getgroups(NGROUPS, gidset);
+  if (n == -1) uerror("getgroups", Nothing);
+  res = alloc_tuple(n);
+  for (i = 0; i < n; i++)
+    Field(res, i) = Val_int(gidset[i]);
+  return res;
+}
+
+#else
+
+value unix_getgroups() { invalid_argument("getgroups not implemented"); }
+
+#endif

File otherlibs/unix/gethost.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include <fail.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+#include <netdb.h>
+
+static int entry_h_length;
+
+extern int socket_domain_table[];
+
+static value alloc_one_addr(a)
+     char * a;
+{
+  bcopy(a, &sock_addr.s_inet.sin_addr, entry_h_length);
+  return alloc_inet_addr(sock_addr.s_inet.sin_addr.s_addr);
+}
+
+static value alloc_host_entry(entry)
+     struct hostent * entry;
+{
+  value res;
+  Push_roots(r, 4);
+
+  r[0] = copy_string(entry->h_name);
+  r[1] = copy_string_array(entry->h_aliases);
+  entry_h_length = entry->h_length;
+#ifdef h_addr
+  r[2] = alloc_array(alloc_one_addr, entry->h_addr_list);
+#else
+  r[3] = alloc_one_addr(entry->h_addr);
+  r[2] = alloc_tuple(1);
+  Field(r[2], 0) = r[3];
+#endif
+  res = alloc_tuple(4);
+  Field(res, 0) = r[0];
+  Field(res, 1) = r[1];
+  Field(res, 2) = entry->h_addrtype == PF_UNIX ? Atom(0) : Atom(1);
+  Field(res, 3) = r[2];
+  Pop_roots();
+  return res;
+}
+
+value unix_gethostbyaddr(a)   /* ML */
+     value a;
+{
+  struct in_addr in_addr;
+  struct hostent * entry;
+  in_addr.s_addr = GET_INET_ADDR(a);
+  entry = gethostbyaddr((char *) &in_addr, sizeof(in_addr), 0);
+  if (entry == (struct hostent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_host_entry(entry);
+}
+
+value unix_gethostbyname(name)   /* ML */
+     value name;
+{
+  struct hostent * entry;
+  entry = gethostbyname(String_val(name));
+  if (entry == (struct hostent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_host_entry(entry);
+}
+
+#else
+
+value unix_gethostbyaddr()
+{ invalid_argument("gethostbyaddr not implemented"); }
+  
+value unix_gethostbyname()
+{ invalid_argument("gethostbyname not implemented"); }
+ 
+#endif

File otherlibs/unix/gethostname.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <sys/param.h>
+#include "unix.h"
+
+#ifdef HAS_GETHOSTNAME
+
+#ifndef MAXHOSTNAMELEN
+#define MAXHOSTNAMELEN 256
+#endif
+
+value unix_gethostname()         /* ML */
+{
+  char name[MAXHOSTNAMELEN];
+  gethostname(name, MAXHOSTNAMELEN);
+  name[MAXHOSTNAMELEN-1] = 0;
+  return copy_string(name);
+}
+
+#else
+#ifdef HAS_UNAME
+
+#include <sys/utsname.h>
+
+value unix_gethostname()
+{
+  struct utsname un;
+  uname(&un);
+  return copy_string(un.nodename);
+}
+
+#else
+
+value unix_gethostname() { invalid_argument("gethostname not implemented"); }
+
+#endif
+#endif

File otherlibs/unix/getlogin.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+#include <errno.h>
+
+extern char * getlogin();
+
+value unix_getlogin()            /* ML */
+{
+  char * name;
+  name = getlogin();
+  if (name == NULL) unix_error(ENOENT, "getlogin", Nothing);
+  return copy_string(name);
+}

File otherlibs/unix/getpid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_getpid()              /* ML */
+{
+  return Val_int(getpid());
+}

File otherlibs/unix/getppid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_getppid()              /* ML */
+{
+  return Val_int(getppid());
+}

File otherlibs/unix/getproto.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include <fail.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include <netdb.h>
+
+static value alloc_proto_entry(entry)
+     struct protoent * entry;
+{
+  value res;
+  Push_roots(r, 2);
+
+  r[0] = copy_string(entry->p_name);
+  r[1] = copy_string_array(entry->p_aliases);
+  res = alloc_tuple(3);
+  Field(res,0) = r[0];
+  Field(res,1) = r[1];
+  Field(res,2) = Val_int(entry->p_proto);
+  Pop_roots();
+  return res;
+}
+
+value unix_getprotobyname(name)  /* ML */
+     value name;
+{
+  struct protoent * entry;
+  entry = getprotobyname(String_val(name));
+  if (entry == (struct protoent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_proto_entry(entry);
+}
+
+value unix_getprotobynumber(proto) /* ML */
+     value proto;
+{
+  struct protoent * entry;
+  entry = getprotobynumber(Int_val(proto));
+  if (entry == (struct protoent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_proto_entry(entry);
+}
+
+#else
+
+value unix_getprotobynumber()
+{ invalid_argument("getprotobynumber not implemented"); }
+  
+value unix_getprotobyname()
+{ invalid_argument("getprotobyname not implemented"); }
+
+#endif

File otherlibs/unix/getpw.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include <fail.h>
+#include "unix.h"
+#include <pwd.h>
+
+static value alloc_passwd_entry(entry)
+     struct passwd * entry;
+{
+  value res;
+  Push_roots(s, 5);
+
+  s[0] = copy_string(entry->pw_name);
+  s[1] = copy_string(entry->pw_passwd);
+  s[2] = copy_string(entry->pw_gecos);
+  s[3] = copy_string(entry->pw_dir);
+  s[4] = copy_string(entry->pw_shell);
+  res = alloc_tuple(7);
+  Field(res,0) = s[0];
+  Field(res,1) = s[1];
+  Field(res,2) = Val_int(entry->pw_uid);
+  Field(res,3) = Val_int(entry->pw_gid);
+  Field(res,4) = s[2];
+  Field(res,5) = s[3];
+  Field(res,6) = s[4];
+  Pop_roots();
+  return res;
+}
+
+value unix_getpwnam(name)        /* ML */
+     value name;
+{
+  struct passwd * entry;
+  entry = getpwnam(String_val(name));
+  if (entry == (struct passwd *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_passwd_entry(entry);
+}
+
+value unix_getpwuid(uid)         /* ML */
+     value uid;
+{
+  struct passwd * entry;
+  entry = getpwuid(Int_val(uid));
+  if (entry == (struct passwd *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_passwd_entry(entry);
+}

File otherlibs/unix/getserv.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include <fail.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+
+static value alloc_service_entry(entry)
+     struct servent * entry;
+{
+  value res;
+  Push_roots(r, 3);
+
+  r[0] = copy_string(entry->s_name);
+  r[1] = copy_string_array(entry->s_aliases);
+  r[2] = copy_string(entry->s_proto);
+  res = alloc_tuple(4);
+  Field(res,0) = r[0];
+  Field(res,1) = r[1];
+  Field(res,2) = Val_int(ntohs(entry->s_port));
+  Field(res,3) = r[2];
+  Pop_roots();
+  return res;
+}
+
+value unix_getservbyname(name, proto)  /* ML */
+     value name, proto;
+{
+  struct servent * entry;
+  entry = getservbyname(String_val(name), String_val(proto));
+  if (entry == (struct servent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_service_entry(entry);
+}
+
+value unix_getservbyport(port, proto)  /* ML */
+     value port, proto;
+{
+  struct servent * entry;
+  entry = getservbyport(Int_val(port), String_val(proto));
+  if (entry == (struct servent *) NULL) mlraise(Atom(NOT_FOUND_EXN));
+  return alloc_service_entry(entry);
+}
+
+#else
+
+value unix_getservbyport()
+{ invalid_argument("getservbyport not implemented"); }
+  
+value unix_getservbyname()
+{ invalid_argument("getservbyname not implemented"); }
+
+#endif

File otherlibs/unix/getuid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_getuid()              /* ML */
+{
+  return Val_int(getuid());
+}

File otherlibs/unix/gmtime.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+#include <time.h>
+
+static value alloc_tm(tm)
+     struct tm * tm;
+{
+  value res;
+  res = alloc_tuple(9);
+  Field(res,0) = Val_int(tm->tm_sec);
+  Field(res,1) = Val_int(tm->tm_min);
+  Field(res,2) = Val_int(tm->tm_hour);
+  Field(res,3) = Val_int(tm->tm_mday);
+  Field(res,4) = Val_int(tm->tm_mon);
+  Field(res,5) = Val_int(tm->tm_year);
+  Field(res,6) = Val_int(tm->tm_wday);
+  Field(res,7) = Val_int(tm->tm_yday);
+  Field(res,8) = tm->tm_isdst ? Val_true : Val_false;
+  return res;
+}
+
+value unix_gmtime(t)             /* ML */
+     value t;
+{
+  int clock;
+  clock = Int_val(t);
+  return alloc_tm(gmtime(&clock));
+}
+
+value unix_localtime(t)          /* ML */
+     value t;
+{
+  int clock;
+  clock = Int_val(t);
+  return alloc_tm(localtime(&clock));
+}

File otherlibs/unix/ioctl.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_ioctl_int(fd, request, arg)
+     value fd, request, arg;
+{
+  int retcode;
+  retcode = ioctl(Int_val(fd), Int_val(request), (char *) Int_val(arg));
+  if (retcode == -1) uerror("ioctl_int", Nothing);
+  return Val_int(retcode);
+}
+
+value unix_ioctl_ptr(fd, request, arg)
+     value fd, request, arg;
+{
+  int retcode;
+  retcode = ioctl(Int_val(fd), Int_val(request), String_val(arg));
+  if (retcode == -1) uerror("ioctl_ptr", Nothing);
+  return Val_int(retcode);
+}

File otherlibs/unix/kill.c

+#include <mlvalues.h>
+#include <fail.h>
+#include "unix.h"
+#include <signal.h>
+
+extern int posix_signals[];     /* defined in byterun/signals.c */
+
+value unix_kill(pid, signal)     /* ML */
+     value pid, signal;
+{
+  int sig;
+  sig = Int_val(signal);
+  if (sig < 0) {
+    sig = posix_signals[-sig-1];
+    if (sig == 0) invalid_argument("Unix.kill: unavailable signal");
+  }
+  if (kill(Int_val(pid), sig) == -1)
+    uerror("kill", Nothing);
+  return Val_unit;
+}

File otherlibs/unix/link.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_link(path1, path2)    /* ML */
+     value path1, path2;
+{
+  if (link(String_val(path1), String_val(path2)) == -1) uerror("link", path2);
+  return Val_unit;
+}

File otherlibs/unix/listen.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+value unix_listen(sock, backlog)
+     value sock, backlog;
+{
+  if (listen(Int_val(sock), Int_val(backlog)) == -1) uerror("listen", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_listen() { invalid_argument("listen not implemented"); }
+
+#endif

File otherlibs/unix/lockf.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_LOCKF
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#define F_ULOCK 0
+#define F_LOCK 1
+#define F_TLOCK 2
+#define F_TEST 3
+#endif
+
+static int lock_command_table[] = {
+  F_ULOCK, F_LOCK, F_TLOCK, F_TEST
+};
+
+value unix_lockf(fd, cmd, span)  /* ML */
+     value fd, cmd, span;
+{
+  if (lockf(Int_val(fd), lock_command_table[Tag_val(cmd)], Long_val(span))
+      == -1) uerror("lockf", Nothing);
+  return Atom(0);
+}
+
+#else
+
+#include <errno.h>
+#include <fcntl.h>
+
+#ifdef F_SETLK
+
+value unix_lockf(fd, cmd, span)  /* ML */
+     value fd, cmd, span;
+{
+  struct flock l;
+  int ret;
+  int fildes;
+  long size;
+
+  fildes = Int_val(fd);
+  size = Long_val(span);
+  l.l_whence = 1;
+  if (size < 0) {
+    l.l_start = size;
+    l.l_len = -size;
+  } else {
+    l.l_start = 0L;
+    l.l_len = size;
+  }
+  switch (Tag_val(cmd)) {
+  case 0: /* F_ULOCK */
+    l.l_type = F_UNLCK;
+    ret = fcntl(fildes, F_SETLK, &l);
+    break;
+  case 1: /* F_LOCK */
+    l.l_type = F_WRLCK;
+    ret = fcntl(fildes, F_SETLKW, &l);
+    break;
+  case 2: /* F_TLOCK */
+    l.l_type = F_WRLCK;
+    ret = fcntl(fildes, F_SETLK, &l);
+    break;
+  case 3: /* F_TEST */
+    l.l_type = F_WRLCK;
+    ret = fcntl(fildes, F_GETLK, &l);
+    if (ret != -1) {
+      if (l.l_type == F_UNLCK)
+        ret = 0;
+      else {
+        errno = EACCES;
+        ret = -1;
+      }
+    }
+    break;
+  default:
+    errno = EINVAL;
+    ret = -1;
+  }
+  if (ret == -1) uerror("lockf", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_lockf() { invalid_argument("lockf not implemented"); }
+
+#endif
+#endif

File otherlibs/unix/lseek.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+static int seek_command_table[] = {
+  SEEK_SET, SEEK_CUR, SEEK_END
+};
+
+value unix_lseek(fd, ofs, cmd)   /* ML */
+     value fd, ofs, cmd;
+{
+  long ret;
+  ret = lseek(Int_val(fd), Long_val(ofs),
+                       seek_command_table[Tag_val(cmd)]);
+  if (ret == -1) uerror("lseek", Nothing);
+  return Val_long(ret);
+}

File otherlibs/unix/mkdir.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_mkdir(path, perm)     /* ML */
+     value path, perm;
+{
+  if (mkdir(String_val(path), Int_val(perm)) == -1) uerror("mkdir", path);
+  return Val_unit;
+}

File otherlibs/unix/mkfifo.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_MKFIFO
+
+value unix_mkfifo(path, mode)
+     value path;
+     value mode;
+{
+  if (mkfifo(String_val(path), Int_val(mode)) == -1)
+    uerror("mkfifo", path);
+  return Val_unit;
+}
+
+#else
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#ifdef S_IFIFO
+
+value unix_mkfifo(path, mode)
+     value path;
+     value mode;
+{
+  if (mknod(String_val(path), (Int_val(mode) & 07777) | S_IFIFO, 0) == -1)
+    uerror("mkfifo", path);
+  return Val_unit;
+}
+
+#else
+
+value unix_mkfifo() { invalid_argument("mkfifo not implemented"); }
+
+#endif
+#endif

File otherlibs/unix/nice.c

+#include <mlvalues.h>
+#include "unix.h"
+#include <errno.h>
+
+#ifdef HAS_GETPRIORITY
+
+#include <sys/time.h>
+#include <sys/resource.h>
+
+value unix_nice(incr)
+     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
+
+value unix_nice(incr)
+     value incr;
+{
+  int ret;
+  errno = 0;
+  ret = nice(Int_val(incr));
+  if (ret == -1 && errno != 0) uerror("nice", Nothing);
+  return Val_int(ret);
+}
+
+#endif

File otherlibs/unix/open.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+#include <fcntl.h>
+
+static int open_flag_table[] = {
+  O_RDONLY, O_WRONLY, O_RDWR, O_NDELAY, O_APPEND, O_CREAT, O_TRUNC, O_EXCL
+};
+
+value unix_open(path, flags, perm) /* ML */
+     value path, flags, perm;
+{
+  int ret;
+
+  ret = open(String_val(path), convert_flag_list(flags, open_flag_table),
+             Int_val(perm));
+  if (ret == -1) uerror("open", path);
+  return Val_int(ret);
+}

File otherlibs/unix/opendir.c

+#include <mlvalues.h>
+#include "unix.h"
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+value unix_opendir(path)         /* ML */
+     value path;
+{
+  DIR * d;
+  d = opendir(String_val(path));
+  if (d == (DIR *) NULL) uerror("opendir", path);
+  return (value) d;
+}

File otherlibs/unix/pause.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_pause()               /* ML */
+{
+  pause();
+  return Val_unit;
+}

File otherlibs/unix/pipe.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include "unix.h"
+
+value unix_pipe()                /* ML */
+{
+  int fd[2];
+  value res;
+  if (pipe(fd) == -1) uerror("pipe", Nothing);
+  res = alloc_tuple(2);
+  Field(res, 0) = Val_int(fd[0]);
+  Field(res, 1) = Val_int(fd[1]);
+  return res;
+}

File otherlibs/unix/read.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_read(fd, buf, ofs, len) /* ML */
+     value fd, buf, ofs, len;
+{
+  int ret;
+  enter_blocking_section();
+  ret = read(Int_val(fd), &Byte(buf, Long_val(ofs)), Int_val(len));
+  leave_blocking_section();
+  if (ret == -1) uerror("read", Nothing);
+  return Val_int(ret);
+}

File otherlibs/unix/readdir.c

+#include <mlvalues.h>
+#include <fail.h>
+#include <alloc.h>
+#include "unix.h"
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+typedef struct dirent directory_entry;
+#else
+#include <sys/dir.h>
+typedef struct direct directory_entry;
+#endif
+
+value unix_readdir(d)            /* ML */
+     value d;
+{
+  directory_entry * e;
+
+  e = readdir((DIR *) d);
+  if (e == (directory_entry *) NULL) mlraise(Atom(END_OF_FILE_EXN));
+  return copy_string(e->d_name);
+}

File otherlibs/unix/readlink.c

+#include <mlvalues.h>
+#include <alloc.h>
+
+#ifdef HAS_SYMLINK
+
+#include <sys/param.h>
+#include "unix.h"
+
+value unix_readlink(path)        /* ML */
+     value path;
+{
+  char buffer[MAXPATHLEN];
+  int len;
+  len = readlink(String_val(path), buffer, sizeof(buffer) - 1);
+  if (len == -1) uerror("readlink", path);
+  buffer[len] = '\0';
+  return copy_string(buffer);
+}
+
+#else
+
+value unix_readlink() { invalid_argument("readlink not implemented"); }
+
+#endif

File otherlibs/unix/rename.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_rename(path1, path2)  /* ML */
+     value path1, path2;
+{
+  if (rename(String_val(path1), String_val(path2)) == -1)
+    uerror("rename", path1);
+  return Atom(0);
+}

File otherlibs/unix/rewinddir.c

+#include <mlvalues.h>
+#include "unix.h"
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+value unix_rewinddir(d)          /* ML */
+     value d;
+{
+  rewinddir((DIR *) d);
+  return Atom(0);
+}

File otherlibs/unix/rmdir.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_rmdir(path)           /* ML */
+     value path;
+{
+  if (rmdir(String_val(path)) == -1) uerror("rmdir", path);
+  return Atom(0);
+}

File otherlibs/unix/select.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unix.h"
+
+#ifdef HAS_SELECT
+
+#include <sys/types.h>
+#include <sys/time.h>
+
+#ifdef FD_ISSET
+typedef fd_set file_descr_set;
+#else
+typedef int file_descr_set;
+#define FD_SETSIZE (sizeof(int) * 8)
+#define FD_SET(fd,fds) (*(fds) |= 1 << (fd))
+#define FD_CLR(fd,fds) (*(fds) &= ~(1 << (fd)))
+#define FD_ISSET(fd,fds) (*(fds) & (1 << (fd)))
+#define FD_ZERO(fds) (*(fds) = 0)
+#endif
+
+static void fdlist_to_fdset(fdlist, fdset)
+     value fdlist;
+     file_descr_set * fdset;
+{
+  value l;
+  FD_ZERO(fdset);
+  for (l = fdlist; Tag_val(l) == 1; l = Field(l, 1)) {
+    FD_SET(Int_val(Field(l, 0)), fdset);
+  }
+}
+
+static value fdset_to_fdlist(fdset)
+     file_descr_set * fdset;
+{
+  int i;
+  Push_roots(roots, 1)
+#define res roots[0]
+  res = Atom(0);
+  for (i = FD_SETSIZE - 1; i >= 0; i--) {
+    if (FD_ISSET(i, fdset)) {
+      value newres = alloc(2, 1);
+      Field(newres, 0) = Val_int(i);
+      Field(newres, 1) = res;
+      res = newres;
+    }
+  }
+  Pop_roots();
+  return res;
+#undef res
+}
+
+value unix_select(readfds, writefds, exceptfds, timeout) /* ML */
+     value readfds, writefds, exceptfds, timeout;
+{
+  file_descr_set read, write, except;
+  double tm;
+  struct timeval tv;
+  struct timeval * tvp;
+  int retcode;
+  Push_roots(roots, 1)
+#define res roots[0]
+
+  fdlist_to_fdset(readfds, &read);
+  fdlist_to_fdset(writefds, &write);
+  fdlist_to_fdset(exceptfds, &except);
+  tm = Double_val(timeout);
+  if (tm < 0.0)
+    tvp = (struct timeval *) NULL;
+  else {
+    tv.tv_sec = (int) tm;
+    tv.tv_usec = (int) (1e6 * (tm - (int) tm));
+    tvp = &tv;
+  }
+  retcode = select(FD_SETSIZE, &read, &write, &except, tvp);
+  if (retcode == -1) uerror("select", Nothing);
+  res = alloc_tuple(3);
+  Field(res, 0) = fdset_to_fdlist(&read);
+  Field(res, 1) = fdset_to_fdlist(&write);
+  Field(res, 2) = fdset_to_fdlist(&except);
+  Pop_roots();
+  return res;
+#undef res
+}
+
+#else
+
+value unix_select() { invalid_argument("select not implemented"); }
+
+#endif

File otherlibs/unix/sendrecv.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+#include "socketaddr.h"
+#endif
+
+#if defined(HAS_SOCKETS) && defined(MSG_OOB) && defined(MSG_DONTROUTE) && defined(MSG_PEEK)
+
+static int msg_flag_table[] = {
+  MSG_OOB, MSG_DONTROUTE, MSG_PEEK
+};
+
+value unix_recv(sock, buff, ofs, len, flags) /* ML */
+     value sock, buff, ofs, len, flags;
+{
+  int ret;
+  enter_blocking_section();
+  ret = recv(Int_val(sock), &Byte(buff, Long_val(ofs)), Int_val(len),
+             convert_flag_list(flags, msg_flag_table));
+  leave_blocking_section();
+  if (ret == -1) uerror("recv", Nothing);
+  return Val_int(ret);
+}
+
+value unix_recvfrom(sock, buff, ofs, len, flags) /* ML */
+     value sock, buff, ofs, len, flags;
+{
+  int retcode;
+  value res;
+  Push_roots(a, 1);
+
+  sock_addr_len = sizeof(sock_addr);
+  enter_blocking_section();
+  retcode = recvfrom(Int_val(sock), &Byte(buff, Long_val(ofs)), Int_val(len),
+                     convert_flag_list(flags, msg_flag_table),
+                     &sock_addr.s_gen, &sock_addr_len);
+  leave_blocking_section();
+  if (retcode == -1) uerror("recvfrom", Nothing);
+  a[0] = alloc_sockaddr();
+  res = alloc_tuple(2);
+  Field(res, 0) = Val_int(retcode);
+  Field(res, 1) = a[0];
+  Pop_roots();
+  return res;
+}
+
+value unix_send(sock, buff, ofs, len, flags) /* ML */
+     value sock, buff, ofs, len, flags;
+{
+  int ret;
+  enter_blocking_section();
+  ret = send(Int_val(sock), &Byte(buff, Long_val(ofs)), Int_val(len),
+             convert_flag_list(flags, msg_flag_table));
+  leave_blocking_section();
+  if (ret == -1) uerror("send", Nothing);
+  return Val_int(ret);
+}
+
+value unix_sendto(argv, argc)    /* ML */
+     value * argv;
+     int argc;
+{
+  int ret;
+  get_sockaddr(argv[5]);
+  enter_blocking_section();
+  ret = sendto(Int_val(argv[0]), &Byte(argv[1], Long_val(argv[2])),
+               Int_val(argv[3]), convert_flag_list(argv[4], msg_flag_table),
+               &sock_addr.s_gen, sock_addr_len);
+  leave_blocking_section();
+  if (ret == -1) uerror("sendto", Nothing);
+  return Val_int(ret);
+}
+
+#else
+
+value unix_recv() { invalid_argument("recv not implemented"); }
+
+value unix_recvfrom() { invalid_argument("recvfrom not implemented"); }
+
+value unix_send() { invalid_argument("send not implemented"); }
+
+value unix_sendto() { invalid_argument("sendto not implemented"); }
+
+#endif

File otherlibs/unix/setgid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_setgid(gid)           /* ML */
+     value gid;
+{
+  if (setgid(Int_val(gid)) == -1) uerror("setgid", Nothing);
+  return Val_unit;
+}

File otherlibs/unix/setuid.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_setuid(uid)           /* ML */
+     value uid;
+{
+  if (setuid(Int_val(uid)) == -1) uerror("setuid", Nothing);
+  return Val_unit;
+}

File otherlibs/unix/shutdown.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+static int shutdown_command_table[] = {
+  0, 1, 2
+};
+
+value unix_shutdown(sock, cmd)   /* ML */
+     value sock, cmd;
+{
+  if (shutdown(Int_val(sock), shutdown_command_table[Tag_val(cmd)]) == -1)
+    uerror("shutdown", Nothing);
+  return Val_unit;
+}
+
+#else
+
+value unix_shutdown() { invalid_argument("shutdown not implemented"); }
+
+#endif

File otherlibs/unix/sleep.c

+#include <mlvalues.h>
+#include "unix.h"
+
+value unix_sleep(t)              /* ML */
+     value t;
+{
+  enter_blocking_section();
+  sleep(Int_val(t));
+  leave_blocking_section();
+  return Val_unit;
+}

File otherlibs/unix/socket.c

+#include <mlvalues.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/types.h>
+#include <sys/socket.h>
+
+int socket_domain_table[] = {
+  PF_UNIX, PF_INET
+};
+
+int socket_type_table[] = {
+  SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
+};
+
+value unix_socket(domain, type, proto) /* ML */
+     value domain, type, proto;
+{
+  int retcode;
+  retcode = socket(socket_domain_table[Tag_val(domain)],
+                   socket_type_table[Tag_val(type)],
+                   Int_val(proto));
+  if (retcode == -1) uerror("socket", Nothing);
+  return Val_int(retcode);
+
+}
+
+#else
+
+value unix_socket() { invalid_argument("socket not implemented"); }
+
+#endif

File otherlibs/unix/socketaddr.c

+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include <str.h>
+#include <errno.h>
+#include "unix.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+value alloc_inet_addr(a)
+     unsigned long a;
+{
+  value res;
+  res = alloc(1, Abstract_tag);
+  GET_INET_ADDR(res) = a;
+  return res;
+}
+
+void get_sockaddr(a)
+     value a;
+{
+  switch(Tag_val(a)) {
+  case 0:                       /* ADDR_UNIX */
+    { value path;
+      mlsize_t len;
+      path = Field(a, 0);
+      len = string_length(path);
+      sock_addr.s_unix.sun_family = AF_UNIX;
+      if (len >= sizeof(sock_addr.s_unix.sun_path)) {
+        unix_error(ENAMETOOLONG, "", path);
+      }
+      bcopy(String_val(path), sock_addr.s_unix.sun_path, (int) len + 1);
+      sock_addr_len = sizeof(sock_addr.s_unix.sun_family) + len;
+      break;
+    }
+  case 1:                       /* ADDR_INET */
+    {
+      char * p;
+      int n;
+      for (p = (char *) &sock_addr.s_inet, n = sizeof(sock_addr.s_inet);
+           n > 0; p++, n--)
+        *p = 0;
+      sock_addr.s_inet.sin_family = AF_INET;
+      sock_addr.s_inet.sin_addr.s_addr = GET_INET_ADDR(Field(a, 0));
+      sock_addr.s_inet.sin_port = htons(Int_val(Field(a, 1)));
+      sock_addr_len = sizeof(struct sockaddr_in);
+      break;
+    }
+  }
+}
+
+value alloc_sockaddr()
+{
+  value res;
+  switch(sock_addr.s_gen.sa_family) {
+  case AF_UNIX:
+    { Push_roots(n, 1);
+      n[0] = copy_string(sock_addr.s_unix.sun_path);
+      res = alloc(1, 0);
+      Field(res,0) = n[0];
+      Pop_roots();
+      break;
+    }
+  case AF_INET:
+    { Push_roots(a, 1);
+      a[0] = alloc_inet_addr(sock_addr.s_inet.sin_addr.s_addr);
+      res = alloc(2, 1);
+      Field(res,0) = a[0];
+      Field(res,1) = Val_int(ntohs(sock_addr.s_inet.sin_port));
+      Pop_roots();
+      break;
+    }
+  default:
+    unix_error(EAFNOSUPPORT, "", Nothing);
+  }
+  return res;
+}
+
+#endif

File otherlibs/unix/socketaddr.h