1 files changed, 459 insertions, 0 deletions
diff --git a/test/monniaux/ocaml/byterun/unix.c b/test/monniaux/ocaml/byterun/unix.c
new file mode 100644
index 00000000..15c67642
--- /dev/null
+++ b/test/monniaux/ocaml/byterun/unix.c
@@ -0,0 +1,459 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/* Unix-specific stuff */
+
+#define _GNU_SOURCE
+           /* Helps finding RTLD_DEFAULT in glibc */
+           /* also secure_getenv */
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <errno.h>
+#if HAS_IOCTL
+#include <sys/ioctl.h>
+#endif
+#include <fcntl.h>
+#include "caml/config.h"
+#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef __CYGWIN__
+#include "flexdll.h"
+#else
+#include <dlfcn.h>
+#endif
+#endif
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#if HAS_DIR
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+#endif
+#ifdef __APPLE__
+#include <mach-o/dyld.h>
+#endif
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+#include "caml/io.h"
+#include "caml/alloc.h"
+
+#ifndef S_ISREG
+#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef EINTR
+#define EINTR (-1)
+#endif
+#ifndef EAGAIN
+#define EAGAIN (-1)
+#endif
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK (-1)
+#endif
+
+int caml_read_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+  do {
+    caml_enter_blocking_section();
+    retcode = read(fd, buf, n);
+    caml_leave_blocking_section();
+  } while (retcode == -1 && errno == EINTR);
+  if (retcode == -1) caml_sys_io_error(NO_ARG);
+  return retcode;
+}
+
+int caml_write_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+ again:
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  if (flags & CHANNEL_FLAG_BLOCKING_WRITE) {
+    retcode = write(fd, buf, n);
+  } else {
+#endif
+  caml_enter_blocking_section();
+  retcode = write(fd, buf, n);
+  caml_leave_blocking_section();
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  }
+#endif
+  if (retcode == -1) {
+    if (errno == EINTR) goto again;
+    if ((errno == EAGAIN || errno == EWOULDBLOCK) && n > 1) {
+      /* We couldn't do a partial write here, probably because
+         n <= PIPE_BUF and POSIX says that writes of less than
+         PIPE_BUF characters must be atomic.
+         We first try again with a partial write of 1 character.
+         If that fails too, we'll return an error code. */
+      n = 1; goto again;
+    }
+  }
+  if (retcode == -1) caml_sys_io_error(NO_ARG);
+  CAMLassert (retcode > 0);
+  return retcode;
+}
+
+caml_stat_string caml_decompose_path(struct ext_table * tbl, char * path)
+{
+  char * p, * q;
+  size_t n;
+
+  if (path == NULL) return NULL;
+  p = caml_stat_strdup(path);
+  q = p;
+  while (1) {
+    for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/;
+    caml_ext_table_add(tbl, q);
+    q = q + n;
+    if (*q == 0) break;
+    *q = 0;
+    q += 1;
+  }
+  return p;
+}
+
+caml_stat_string caml_search_in_path(struct ext_table * path, const char * name)
+{
+  const char * p;
+  char * dir, * fullname;
+  int i;
+  struct stat st;
+
+  for (p = name; *p != 0; p++) {
+    if (*p == '/') goto not_found;
+  }
+  for (i = 0; i < path->size; i++) {
+    dir = path->contents[i];
+    if (dir[0] == 0) dir = ".";  /* empty path component = current dir */
+    fullname = caml_stat_strconcat(3, dir, "/", name);
+    if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode))
+      return fullname;
+    caml_stat_free(fullname);
+  }
+ not_found:
+  return caml_stat_strdup(name);
+}
+
+#ifdef __CYGWIN__
+
+/* Cygwin needs special treatment because of the implicit ".exe" at the
+   end of executable file names */
+
+static int cygwin_file_exists(const char * name)
+{
+  int fd, ret;
+  struct stat st;
+  /* Cannot use stat() here because it adds ".exe" implicitly */
+  fd = open(name, O_RDONLY);
+  if (fd == -1) return 0;
+  ret = fstat(fd, &st);
+  close(fd);
+  return ret == 0 && S_ISREG(st.st_mode);
+}
+
+static caml_stat_string cygwin_search_exe_in_path(struct ext_table * path, const char * name)
+{
+  const char * p;
+  char * dir, * fullname;
+  int i;
+
+  for (p = name; *p != 0; p++) {
+    if (*p == '/' || *p == '\\') goto not_found;
+  }
+  for (i = 0; i < path->size; i++) {
+    dir = path->contents[i];
+    if (dir[0] == 0) dir = ".";  /* empty path component = current dir */
+    fullname = caml_stat_strconcat(3, dir, "/", name);
+    if (cygwin_file_exists(fullname)) return fullname;
+    caml_stat_free(fullname);
+    fullname = caml_stat_strconcat(4, dir, "/", name, ".exe");
+    if (cygwin_file_exists(fullname)) return fullname;
+    caml_stat_free(fullname);
+  }
+ not_found:
+  if (cygwin_file_exists(name)) return caml_stat_strdup(name);
+  fullname = caml_stat_strconcat(2, name, ".exe");
+  if (cygwin_file_exists(fullname)) return fullname;
+  caml_stat_free(fullname);
+  return caml_stat_strdup(name);
+}
+
+#endif
+
+caml_stat_string caml_search_exe_in_path(const char * name)
+{
+  struct ext_table path;
+  char * tofree;
+  caml_stat_string res;
+
+  caml_ext_table_init(&path, 8);
+  tofree = caml_decompose_path(&path, getenv("PATH"));
+#ifndef __CYGWIN__
+  res = caml_search_in_path(&path, name);
+#else
+  res = cygwin_search_exe_in_path(&path, name);
+#endif
+  caml_stat_free(tofree);
+  caml_ext_table_free(&path, 0);
+  return res;
+}
+
+caml_stat_string caml_search_dll_in_path(struct ext_table * path, const char * name)
+{
+  caml_stat_string dllname;
+  caml_stat_string res;
+
+  dllname = caml_stat_strconcat(2, name, ".so");
+  res = caml_search_in_path(path, dllname);
+  caml_stat_free(dllname);
+  return res;
+}
+
+#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef __CYGWIN__
+/* Use flexdll */
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  int flags = (global ? FLEXDLL_RTLD_GLOBAL : 0);
+  if (!for_execution) flags |= FLEXDLL_RTLD_NOEXEC;
+  return flexdll_dlopen(libname, flags);
+}
+
+void caml_dlclose(void * handle)
+{
+  flexdll_dlclose(handle);
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return flexdll_dlsym(handle, name);
+}
+
+void * caml_globalsym(const char * name)
+{
+  return flexdll_dlsym(flexdll_dlopen(NULL,0), name);
+}
+
+char * caml_dlerror(void)
+{
+  return flexdll_dlerror();
+}
+
+#else
+/* Use normal dlopen */
+
+#ifndef RTLD_GLOBAL
+#define RTLD_GLOBAL 0
+#endif
+#ifndef RTLD_LOCAL
+#define RTLD_LOCAL 0
+#endif
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  return dlopen(libname, RTLD_NOW | (global ? RTLD_GLOBAL : RTLD_LOCAL));
+  /* Could use RTLD_LAZY if for_execution == 0, but needs testing */
+}
+
+void caml_dlclose(void * handle)
+{
+  dlclose(handle);
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+#ifdef DL_NEEDS_UNDERSCORE
+  char _name[1000] = "_";
+  strncat (_name, name, 998);
+  name = _name;
+#endif
+  return dlsym(handle, name);
+}
+
+void * caml_globalsym(const char * name)
+{
+#ifdef RTLD_DEFAULT
+  return caml_dlsym(RTLD_DEFAULT, name);
+#else
+  return NULL;
+#endif
+}
+
+char * caml_dlerror(void)
+{
+  return (char*) dlerror();
+}
+
+#endif
+#else
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  return NULL;
+}
+
+void caml_dlclose(void * handle)
+{
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return NULL;
+}
+
+void * caml_globalsym(const char * name)
+{
+  return NULL;
+}
+
+char * caml_dlerror(void)
+{
+  return "dynamic loading not supported on this platform";
+}
+
+#endif
+
+/* Add to [contents] the (short) names of the files contained in
+   the directory named [dirname].  No entries are added for [.] and [..].
+   Return 0 on success, -1 on error; set errno in the case of error. */
+
+CAMLexport int caml_read_directory(char * dirname, struct ext_table * contents)
+{
+#if HAS_DIR
+  DIR * d;
+#ifdef HAS_DIRENT
+  struct dirent * e;
+#else
+  struct direct * e;
+#endif
+
+  d = opendir(dirname);
+  if (d == NULL) return -1;
+  while (1) {
+    e = readdir(d);
+    if (e == NULL) break;
+    if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
+    caml_ext_table_add(contents, caml_stat_strdup(e->d_name));
+  }
+  closedir(d);
+  return 0;
+#else
+  caml_invalid_argument("Unix.read_directory not implemented");  
+#endif
+}
+
+/* Recover executable name from /proc/self/exe if possible */
+
+char * caml_executable_name(void)
+{
+#if defined(__linux__)
+  int namelen, retcode;
+  char * name;
+  struct stat st;
+
+  /* lstat("/proc/self/exe") returns st_size == 0 so we cannot use it
+     to determine the size of the buffer.  Instead, we guess and adjust. */
+  namelen = 256;
+  while (1) {
+    name = caml_stat_alloc(namelen);
+    retcode = readlink("/proc/self/exe", name, namelen);
+    if (retcode == -1) { caml_stat_free(name); return NULL; }
+    if (retcode < namelen) break;
+    caml_stat_free(name);
+    if (namelen >= 1024*1024) return NULL; /* avoid runaway and overflow */
+    namelen *= 2;
+  }
+  /* readlink() does not zero-terminate its result.
+     There is room for a final zero since retcode < namelen. */
+  name[retcode] = 0;
+  /* Make sure that the contents of /proc/self/exe is a regular file.
+     (Old Linux kernels return an inode number instead.) */
+  if (stat(name, &st) == -1 || ! S_ISREG(st.st_mode)) {
+    caml_stat_free(name); return NULL;
+  }
+  return name;
+
+#elif defined(__APPLE__)
+  unsigned int namelen;
+  char * name;
+
+  namelen = 256;
+  name = caml_stat_alloc(namelen);
+  if (_NSGetExecutablePath(name, &namelen) == 0) return name;
+  caml_stat_free(name);
+  /* Buffer is too small, but namelen now contains the size needed */
+  name = caml_stat_alloc(namelen);
+  if (_NSGetExecutablePath(name, &namelen) == 0) return name;
+  caml_stat_free(name);
+  return NULL;
+
+#else
+  return NULL;
+
+#endif
+}
+
+char *caml_secure_getenv (char const *var)
+{
+#ifdef HAS_GETENV
+#ifdef HAS_SECURE_GETENV
+  return secure_getenv (var);
+#elif defined (HAS___SECURE_GETENV)
+  return __secure_getenv (var);
+#elif defined(HAS_ISSETUGID)
+  if (!issetugid ())
+    return CAML_SYS_GETENV (var);
+  else
+    return NULL;
+#else
+  if (geteuid () == getuid () && getegid () == getgid ())
+    return CAML_SYS_GETENV (var);
+  else
+    return NULL;
+#endif
+#else
+  return NULL;
+#endif
+}
+
+int caml_num_rows_fd(int fd)
+{
+#ifdef TIOCGWINSZ
+  struct winsize w;
+  w.ws_row = -1;
+  if (ioctl(fd, TIOCGWINSZ, &w) == 0)
+    return w.ws_row;
+  else
+    return -1;
+#else
+  return -1;
+#endif
+}
+
+