From 38a3c71734760b87bd2ee9a5f80c8aaeadc9ee54 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Sun, 21 Oct 2012 09:36:36 +0200
Subject: [PATCH] WIP on beautyfying the pretty-printing module.     move the
 reading of /proc/<pid>/status in the Utils module     work to move the timing
 function in there too.

---
 include/utils.ml |  5 +++--
 src/options.ml   |  5 ++---
 src/utils.ml     | 55 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/include/utils.ml b/include/utils.ml
index 4a844f4..1554f44 100644
--- a/include/utils.ml
+++ b/include/utils.ml
@@ -107,14 +107,15 @@ let time f ?(count=1) ?(msg="") x =
   else
   let rec loop i =
     Gc.compact();
-    let oldstack = read_procmem () in
+    let oldstack = Utils.System.get_status "VmStk" in
     let t1 = Unix.gettimeofday () in
     let r = f x in
     let t2 = Unix.gettimeofday () in
+    let newstack = Utils.System.get_status "VmStk" 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;
-    Logger.verbose Format.err_formatter "%fms (stack size: before=%s, after=%s)@\n" t oldstack (read_procmem());
+    Logger.verbose Format.err_formatter "%fms (stack size: before=%s, after=%s)@\n" t oldstack newstack;
     if i >= count then  (l:= t::!l;r)
     else loop (i+1)
   in
diff --git a/src/options.ml b/src/options.ml
index 4a7a0c7..197982d 100644
--- a/src/options.ml
+++ b/src/options.ml
@@ -1,4 +1,3 @@
-open Utils
 open Format
 
 let index_empty_texts = ref true
@@ -43,13 +42,13 @@ let set_logger s =
   List.iter (fun t ->
     if t = "" then ()
     else
-      match String.explode t ':' with
+      match Utils.String.explode t ':' with
 	[ tr; lvl ] ->
 	  let l = try int_of_string lvl with _ -> raise (Arg.Bad (lvl)) in
 	  if Logger.is_logger tr then Logger.activate tr l
 	  else raise (Arg.Bad (t))
       | _ -> raise (Arg.Bad (t))
-  ) (String.explode s ',')
+  ) (Utils.String.explode s ',')
 
 let pretty_loggers () =
   ignore(flush_str_formatter());
diff --git a/src/utils.ml b/src/utils.ml
index c5547aa..4ea44cb 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -22,3 +22,58 @@ 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 !Options.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;
+    Logger.verbose
+      Format.err_formatter
+      "%fms (before: %a, after: %a)@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
+    if i >= count then r
+    else loop (i+1)
+  in
+  loop 1
+  
+;;
+*)
-- 
2.17.1