Fix a subtle bug where OCaml/C function stack are not aligned on a 16 byte

[SXSI/xpathcomp.git] / src / utils.ml

diff --git a/src/utils.ml b/src/utils.ml
index c5547aa..8cab636 100644 (file)
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -22,3 +22,59 @@ struct
     loop 0
 end
 ;;
+
+module System =
+struct
+  let status () =
+    let pid = Unix.getpid() in
+    let cin = open_in (Printf.sprintf "/proc/%i/status" pid) in
+    let h = Hashtbl.create 17 in
+    try
+      while true do
+        let s = input_line cin in
+        Scanf.sscanf s "%s@: %s@\n" (fun k v ->
+          Hashtbl.replace h k v)
+      done;
+      (* never reached *)
+      h
+    with
+      End_of_file -> begin
+        close_in cin;
+        h
+      end
+  let get_status s = Hashtbl.find (status()) s
+
+  let pr_mem_status fmt h =
+    Format.fprintf fmt "[";
+    List.iter (fun k ->
+      let v = Hashtbl.find h k in
+      Format.fprintf fmt "%s: %s " k v
+    ) [ "VmStk"; "VmRSS"; "VmPeak" ];
+    Format.fprintf fmt "]"
+
+end
+
+let time f ?(count=1) ?(msg="") x =
+  if not !Config.verbose then f x
+  else
+  let rec loop i =
+    Gc.compact();
+    let oldmem = System.status () in
+    let t1 = Unix.gettimeofday () in
+    let r = f x in
+    let t2 = Unix.gettimeofday () in
+    let newmem = System.status () in
+    let t = (1000. *. (t2 -. t1)) in
+    Logger.verbose Format.err_formatter "@[%s: [" msg;
+    if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i,  "  i count;
+    begin
+      Format.pp_open_vbox Format.err_formatter (2 + String.length msg);
+      Logger.verbose
+        Format.err_formatter
+        "@\n| Time: %fms@\n| Memory before: %a@\n| Memory after:  %a@\n]@]@]@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
+    end;
+    if i >= count then r
+    else loop (i+1)
+  in
+  loop 1
+;;