blob: ed14563df7c49fbc8146980c39004441b94a43c5 (
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
|
(***********************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
(* \VV/ *************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
(*s Logical and physical size of ocaml values. *)
(** {6 Logical sizes} *)
let c = ref 0
let s = ref 0
let b = ref 0
let m = ref 0
let rec obj_stats d t =
if Obj.is_int t then m := max d !m
else if Obj.tag t >= Obj.no_scan_tag then
if Obj.tag t = Obj.string_tag then
(c := !c + Obj.size t; b := !b + 1; m := max d !m)
else if Obj.tag t = Obj.double_tag then
(s := !s + 2; b := !b + 1; m := max d !m)
else if Obj.tag t = Obj.double_array_tag then
(s := !s + 2 * Obj.size t; b := !b + 1; m := max d !m)
else (b := !b + 1; m := max d !m)
else
let n = Obj.size t in
s := !s + n; b := !b + 1;
block_stats (d + 1) (n - 1) t
and block_stats d i t =
if i >= 0 then (obj_stats d (Obj.field t i); block_stats d (i-1) t)
let obj_stats a =
c := 0; s:= 0; b:= 0; m:= 0;
obj_stats 0 (Obj.repr a);
(!c, !s + !b, !m)
(** {6 Physical sizes} *)
(*s Pointers already visited are stored in a hash-table, where
comparisons are done using physical equality. *)
module H = Hashtbl.Make(
struct
type t = Obj.t
let equal = (==)
let hash o = Hashtbl.hash (Obj.magic o : int)
end)
let node_table = (H.create 257 : unit H.t)
let in_table o = try H.find node_table o; true with Not_found -> false
let add_in_table o = H.add node_table o ()
let reset_table () = H.clear node_table
(*s Objects are traversed recursively, as soon as their tags are less than
[no_scan_tag]. [count] records the numbers of words already visited. *)
let size_of_double = Obj.size (Obj.repr 1.0)
let count = ref 0
let rec traverse t =
if not (in_table t) then begin
if Obj.is_block t then begin
add_in_table t;
let n = Obj.size t in
let tag = Obj.tag t in
if tag < Obj.no_scan_tag then begin
count := !count + 1 + n;
for i = 0 to n - 1 do
let f = Obj.field t i in traverse f
done
end else if tag = Obj.string_tag then
count := !count + 1 + n
else if tag = Obj.double_tag then
count := !count + size_of_double
else if tag = Obj.double_array_tag then
count := !count + 1 + size_of_double * n
else
incr count
end
end
(*s Sizes of objects in words and in bytes. The size in bytes is computed
system-independently according to [Sys.word_size]. *)
let size o =
reset_table ();
count := 0;
traverse (Obj.repr o);
!count
let size_b o = (size o) * (Sys.word_size / 8)
let size_kb o = (size o) / (8192 / Sys.word_size)
(*s Total size of the allocated ocaml heap. *)
let heap_size () =
let stat = Gc.stat ()
and control = Gc.get () in
let max_words_total = stat.Gc.heap_words + control.Gc.minor_heap_size in
(max_words_total * (Sys.word_size / 8))
let heap_size_kb () = (heap_size () + 1023) / 1024
|
