summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--otherlibs/bigarray/bigarray.ml14
-rw-r--r--otherlibs/bigarray/bigarray.mli32
-rw-r--r--otherlibs/bigarray/mmap_unix.c44
-rw-r--r--otherlibs/bigarray/mmap_win32.c65
-rw-r--r--test/Moretest/bigarrays.ml20
5 files changed, 140 insertions, 35 deletions
diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
index 529eb922b..c1f107a8c 100644
--- a/otherlibs/bigarray/bigarray.ml
+++ b/otherlibs/bigarray/bigarray.ml
@@ -94,9 +94,11 @@ module Genarray = struct
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
= "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
- external map_file: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
- bool -> int array -> ('a, 'b, 'c) t
- = "caml_ba_map_file"
+ external map_subfile: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
+ bool -> int array -> int64 -> ('a, 'b, 'c) t
+ = "caml_ba_map_file_bytecode" "caml_ba_map_file"
+ let map_file fd kind layout shared dims =
+ map_subfile fd kind layout shared dims 0L
end
module Array1 = struct
@@ -118,6 +120,8 @@ module Array1 = struct
ba
let map_file fd kind layout shared dim =
Genarray.map_file fd kind layout shared [|dim|]
+ let map_subfile fd kind layout shared dim ofs =
+ Genarray.map_subfile fd kind layout shared [|dim|] ofs
end
module Array2 = struct
@@ -155,6 +159,8 @@ module Array2 = struct
ba
let map_file fd kind layout shared dim1 dim2 =
Genarray.map_file fd kind layout shared [|dim1;dim2|]
+ let map_subfile fd kind layout shared dim1 dim2 ofs =
+ Genarray.map_subfile fd kind layout shared [|dim1;dim2|] ofs
end
module Array3 = struct
@@ -202,6 +208,8 @@ module Array3 = struct
ba
let map_file fd kind layout shared dim1 dim2 dim3 =
Genarray.map_file fd kind layout shared [|dim1;dim2;dim3|]
+ let map_subfile fd kind layout shared dim1 dim2 dim3 ofs =
+ Genarray.map_subfile fd kind layout shared [|dim1;dim2;dim3|] ofs
end
external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
index e1f927f77..907ef41eb 100644
--- a/otherlibs/bigarray/bigarray.mli
+++ b/otherlibs/bigarray/bigarray.mli
@@ -380,9 +380,9 @@ module Genarray :
can be achieved by applying [Genarray.fill] to a sub-array
or a slice of [a]. *)
- external map_file:
+ val map_file:
Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
- bool -> int array -> ('a, 'b, 'c) t = "caml_ba_map_file"
+ bool -> int array -> ('a, 'b, 'c) t
(** Memory mapping of a file as a big array.
[Genarray.map_file fd kind layout shared dims]
returns a big array of kind [kind], layout [layout],
@@ -416,6 +416,16 @@ module Genarray :
array, the file is automatically grown to the size of the big array.
This requires write permissions on [fd]. *)
+ val map_subfile:
+ Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
+ bool -> int array -> int64 -> ('a, 'b, 'c) t
+ (** Memory mapping of a file as a big array. The file data being mapped
+ starts at the given file offset, instead of the whole file
+ (start offset 0) like [Genarray.map_file] does.
+ In the call [Genarray.map_subfile fd kind layout shared dims ofs],
+ the [ofs] parameter is the starting file offset; the other parameters
+ are as in {!Bigarray.Genarray.map_file}. *)
+
end
(** {6 One-dimensional arrays} *)
@@ -485,6 +495,12 @@ module Array1 : sig
bool -> int -> ('a, 'b, 'c) t
(** Memory mapping of a file as a one-dimensional big array.
See {!Bigarray.Genarray.map_file} for more details. *)
+
+ val map_subfile: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
+ bool -> int -> int64 -> ('a, 'b, 'c) t
+ (** Memory mapping of a file as a one-dimensional big array,
+ starting at a given file offset.
+ See {!Bigarray.Genarray.map_subfile} for more details. *)
end
@@ -579,6 +595,12 @@ module Array2 :
(** Memory mapping of a file as a two-dimensional big array.
See {!Bigarray.Genarray.map_file} for more details. *)
+ val map_subfile: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
+ bool -> int -> int -> int64 -> ('a, 'b, 'c) t
+ (** Memory mapping of a file as a two-dimensional big array,
+ starting at a given file offset.
+ See {!Bigarray.Genarray.map_subfile} for more details. *)
+
end
(** {6 Three-dimensional arrays} *)
@@ -697,6 +719,12 @@ module Array3 :
(** Memory mapping of a file as a three-dimensional big array.
See {!Bigarray.Genarray.map_file} for more details. *)
+ val map_subfile: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
+ bool -> int -> int -> int -> int64 -> ('a, 'b, 'c) t
+ (** Memory mapping of a file as a three-dimensional big array,
+ starting at a given file offset.
+ See {!Bigarray.Genarray.map_subfile} for more details. *)
+
end
(** {6 Coercions between generic big arrays and fixed-dimension big arrays} *)
diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
index 3b5ffd1ce..0acef2004 100644
--- a/otherlibs/bigarray/mmap_unix.c
+++ b/otherlibs/bigarray/mmap_unix.c
@@ -18,6 +18,7 @@
#include "bigarray.h"
#include "custom.h"
#include "fail.h"
+#include "io.h"
#include "mlvalues.h"
#include "sys.h"
@@ -38,18 +39,19 @@ extern int caml_ba_element_size[]; /* from bigarray_stubs.c */
#endif
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
- value vshared, value vdim)
+ value vshared, value vdim, value vstart)
{
int fd, flags, major_dim, shared;
intnat num_dims, i;
intnat dim[MAX_NUM_DIMS];
- intnat currpos, file_size;
- uintnat array_size;
+ file_offset currpos, startpos, file_size, data_size;
+ uintnat array_size, page, delta;
char c;
void * addr;
fd = Int_val(vfd);
flags = Int_val(vkind) | Int_val(vlayout);
+ startpos = File_offset_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & BIGARRAY_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from Caml array */
@@ -72,27 +74,36 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
array_size = bigarray_element_size[flags & BIGARRAY_KIND_MASK];
for (i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
- /* Check if the first/last dimension is unknown */
+ /* Check if the major dimension is unknown */
if (dim[major_dim] == -1) {
- /* Determine first/last dimension from file size */
- if ((uintnat) file_size % array_size != 0)
+ /* Determine major dimension from file size */
+ if (file_size < startpos)
+ failwith("Bigarray.mmap: file position exceeds file size");
+ data_size = file_size - startpos;
+ dim[major_dim] = (uintnat) (data_size / array_size);
+ array_size = dim[major_dim] * array_size;
+ if (array_size != data_size)
failwith("Bigarray.mmap: file size doesn't match array dimensions");
- dim[major_dim] = (uintnat) file_size / array_size;
- array_size = file_size;
} else {
/* Check that file is large enough, and grow it otherwise */
- if (file_size < array_size) {
- if (lseek(fd, array_size - 1, SEEK_SET) == -1) sys_error(NO_ARG);
+ if (file_size < startpos + array_size) {
+ if (lseek(fd, startpos + array_size - 1, SEEK_SET) == -1)
+ sys_error(NO_ARG);
c = 0;
if (write(fd, &c, 1) != 1) 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);
/* Do the mmap */
shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
- addr = mmap(NULL, array_size, PROT_READ | PROT_WRITE, shared, fd, 0);
+ addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
+ shared, fd, startpos - delta);
if (addr == (void *) MAP_FAILED) sys_error(NO_ARG);
+ addr = (void *) ((uintnat) addr + delta);
/* Build and return the Caml bigarray */
return alloc_bigarray(flags | BIGARRAY_MAPPED_FILE, num_dims, addr, dim);
}
@@ -100,7 +111,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
#else
value caml_ba_map_file(value vfd, value vkind, value vlayout,
- value vshared, value vdim)
+ value vshared, value vdim, value vpos)
{
invalid_argument("Bigarray.map_file: not supported");
return Val_unit;
@@ -108,10 +119,17 @@ value caml_ba_map_file(value vfd, value vkind, value vlayout,
#endif
+CAMLprim value caml_ba_map_file_bytecode(value * argv, int argn)
+{
+ return caml_ba_map_file(argv[0], argv[1], argv[2],
+ argv[3], argv[4], argv[5]);
+}
void caml_ba_unmap_file(void * addr, uintnat len)
{
#if defined(HAS_MMAP)
- munmap(addr, len);
+ uintnat page = getpagesize();
+ uintnat delta = (uintnat) addr % page;
+ munmap((void *)((uintnat)addr - delta), len + delta);
#endif
}
diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c
index 35cbbe4d5..3a64e7b67 100644
--- a/otherlibs/bigarray/mmap_win32.c
+++ b/otherlibs/bigarray/mmap_win32.c
@@ -24,26 +24,38 @@
#include "sys.h"
#include "unixsupport.h"
-/* TODO: handle mappings larger than 2^32 bytes on Win64 */
-
extern int caml_ba_element_size[]; /* from bigarray_stubs.c */
static void caml_ba_sys_error(void);
+static __int64 caml_ba_set_file_pointer(HANDLE h, __int64 dist, DWORD mode)
+{
+ LARGE_INTEGER i;
+ DWORD err;
+
+ i.QuadPart = dist;
+ i.LowPart = SetFilePointer(h, i.LowPart, &i.HighPart, mode);
+ if (i.LowPart == INVALID_SET_FILE_POINTER) return -1;
+ return i.QuadPart;
+}
+
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
- value vshared, value vdim)
+ value vshared, value vdim, value vstart)
{
HANDLE fd, fmap;
int flags, major_dim, mode, perm;
intnat num_dims, i;
intnat dim[MAX_NUM_DIMS];
- DWORD currpos, file_size;
- uintnat array_size;
+ __int64 currpos, startpos, file_size, data_size;
+ uintnat array_size, page, delta;
char c;
void * addr;
+ LARGE_INTEGER li;
+ SYSTEM_INFO sysinfo;
fd = Handle_val(vfd);
flags = Int_val(vkind) | Int_val(vlayout);
+ startpos = Int64_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & BIGARRAY_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from Caml array */
@@ -57,10 +69,10 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
invalid_argument("Bigarray.create: negative dimension");
}
/* Determine file size */
- currpos = SetFilePointer(fd, 0, NULL, FILE_CURRENT);
- if (currpos == INVALID_SET_FILE_POINTER) caml_ba_sys_error();
- file_size = SetFilePointer(fd, 0, NULL, FILE_END);
- if (file_size == INVALID_SET_FILE_POINTER) caml_ba_sys_error();
+ currpos = caml_ba_set_file_pointer(fd, 0, FILE_CURRENT);
+ if (currpos == -1) caml_ba_sys_error();
+ file_size = caml_ba_set_file_pointer(fd, 0, FILE_END);
+ if (file_size == -1) caml_ba_sys_error();
/* Determine array size in bytes (or size of array without the major
dimension if that dimension wasn't specified) */
array_size = bigarray_element_size[flags & BIGARRAY_KIND_MASK];
@@ -69,13 +81,16 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
/* Check if the first/last dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine first/last dimension from file size */
- if ((uintnat) file_size % array_size != 0)
+ if (file_size < startpos)
+ failwith("Bigarray.mmap: file position exceeds file size");
+ data_size = file_size - startpos;
+ dim[major_dim] = (uintnat) (data_size / array_size);
+ array_size = dim[major_dim] * array_size;
+ if (array_size != data_size)
failwith("Bigarray.mmap: file size doesn't match array dimensions");
- dim[major_dim] = (uintnat) file_size / array_size;
- array_size = file_size;
}
/* Restore original file position */
- SetFilePointer(fd, currpos, NULL, FILE_BEGIN);
+ caml_ba_set_file_pointer(fd, currpos, FILE_BEGIN);
/* Create the file mapping */
if (Bool_val(vshared)) {
perm = PAGE_READWRITE;
@@ -84,20 +99,38 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
perm = PAGE_READONLY; /* doesn't work under Win98 */
mode = FILE_MAP_COPY;
}
- fmap = CreateFileMapping(fd, NULL, perm, 0, array_size, NULL);
+ li.QuadPart = startpos + array_size;
+ fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
if (fmap == NULL) caml_ba_sys_error();
+ /* Determine offset so that the mapping starts at the given file pos */
+ GetSystemInfo(&sysinfo);
+ delta = (uintnat) (startpos % sysinfo.dwPageSize);
/* Map the mapping in memory */
- addr = MapViewOfFile(fmap, mode, 0, 0, array_size);
+ li.QuadPart = startpos - delta;
+ addr =
+ MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
if (addr == NULL) caml_ba_sys_error();
+ addr = (void *) ((uintnat) addr + delta);
/* Close the file mapping */
CloseHandle(fmap);
/* Build and return the Caml bigarray */
return alloc_bigarray(flags | BIGARRAY_MAPPED_FILE, num_dims, addr, dim);
}
+CAMLprim value caml_ba_map_file_bytecode(value * argv, int argn)
+{
+ return caml_ba_map_file(argv[0], argv[1], argv[2],
+ argv[3], argv[4], argv[5]);
+}
+
void caml_ba_unmap_file(void * addr, uintnat len)
{
- UnmapViewOfFile(addr);
+ SYSTEM_INFO sysinfo;
+ uintnat delta;
+
+ GetSystemInfo(&sysinfo);
+ delta = (uintnat) (startpos % sysinfo.dwPageSize);
+ UnmapViewOfFile((void *)((uintnat)addr - delta));
}
static void caml_ba_sys_error(void)
diff --git a/test/Moretest/bigarrays.ml b/test/Moretest/bigarrays.ml
index 302ade999..fadad4593 100644
--- a/test/Moretest/bigarrays.ml
+++ b/test/Moretest/bigarrays.ml
@@ -700,7 +700,25 @@ let _ =
if c.{i,j} <> float (100 * i + j) then ok := false
done
done;
- test 2 !ok true
+ test 2 !ok true;
+ let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+ let c = Array2.map_subfile fd float64 c_layout false (-1) 100 800L in
+ Unix.close fd;
+ let ok = ref true in
+ for i = 1 to 99 do
+ for j = 0 to 99 do
+ if c.{i-1,j} <> float (100 * i + j) then ok := false
+ done
+ done;
+ test 3 !ok true;
+ let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+ let c = Array2.map_subfile fd float64 c_layout false (-1) 100 79200L in
+ Unix.close fd;
+ let ok = ref true in
+ for j = 0 to 99 do
+ if c.{0,j} <> float (100 * 99 + j) then ok := false
+ done;
+ test 4 !ok true
end;
(* Force garbage collection of the mapped bigarrays above, otherwise
Win32 doesn't let us erase the file. Notice the begin...end above
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 03:31:10 +0000