7 let buff = Buffer.create 40 in
10 [ Buffer.contents buff ]
14 let ss = Buffer.contents buff in
18 Buffer.add_char buff c;
29 let pid = Unix.getpid() in
30 let cin = open_in (Printf.sprintf "/proc/%i/status" pid) in
31 let h = Hashtbl.create 17 in
34 let s = input_line cin in
35 Scanf.sscanf s "%s@: %s@\n" (fun k v ->
36 Hashtbl.replace h k v)
45 let get_status s = Hashtbl.find (status()) s
47 let pr_mem_status fmt h =
48 Format.fprintf fmt "[";
50 let v = Hashtbl.find h k in
51 Format.fprintf fmt "%s: %s " k v
52 ) [ "VmStk"; "VmRSS"; "VmPeak" ];
53 Format.fprintf fmt "]"
59 let _timings = Hashtbl.create 43
60 let _t_queue = Queue.create ()
64 Hashtbl.find _timings s
69 Hashtbl.replace _timings s v
72 let display_result fmt msg sub l =
73 let h = Hashtbl.create 0 in
74 let tmin, tmax, ttotal, len, memo, memn =
76 (atmin, atmax, attotal, alen, _, _)
83 (infinity, 0., 0., 0, h, h) l
85 Logger.start_msg fmt "[Stats] ";
86 Logger.msg fmt "%s %s:@\n @[<v 0>[" sub msg;
96 | Number of runs: %i@\n\
97 | Average time: %fms@\n\
98 | Minimum time: %fms@\n\
99 | Maximum time: %fms@\n"
101 (ttotal /. (float_of_int len))
107 "| Memory before: %a@\n\
108 | Memory after: %a@\n]@]"
109 System.pr_mem_status memo
110 System.pr_mem_status memn;
111 Logger.end_msg fmt "\n\n"
114 let time f ?(count=1) ?(msg="") x =
115 if not !Config.verbose then f x
118 let oldmem = System.status () in
119 let t1 = Unix.gettimeofday () in
120 set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
122 let t2 = Unix.gettimeofday () in
123 let newmem = System.status () in
125 match get_timing msg with
126 (a, b, _) :: l -> a,b,l
129 let t = (1000. *. (t2 -. t1)) in
130 set_timing msg ((t, oldmem, newmem)::l);
134 Queue.push msg _t_queue;
137 if (Queue.peek _t_queue) = msg then
138 let pr_stack = Queue.fold (fun a e -> e::a) [] _t_queue in
139 Queue.clear _t_queue;
140 List.iter (fun msg' ->
142 if msg' <> msg then "+" else "="
144 display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
150 let time = Timing.time