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 "]"
57 let time f ?(count=1) ?(msg="") x =
58 if not !Config.verbose then f x
62 let oldmem = System.status () in
63 let t1 = Unix.gettimeofday () in
65 let t2 = Unix.gettimeofday () in
66 let newmem = System.status () in
67 let t = (1000. *. (t2 -. t1)) in
68 Logger.verbose Format.err_formatter "@[%s: [" msg;
69 if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i, " i count;
71 Format.pp_open_vbox Format.err_formatter (2 + String.length msg);
74 "@\n| Time: %fms@\n| Memory before: %a@\n| Memory after: %a@\n]@]@]@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
84 let _timings = Hashtbl.create 43
85 let _t_queue = Queue.create ()
89 Hashtbl.find _timings s
94 Hashtbl.replace _timings s v
97 let display_result fmt msg sub l =
98 let h = Hashtbl.create 0 in
99 let tmin, tmax, ttotal, len, memo, memn =
101 (atmin, atmax, attotal, alen, _, _)
108 (infinity, 0., 0., 0, h, h) l
110 Logger.verbose fmt "@[%s%s: [" sub msg;
111 Format.pp_open_vbox fmt (2 + String.length msg + String.length sub);
114 | Number of runs: %i@\n\
115 | Average time: %fms@\n\
116 | Minimum time: %fms@\n\
117 | Maximum time: %fms@\n\
118 | Memory before: %a@\n\
119 | Memory after: %a@\n]@]@]@\n"
121 (ttotal /. (float_of_int len))
124 System.pr_mem_status memo
125 System.pr_mem_status memn
128 let time f ?(count=1) ?(msg="") x =
129 if not !Config.verbose then f x
132 let oldmem = System.status () in
133 let t1 = Unix.gettimeofday () in
134 set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
136 let t2 = Unix.gettimeofday () in
137 let newmem = System.status () in
139 match get_timing msg with
140 (a, b, _) :: l -> a,b,l
143 let t = (1000. *. (t2 -. t1)) in
144 set_timing msg ((t, oldmem, newmem)::l);
148 Queue.push msg _t_queue;
151 if (Queue.peek _t_queue) = msg then
152 let pr_stack = Queue.fold (fun a e -> e::a) [] _t_queue in
153 Queue.clear _t_queue;
154 List.iter (fun msg' ->
156 if msg' <> msg then "(sub-timing) " else ""
158 display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
164 let time = Timing.time