blob: 1dd253dcd671fe09f06dba463e1d3fd21eac3d81 (
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
(* TEST
flags = "-g";
reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
skip;
*)
open Gc.Memprof
let root = ref []
let[@inline never] allocate_arrays lo hi cnt keep =
assert (lo >= 300); (* Will be allocated in major heap. *)
for j = 0 to cnt-1 do
for i = lo to hi do
root := Array.make i 0 :: !root
done;
if not keep then root := []
done
let check_nosample () =
Printf.printf "check_nosample\n%!";
let alloc _ =
Printf.printf "Callback called with sampling_rate = 0\n";
assert(false)
in
start ~callstack_size:10 ~sampling_rate:0.
{ null_tracker with alloc_minor = alloc; alloc_major = alloc; };
allocate_arrays 300 3000 1 false;
stop ()
let () = check_nosample ()
let check_counts_full_major force_promote =
Printf.printf "check_counts_full_major\n%!";
let nalloc_minor = ref 0 in
let nalloc_major = ref 0 in
let enable = ref true in
let npromote = ref 0 in
let ndealloc_minor = ref 0 in
let ndealloc_major = ref 0 in
start ~callstack_size:10 ~sampling_rate:0.01
{
alloc_minor = (fun _ ->
if not !enable then None
else Some (incr nalloc_minor)
);
alloc_major = (fun _ ->
if not !enable then None
else Some (incr nalloc_major)
);
promote = (fun _ ->
Some (incr npromote)
);
dealloc_minor = (fun _ ->
incr ndealloc_minor
);
dealloc_major = (fun _ ->
incr ndealloc_major
);
};
allocate_arrays 300 3000 1 true;
enable := false;
assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
if force_promote then begin
Gc.full_major ();
assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
!npromote = !nalloc_minor);
root := [];
Gc.full_major ();
assert (!ndealloc_minor = 0 &&
!ndealloc_major = !nalloc_minor + !nalloc_major);
end else begin
root := [];
Gc.minor ();
Gc.full_major ();
Gc.full_major ();
assert (!nalloc_minor = !ndealloc_minor + !npromote &&
!ndealloc_major = !npromote + !nalloc_major)
end;
stop ()
let () =
check_counts_full_major false;
check_counts_full_major true
let check_no_nested () =
Printf.printf "check_no_nested\n%!";
let in_callback = ref false in
let cb _ =
assert (not !in_callback);
in_callback := true;
allocate_arrays 300 300 100 false;
in_callback := false;
()
in
let cb' _ = cb (); Some () in
start ~callstack_size:10 ~sampling_rate:1.
{
alloc_minor = cb';
alloc_major = cb';
promote = cb';
dealloc_minor = cb;
dealloc_major = cb;
};
allocate_arrays 300 300 100 false;
stop ()
let () = check_no_nested ()
let check_distrib lo hi cnt rate =
Printf.printf "check_distrib %d %d %d %f\n%!" lo hi cnt rate;
let smp = ref 0 in
start ~callstack_size:10 ~sampling_rate:rate
{ null_tracker with
alloc_major = (fun info ->
assert (info.size >= lo && info.size <= hi);
assert (info.n_samples > 0);
assert (info.source = Normal);
smp := !smp + info.n_samples;
None
);
};
allocate_arrays lo hi cnt false;
stop ();
(* The probability distribution of the number of samples follows a
binomial distribution of parameters tot_alloc and rate. Given
that tot_alloc*rate and tot_alloc*(1-rate) are large (i.e., >
100), this distribution is approximately equal to a normal
distribution. We compute a 1e-8 confidence interval for !smp
using quantiles of the normal distribution, and check that we are
in this confidence interval. *)
let tot_alloc = cnt*(lo+hi+2)*(hi-lo+1)/2 in
assert (float tot_alloc *. rate > 100. &&
float tot_alloc *. (1. -. rate) > 100.);
let mean = float tot_alloc *. rate in
let stddev = sqrt (float tot_alloc *. rate *. (1. -. rate)) in
(* This assertion has probability to fail close to 1e-8. *)
assert (abs_float (mean -. float !smp) <= stddev *. 5.7)
let () =
check_distrib 300 3000 3 0.00001;
check_distrib 300 3000 1 0.0001;
check_distrib 300 3000 1 0.01;
check_distrib 300 3000 1 0.9;
check_distrib 300 300 100000 0.1;
check_distrib 300000 300000 30 0.1
let () =
Printf.printf "OK !\n"
|
