merge version/4.00 at revision 12866

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/short-paths@12869 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 77 insertions, 26 deletions

diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
index 4d77c2e541..2e7d98d2da 100644
--- a/otherlibs/bigarray/mmap_unix.c
+++ b/otherlibs/bigarray/mmap_unix.c
@@ -13,6 +13,10 @@
 
 /* $Id$ */
 
+/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
+   Must be defined before the first system .h is included. */
+#define _XOPEN_SOURCE 500
+
 #include <stddef.h>
 #include <string.h>
 #include "bigarray.h"
@@ -25,12 +29,14 @@
 
 extern int caml_ba_element_size[];  /* from bigarray_stubs.c */
 
+#include <errno.h>
 #ifdef HAS_UNISTD
 #include <unistd.h>
 #endif
 #ifdef HAS_MMAP
 #include <sys/types.h>
 #include <sys/mman.h>
+#include <sys/stat.h>
 #endif
 
 #if defined(HAS_MMAP)
@@ -39,15 +45,61 @@ extern int caml_ba_element_size[];  /* from bigarray_stubs.c */
 #define MAP_FAILED ((void *) -1)
 #endif
 
+/* [caml_grow_file] function contributed by Gerd Stolpmann (PR#5543). */
+
+static int caml_grow_file(int fd, file_offset size)
+{
+  char c;
+  int p;
+
+  /* First use pwrite for growing - it is a conservative method, as it
+     can never happen that we shrink by accident
+   */
+#ifdef HAS_PWRITE
+  c = 0;
+  p = pwrite(fd, &c, 1, size - 1);
+#else
+
+  /* Emulate pwrite with lseek. This should only be necessary on ancient
+     systems nowadays
+   */
+  file_offset currpos;
+  currpos = lseek(fd, 0, SEEK_CUR);
+  if (currpos != -1) {
+    p = lseek(fd, size - 1, SEEK_SET);
+    if (p != -1) {
+      c = 0;
+      p = write(fd, &c, 1);
+      if (p != -1)
+        p = lseek(fd, currpos, SEEK_SET);
+    }
+  }
+  else p=-1;
+#endif
+#ifdef HAS_TRUNCATE
+  if (p == -1 && errno == ESPIPE) {
+    /* Plan B. Check if at least ftruncate is possible. There are
+       some non-seekable descriptor types that do not support pwrite
+       but ftruncate, like shared memory. We never get into this case
+       for real files, so there is no danger of truncating persistent
+       data by accident
+     */
+    p = ftruncate(fd, size);
+  }
+#endif
+  return p;
+}
+
+
 CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
                                 value vshared, value vdim, value vstart)
 {
   int fd, flags, major_dim, shared;
   intnat num_dims, i;
   intnat dim[CAML_BA_MAX_NUM_DIMS];
-  file_offset currpos, startpos, file_size, data_size;
+  file_offset startpos, file_size, data_size;
+  struct stat st;
   uintnat array_size, page, delta;
-  char c;
   void * addr;
 
   fd = Int_val(vfd);
@@ -55,7 +107,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   startpos = File_offset_val(vstart);
   num_dims = Wosize_val(vdim);
   major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
-  /* Extract dimensions from Caml array */
+  /* Extract dimensions from OCaml array */
   num_dims = Wosize_val(vdim);
   if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Bigarray.mmap: bad number of dimensions");
@@ -65,18 +117,15 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
     if (dim[i] < 0)
       caml_invalid_argument("Bigarray.create: negative dimension");
   }
-  /* Determine file size */
+  /* Determine file size. We avoid lseek here because it is fragile,
+     and because some mappable file types do not support it
+   */
   caml_enter_blocking_section();
-  currpos = lseek(fd, 0, SEEK_CUR);
-  if (currpos == -1) {
-    caml_leave_blocking_section();
-    caml_sys_error(NO_ARG);
-  }
-  file_size = lseek(fd, 0, SEEK_END);
-  if (file_size == -1) {
+  if (fstat(fd, &st) == -1) {
     caml_leave_blocking_section();
     caml_sys_error(NO_ARG);
   }
+  file_size = st.st_size;
   /* Determine array size in bytes (or size of array without the major
      dimension if that dimension wasn't specified) */
   array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
@@ -99,37 +148,33 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   } else {
     /* Check that file is large enough, and grow it otherwise */
     if (file_size < startpos + array_size) {
-      if (lseek(fd, startpos + array_size - 1, SEEK_SET) == -1) {
-        caml_leave_blocking_section();
-        caml_sys_error(NO_ARG);
-      }
-      c = 0;
-      if (write(fd, &c, 1) != 1) {
+      if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
         caml_leave_blocking_section();
         caml_sys_error(NO_ARG);
       }
     }
   }
-  /* Restore original file position */
-  lseek(fd, currpos, SEEK_SET);
   /* Determine offset so that the mapping starts at the given file pos */
   page = getpagesize();
-  delta = (uintnat) (startpos % page);
+  delta = (uintnat) startpos % page;
   /* Do the mmap */
   shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
-  addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
-              shared, fd, startpos - delta);
+  if (array_size > 0)
+    addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
+                shared, fd, startpos - delta);
+  else
+    addr = NULL;                /* PR#5463 - mmap fails on empty region */
   caml_leave_blocking_section();
   if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG);
   addr = (void *) ((uintnat) addr + delta);
-  /* Build and return the Caml bigarray */
+  /* Build and return the OCaml bigarray */
   return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
 }
 
 #else
 
-value caml_ba_map_file(value vfd, value vkind, value vlayout,
-                       value vshared, value vdim, value vpos)
+CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
+                                value vshared, value vdim, value vpos)
 {
   caml_invalid_argument("Bigarray.map_file: not supported");
   return Val_unit;
@@ -148,6 +193,12 @@ void caml_ba_unmap_file(void * addr, uintnat len)
 #if defined(HAS_MMAP)
   uintnat page = getpagesize();
   uintnat delta = (uintnat) addr % page;
-  munmap((void *)((uintnat)addr - delta), len + delta);
+  if (len == 0) return;         /* PR#5463 */
+  addr = (void *)((uintnat)addr - delta);
+  len  = len + delta;
+#if defined(_POSIX_SYNCHRONIZED_IO)
+  msync(addr, len, MS_ASYNC);   /* PR#3571 */
+#endif
+  munmap(addr, len);
 #endif
 }