blob: bb8dfc9848e05347cb99efeb5786ec0e282852d0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
(* TEST
* hassysthreads
include systhreads
* skip
reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634"
** bytecode
** native
*)
let t2_begin = Atomic.make false
let t2_promoting = Atomic.make false
let t2_finish_promote = Atomic.make false
let t2_done = Atomic.make false
let t2_quit = Atomic.make false
let await a =
while not (Atomic.get a) do Thread.yield () done
let set a =
Atomic.set a true
(* no-alloc printing to stdout *)
let say msg =
Unix.write Unix.stdout (Bytes.unsafe_of_string msg) 0 (String.length msg) |> ignore
let static_ref = ref 0
let global = ref static_ref
let thread_fn () =
await t2_begin;
say "T2: alloc\n";
let r = ref 0 in
global := r;
say "T2: minor GC\n";
Gc.minor ();
global := static_ref;
say "T2: done\n";
set t2_done;
await t2_quit
let big = ref [| |]
let fill_big () = big := Array.make 1000 42
[@@inline never] (* Prevent flambda to move the allocated array in a global
root (see #9978). *)
let empty_big () = big := [| |]
[@@inline never]
let () =
let th = Thread.create thread_fn () in
Gc.Memprof.(start ~sampling_rate:1.
{ null_tracker with
alloc_minor = (fun _ ->
say " minor alloc\n";
Some ());
alloc_major = (fun _ ->
say " major alloc\n";
Some "major block\n");
promote = (fun () ->
say " promoting...\n";
set t2_promoting;
await t2_finish_promote;
say " ...done promoting\n";
Some "promoted block\n");
dealloc_major = (fun msg ->
say " major dealloc: "; say msg) });
say "T1: alloc\n";
fill_big ();
set t2_begin;
await t2_promoting;
say "T1: major GC\n";
empty_big ();
Gc.full_major ();
set t2_finish_promote;
await t2_done;
say "T1: major GC\n";
Gc.full_major ();
say "T1: done\n";
Gc.Memprof.stop ();
set t2_quit;
Thread.join th
|
