diff options
| -rw-r--r-- | Changes | 6 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray.ml | 8 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray.mli | 58 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray_stubs.c | 16 | ||||
| -rw-r--r-- | otherlibs/bigarray/mmap_unix.c | 21 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray/bigarrays.ml | 41 | ||||
| -rw-r--r-- | testsuite/tests/lib-bigarray/bigarrays.reference | 8 |
7 files changed, 132 insertions, 26 deletions
@@ -65,9 +65,14 @@ Standard library: - Set and Map: more efficient implementation of "filter" and "partition" - String: new function "map" (PR#3888) +Other libraries: +- Bigarray: added "release" functions that free memory and file mappings + just like GC finalization does eventually, but does it immediately. + Bug Fixes: - PR#1643: functions of the Lazy module whose named started with 'lazy_' have been deprecated, and new ones without the prefix added +- PR#3571: in Bigarrays, call msync() before unmapping to commit changes - PR#4549: Filename.dirname is not handling multiple / on Unix - PR#4688: (Windows) special floating-point values aren't converted to strings correctly @@ -115,6 +120,7 @@ Bug Fixes: - PR#5436: update object ids on unmarshaling - PR#5453: configure doesn't find X11 under Ubuntu/MultiarchSpec - PR#5461: Double linking of bytecode modules +- PR#5463: Bigarray.*.map_file fail if empty array is requested - PR#5469: private record type generated by functor loses abbreviation - PR#5475: Wrapper script for interpreted LablTk wrongly handles command line parameters diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 1d3dbcf97..b9f22b182 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -99,6 +99,8 @@ module Genarray = struct = "caml_ba_map_file_bytecode" "caml_ba_map_file" let map_file fd ?(pos = 0L) kind layout shared dims = map_internal fd kind layout shared dims pos + external release: ('a, 'b, 'c) t -> unit + = "caml_ba_release" end module Array1 = struct @@ -122,6 +124,8 @@ module Array1 = struct ba let map_file fd ?pos kind layout shared dim = Genarray.map_file fd ?pos kind layout shared [|dim|] + external release: ('a, 'b, 'c) t -> unit + = "caml_ba_release" end module Array2 = struct @@ -161,6 +165,8 @@ module Array2 = struct ba let map_file fd ?pos kind layout shared dim1 dim2 = Genarray.map_file fd ?pos kind layout shared [|dim1;dim2|] + external release: ('a, 'b, 'c) t -> unit + = "caml_ba_release" end module Array3 = struct @@ -210,6 +216,8 @@ module Array3 = struct ba let map_file fd ?pos kind layout shared dim1 dim2 dim3 = Genarray.map_file fd ?pos kind layout shared [|dim1;dim2;dim3|] + external release: ('a, 'b, 'c) t -> unit + = "caml_ba_release" 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 8b260bf79..73c27b575 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -426,7 +426,27 @@ module Genarray : or a SIGBUS signal may be raised. This happens, for instance, if the file is shrinked. *) - end + val release: ('a, 'b, 'c) t -> unit + (** Release the resources associated with the given big array, + then set all of its dimensions to 0, causing subsequent accesses + to the big array to fail. This releasing of resources is performed + automatically by the garbage collector when the big array is no longer + referenced by the program. However, memory behavior of the program + can be improved by releasing the resources explicitly via + [Genarray.release] as soon as the big array is no longer useful. + + If the big array was created with [Genarray.create], the memory + space occupied by its data is freed. If the big array was + created with [Genarray.map_file], updates performed on the array + are flushed to the file (if the mapping is shared), then the + mapping is removed, freeing the corresponding virtual memory + space. If several views on the big array data were created + using [Genarray.sub_*] or [Genarray.slice_*], data release occurs + when the last not-yet-released view is released. Multiple calls + to [Genarray.release] on the same big array are safe: the second + and subsequent calls have no effect. *) + +end (** {6 One-dimensional arrays} *) @@ -496,16 +516,20 @@ module Array1 : sig (** Memory mapping of a file as a one-dimensional big array. See {!Bigarray.Genarray.map_file} for more details. *) + val release: ('a, 'b, 'c) t -> unit + (** Explicit release of the resources associated with the big array. + See {!Bigarray.Genarray.release} for more details. *) + external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1" (** Like {!Bigarray.Array1.get}, but bounds checking is not always performed. Use with caution and only when the program logic guarantees that - the access is within bounds. *) + the access is within bounds and the big array has not been released. *) external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_unsafe_set_1" (** Like {!Bigarray.Array1.set}, but bounds checking is not always performed. Use with caution and only when the program logic guarantees that - the access is within bounds. *) + the access is within bounds and the big array has not been released. *) end @@ -601,15 +625,21 @@ module Array2 : (** Memory mapping of a file as a two-dimensional big array. See {!Bigarray.Genarray.map_file} for more details. *) + val release: ('a, 'b, 'c) t -> unit + (** Explicit release of the resources associated with the big array. + See {!Bigarray.Genarray.release} for more details. *) + external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_unsafe_ref_2" - (** Like {!Bigarray.Array2.get}, but bounds checking is not always - performed. *) + (** Like {!Bigarray.Array2.get}, but bounds checking is not always performed. + Use with caution and only when the program logic guarantees that + the access is within bounds and the big array has not been released. *) external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_2" - (** Like {!Bigarray.Array2.set}, but bounds checking is not always - performed. *) + (** Like {!Bigarray.Array2.set}, but bounds checking is not always performed. + Use with caution and only when the program logic guarantees that + the access is within bounds and the big array has not been released. *) end @@ -729,15 +759,21 @@ module Array3 : (** Memory mapping of a file as a three-dimensional big array. See {!Bigarray.Genarray.map_file} for more details. *) + val release: ('a, 'b, 'c) t -> unit + (** Explicit release of the resources associated with the big array. + See {!Bigarray.Genarray.release} for more details. *) + external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_unsafe_ref_3" - (** Like {!Bigarray.Array3.get}, but bounds checking is not always - performed. *) + (** Like {!Bigarray.Array3.get}, but bounds checking is not always performed. + Use with caution and only when the program logic guarantees that + the access is within bounds and the big array has not been released. *) external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_3" - (** Like {!Bigarray.Array3.set}, but bounds checking is not always - performed. *) + (** Like {!Bigarray.Array3.set}, but bounds checking is not always performed. + Use with caution and only when the program logic guarantees that + the access is within bounds and the big array has not been released. *) end diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index c66ccbcc3..4021b74ae 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -496,18 +496,19 @@ CAMLprim value caml_ba_layout(value vb) return Val_int(Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK); } -/* Finalization of a big array */ +/* Finalization / release of a big array */ static void caml_ba_finalize(value v) { struct caml_ba_array * b = Caml_ba_array_val(v); + intnat i; switch (b->flags & CAML_BA_MANAGED_MASK) { case CAML_BA_EXTERNAL: break; case CAML_BA_MANAGED: if (b->proxy == NULL) { - free(b->data); + free(b->data); /* no op if b->data = NULL */ } else { if (-- b->proxy->refcount == 0) { free(b->proxy->data); @@ -526,6 +527,17 @@ static void caml_ba_finalize(value v) } break; } + /* Make sure that subsequent accesses to the bigarray fail (empty bounds) + and that subsequent calls to caml_ba_finalize do nothing. */ + for (i = 0; i < b->num_dims; i++) b->dim[i] = 0; + b->data = NULL; + b->proxy = NULL; +} + +CAMLprim value caml_ba_release(value v) +{ + caml_ba_finalize(v); + return Val_unit; } /* Comparison of two big arrays */ diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index f10835443..30294cc4b 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -152,11 +152,14 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, } /* 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); @@ -166,8 +169,8 @@ 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 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; @@ -186,6 +189,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 } diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml index 85901400e..28ed9af6f 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.ml +++ b/testsuite/tests/lib-bigarray/bigarrays.ml @@ -384,6 +384,12 @@ let _ = test 12 true (test_blit_fill complex64 [Complex.zero; Complex.one; Complex.i] Complex.i 1 1); + testing_function "release"; + let a = from_list int [1;2;3;4;5] in + test 1 (Array1.dim a) 5; + Array1.release a; + test 2 (Array1.dim a) 0; + (* Bi-dimensional arrays *) print_newline(); @@ -533,6 +539,14 @@ let _ = test 7 (Array2.slice_right a 2) (from_list_fortran int [1002;2002;3002;4002;5002]); test 8 (Array2.slice_right a 3) (from_list_fortran int [1003;2003;3003;4003;5003]); + testing_function "release"; + let a = (make_array2 int c_layout 0 4 6 id) in + test 1 (Array2.dim1 a) 4; + test 2 (Array2.dim2 a) 6; + Array2.release a; + test 3 (Array2.dim1 a) 0; + test 4 (Array2.dim2 a) 0; + (* Tri-dimensional arrays *) print_newline(); @@ -654,6 +668,16 @@ let _ = test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]); test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]); + testing_function "release"; + let a = (make_array3 int c_layout 0 4 5 6 id) in + test 1 (Array3.dim1 a) 4; + test 2 (Array3.dim2 a) 5; + test 3 (Array3.dim3 a) 6; + Array3.release a; + test 4 (Array3.dim1 a) 0; + test 5 (Array3.dim2 a) 0; + test 6 (Array3.dim3 a) 0; + (* Reshaping *) print_newline(); testing_function "------ Reshaping --------"; @@ -717,6 +741,7 @@ let _ = let a = Array1.map_file fd float64 c_layout true 10000 in Unix.close fd; for i = 0 to 9999 do a.{i} <- float i done; + Array1.release a; let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in let b = Array2.map_file fd float64 fortran_layout false 100 (-1) in Unix.close fd; @@ -727,7 +752,8 @@ let _ = done done; test 1 !ok true; - b.{50,50} <- (-1.0); + b.{50,50} <- (-1.0); (* private mapping -> no effect on file *) + Array2.release b; let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in let c = Array2.map_file fd float64 c_layout false (-1) 100 in Unix.close fd; @@ -738,6 +764,7 @@ let _ = done done; test 2 !ok true; + Array2.release c; let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in let c = Array2.map_file fd ~pos:800L float64 c_layout false (-1) 100 in Unix.close fd; @@ -748,6 +775,7 @@ let _ = done done; test 3 !ok true; + Array2.release c; let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in let c = Array2.map_file fd ~pos:79200L float64 c_layout false (-1) 100 in Unix.close fd; @@ -755,12 +783,13 @@ let _ = for j = 0 to 99 do if c.{0,j} <> float (100 * 99 + j) then ok := false done; - test 4 !ok true + test 4 !ok true; + Array2.release c; + test 5 (Array2.dim1 c) 0; + test 5 (Array2.dim2 c) 0 end; - (* Force garbage collection of the mapped bigarrays above, otherwise - Win32 doesn't let us erase the file. Notice the begin...end above - so that the VM doesn't keep stack references to the mapped bigarrays. *) - Gc.full_major(); + (* Win32 doesn't let us erase the file if any mapping on the file is + still active. Normally, they have all been released explicitly. *) Sys.remove mapped_file; () diff --git a/testsuite/tests/lib-bigarray/bigarrays.reference b/testsuite/tests/lib-bigarray/bigarrays.reference index bdc7beae2..def96fe4c 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.reference +++ b/testsuite/tests/lib-bigarray/bigarrays.reference @@ -17,6 +17,8 @@ sub 1... 2... 3... 4... 5... 6... 7... 8... 9... blit, fill 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... +release + 1... 2... ------ Array2 -------- @@ -32,6 +34,8 @@ sub 1... 2... slice 1... 2... 3... 4... 5... 6... 7... 8... +release + 1... 2... 3... 4... ------ Array3 -------- @@ -45,6 +49,8 @@ dim 1... 2... 3... 4... 5... 6... slice1 1... 2... 3... 4... 5... 6... 7... +release + 1... 2... 3... 4... 5... 6... ------ Reshaping -------- @@ -58,4 +64,4 @@ reshape_2 output_value/input_value 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... map_file - 1... 2... 3... 4... + 1... 2... 3... 4... 5... 5... |