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.verbose fmt "@[%s%s: [" sub msg;
86 Format.pp_open_vbox fmt (2 + String.length msg + String.length sub);
89 | Number of runs: %i@\n\
90 | Average time: %fms@\n\
91 | Minimum time: %fms@\n\
92 | Maximum time: %fms@\n\
93 | Memory before: %a@\n\
94 | Memory after: %a@\n]@]@]@\n"
96 (ttotal /. (float_of_int len))
99 System.pr_mem_status memo
100 System.pr_mem_status memn
103 let time f ?(count=1) ?(msg="") x =
104 if not !Config.verbose then f x
107 let oldmem = System.status () in
108 let t1 = Unix.gettimeofday () in
109 set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
111 let t2 = Unix.gettimeofday () in
112 let newmem = System.status () in
114 match get_timing msg with
115 (a, b, _) :: l -> a,b,l
118 let t = (1000. *. (t2 -. t1)) in
119 set_timing msg ((t, oldmem, newmem)::l);
123 Queue.push msg _t_queue;
126 if (Queue.peek _t_queue) = msg then
127 let pr_stack = Queue.fold (fun a e -> e::a) [] _t_queue in
128 Queue.clear _t_queue;
129 List.iter (fun msg' ->
131 if msg' <> msg then "(sub-timing) " else ""
133 display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
139 let time = Timing.time