blob: 8bbb7d05d61677958eadefde5156d614cf20d4d8 (
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
|
(* The following functions are implemented in perfcount.c *)
(* Returns true is we have the performance counters *)
external has_performance_counters: unit -> bool = "has_performance_counters"
(* Returns number of seconds since the first read *)
external read_pentium_perfcount : unit -> float = "read_pentium_perfcount"
(* Returns current cycle counter, divided by 1^20, and truncated to 30 bits *)
external sample_pentium_perfcount_20 : unit -> int = "sample_pentium_perfcount_20"
(* Returns current cycle counter, divided by 1^10, and truncated to 30 bits *)
external sample_pentium_perfcount_10 : unit -> int = "sample_pentium_perfcount_10"
(* Whether to use the performance counters (on Pentium only) *)
(* The performance counters are disabled by default. *)
let do_use_performance_counters = ref false
(* A hierarchy of timings *)
type t = { name : string;
mutable time : float; (* In seconds *)
mutable sub : t list}
(* Create the top level *)
let top = { name = "TOTAL";
time = 0.0;
sub = []; }
(* The stack of current path through
* the hierarchy. The first is the
* leaf. *)
let current : t list ref = ref [top]
exception NoPerfCount
let reset (perfcount: bool) =
top.sub <- [];
if perfcount then begin
if not (has_performance_counters ()) then begin
raise NoPerfCount
end
end;
do_use_performance_counters := perfcount
let print chn msg =
(* Total up *)
top.time <- List.fold_left (fun sum f -> sum +. f.time) 0.0 top.sub;
let rec prTree ind node =
if !do_use_performance_counters then
(Printf.fprintf chn "%s%-20s %8.5f s\n"
(String.make ind ' ') node.name node.time)
else
(Printf.fprintf chn "%s%-20s %6.3f s\n"
(String.make ind ' ') node.name node.time);
List.iter (prTree (ind + 2)) (List.rev node.sub)
in
Printf.fprintf chn "%s" msg;
List.iter (prTree 0) [ top ];
Printf.fprintf chn "Timing used %s\n"
(if !do_use_performance_counters then "Pentium performance counters"
else "Unix.time");
let gc = Gc.quick_stat () in
let printM (w: float) : string =
Printf.sprintf "%.2fMb" (w *. 4.0 /. 1000000.0)
in
Printf.fprintf chn
"Memory statistics: total=%s, max=%s, minor=%s, major=%s, promoted=%s\n minor collections=%d major collections=%d compactions=%d\n"
(printM (gc.Gc.minor_words +. gc.Gc.major_words
-. gc.Gc.promoted_words))
(printM (float_of_int gc.Gc.top_heap_words))
(printM gc.Gc.minor_words)
(printM gc.Gc.major_words)
(printM gc.Gc.promoted_words)
gc.Gc.minor_collections
gc.Gc.major_collections
gc.Gc.compactions;
()
(* Get the current time, in seconds *)
let get_current_time () : float =
if !do_use_performance_counters then
read_pentium_perfcount ()
else
(Unix.times ()).Unix.tms_utime
let repeattime limit str f arg =
(* Find the right stat *)
let stat : t =
let curr = match !current with h :: _ -> h | _ -> assert false in
let rec loop = function
h :: _ when h.name = str -> h
| _ :: rest -> loop rest
| [] ->
let nw = {name = str; time = 0.0; sub = []} in
curr.sub <- nw :: curr.sub;
nw
in
loop curr.sub
in
let oldcurrent = !current in
current := stat :: oldcurrent;
let start = get_current_time () in
let rec repeatf count =
let res = f arg in
let diff = get_current_time () -. start in
if diff < limit then
repeatf (count + 1)
else begin
stat.time <- stat.time +. (diff /. float(count));
current := oldcurrent; (* Pop the current stat *)
res (* Return the function result *)
end
in
repeatf 1
let time str f arg = repeattime 0.0 str f arg
let lastTime = ref 0.0
let timethis (f: 'a -> 'b) (arg: 'a) : 'b =
let start = get_current_time () in
let res = f arg in
lastTime := get_current_time () -. start;
res
|
