diff options
Diffstat (limited to 'otherlibs/unix')
91 files changed, 0 insertions, 4141 deletions
diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile deleted file mode 100644 index 3542eeb4d7..0000000000 --- a/otherlibs/unix/Makefile +++ /dev/null @@ -1,57 +0,0 @@ -# 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 diff --git a/otherlibs/unix/accept.c b/otherlibs/unix/accept.c deleted file mode 100644 index 0018663192..0000000000 --- a/otherlibs/unix/accept.c +++ /dev/null @@ -1,34 +0,0 @@ -#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 diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c deleted file mode 100644 index d23ee68b62..0000000000 --- a/otherlibs/unix/access.c +++ /dev/null @@ -1,30 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/addrofstr.c b/otherlibs/unix/addrofstr.c deleted file mode 100644 index 393e32fb0f..0000000000 --- a/otherlibs/unix/addrofstr.c +++ /dev/null @@ -1,25 +0,0 @@ -#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 diff --git a/otherlibs/unix/alarm.c b/otherlibs/unix/alarm.c deleted file mode 100644 index a4bd78c9d8..0000000000 --- a/otherlibs/unix/alarm.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_alarm(t) /* ML */ - value t; -{ - return Val_int(alarm((unsigned int) Long_val(t))); -} diff --git a/otherlibs/unix/bind.c b/otherlibs/unix/bind.c deleted file mode 100644 index 1684ccb183..0000000000 --- a/otherlibs/unix/bind.c +++ /dev/null @@ -1,22 +0,0 @@ -#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 diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c deleted file mode 100644 index ec7aeb4650..0000000000 --- a/otherlibs/unix/chdir.c +++ /dev/null @@ -1,11 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c deleted file mode 100644 index ebfa6368b3..0000000000 --- a/otherlibs/unix/chmod.c +++ /dev/null @@ -1,11 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c deleted file mode 100644 index b7ea57d6d3..0000000000 --- a/otherlibs/unix/chown.c +++ /dev/null @@ -1,11 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c deleted file mode 100644 index 6f5954b665..0000000000 --- a/otherlibs/unix/chroot.c +++ /dev/null @@ -1,11 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c deleted file mode 100644 index 47ea2ef1da..0000000000 --- a/otherlibs/unix/close.c +++ /dev/null @@ -1,9 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/closedir.c b/otherlibs/unix/closedir.c deleted file mode 100644 index 2701e51d6e..0000000000 --- a/otherlibs/unix/closedir.c +++ /dev/null @@ -1,15 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/connect.c b/otherlibs/unix/connect.c deleted file mode 100644 index 51eee43050..0000000000 --- a/otherlibs/unix/connect.c +++ /dev/null @@ -1,21 +0,0 @@ -#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 diff --git a/otherlibs/unix/cst2constr.c b/otherlibs/unix/cst2constr.c deleted file mode 100644 index 7a519a7501..0000000000 --- a/otherlibs/unix/cst2constr.c +++ /dev/null @@ -1,15 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/cst2constr.h b/otherlibs/unix/cst2constr.h deleted file mode 100644 index 307926b353..0000000000 --- a/otherlibs/unix/cst2constr.h +++ /dev/null @@ -1,5 +0,0 @@ -#ifdef ANSI -value cst_to_constr(int, int *, int, int); -#else -value cst_to_constr(); -#endif diff --git a/otherlibs/unix/cstringv.c b/otherlibs/unix/cstringv.c deleted file mode 100644 index 8c2fa1e564..0000000000 --- a/otherlibs/unix/cstringv.c +++ /dev/null @@ -1,18 +0,0 @@ -#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; -} - - diff --git a/otherlibs/unix/dup.c b/otherlibs/unix/dup.c deleted file mode 100644 index 5ee521305b..0000000000 --- a/otherlibs/unix/dup.c +++ /dev/null @@ -1,11 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/dup2.c b/otherlibs/unix/dup2.c deleted file mode 100644 index e8fbc3647a..0000000000 --- a/otherlibs/unix/dup2.c +++ /dev/null @@ -1,37 +0,0 @@ -#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 diff --git a/otherlibs/unix/envir.c b/otherlibs/unix/envir.c deleted file mode 100644 index a9489fe87f..0000000000 --- a/otherlibs/unix/envir.c +++ /dev/null @@ -1,9 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> - -extern char ** environ; - -value unix_environment() -{ - return copy_string_array(environ); -} diff --git a/otherlibs/unix/errmsg.c b/otherlibs/unix/errmsg.c deleted file mode 100644 index d3efc8414b..0000000000 --- a/otherlibs/unix/errmsg.c +++ /dev/null @@ -1,36 +0,0 @@ -#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 diff --git a/otherlibs/unix/execv.c b/otherlibs/unix/execv.c deleted file mode 100644 index 851d331cb1..0000000000 --- a/otherlibs/unix/execv.c +++ /dev/null @@ -1,18 +0,0 @@ -#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 */ -} - diff --git a/otherlibs/unix/execve.c b/otherlibs/unix/execve.c deleted file mode 100644 index ecdad41046..0000000000 --- a/otherlibs/unix/execve.c +++ /dev/null @@ -1,21 +0,0 @@ -#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 */ -} - diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c deleted file mode 100644 index d8f77bfabd..0000000000 --- a/otherlibs/unix/execvp.c +++ /dev/null @@ -1,18 +0,0 @@ -#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 */ -} - diff --git a/otherlibs/unix/exit.c b/otherlibs/unix/exit.c deleted file mode 100644 index c3cf6572c9..0000000000 --- a/otherlibs/unix/exit.c +++ /dev/null @@ -1,12 +0,0 @@ -#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 */ -} - - diff --git a/otherlibs/unix/fchmod.c b/otherlibs/unix/fchmod.c deleted file mode 100644 index fd74353c0a..0000000000 --- a/otherlibs/unix/fchmod.c +++ /dev/null @@ -1,17 +0,0 @@ -#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 diff --git a/otherlibs/unix/fchown.c b/otherlibs/unix/fchown.c deleted file mode 100644 index 4aaa2ae55e..0000000000 --- a/otherlibs/unix/fchown.c +++ /dev/null @@ -1,18 +0,0 @@ -#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 diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c deleted file mode 100644 index 7898d3c848..0000000000 --- a/otherlibs/unix/fcntl.c +++ /dev/null @@ -1,20 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/fork.c b/otherlibs/unix/fork.c deleted file mode 100644 index 046dd894ce..0000000000 --- a/otherlibs/unix/fork.c +++ /dev/null @@ -1,12 +0,0 @@ -#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); -} - diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c deleted file mode 100644 index 769ff86fb2..0000000000 --- a/otherlibs/unix/ftruncate.c +++ /dev/null @@ -1,18 +0,0 @@ -#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 diff --git a/otherlibs/unix/getcwd.c b/otherlibs/unix/getcwd.c deleted file mode 100644 index 7bbddf12df..0000000000 --- a/otherlibs/unix/getcwd.c +++ /dev/null @@ -1,33 +0,0 @@ -#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 diff --git a/otherlibs/unix/getegid.c b/otherlibs/unix/getegid.c deleted file mode 100644 index 482177410f..0000000000 --- a/otherlibs/unix/getegid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_getegid() /* ML */ -{ - return Val_int(getegid()); -} diff --git a/otherlibs/unix/geteuid.c b/otherlibs/unix/geteuid.c deleted file mode 100644 index e7e8d4c4ab..0000000000 --- a/otherlibs/unix/geteuid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_geteuid() /* ML */ -{ - return Val_int(geteuid()); -} diff --git a/otherlibs/unix/getgid.c b/otherlibs/unix/getgid.c deleted file mode 100644 index 81debfa058..0000000000 --- a/otherlibs/unix/getgid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_getgid() /* ML */ -{ - return Val_int(getgid()); -} diff --git a/otherlibs/unix/getgr.c b/otherlibs/unix/getgr.c deleted file mode 100644 index efb55b9b5a..0000000000 --- a/otherlibs/unix/getgr.c +++ /dev/null @@ -1,43 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/getgroups.c b/otherlibs/unix/getgroups.c deleted file mode 100644 index b5c1d52e48..0000000000 --- a/otherlibs/unix/getgroups.c +++ /dev/null @@ -1,29 +0,0 @@ -#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 diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c deleted file mode 100644 index 096b28fe50..0000000000 --- a/otherlibs/unix/gethost.c +++ /dev/null @@ -1,76 +0,0 @@ -#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 diff --git a/otherlibs/unix/gethostname.c b/otherlibs/unix/gethostname.c deleted file mode 100644 index 4c11c6b2a9..0000000000 --- a/otherlibs/unix/gethostname.c +++ /dev/null @@ -1,37 +0,0 @@ -#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 diff --git a/otherlibs/unix/getlogin.c b/otherlibs/unix/getlogin.c deleted file mode 100644 index 72274a7d93..0000000000 --- a/otherlibs/unix/getlogin.c +++ /dev/null @@ -1,14 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/getpid.c b/otherlibs/unix/getpid.c deleted file mode 100644 index b8082b95f0..0000000000 --- a/otherlibs/unix/getpid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_getpid() /* ML */ -{ - return Val_int(getpid()); -} diff --git a/otherlibs/unix/getppid.c b/otherlibs/unix/getppid.c deleted file mode 100644 index 4b76b736e5..0000000000 --- a/otherlibs/unix/getppid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_getppid() /* ML */ -{ - return Val_int(getppid()); -} diff --git a/otherlibs/unix/getproto.c b/otherlibs/unix/getproto.c deleted file mode 100644 index 56ea699134..0000000000 --- a/otherlibs/unix/getproto.c +++ /dev/null @@ -1,53 +0,0 @@ -#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 diff --git a/otherlibs/unix/getpw.c b/otherlibs/unix/getpw.c deleted file mode 100644 index 86d27474ab..0000000000 --- a/otherlibs/unix/getpw.c +++ /dev/null @@ -1,47 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/getserv.c b/otherlibs/unix/getserv.c deleted file mode 100644 index ddd25dafb7..0000000000 --- a/otherlibs/unix/getserv.c +++ /dev/null @@ -1,58 +0,0 @@ -#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 diff --git a/otherlibs/unix/getuid.c b/otherlibs/unix/getuid.c deleted file mode 100644 index 558e5e2992..0000000000 --- a/otherlibs/unix/getuid.c +++ /dev/null @@ -1,7 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_getuid() /* ML */ -{ - return Val_int(getuid()); -} diff --git a/otherlibs/unix/gmtime.c b/otherlibs/unix/gmtime.c deleted file mode 100644 index ecbcd81a5f..0000000000 --- a/otherlibs/unix/gmtime.c +++ /dev/null @@ -1,37 +0,0 @@ -#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)); -} diff --git a/otherlibs/unix/ioctl.c b/otherlibs/unix/ioctl.c deleted file mode 100644 index e4d2e5e6d4..0000000000 --- a/otherlibs/unix/ioctl.c +++ /dev/null @@ -1,20 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/kill.c b/otherlibs/unix/kill.c deleted file mode 100644 index a552d0931c..0000000000 --- a/otherlibs/unix/kill.c +++ /dev/null @@ -1,20 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c deleted file mode 100644 index 3c7ef671dc..0000000000 --- a/otherlibs/unix/link.c +++ /dev/null @@ -1,9 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/listen.c b/otherlibs/unix/listen.c deleted file mode 100644 index d3791a2c4a..0000000000 --- a/otherlibs/unix/listen.c +++ /dev/null @@ -1,17 +0,0 @@ -#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 diff --git a/otherlibs/unix/lockf.c b/otherlibs/unix/lockf.c deleted file mode 100644 index bfc22c77dc..0000000000 --- a/otherlibs/unix/lockf.c +++ /dev/null @@ -1,89 +0,0 @@ -#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 diff --git a/otherlibs/unix/lseek.c b/otherlibs/unix/lseek.c deleted file mode 100644 index 05d6d2422e..0000000000 --- a/otherlibs/unix/lseek.c +++ /dev/null @@ -1,24 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c deleted file mode 100644 index a65157532b..0000000000 --- a/otherlibs/unix/mkdir.c +++ /dev/null @@ -1,9 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c deleted file mode 100644 index 453bcfc5e6..0000000000 --- a/otherlibs/unix/mkfifo.c +++ /dev/null @@ -1,36 +0,0 @@ -#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 diff --git a/otherlibs/unix/nice.c b/otherlibs/unix/nice.c deleted file mode 100644 index 8fc265adba..0000000000 --- a/otherlibs/unix/nice.c +++ /dev/null @@ -1,36 +0,0 @@ -#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 diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c deleted file mode 100644 index bec1e8ed80..0000000000 --- a/otherlibs/unix/open.c +++ /dev/null @@ -1,19 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c deleted file mode 100644 index 0fa82657fd..0000000000 --- a/otherlibs/unix/opendir.c +++ /dev/null @@ -1,17 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/pause.c b/otherlibs/unix/pause.c deleted file mode 100644 index 126c310f9d..0000000000 --- a/otherlibs/unix/pause.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_pause() /* ML */ -{ - pause(); - return Val_unit; -} diff --git a/otherlibs/unix/pipe.c b/otherlibs/unix/pipe.c deleted file mode 100644 index 102aeafb98..0000000000 --- a/otherlibs/unix/pipe.c +++ /dev/null @@ -1,14 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/read.c b/otherlibs/unix/read.c deleted file mode 100644 index 18ba74d662..0000000000 --- a/otherlibs/unix/read.c +++ /dev/null @@ -1,13 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/readdir.c b/otherlibs/unix/readdir.c deleted file mode 100644 index 41093f95a7..0000000000 --- a/otherlibs/unix/readdir.c +++ /dev/null @@ -1,22 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c deleted file mode 100644 index ffd979da5c..0000000000 --- a/otherlibs/unix/readlink.c +++ /dev/null @@ -1,24 +0,0 @@ -#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 diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c deleted file mode 100644 index 76b6e3f6e5..0000000000 --- a/otherlibs/unix/rename.c +++ /dev/null @@ -1,10 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/rewinddir.c b/otherlibs/unix/rewinddir.c deleted file mode 100644 index 4062a46c7e..0000000000 --- a/otherlibs/unix/rewinddir.c +++ /dev/null @@ -1,15 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c deleted file mode 100644 index 49e82b253a..0000000000 --- a/otherlibs/unix/rmdir.c +++ /dev/null @@ -1,9 +0,0 @@ -#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); -} diff --git a/otherlibs/unix/select.c b/otherlibs/unix/select.c deleted file mode 100644 index 7015cdb75e..0000000000 --- a/otherlibs/unix/select.c +++ /dev/null @@ -1,90 +0,0 @@ -#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 diff --git a/otherlibs/unix/sendrecv.c b/otherlibs/unix/sendrecv.c deleted file mode 100644 index 82f7ebf1d3..0000000000 --- a/otherlibs/unix/sendrecv.c +++ /dev/null @@ -1,87 +0,0 @@ -#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 diff --git a/otherlibs/unix/setgid.c b/otherlibs/unix/setgid.c deleted file mode 100644 index eff8a444f0..0000000000 --- a/otherlibs/unix/setgid.c +++ /dev/null @@ -1,9 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/setuid.c b/otherlibs/unix/setuid.c deleted file mode 100644 index 31bba023f7..0000000000 --- a/otherlibs/unix/setuid.c +++ /dev/null @@ -1,9 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/shutdown.c b/otherlibs/unix/shutdown.c deleted file mode 100644 index 79326494e5..0000000000 --- a/otherlibs/unix/shutdown.c +++ /dev/null @@ -1,22 +0,0 @@ -#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 diff --git a/otherlibs/unix/sleep.c b/otherlibs/unix/sleep.c deleted file mode 100644 index 6abc80edfd..0000000000 --- a/otherlibs/unix/sleep.c +++ /dev/null @@ -1,11 +0,0 @@ -#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; -} diff --git a/otherlibs/unix/socket.c b/otherlibs/unix/socket.c deleted file mode 100644 index 6a1e197545..0000000000 --- a/otherlibs/unix/socket.c +++ /dev/null @@ -1,33 +0,0 @@ -#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 diff --git a/otherlibs/unix/socketaddr.c b/otherlibs/unix/socketaddr.c deleted file mode 100644 index 1cb9115a07..0000000000 --- a/otherlibs/unix/socketaddr.c +++ /dev/null @@ -1,81 +0,0 @@ -#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 diff --git a/otherlibs/unix/socketaddr.h b/otherlibs/unix/socketaddr.h deleted file mode 100644 index 0cc9be8f79..0000000000 --- a/otherlibs/unix/socketaddr.h +++ /dev/null @@ -1,24 +0,0 @@ -#include <sys/types.h> -#include <sys/socket.h> -#include <sys/un.h> -#include <netinet/in.h> - -union { - struct sockaddr s_gen; - struct sockaddr_un s_unix; - struct sockaddr_in s_inet; -} sock_addr; - -int sock_addr_len; - -#ifdef ANSI -void get_sockaddr(value); -value alloc_sockaddr(void); -value alloc_inet_addr(unsigned long); -#else -void get_sockaddr(); -value alloc_sockaddr(); -value alloc_inet_addr(); -#endif - -#define GET_INET_ADDR(v) (*((unsigned long *) (v))) diff --git a/otherlibs/unix/socketpair.c b/otherlibs/unix/socketpair.c deleted file mode 100644 index 5a5a02d968..0000000000 --- a/otherlibs/unix/socketpair.c +++ /dev/null @@ -1,28 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include "unix.h" - -#ifdef HAS_SOCKETS - -extern int socket_domain_table[], socket_type_table[]; - -value unix_socketpair(domain, type, proto) /* ML */ - value domain, type, proto; -{ - int sv[2]; - value res; - if (socketpair(socket_domain_table[Tag_val(domain)], - socket_type_table[Tag_val(type)], - Int_val(proto), sv) == -1) - uerror("socketpair", Nothing); - res = alloc_tuple(2); - Field(res,0) = Val_int(sv[0]); - Field(res,1) = Val_int(sv[1]); - return res; -} - -#else - -value unix_socketpair() { invalid_argument("socketpair not implemented"); } - -#endif diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c deleted file mode 100644 index 5b19049b36..0000000000 --- a/otherlibs/unix/stat.c +++ /dev/null @@ -1,76 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include "unix.h" -#include "cst2constr.h" -#include <sys/types.h> -#include <sys/stat.h> - -#ifndef S_IFLNK -#define S_IFLNK 0 -#endif -#ifndef S_IFIFO -#define S_IFIFO 0 -#endif -#ifndef S_IFSOCK -#define S_IFSOCK 0 -#endif - -static int file_kind_table[] = { - S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK -}; - -static value stat_aux(buf) - struct stat * buf; -{ - value v; - - v = alloc_tuple(12); - Field (v, 0) = Val_int (buf->st_dev); - Field (v, 1) = Val_int (buf->st_ino); - Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table, - sizeof(file_kind_table) / sizeof(int), 0); - Field (v, 3) = Val_int(buf->st_mode & 07777); - Field (v, 4) = Val_int (buf->st_nlink); - Field (v, 5) = Val_int (buf->st_uid); - Field (v, 6) = Val_int (buf->st_gid); - Field (v, 7) = Val_int (buf->st_rdev); - Field (v, 8) = Val_int (buf->st_size); - Field (v, 9) = Val_int (buf->st_atime); - Field (v, 10) = Val_int (buf->st_mtime); - Field (v, 11) = Val_int (buf->st_ctime); - return v; -} - -value unix_stat(path) /* ML */ - value path; -{ - int ret; - struct stat buf; - ret = stat(String_val(path), &buf); - if (ret == -1) uerror("stat", path); - return stat_aux(&buf); -} - -value unix_lstat(path) /* ML */ - value path; -{ - int ret; - struct stat buf; -#ifdef HAS_SYMLINK - ret = lstat(String_val(path), &buf); -#else - ret = stat(String_val(path), &buf); -#endif - if (ret == -1) uerror("lstat", path); - return stat_aux(&buf); -} - -value unix_fstat(fd) /* ML */ - value fd; -{ - int ret; - struct stat buf; - ret = fstat(Int_val(fd), &buf); - if (ret == -1) uerror("fstat", Nothing); - return stat_aux(&buf); -} diff --git a/otherlibs/unix/strofaddr.c b/otherlibs/unix/strofaddr.c deleted file mode 100644 index 3407989462..0000000000 --- a/otherlibs/unix/strofaddr.c +++ /dev/null @@ -1,24 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include "unix.h" - -#ifdef HAS_SOCKETS - -#include "socketaddr.h" - -extern char * inet_ntoa(); - -value unix_string_of_inet_addr(a) /* ML */ - value a; -{ - struct in_addr address; - address.s_addr = GET_INET_ADDR(a); - return copy_string(inet_ntoa(address)); -} - -#else - -value unix_string_of_inet_addr() -{ invalid_argument("string_of_inet_addr not implemented"); } - -#endif diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c deleted file mode 100644 index e4fdabd94b..0000000000 --- a/otherlibs/unix/symlink.c +++ /dev/null @@ -1,18 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -#ifdef HAS_SYMLINK - -value unix_symlink(path1, path2) /* ML */ - value path1, path2; -{ - if (symlink(String_val(path1), String_val(path2)) == -1) - uerror("symlink", path2); - return Val_unit; -} - -#else - -value unix_symlink() { invalid_argument("symlink not implemented"); } - -#endif diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c deleted file mode 100644 index fdb0fb95dd..0000000000 --- a/otherlibs/unix/termios.c +++ /dev/null @@ -1,303 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include "unix.h" - -#ifdef HAS_TERMIOS - -#include <termios.h> -#include <errno.h> - -static struct termios terminal_status; - -enum { Bool, Enum, Speed, Char, End }; - -enum { Input, Output }; - -#define iflags ((long)(&terminal_status.c_iflag)) -#define oflags ((long)(&terminal_status.c_oflag)) -#define cflags ((long)(&terminal_status.c_cflag)) -#define lflags ((long)(&terminal_status.c_lflag)) -#define cc(n) ((long)(&terminal_status.c_cc[n])) - -/* Number of fields in the terminal_io record field. Cf. unix.mli */ - -#define NFIELDS 51 - -/* Structure of the terminal_io record. Cf. unix.mli */ - -static long terminal_io_descr[] = { - /* Input modes */ - Bool, iflags, IGNBRK, - Bool, iflags, BRKINT, - Bool, iflags, IGNPAR, - Bool, iflags, PARMRK, - Bool, iflags, INPCK, - Bool, iflags, ISTRIP, - Bool, iflags, INLCR, - Bool, iflags, IGNCR, - Bool, iflags, ICRNL, - Bool, iflags, IXON, - Bool, iflags, IXOFF, - /* Output modes */ - Bool, oflags, OPOST, - Bool, oflags, OLCUC, - Bool, oflags, ONLCR, - Bool, oflags, OCRNL, - Bool, oflags, ONOCR, - Bool, oflags, ONLRET, - Bool, oflags, OFILL, - Bool, oflags, OFDEL, - Enum, oflags, 0, 2, NLDLY, NL0, NL1, - Enum, oflags, 0, 2, CRDLY, CR0, CR1, - Enum, oflags, 0, 4, TABDLY, TAB0, TAB1, TAB2, TAB3, - Enum, oflags, 0, 2, BSDLY, BS0, BS1, - Enum, oflags, 0, 2, VTDLY, VT0, VT1, - Enum, oflags, 0, 2, FFDLY, FF0, FF1, - /* Control modes */ - Speed, Output, - Speed, Input, - Enum, cflags, 5, 4, CSIZE, CS5, CS6, CS7, CS8, - Enum, cflags, 1, 2, CSTOPB, 0, CSTOPB, - Bool, cflags, CREAD, - Bool, cflags, PARENB, - Bool, cflags, PARODD, - Bool, cflags, HUPCL, - Bool, cflags, CLOCAL, - /* Local modes */ - Bool, lflags, ISIG, - Bool, lflags, ICANON, - Bool, lflags, NOFLSH, - Bool, lflags, ECHO, - Bool, lflags, ECHOE, - Bool, lflags, ECHOK, - Bool, lflags, ECHONL, - /* Control characters */ - Char, cc(VINTR), - Char, cc(VQUIT), - Char, cc(VERASE), - Char, cc(VKILL), - Char, cc(VEOF), - Char, cc(VEOL), - Char, cc(VMIN), - Char, cc(VTIME), - Char, cc(VSTART), - Char, cc(VSTOP), - End -}; - -#undef iflags -#undef oflags -#undef cflags -#undef lflags -#undef cc - -struct speedtable_entry ; - -static struct { - speed_t speed; - int baud; -} speedtable[] = { - B0, 0, - B50, 50, - B75, 75, - B110, 110, - B134, 134, - B150, 150, - B300, 300, - B600, 600, - B1200, 1200, - B1800, 1800, - B2400, 2400, - B4800, 4800, - B9600, 9600, - B19200, 19200, - B38400, 38400 -}; - -#define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0])) - -static void encode_terminal_status(dst) - value * dst; -{ - long * pc; - int i; - - for(pc = terminal_io_descr; *pc != End; dst++) { - switch(*pc++) { - case Bool: - { int * src = (int *) (*pc++); - int msk = *pc++; - *dst = Val_bool(*src & msk); - break; } - case Enum: - { int * src = (int *) (*pc++); - int ofs = *pc++; - int num = *pc++; - int msk = *pc++; - for (i = 0; i < num; i++) { - if ((*src & msk) == pc[i]) { - *dst = Val_int(i + ofs); - break; - } - } - pc += num; - break; } - case Speed: - { int which = *pc++; - speed_t speed; - switch (which) { - case Output: - speed = cfgetospeed(&terminal_status); break; - case Input: - speed = cfgetispeed(&terminal_status); break; - } - for (i = 0; i < NSPEEDS; i++) { - if (speed == speedtable[i].speed) { - *dst = Val_int(speedtable[i].baud); - break; - } - } - break; } - case Char: - { unsigned char * src = (unsigned char *) (*pc++); - *dst = Val_int(*src); - break; } - } - } -} - -static void decode_terminal_status(src) - value * src; -{ - long * pc; - int i; - - for (pc = terminal_io_descr; *pc != End; src++) { - switch(*pc++) { - case Bool: - { int * dst = (int *) (*pc++); - int msk = *pc++; - if (Tag_val(*src) != 0) - *dst |= msk; - else - *dst &= ~msk; - break; } - case Enum: - { int * dst = (int *) (*pc++); - int ofs = *pc++; - int num = *pc++; - int msk = *pc++; - i = Int_val(*src) - ofs; - if (i >= 0 && i < num) { - *dst = (*dst & ~msk) | pc[i]; - } else { - unix_error(EINVAL, "tcsetattr", Nothing); - } - pc += num; - break; } - case Speed: - { int which = *pc++; - int baud = Int_val(*src); - int res; - for (i = 0; i < NSPEEDS; i++) { - if (baud == speedtable[i].baud) { - switch (which) { - case Output: - res = cfsetospeed(&terminal_status, speedtable[i].speed); break; - case Input: - res = cfsetispeed(&terminal_status, speedtable[i].speed); break; - } - if (res == -1) uerror("tcsetattr", Nothing); - goto ok; - } - } - unix_error(EINVAL, "tcsetattr", Nothing); - ok: - break; } - case Char: - { unsigned char * dst = (unsigned char *) (*pc++); - *dst = Int_val(*src); - break; } - } - } -} - -value unix_tcgetattr(fd) - value fd; -{ - value res; - - if (tcgetattr(Int_val(fd), &terminal_status) == -1) - uerror("tcgetattr", Nothing); - res = alloc_tuple(NFIELDS); - encode_terminal_status(&Field(res, 0)); - return res; -} - -static int when_flag_table[] = { - TCSANOW, TCSADRAIN, TCSAFLUSH -}; - -value unix_tcsetattr(fd, when, arg) - value fd, when, arg; -{ - if (tcgetattr(Int_val(fd), &terminal_status) == -1) - uerror("tcsetattr", Nothing); - decode_terminal_status(&Field(arg, 0)); - if (tcsetattr(Int_val(fd), - when_flag_table[Tag_val(when)], - &terminal_status) == -1) - uerror("tcsetattr", Nothing); - return Val_unit; -} - -value unix_tcsendbreak(fd, delay) - value fd, delay; -{ - if (tcsendbreak(Int_val(fd), Int_val(delay)) == -1) - uerror("tcsendbreak", Nothing); - return Val_unit; -} - -value unix_tcdrain(fd) - value fd; -{ - if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing); - return Val_unit; -} - -static int queue_flag_table[] = { - TCIFLUSH, TCOFLUSH, TCIOFLUSH -}; - -value unix_tcflush(fd, queue) - value fd, queue; -{ - if (tcflush(Int_val(fd), queue_flag_table[Tag_val(queue)]) == -1) - uerror("tcflush", Nothing); - return Val_unit; -} - -static int action_flag_table[] = { - TCOOFF, TCOON, TCIOFF, TCION -}; - -value unix_tcflow(fd, action) - value fd, action; -{ - if (tcflow(Int_val(fd), action_flag_table[Tag_val(action)]) == -1) - uerror("tcflow", Nothing); - return Val_unit; -} - -#else - -value unix_tcgetattr() { invalid_argument("tcgetattr not implemented"); } -value unix_tcsetattr() { invalid_argument("tcsetattr not implemented"); } -value unix_tcsendbreak() { invalid_argument("tcsendbreak not implemented"); } -value unix_tcdrain() { invalid_argument("tcdrain not implemented"); } -value unix_tcflush() { invalid_argument("tcflush not implemented"); } -value unix_tcflow() { invalid_argument("tcflow not implemented"); } - -#endif - diff --git a/otherlibs/unix/time.c b/otherlibs/unix/time.c deleted file mode 100644 index 5cf811b472..0000000000 --- a/otherlibs/unix/time.c +++ /dev/null @@ -1,9 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -extern long time(); - -value unix_time() /* ML */ -{ - return Val_long(time((long *) NULL)); -} diff --git a/otherlibs/unix/times.c b/otherlibs/unix/times.c deleted file mode 100644 index a64ec327c2..0000000000 --- a/otherlibs/unix/times.c +++ /dev/null @@ -1,29 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include <memory.h> -#include "unix.h" -#include <sys/types.h> -#include <sys/times.h> - -value unix_times() /* ML */ -{ - value res; - struct tms buffer; - int i; - Push_roots(t,4); - -#ifndef HZ -#define HZ 60 -#endif - - times(&buffer); - t[0] = copy_double((double) buffer.tms_utime / HZ); - t[1] = copy_double((double) buffer.tms_stime / HZ); - t[2] = copy_double((double) buffer.tms_cutime / HZ); - t[3] = copy_double((double) buffer.tms_cstime / HZ); - res = alloc_tuple(4); - for (i = 0; i < 4; i++) - Field(res, i) = t[i]; - Pop_roots(); - return res; -} diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c deleted file mode 100644 index 1226df122d..0000000000 --- a/otherlibs/unix/truncate.c +++ /dev/null @@ -1,18 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -#ifdef HAS_TRUNCATE - -value unix_truncate(path, len) /* ML */ - value path, len; -{ - if (truncate(String_val(path), Long_val(len)) == -1) - uerror("truncate", path); - return Val_unit; -} - -#else - -value unix_truncate() { invalid_argument("truncate not implemented"); } - -#endif diff --git a/otherlibs/unix/umask.c b/otherlibs/unix/umask.c deleted file mode 100644 index e5581fb2b8..0000000000 --- a/otherlibs/unix/umask.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_umask(perm) /* ML */ - value perm; -{ - return Val_int(umask(Int_val(perm))); -} diff --git a/otherlibs/unix/unix.c b/otherlibs/unix/unix.c deleted file mode 100644 index 848b650e58..0000000000 --- a/otherlibs/unix/unix.c +++ /dev/null @@ -1,287 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include <memory.h> -#include <fail.h> -#include "unix.h" -#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) -#endif -#ifndef EBADF -#define EBADF (-1) -#endif -#ifndef ECHILD -#define ECHILD (-1) -#endif -#ifndef EAGAIN -#define EAGAIN (-1) -#endif -#ifndef ENOMEM -#define ENOMEM (-1) -#endif -#ifndef EACCES -#define EACCES (-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) -#endif -#ifndef EXDEV -#define EXDEV (-1) -#endif -#ifndef ENODEV -#define ENODEV (-1) -#endif -#ifndef ENOTDIR -#define ENOTDIR (-1) -#endif -#ifndef EISDIR -#define EISDIR (-1) -#endif -#ifndef EINVAL -#define EINVAL (-1) -#endif -#ifndef ENFILE -#define ENFILE (-1) -#endif -#ifndef EMFILE -#define EMFILE (-1) -#endif -#ifndef ENOTTY -#define ENOTTY (-1) -#endif -#ifndef ETXTBSY -#define ETXTBSY (-1) -#endif -#ifndef EFBIG -#define EFBIG (-1) -#endif -#ifndef ENOSPC -#define ENOSPC (-1) -#endif -#ifndef ESPIPE -#define ESPIPE (-1) -#endif -#ifndef EROFS -#define EROFS (-1) -#endif -#ifndef EMLINK -#define EMLINK (-1) -#endif -#ifndef EPIPE -#define EPIPE (-1) -#endif -#ifndef EDOM -#define EDOM (-1) -#endif -#ifndef ERANGE -#define ERANGE (-1) -#endif -#ifndef EWOULDBLOCK -#define EWOULDBLOCK (-1) -#endif -#ifndef EINPROGRESS -#define EINPROGRESS (-1) -#endif -#ifndef EALREADY -#define EALREADY (-1) -#endif -#ifndef ENOTSOCK -#define ENOTSOCK (-1) -#endif -#ifndef EDESTADDRREQ -#define EDESTADDRREQ (-1) -#endif -#ifndef EMSGSIZE -#define EMSGSIZE (-1) -#endif -#ifndef EPROTOTYPE -#define EPROTOTYPE (-1) -#endif -#ifndef ENOPROTOOPT -#define ENOPROTOOPT (-1) -#endif -#ifndef EPROTONOSUPPORT -#define EPROTONOSUPPORT (-1) -#endif -#ifndef ESOCKTNOSUPPORT -#define ESOCKTNOSUPPORT (-1) -#endif -#ifndef EOPNOTSUPP -#define EOPNOTSUPP (-1) -#endif -#ifndef EPFNOSUPPORT -#define EPFNOSUPPORT (-1) -#endif -#ifndef EAFNOSUPPORT -#define EAFNOSUPPORT (-1) -#endif -#ifndef EADDRINUSE -#define EADDRINUSE (-1) -#endif -#ifndef EADDRNOTAVAIL -#define EADDRNOTAVAIL (-1) -#endif -#ifndef ENETDOWN -#define ENETDOWN (-1) -#endif -#ifndef ENETUNREACH -#define ENETUNREACH (-1) -#endif -#ifndef ENETRESET -#define ENETRESET (-1) -#endif -#ifndef ECONNABORTED -#define ECONNABORTED (-1) -#endif -#ifndef ECONNRESET -#define ECONNRESET (-1) -#endif -#ifndef ENOBUFS -#define ENOBUFS (-1) -#endif -#ifndef EISCONN -#define EISCONN (-1) -#endif -#ifndef ENOTCONN -#define ENOTCONN (-1) -#endif -#ifndef ESHUTDOWN -#define ESHUTDOWN (-1) -#endif -#ifndef ETOOMANYREFS -#define ETOOMANYREFS (-1) -#endif -#ifndef ETIMEDOUT -#define ETIMEDOUT (-1) -#endif -#ifndef ECONNREFUSED -#define ECONNREFUSED (-1) -#endif -#ifndef ELOOP -#define ELOOP (-1) -#endif -#ifndef ENAMETOOLONG -#define ENAMETOOLONG (-1) -#endif -#ifndef EHOSTDOWN -#define EHOSTDOWN (-1) -#endif -#ifndef EHOSTUNREACH -#define EHOSTUNREACH (-1) -#endif -#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) -#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 */ -}; - -static value unix_error_exn; - -value unix_register_error(exnval) - value exnval; -{ - unix_error_exn = Field(exnval, 0); - register_global_root(&unix_error_exn); - return Val_unit; -} - -void unix_error(errcode, cmdname, cmdarg) - int errcode; - char * cmdname; - value cmdarg; -{ - value res; - Push_roots(r, 2); -#define name r[0] -#define arg r[1] - arg = cmdarg == Nothing ? copy_string("") : cmdarg; - name = copy_string(cmdname); - res = alloc(4, 0); - Field(res, 0) = unix_error_exn; - Field(res, 1) = - cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), - sizeof(error_table)/sizeof(int)); - Field(res, 2) = name; - Field(res, 3) = arg; - Pop_roots(); - mlraise(res); -} - -void uerror(cmdname, cmdarg) - char * cmdname; - value cmdarg; -{ - unix_error(errno, cmdname, cmdarg); -} diff --git a/otherlibs/unix/unix.h b/otherlibs/unix/unix.h deleted file mode 100644 index e63b04a7fe..0000000000 --- a/otherlibs/unix/unix.h +++ /dev/null @@ -1,18 +0,0 @@ -#define Nothing ((value) 0) - -#ifndef NULL -#ifdef ANSI -#define NULL ((void *) 0) -#else -#define NULL ((char *) 0) -#endif -#endif - -#ifdef ANSI -extern void unix_error(int errcode, char * cmdname, value arg); -extern void uerror(char * cmdname, value arg); -#else -void unix_error(); -void uerror(); -#endif - diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml deleted file mode 100644 index 729105ca18..0000000000 --- a/otherlibs/unix/unix.ml +++ /dev/null @@ -1,536 +0,0 @@ -type error = - ENOERR - | 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 - | EUNKNOWNERR - -exception Unix_error of error * string * string - -external register_unix_error: exn -> unit = "unix_register_error" - -let _ = register_unix_error(Unix_error(EUNKNOWNERR, "", "")) - -external error_message : error -> string = "unix_error_message" - -let handle_unix_error f arg = - try - f arg - with Unix_error(err, fun_name, arg) -> - prerr_string Sys.argv.(0); - prerr_string ": \""; - prerr_string fun_name; - prerr_string "\" failed"; - if String.length arg > 0 then begin - prerr_string " on \""; - prerr_string arg; - prerr_string "\"" - end; - prerr_string ": "; - prerr_endline (error_message err); - exit 2 - -external environment : unit -> string array = "unix_environment" - -type process_status = - WEXITED of int - | WSIGNALED of int * bool - | WSTOPPED of int - -type wait_flag = - WNOHANG - | WUNTRACED - -external execv : string -> string array -> unit = "unix_execv" -external execve : string -> string array -> string array -> unit = "unix_execve" -external execvp : string -> string array -> unit = "unix_execvp" -external fork : unit -> int = "unix_fork" -external wait : unit -> int * process_status = "unix_wait" -external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid" -external getpid : unit -> int = "unix_getpid" -external getppid : unit -> int = "unix_getppid" -external nice : int -> int = "unix_nice" - -type file_descr = int - -let stdin = 0 -let stdout = 1 -let stderr = 2 - -type open_flag = - O_RDONLY - | O_WRONLY - | O_RDWR - | O_NDELAY - | O_APPEND - | O_CREAT - | O_TRUNC - | O_EXCL - -type file_perm = int - - -external openfile : string -> open_flag list -> file_perm -> file_descr - = "unix_open" -external close : file_descr -> unit = "unix_close" -external read : file_descr -> string -> int -> int -> int = "unix_read" -external write : file_descr -> string -> int -> int -> int = "unix_write" -external in_channel_of_descr : file_descr -> in_channel = "open_descriptor" -external out_channel_of_descr : file_descr -> out_channel = "open_descriptor" -external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor" -external descr_of_out_channel : out_channel -> file_descr = "channel_descriptor" - -type seek_command = - SEEK_SET - | SEEK_CUR - | SEEK_END - -external lseek : file_descr -> int -> seek_command -> int = "unix_lseek" -external truncate : string -> int -> unit = "unix_truncate" -external ftruncate : file_descr -> int -> unit = "unix_ftruncate" - -type file_kind = - S_REG - | S_DIR - | S_CHR - | S_BLK - | S_LNK - | S_FIFO - | S_SOCK - -type stats = - { st_dev : int; - st_ino : int; - st_kind : file_kind; - st_perm : file_perm; - st_nlink : int; - st_uid : int; - st_gid : int; - st_rdev : int; - st_size : int; - st_atime : int; - st_mtime : int; - st_ctime : int } - -external stat : string -> stats = "unix_stat" -external lstat : string -> stats = "unix_lstat" -external fstat : file_descr -> stats = "unix_fstat" -external unlink : string -> unit = "unix_unlink" -external rename : string -> string -> unit = "unix_rename" -external link : string -> string -> unit = "unix_link" - -type access_permission = - R_OK - | W_OK - | X_OK - | F_OK - -external chmod : string -> file_perm -> unit = "unix_chmod" -external fchmod : file_descr -> file_perm -> unit = "unix_fchmod" -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 mkdir : string -> file_perm -> unit = "unix_mkdir" -external rmdir : string -> unit = "unix_rmdir" -external chdir : string -> unit = "unix_chdir" -external getcwd : unit -> string = "unix_getcwd" - -type dir_handle - -external opendir : string -> dir_handle = "unix_opendir" -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" -external ioctl_int : file_descr -> int -> int -> int = "unix_ioctl_int" -external ioctl_ptr : file_descr -> int -> string -> int = "unix_ioctl_ptr" -external select : - file_descr list -> file_descr list -> file_descr list -> float -> - file_descr list * file_descr list * file_descr list = "unix_select" - -type lock_command = - F_ULOCK - | F_LOCK - | F_TLOCK - | F_TEST - -external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf" -external kill : int -> int -> unit = "unix_kill" -external pause : unit -> unit = "unix_pause" - -type process_times = - { tms_utime : float; - tms_stime : float; - tms_cutime : float; - tms_cstime : float } - -type tm = - { tm_sec : int; - tm_min : int; - tm_hour : int; - tm_mday : int; - tm_mon : int; - tm_year : int; - tm_wday : int; - tm_yday : int; - tm_isdst : bool } - -external time : unit -> int = "unix_time" -external gmtime : int -> tm = "unix_gmtime" -external localtime : int -> tm = "unix_localtime" -external alarm : int -> int = "unix_alarm" -external sleep : int -> unit = "unix_sleep" -external times : unit -> process_times = "unix_times" -external utimes : string -> int -> int -> unit = "unix_utimes" -external getuid : unit -> int = "unix_getuid" -external geteuid : unit -> int = "unix_geteuid" -external setuid : int -> unit = "unix_setuid" -external getgid : unit -> int = "unix_getgid" -external getegid : unit -> int = "unix_getegid" -external setgid : int -> unit = "unix_setgid" -external getgroups : unit -> int array = "unix_getgroups" - -type passwd_entry = - { pw_name : string; - pw_passwd : string; - pw_uid : int; - pw_gid : int; - pw_gecos : string; - pw_dir : string; - pw_shell : string } - -type group_entry = - { gr_name : string; - gr_passwd : string; - gr_gid : int; - gr_mem : string array } - - -external getlogin : unit -> string = "unix_getlogin" -external getpwnam : string -> passwd_entry = "unix_getpwnam" -external getgrnam : string -> group_entry = "unix_getgrnam" -external getpwuid : int -> passwd_entry = "unix_getpwuid" -external getgrgid : int -> group_entry = "unix_getgrgid" - -type inet_addr - -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" -type socket_domain = - PF_UNIX - | PF_INET - -type socket_type = - SOCK_STREAM - | SOCK_DGRAM - | SOCK_RAW - | SOCK_SEQPACKET - -type sockaddr = - ADDR_UNIX of string - | ADDR_INET of inet_addr * int - -type shutdown_command = - SHUTDOWN_RECEIVE - | SHUTDOWN_SEND - | SHUTDOWN_ALL - -type msg_flag = - MSG_OOB - | MSG_DONTROUTE - | MSG_PEEK - -external socket : socket_domain -> socket_type -> int -> file_descr - = "unix_socket" -external socketpair : - socket_domain -> socket_type -> int -> file_descr * file_descr - = "unix_socketpair" -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" -external listen : file_descr -> int -> unit = "unix_listen" -external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown" -external recv : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_recv" -external recvfrom : - file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr - = "unix_recvfrom" -external send : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_send" -external sendto : - file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int - = "unix_sendto" - -type host_entry = - { h_name : string; - h_aliases : string array; - h_addrtype : socket_domain; - h_addr_list : inet_addr array } - -type protocol_entry = - { p_name : string; - p_aliases : string array; - p_proto : int } - -type service_entry = - { s_name : string; - s_aliases : string array; - s_port : int; - s_proto : string } - -external gethostname : unit -> string = "unix_gethostname" -external gethostbyname : string -> host_entry = "unix_gethostbyname" -external gethostbyaddr : inet_addr -> host_entry = "unix_gethostbyaddr" -external getprotobyname : string -> protocol_entry - = "unix_getprotobyname" -external getprotobynumber : int -> protocol_entry - = "unix_getprotobynumber" -external getservbyname : string -> string -> service_entry - = "unix_getservbyname" -external getservbyport : int -> string -> service_entry - = "unix_getservbyport" -type terminal_io = { - mutable c_ignbrk: bool; - mutable c_brkint: bool; - mutable c_ignpar: bool; - mutable c_parmrk: bool; - mutable c_inpck: bool; - mutable c_istrip: bool; - mutable c_inlcr: bool; - mutable c_igncr: bool; - mutable c_icrnl: bool; - mutable c_ixon: bool; - mutable c_ixoff: bool; - mutable c_opost: bool; - mutable c_olcuc: bool; - mutable c_onlcr: bool; - mutable c_ocrnl: bool; - mutable c_onocr: bool; - mutable c_onlret: bool; - mutable c_ofill: bool; - mutable c_ofdel: bool; - mutable c_nldly: int; - mutable c_crdly: int; - mutable c_tabdly: int; - mutable c_bsdly: int; - mutable c_vtdly: int; - mutable c_ffdly: int; - mutable c_obaud: int; - mutable c_ibaud: int; - mutable c_csize: int; - mutable c_cstopb: int; - mutable c_cread: bool; - mutable c_parenb: bool; - mutable c_parodd: bool; - mutable c_hupcl: bool; - mutable c_clocal: bool; - mutable c_isig: bool; - mutable c_icanon: bool; - mutable c_noflsh: bool; - mutable c_echo: bool; - mutable c_echoe: bool; - mutable c_echok: bool; - mutable c_echonl: bool; - mutable c_vintr: char; - mutable c_vquit: char; - mutable c_verase: char; - mutable c_vkill: char; - mutable c_veof: char; - mutable c_veol: char; - mutable c_vmin: int; - mutable c_vtime: int; - mutable c_vstart: char; - mutable c_vstop: char - } - -external tcgetattr: file_descr -> terminal_io = "unix_tcgetattr" - -type setattr_when = TCSANOW | TCSADRAIN | TCSAFLUSH - -external tcsetattr: file_descr -> setattr_when -> terminal_io -> unit - = "unix_tcsetattr" -external tcsendbreak: file_descr -> int -> unit = "unix_tcsendbreak" -external tcdrain: file_descr -> unit = "unix_tcdrain" - -type flush_queue = TCIFLUSH | TCOFLUSH | TCIOFLUSH - -external tcflush: file_descr -> flush_queue -> unit = "unix_tcflush" - -type flow_action = TCOOFF | TCOON | TCIOFF | TCION - -external tcflow: file_descr -> flow_action -> unit = "unix_tcflow" - -(* High-level process management (system, popen) *) - -let system cmd = - match fork() with - 0 -> execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127 - | id -> snd(waitpid [] id) - -type popen_process = - Process of in_channel * out_channel - | Process_in of in_channel - | Process_out of out_channel - -let popen_processes = (Hashtbl.new 7 : (popen_process, int) Hashtbl.t) - -let open_proc cmd proc input output = - 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; - execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; - exit 127 - | id -> Hashtbl.add popen_processes proc id - -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; 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; outchan - -let open_process cmd = - let (in_read, in_write) = pipe() in - 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) - -let close_proc fun_name proc = - try - let (_, status) = waitpid [] (Hashtbl.find popen_processes proc) in - Hashtbl.remove popen_processes proc; - status - 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 close_process_out outchan = - close_out outchan; - close_proc "close_process_out" (Process_out outchan) - -let close_process (inchan, outchan) = - close_in inchan; close_out outchan; - close_proc "close_process" (Process(inchan, outchan)) - -(* High-level network functions *) - -let open_connection sockaddr = - let domain = - match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in - let sock = - socket domain SOCK_STREAM 0 in - connect sock sockaddr; - (in_channel_of_descr sock, out_channel_of_descr sock) - -let shutdown_connection inchan = - shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND - -let establish_server server_fun sockaddr = - let domain = - match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in - let sock = - socket domain SOCK_STREAM 0 in - bind sock sockaddr; - listen sock 3; - while true do - let (s, caller) = accept sock in - (* 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 *) - let inchan = in_channel_of_descr s in - let outchan = out_channel_of_descr s in - server_fun inchan outchan; - close_in inchan; - close_out outchan - | id -> close s; waitpid [] id (* Reclaim the son *); () - done diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli deleted file mode 100644 index a102e5330c..0000000000 --- a/otherlibs/unix/unix.mli +++ /dev/null @@ -1,831 +0,0 @@ -(* Interface to the Unix system *) - -(*** 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 *) - | 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 *) - | EFBIG (* File too large *) - | ENOSPC (* No space left on device *) - | ESPIPE (* Illegal seek *) - | EROFS (* Read-only file system *) - | EMLINK (* Too many links *) - | EPIPE (* Broken pipe *) - | EDOM (* Argument too large *) - | ERANGE (* Result too large *) - | EWOULDBLOCK (* Operation would block *) - | EINPROGRESS (* Operation now in progress *) - | EALREADY (* Operation already in progress *) - | ENOTSOCK (* Socket operation on non-socket *) - | EDESTADDRREQ (* Destination address required *) - | EMSGSIZE (* Message too long *) - | EPROTOTYPE (* Protocol wrong type for socket *) - | ENOPROTOOPT (* Protocol not available *) - | EPROTONOSUPPORT (* Protocol not supported *) - | ESOCKTNOSUPPORT (* Socket type not supported *) - | EOPNOTSUPP (* Operation not supported on socket *) - | EPFNOSUPPORT (* Protocol family not supported *) - | EAFNOSUPPORT (* Address family not supported by protocol family *) - | EADDRINUSE (* Address already in use *) - | EADDRNOTAVAIL (* Can't assign requested address *) - | ENETDOWN (* Network is down *) - | ENETUNREACH (* Network is unreachable *) - | ENETRESET (* Network dropped connection on reset *) - | ECONNABORTED (* Software caused connection abort *) - | ECONNRESET (* Connection reset by peer *) - | ENOBUFS (* No buffer space available *) - | EISCONN (* Socket is already connected *) - | ENOTCONN (* Socket is not connected *) - | ESHUTDOWN (* Can't send after socket shutdown *) - | 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 - - (* The type of error codes. *) - -exception Unix_error of error * string * string - (* Raised by the system calls below when an error is encountered. - The first component is the error code; the second component - is the function name; the third component is the string parameter - to the function, if it has one, or the empty string otherwise. *) - -external error_message : error -> string = "unix_error_message" - (* Return a string describing the given error code. *) - -val handle_unix_error : ('a -> 'b) -> 'a -> 'b - (* [handle_unix_error f x] applies [f] to [x] and returns the result. - If the exception [Unix_error] is raised, it prints a message - describing the error and exits with code 2. *) - - -(*** Interface with the parent process *) - -external environment : unit -> string array = "unix_environment" - (* Return the process environment, as an array of strings - with the format ``variable=value''. See also [sys__getenv]. *) - -(*** Process handling *) - -type process_status = - WEXITED of int - | WSIGNALED of int * bool - | 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 - that the process was stopped by a signal; the argument is the - signal number. *) - -type wait_flag = - WNOHANG - | WUNTRACED - - (* Flags for [waitopt] and [waitpid]. - [WNOHANG] means do not block if no child has - died yet, but immediately return with a pid equal to 0. - [WUNTRACED] means report also the children that receive stop - signals. *) - -external execv : string -> string array -> unit = "unix_execv" - (* [execv prog args] execute the program in file [prog], with - the arguments [args], and the current process environment. *) -external execve : string -> string array -> string array -> unit = "unix_execve" - (* Same as [execv], except that the third argument provides the - environment to the program executed. *) -external execvp : string -> string array -> unit = "unix_execvp" - (* Same as [execv], except that the program is searched in the path. *) -external fork : unit -> int = "unix_fork" - (* Fork a new process. The returned integer is 0 for the child - process, the pid of the child process for the parent process. *) -external wait : unit -> int * process_status = "unix_wait" - (* Wait until one of the children processes die, and return its pid - and termination status. *) -external waitpid : wait_flag list -> int -> int * process_status - = "unix_waitpid" - (* Same as [waitopt], but waits for the process whose pid is given. - Negative pid arguments represent process groups. *) -val system : string -> process_status - (* Execute the given command, wait until it terminates, and return - its termination status. The string is interpreted by the shell - [/bin/sh] and therefore can contain redirections, quotes, variables, - etc. The result [WEXITED 127] indicates that the shell couldn't - be executed. *) -external getpid : unit -> int = "unix_getpid" - (* Return the pid of the process. *) -external getppid : unit -> int = "unix_getppid" - (* Return the pid of the parent process. *) -external nice : int -> int = "unix_nice" - (* Change the process priority. The integer argument is added to the - ``nice'' value. (Higher values of the ``nice'' value mean - lower priorities.) Return the new nice value. *) - - -(*** Basic file input/output *) - -type file_descr - (* The abstract type of file descriptors. *) - -val stdin : file_descr -val stdout : file_descr -val stderr : file_descr - (* File descriptors for standard input, standard output and - standard error. *) - - -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_APPEND (* Open for append *) - | O_CREAT (* Create if nonexistent *) - | O_TRUNC (* Truncate to 0 length if existing *) - | O_EXCL (* Fail if existing *) - - (* The flags to [open]. *) - -type file_perm = int - (* The type of file access rights. *) - -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. *) -external close : file_descr -> unit = "unix_close" - (* Close a file descriptor. *) -external read : file_descr -> string -> int -> int -> int = "unix_read" - (* [read fd buff start len] reads [len] characters from descriptor - [fd], storing them in string [buff], starting at position [ofs] - in string [buff]. Return the number of characters actually read. *) -external write : file_descr -> string -> int -> int -> int = "unix_write" - (* [write fd buff start len] writes [len] characters to descriptor - [fd], taking them from string [buff], starting at position [ofs] - in string [buff]. Return the number of characters actually - written. *) - - -(*** Interfacing with the standard input/output library (module io). *) - -external in_channel_of_descr : file_descr -> in_channel = "open_descriptor" - (* Create an input channel reading from the given descriptor. *) -external out_channel_of_descr : file_descr -> out_channel = "open_descriptor" - (* Create an output channel writing on the given descriptor. *) -external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor" - (* Return the descriptor corresponding to an input channel. *) -external descr_of_out_channel : out_channel -> file_descr = "channel_descriptor" - (* Return the descriptor corresponding to an output channel. *) - - -(*** Seeking and truncating *) - -type seek_command = - SEEK_SET - | SEEK_CUR - | SEEK_END - - (* Positioning modes for [lseek]. [SEEK_SET] indicates positions - relative to the beginning of the file, [SEEK_CUR] relative to - the current position, [SEEK_END] relative to the end of the - file. *) - -external lseek : file_descr -> int -> seek_command -> int = "unix_lseek" - (* Set the current position for a file descriptor *) -external truncate : string -> int -> unit = "unix_truncate" - (* Truncates the named file to the given size. *) -external ftruncate : file_descr -> int -> unit = "unix_ftruncate" - (* Truncates the file corresponding to the given descriptor - to the given size. *) - - -(*** File statistics *) - -type file_kind = - S_REG (* Regular file *) - | S_DIR (* Directory *) - | S_CHR (* Character device *) - | S_BLK (* Block device *) - | S_LNK (* Symbolic link *) - | S_FIFO (* Named pipe *) - | S_SOCK (* Socket *) - -type stats = - { st_dev : int; (* Device number *) - st_ino : int; (* Inode number *) - st_kind : file_kind; (* Kind of the file *) - st_perm : file_perm; (* Access rights *) - st_nlink : int; (* Number of links *) - st_uid : int; (* User id of the owner *) - st_gid : int; (* Group id of the owner *) - st_rdev : int; (* Device minor number *) - st_size : int; (* Size in bytes *) - st_atime : int; (* Last access time *) - st_mtime : int; (* Last modification time *) - st_ctime : int } (* Last status change time *) - - (* The informations returned by the [stat] calls. *) - -external stat : string -> stats = "unix_stat" - (* Return the information for the named file. *) -external lstat : string -> stats = "unix_lstat" - (* Same as [stat], but in case the file is a symbolic link, - return the information for the link itself. *) -external fstat : file_descr -> stats = "unix_fstat" - (* Return the information for the file associated with the given - descriptor. *) - - -(*** Operations on file names *) - -external unlink : string -> unit = "unix_unlink" - (* Removes the named file *) -external rename : string -> string -> unit = "unix_rename" - (* [rename old new] changes the name of a file from [old] to [new]. *) -external link : string -> string -> unit = "unix_link" - (* [link source dest] creates a hard link named [dest] to the file - named [new]. *) - - -(*** File permissions and ownership *) - -type access_permission = - R_OK (* Read permission *) - | W_OK (* Write permission *) - | X_OK (* Execution permission *) - | F_OK (* File exists *) - - (* Flags for the [access] call. *) - -external chmod : string -> file_perm -> unit = "unix_chmod" - (* Change the permissions of the named file. *) -external fchmod : file_descr -> file_perm -> unit = "unix_fchmod" - (* Change the permissions of an opened file. *) -external chown : string -> int -> int -> unit = "unix_chown" - (* Change the owner uid and owner gid of the named file. *) -external fchown : file_descr -> int -> int -> unit = "unix_fchown" - (* Change the owner uid and owner gid of an opened file. *) -external umask : int -> int = "unix_umask" - (* Set the process creation mask, and return the previous mask. *) -external access : string -> access_permission list -> unit = "unix_access" - (* Check that the process has the given permissions over the named - file. Raise [Unix_error] otherwise. *) - - -(*** File descriptor hacking *) - -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. The string argument - is usually set up with the functions from modules [peek] and - [poke]. *) - - -(*** Directories *) - -external mkdir : string -> file_perm -> unit = "unix_mkdir" - (* Create a directory with the given permissions. *) -external rmdir : string -> unit = "unix_rmdir" - (* Remove an empty directory. *) -external chdir : string -> unit = "unix_chdir" - (* Change the process working directory. *) -external getcwd : unit -> string = "unix_getcwd" - (* Return the name of the current working directory. *) - - -type dir_handle - - (* The type of descriptors over opened directories. *) - -external opendir : string -> dir_handle = "unix_opendir" - (* Open a descriptor on a directory *) -external readdir : dir_handle -> string = "unix_readdir" - (* Return the next entry in a directory. - Raise [End_of_file] when the end of the directory has been - reached. *) -external rewinddir : dir_handle -> unit = "unix_rewinddir" - (* Reposition the descriptor to the beginning of the directory *) -external closedir : dir_handle -> unit = "unix_closedir" - (* Close a directory descriptor. *) - - -(*** Pipes and redirections *) - -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 -val open_process: string -> in_channel * out_channel - (* High-level pipe and process management. These functions - run the given command in parallel with the program, - and return channels connected to the standard input and/or - the standard output of the command. The command is interpreted - by the shell [/bin/sh] (cf. [system]). Warning: writes on channels - are buffered, hence be careful to call [flush] at the right times - to ensure correct synchronization. *) -val close_process_in: in_channel -> process_status -val close_process_out: out_channel -> process_status -val close_process: in_channel * out_channel -> process_status - (* Close channels opened by [open_process_in], [open_process_out] - and [open_process], respectively, wait for the associated - command to terminate, and return its termination status. *) - - -(*** Symbolic links *) - -external symlink : string -> string -> unit = "unix_symlink" - (* [symlink source dest] creates the file [dest] as a symbolic link - to the file [source]. *) -external readlink : string -> string = "unix_readlink" - (* Read the contents of a link. *) - - -(*** Named pipes *) - -external mkfifo : string -> file_perm -> unit = "unix_mkfifo" - (* Create a named pipe with the given permissions. *) - - -(*** Special files *) - -external ioctl_int : file_descr -> int -> int -> int = "unix_ioctl_int" - (* Interface to [ioctl] in the case where the argument is an - integer. The first integer argument is the command code; - the second is the integer parameter. *) -external ioctl_ptr : file_descr -> int -> string -> int = "unix_ioctl_ptr" - (* Interface to [ioctl] 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. The string argument - is usually set up with the functions from modules [peek] and - [poke]. *) - - -(*** Polling *) - -external select : - file_descr list -> file_descr list -> file_descr list -> float -> - file_descr list * file_descr list * file_descr list = "unix_select" - - (* Wait until some input/output operations become possible on - some channels. The three list arguments are, respectively, a set - of descriptors to check for reading (first argument), for writing - (second argument), or for exceptional conditions (third argument). - The fourth argument is the maximal timeout, in seconds; a - negative fourth argument means no timeout (unbounded wait). - The result is composed of three sets of descriptors: those ready - for reading (first component), ready for writing (second component), - and over which an exceptional condition is pending (third - component). *) - -(*** Locking *) - -type lock_command = - F_ULOCK (* Unlock a region *) - | F_LOCK (* Lock a region, and block if already locked *) - | F_TLOCK (* Lock a region, or fail if already locked *) - | F_TEST (* Test a region for other process' locks *) - - (* Commands for [lockf]. *) - -external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf" - - (* [lockf fd cmd size] puts a lock on a region of the file opened - as [fd]. The region starts at the current read/write position for - [fd] (as set by [lseek]), and extends [size] bytes forward if - [size] is positive, [size] bytes backwards if [size] is negative, - or to the end of the file if [size] is zero. *) - -(*** Signals *) - -external kill : int -> int -> unit = "unix_kill" - (* [kill pid sig] sends signal number [sig] to the process - with id [pid]. *) -external pause : unit -> unit = "unix_pause" - (* Wait until a non-ignored signal is delivered. *) - - -(*** Time functions *) - -type process_times = - { tms_utime : float; (* User time for the process *) - tms_stime : float; (* System time for the process *) - tms_cutime : float; (* User time for the children processes *) - tms_cstime : float } (* System time for the children processes *) - - (* The execution times (CPU times) of a process. *) - -type tm = - { tm_sec : int; (* Seconds 0..59 *) - tm_min : int; (* Minutes 0..59 *) - tm_hour : int; (* Hours 0..23 *) - tm_mday : int; (* Day of month 1..31 *) - tm_mon : int; (* Month of year 0..11 *) - tm_year : int; (* Year - 1900 *) - tm_wday : int; (* Day of week (Sunday is 0) *) - tm_yday : int; (* Day of year 0..365 *) - tm_isdst : bool } (* Daylight time savings in effect *) - - (* The type representing wallclock time and calendar date. *) - -external time : unit -> int = "unix_time" - (* Return the current time since 00:00:00 GMT, Jan. 1, 1970, - in seconds. *) -external gmtime : int -> tm = "unix_gmtime" - (* Convert a time in seconds, as returned by [time], into a date and - a time. Assumes Greenwich meridian time zone. *) -external localtime : int -> tm = "unix_localtime" - (* Convert a time in seconds, as returned by [time], into a date and - a time. Assumes the local time zone. *) -external alarm : int -> int = "unix_alarm" - (* Schedule a [SIGALRM] signals after the given number of seconds. *) -external sleep : int -> unit = "unix_sleep" - (* Stop execution for the given number of seconds. *) -external times : unit -> process_times = "unix_times" - (* Return the execution times of the process. *) -external utimes : string -> int -> int -> unit = "unix_utimes" - (* Set the last access time (second arg) and last modification time - (third arg) for a file. Times are expressed in seconds from - 00:00:00 GMT, Jan. 1, 1970. *) - - -(*** User id, group id *) - -external getuid : unit -> int = "unix_getuid" - (* Return the user id of the user executing the process. *) -external geteuid : unit -> int = "unix_geteuid" - (* Return the effective user id under which the process runs. *) -external setuid : int -> unit = "unix_setuid" - (* Set the real user id and effective user id for the process. *) -external getgid : unit -> int = "unix_getgid" - (* Return the group id of the user executing the process. *) -external getegid : unit -> int = "unix_getegid" - (* Return the effective group id under which the process runs. *) -external setgid : int -> unit = "unix_setgid" - (* Set the real group id and effective group id for the process. *) -external getgroups : unit -> int array = "unix_getgroups" - (* Return the list of groups to which the user executing the process - belongs. *) - - -type passwd_entry = - { pw_name : string; - pw_passwd : string; - pw_uid : int; - pw_gid : int; - pw_gecos : string; - pw_dir : string; - pw_shell : string } - (* Structure of entries in the [passwd] database. *) - -type group_entry = - { gr_name : string; - gr_passwd : string; - gr_gid : int; - gr_mem : string array } - (* Structure of entries in the [groups] database. *) - -external getlogin : unit -> string = "unix_getlogin" - (* Return the login name of the user executing the process. *) -external getpwnam : string -> passwd_entry = "unix_getpwnam" - (* Find an entry in [passwd] with the given name, or raise - [Not_found]. *) -external getgrnam : string -> group_entry = "unix_getgrnam" - (* Find an entry in [group] with the given name, or raise - [Not_found]. *) -external getpwuid : int -> passwd_entry = "unix_getpwuid" - (* Find an entry in [passwd] with the given user id, or raise - [Not_found]. *) -external getgrgid : int -> group_entry = "unix_getgrgid" - (* Find an entry in [group] with the given group id, or raise - [Not_found]. *) - - -(*** Internet addresses *) - -type inet_addr - (* The abstract type of Internet addresses. *) - -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" - (* Conversions between string with the format [XXX.YYY.ZZZ.TTT] - and Internet addresses. [inet_addr_of_string] raises [Failure] - when given a string that does not match this format. *) - - -(*** Sockets *) - -type socket_domain = - PF_UNIX (* Unix domain *) - | PF_INET (* Internet domain *) - - (* The type of socket domains. *) - -type socket_type = - SOCK_STREAM (* Stream socket *) - | SOCK_DGRAM (* Datagram socket *) - | SOCK_RAW (* Raw socket *) - | SOCK_SEQPACKET (* Sequenced packets socket *) - - (* The type of socket kinds, specifying the semantics of - communications. *) - -type sockaddr = - ADDR_UNIX of string - | ADDR_INET of inet_addr * int - - (* The type of socket addresses. [ADDR_UNIX name] is a socket - address in the Unix domain; [name] is a file name in the file - system. [ADDR_INET(addr,port)] is a socket address in the Internet - 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 - given kind. The third argument is the protocol type; 0 selects - the default protocol for that kind of sockets. *) -external socketpair : - socket_domain -> socket_type -> int -> file_descr * file_descr - = "unix_socketpair" - (* Create a pair of unnamed sockets, connected together. *) -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. *) -external bind : file_descr -> sockaddr -> unit = "unix_bind" - (* Bind a socket to an address. *) -external connect : file_descr -> sockaddr -> unit = "unix_connect" - (* Connect a socket to an address. *) -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. *) -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 recv : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_recv" -external recvfrom : - file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr - = "unix_recvfrom" - (* Receive data from an unconnected socket. *) -external send : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_send" -external sendto : - file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int - = "unix_sendto" - (* Send data over an unconnected socket. *) - - -(*** High-level network connection functions *) - -val open_connection : sockaddr -> in_channel * out_channel - (* Connect to a server at the given address. - Return a pair of buffered channels connected to the server. - Remember to call [flush] on the output channel at the right times - to ensure correct synchronization. *) -val shutdown_connection : in_channel -> unit - (* ``Shut down'' a connection established with [open_connection]; - that is, transmit an end-of-file condition to the server reading - on the other side of the connection. *) -val establish_server : (in_channel -> out_channel -> 'a) -> sockaddr -> unit - (* Establish a server on the given address. - The function given as first argument is called for each connection - with two buffered channels connected to the client. A new process - is created for each connection. The function [establish_server] - never returns normally. *) - - -(*** Host and protocol databases *) - -type host_entry = - { h_name : string; - h_aliases : string array; - h_addrtype : socket_domain; - h_addr_list : inet_addr array } - (* Structure of entries in the [hosts] database. *) - -type protocol_entry = - { p_name : string; - p_aliases : string array; - p_proto : int } - (* Structure of entries in the [protocols] database. *) - -type service_entry = - { s_name : string; - s_aliases : string array; - s_port : int; - s_proto : string } - (* Structure of entries in the [services] database. *) - -external gethostname : unit -> string = "unix_gethostname" - (* Return the name of the local host. *) -external gethostbyname : string -> host_entry = "unix_gethostbyname" - (* Find an entry in [hosts] with the given name, or raise - [Not_found]. *) -external gethostbyaddr : inet_addr -> host_entry = "unix_gethostbyaddr" - (* Find an entry in [hosts] with the given address, or raise - [Not_found]. *) -external getprotobyname : string -> protocol_entry - = "unix_getprotobyname" - (* Find an entry in [protocols] with the given name, or raise - [Not_found]. *) -external getprotobynumber : int -> protocol_entry - = "unix_getprotobynumber" - (* Find an entry in [protocols] with the given protocol number, - or raise [Not_found]. *) -external getservbyname : string -> string -> service_entry - = "unix_getservbyname" - (* Find an entry in [services] with the given name, or raise - [Not_found]. *) -external getservbyport : int -> string -> service_entry - = "unix_getservbyport" - (* Find an entry in [services] with the given service number, - or raise [Not_found]. *) - - -(*** Terminal interface *) - -(* The following functions implement the POSIX standard terminal - interface. They provide control over asynchronous communication ports - and pseudo-terminals. Refer to the [termios] man page for a - complete description. *) - -type terminal_io = { - (* Input modes: *) - mutable c_ignbrk: bool; (* Ignore the break condition. *) - mutable c_brkint: bool; (* Signal interrupt on break condition. *) - mutable c_ignpar: bool; (* Ignore characters with parity errors. *) - mutable c_parmrk: bool; (* Mark parity errors. *) - mutable c_inpck: bool; (* Enable parity check on input. *) - mutable c_istrip: bool; (* Strip 8th bit on input characters. *) - mutable c_inlcr: bool; (* Map NL to CR on input. *) - mutable c_igncr: bool; (* Ignore CR on input. *) - mutable c_icrnl: bool; (* Map CR to NL on input. *) - mutable c_ixon: bool; (* Recognize XON/XOFF characters on input. *) - mutable c_ixoff: bool; (* Emit XON/XOFF chars to control input flow. *) - (* Output modes: *) - mutable c_opost: bool; (* Enable output processing. *) - mutable c_olcuc: bool; (* Map lowercase to uppercase on output. *) - mutable c_onlcr: bool; (* Map NL to CR/NL on output. *) - mutable c_ocrnl: bool; (* Map CR to NL on output. *) - mutable c_onocr: bool; (* No CR output at column 0. *) - mutable c_onlret: bool; (* NL is assumed to perform as CR. *) - mutable c_ofill: bool; (* Use fill characters instead of delays. *) - mutable c_ofdel: bool; (* Fill character is DEL instead of NULL. *) - mutable c_nldly: int; (* Newline delay type (0-1). *) - mutable c_crdly: int; (* Carriage return delay type (0-3). *) - mutable c_tabdly: int; (* Horizontal tab delay type (0-3). *) - mutable c_bsdly: int; (* Backspace delay type (0-1). *) - mutable c_vtdly: int; (* Vertical tab delay type (0-1). *) - mutable c_ffdly: int; (* Form feed delay type (0-1). *) - (* Control modes: *) - mutable c_obaud: int; (* Output baud rate (0 means close connection).*) - mutable c_ibaud: int; (* Input baud rate. *) - mutable c_csize: int; (* Number of bits per character (5-8). *) - mutable c_cstopb: int; (* Number of stop bits (1-2). *) - mutable c_cread: bool; (* Reception is enabled. *) - mutable c_parenb: bool; (* Enable parity generation and detection. *) - mutable c_parodd: bool; (* Specify odd parity instead of even. *) - mutable c_hupcl: bool; (* Hang up on last close. *) - mutable c_clocal: bool; (* Ignore modem status lines. *) - (* Local modes: *) - mutable c_isig: bool; (* Generate signal on INTR, QUIT, SUSP. *) - mutable c_icanon: bool; (* Enable canonical processing - (line buffering and editing) *) - mutable c_noflsh: bool; (* Disable flush after INTR, QUIT, SUSP. *) - mutable c_echo: bool; (* Echo input characters. *) - mutable c_echoe: bool; (* Echo ERASE (to erase previous character). *) - mutable c_echok: bool; (* Echo KILL (to erase the current line). *) - mutable c_echonl: bool; (* Echo NL even if c_echo is not set. *) - (* Control characters: *) - mutable c_vintr: char; (* Interrupt character (usually ctrl-C). *) - mutable c_vquit: char; (* Quit character (usually ctrl-\). *) - mutable c_verase: char; (* Erase character (usually DEL or ctrl-H). *) - mutable c_vkill: char; (* Kill line character (usually ctrl-U). *) - mutable c_veof: char; (* End-of-file character (usually ctrl-D). *) - mutable c_veol: char; (* Alternate end-of-line char. (usually none). *) - mutable c_vmin: int; (* Minimum number of characters to read - before the read request is satisfied. *) - mutable c_vtime: int; (* Maximum read wait (in 0.1s units). *) - mutable c_vstart: char; (* Start character (usually ctrl-Q). *) - mutable c_vstop: char (* Stop character (usually ctrl-S). *) - } - -external tcgetattr: file_descr -> terminal_io = "unix_tcgetattr" - (* Return the status of the terminal referred to by the given - file descriptor. *) - -type setattr_when = TCSANOW | TCSADRAIN | TCSAFLUSH - -external tcsetattr: file_descr -> setattr_when -> terminal_io -> unit - = "unix_tcsetattr" - (* Set the status of the terminal referred to by the given - file descriptor. The second argument indicates when the - status change takes place: immediately ([TCSANOW]), - when all pending output has been transmitted ([TCSADRAIN]), - or after flushing all input that has been received but not - read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing - the output parameters; [TCSAFLUSH], when changing the input - parameters. *) - -external tcsendbreak: file_descr -> int -> unit = "unix_tcsendbreak" - (* Send a break condition on the given file descriptor. - The second argument is the duration of the break, in 0.1s units; - 0 means standard duration (0.25s). *) - -external tcdrain: file_descr -> unit = "unix_tcdrain" - (* Waits until all output written on the given file descriptor - has been transmitted. *) - -type flush_queue = TCIFLUSH | TCOFLUSH | TCIOFLUSH - -external tcflush: file_descr -> flush_queue -> unit = "unix_tcflush" - (* Discard data written on the given file descriptor but not yet - transmitted, or data received but not yet read, depending on the - second argument: [TCIFLUSH] flushes data received but not read, - [TCOFLUSH] flushes data written but not transmitted, and - [TCIOFLUSH] flushes both. *) - -type flow_action = TCOOFF | TCOON | TCIOFF | TCION - -external tcflow: file_descr -> flow_action -> unit = "unix_tcflow" - (* Suspend or restart reception or transmission of data on - the given file descriptor, depending on the second argument: - [TCOOFF] suspends output, [TCOON] restarts output, - [TCIOFF] transmits a STOP character to suspend input, - and [TCION] transmits a START character to restart input. *) diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c deleted file mode 100644 index 67684f473a..0000000000 --- a/otherlibs/unix/unlink.c +++ /dev/null @@ -1,9 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_unlink(path) /* ML */ - value path; -{ - if (unlink(String_val(path)) == -1) uerror("unlink", path); - return Val_unit; -} diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c deleted file mode 100644 index 2c481829ed..0000000000 --- a/otherlibs/unix/utimes.c +++ /dev/null @@ -1,51 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -#ifdef HAS_UTIME - -#include <sys/types.h> -#include <utime.h> - -value unix_utimes(path, atime, mtime) /* ML */ - value path, atime, mtime; -{ - struct utimbuf times, * t; - times.actime = Int_val(atime); - times.modtime = Int_val(mtime); - if (times.actime || times.modtime) - t = × - else - t = (struct utimbuf *) NULL; - if (utime(String_val(path), t) == -1) uerror("utimes", path); - return Val_unit; -} - -#else - -#ifdef HAS_UTIMES - -#include <sys/types.h> -#include <sys/time.h> - -value unix_utimes(path, atime, mtime) /* ML */ - value path, atime, mtime; -{ - struct timeval tv[2], * t; - tv[0].tv_sec = Int_val(atime); - tv[0].tv_usec = 0; - tv[1].tv_sec = Int_val(mtime); - tv[1].tv_usec = 0; - if (tv[0].tv_sec || tv[1].tv_sec) - t = tv; - else - t = (struct timeval *) NULL; - if (utimes(String_val(path), t) == -1) uerror("utime", path); - return Val_unit; -} - -#else - -value unix_utimes() { invalid_argument("utimes not implemented"); } - -#endif -#endif diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c deleted file mode 100644 index 1f41da9f3d..0000000000 --- a/otherlibs/unix/wait.c +++ /dev/null @@ -1,35 +0,0 @@ -#include <mlvalues.h> -#include <alloc.h> -#include <memory.h> -#include "unix.h" - -value unix_wait() /* ML */ -{ - value res; - int pid, status; - Push_roots(r, 1); -#define st r[0] - pid = wait(&status); - if (pid == -1) uerror("wait", 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; -} - diff --git a/otherlibs/unix/waitpid.c b/otherlibs/unix/waitpid.c deleted file mode 100644 index 9761a38520..0000000000 --- a/otherlibs/unix/waitpid.c +++ /dev/null @@ -1,52 +0,0 @@ -#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 diff --git a/otherlibs/unix/write.c b/otherlibs/unix/write.c deleted file mode 100644 index acb6f3331b..0000000000 --- a/otherlibs/unix/write.c +++ /dev/null @@ -1,13 +0,0 @@ -#include <mlvalues.h> -#include "unix.h" - -value unix_write(fd, buf, ofs, len) /* ML */ - value fd, buf, ofs, len; -{ - int ret; - enter_blocking_section(); - ret = write(Int_val(fd), &Byte(buf, Long_val(ofs)), Int_val(len)); - leave_blocking_section(); - if (ret == -1) uerror("write", Nothing); - return Val_int(ret); -} |