-
Notifications
You must be signed in to change notification settings - Fork 76
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Ensure that all Bigarray memory managed by the GC is tracked by Mempr…
…of (#3356) There were two cases where this was not already the case: - Unix.map_file: Fixed by adding memprof calls to mmap_ba.c - User-allocated, GC-freed bigstrings: These are allocated by calls to caml_ba_alloc with CAML_BA_MANAGED, non-NULL data, and not CAML_BA_SUBARRAY (so new bigarrays, not slices) Runtime5 already handled this case correctly. The fix for runtime4 is to add a new call to memprof for the missing case.
- Loading branch information
Showing
6 changed files
with
182 additions
and
24 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,90 @@ | ||
| (* TEST | ||
| modules = "bigarray_stubs.c"; | ||
| include unix; | ||
| hasunix; | ||
| { | ||
| bytecode; | ||
| }{ | ||
| native; | ||
| } | ||
| *) | ||
| module MP = Gc.Memprof | ||
|
|
||
| type bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t | ||
|
|
||
| external static_bigstring : unit -> bigstring = "static_bigstring" | ||
| external new_bigstring : unit -> bigstring = "new_bigstring" | ||
| external malloc_bigstring : unit -> bigstring = "malloc_bigstring" | ||
|
|
||
| let bigstring_create sz : bigstring = | ||
| Bigarray.Array1.create Bigarray.char Bigarray.c_layout sz | ||
|
|
||
| let keep = ref [] | ||
|
|
||
| let test () = | ||
| let custom_words = ref 0 in | ||
| let tmp_filename = Filename.temp_file "custom_test" ".dat" in | ||
| let alloc (info : MP.allocation) = | ||
| match info.source with | ||
| | Custom -> | ||
| custom_words := !custom_words + info.size * Sys.word_size/8; | ||
| Some info.size | ||
| | _ -> | ||
| None | ||
| in | ||
| let dealloc size = | ||
| custom_words := !custom_words - size * Sys.word_size/8 | ||
| in | ||
| let tracker : _ MP.tracker = | ||
| { alloc_minor = alloc; | ||
| alloc_major = alloc; | ||
| promote = (fun x -> Some x); | ||
| dealloc_minor = dealloc; | ||
| dealloc_major = dealloc } | ||
| in | ||
| let _:MP.t = MP.start ~sampling_rate:1. tracker in | ||
| let log s = Printf.printf "%20s: %d bytes\n%!" s !custom_words in | ||
| let[@inline never] test_tail () = | ||
| (* This is a separate tail-called function, to ensure | ||
| that [str] is out of scope even on bytecode builds *) | ||
| keep := []; | ||
| Gc.full_major (); | ||
| log "gc" | ||
| in | ||
| let test msg str = | ||
| Sys.poll_actions (); | ||
| log msg; | ||
| keep := [str]; | ||
| (* sub and slice should not count as allocations *) | ||
| keep := Bigarray.Array1.sub str 1000 1000 :: !keep; | ||
| log "sub"; | ||
| Gc.full_major (); | ||
| keep := Bigarray.Array1.sub str 1000 1000 :: !keep; | ||
| log "slice"; | ||
| (test_tail[@tailcall]) () | ||
| in | ||
| test "Allocation" (bigstring_create 5000); | ||
|
|
||
| let map_len = 64 * 1024 in | ||
| Unix.truncate tmp_filename map_len; | ||
| let fd = Unix.openfile tmp_filename [O_RDONLY] 0o600 in | ||
| test "Unix.map_file" | ||
| (Unix.map_file fd Bigarray.char Bigarray.c_layout false [| map_len |] | ||
| |> Bigarray.array1_of_genarray); | ||
| Unix.close fd; | ||
|
|
||
| (* Externally managed memory, should not be tracked *) | ||
| test "CAML_BA_EXTERNAL" (static_bigstring ()); | ||
|
|
||
| (* Runtime-allocated memory, should be tracked *) | ||
| test "ba_alloc NULL" (new_bigstring ()); | ||
|
|
||
| (* User-allocated yet GC-managed memory, should be tracked *) | ||
| test "CAML_BA_MANAGED" (malloc_bigstring ()); | ||
|
|
||
| MP.stop (); | ||
| Sys.remove tmp_filename; | ||
| assert (!custom_words = 0) | ||
|
|
||
|
|
||
| let () = test () |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,20 @@ | ||
| Allocation: 5000 bytes | ||
| sub: 5000 bytes | ||
| slice: 5000 bytes | ||
| gc: 0 bytes | ||
| Unix.map_file: 65536 bytes | ||
| sub: 65536 bytes | ||
| slice: 65536 bytes | ||
| gc: 0 bytes | ||
| CAML_BA_EXTERNAL: 0 bytes | ||
| sub: 0 bytes | ||
| slice: 0 bytes | ||
| gc: 0 bytes | ||
| ba_alloc NULL: 5000 bytes | ||
| sub: 5000 bytes | ||
| slice: 5000 bytes | ||
| gc: 0 bytes | ||
| CAML_BA_MANAGED: 5000 bytes | ||
| sub: 5000 bytes | ||
| slice: 5000 bytes | ||
| gc: 0 bytes |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,24 @@ | ||
| #include <stdlib.h> | ||
| #include <caml/bigarray.h> | ||
|
|
||
| static char buf[10000]; | ||
| value static_bigstring(value unit) | ||
| { | ||
| intnat dim[] = { sizeof(buf) }; | ||
| return caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_EXTERNAL, | ||
| 1, buf, dim); | ||
| } | ||
|
|
||
| value new_bigstring(value unit) | ||
| { | ||
| intnat dim[] = { 5000 }; | ||
| return caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, | ||
| 1, NULL, dim); | ||
| } | ||
|
|
||
| value malloc_bigstring(value unit) | ||
| { | ||
| intnat dim[] = { 5000 }; | ||
| return caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, | ||
| 1, malloc(dim[0]), dim); | ||
| } |