From a84e4fba7daf4f600958487d88f0b733fb19042e Mon Sep 17 00:00:00 2001
From: kim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Date: Thu, 19 Jan 2012 09:48:50 +0000
Subject: [PATCH] Add performances counter option

git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@1185 3cdefd35-fc62-479d-8e8d-bae585ffb9ca
---
 include/utils.ml | 33 +++++++++++++++++++++++++++++++++
 src/main.ml      |  3 ++-
 src/options.ml   |  3 +++
 src/options.mli  |  1 +
 4 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/include/utils.ml b/include/utils.ml
index 5de5646..88a1dd2 100644
--- a/include/utils.ml
+++ b/include/utils.ml
@@ -69,6 +69,39 @@ let time_mem f x =
     Printf.eprintf "Final Mem: %s\n\n\n%!" s2;
     r
 ;;
+
+let pid = ref 0
+let start_perf () =
+
+  let ppid = Unix.getpid() in
+  let cmd = "/usr/bin/perf" in
+  if not (Sys.file_exists cmd) then (failwith "Binary '/usr/bin/perf' not found");
+  let args = [| cmd; "stat"; "--pid=" ^ (string_of_int ppid);
+		"-e"; "L1-dcache-load";
+		"-e"; "L1-dcache-load-misses";
+		"-e"; "L1-dcache-store";
+		"-e"; "L1-dcache-store-misses";
+		"-e"; "L1-icache-load";
+		"-e"; "L1-icache-load-misses";
+		"-e"; "branch-load";
+		"-e"; "branch-load-misses";
+		"-e"; "cpu-cycles";
+		"-e"; "stalled-cycles-frontend";
+		"-e"; "stalled-cycles-backend";
+		"-e"; "instructions";
+		"-e"; "cache-references";
+		"-e"; "cache-misses";
+		"-e"; "branch-instructions";
+		"-e"; "branch-misses";
+		"-e"; "bus-cycles";
+	     |] in
+  let p =  Unix.fork() in
+  pid := p;
+  if !pid == 0 then Unix.execv cmd args
+
+let stop_perf () =
+  Unix.kill !pid Sys.sigint
+
 let time f ?(count=1) ?(msg="") x =
   let rec loop i =
     Gc.compact();
diff --git a/src/main.ml b/src/main.ml
index 1981fc2..8c7c81f 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -19,10 +19,11 @@ let tuned_gc = { default_gc with
 		   Gc.space_overhead = 100;
 	       }
 
-
 let mk_runtime run auto doc arg count print outfile =
   fun () ->
+    if !Options.do_perf then start_perf ();
     let r = time ~count:1 ~msg:"Execution time" (run auto doc) arg in
+    if !Options.do_perf then stop_perf ();
     Printf.eprintf "Number of results: %i\n%!" (count r);
     match outfile with
 	None -> ()
diff --git a/src/options.ml b/src/options.ml
index 10c7633..d72763e 100644
--- a/src/options.ml
+++ b/src/options.ml
@@ -13,6 +13,7 @@ let bottom_up = ref false
 let no_jump = ref false
 let verbose = ref false
 let text_index_type = ref 0
+let do_perf = ref false
 
 (* Only valid if compiled with -DTRACE *)
 let trace_file = ref "trace.dot"
@@ -55,6 +56,8 @@ let spec = Arg.align
 
     "-nj", Arg.Set(no_jump), " disable jumping";
 
+    "-p",  Arg.Set(do_perf), " dump perf counters (Linux only)";
+
     "-index-type", Arg.Symbol ([ "default"; "swcsa"; "rlcsa" ],
 			       set_index_type),
     " choose text index type";
diff --git a/src/options.mli b/src/options.mli
index 497f565..57f142b 100644
--- a/src/options.mli
+++ b/src/options.mli
@@ -13,3 +13,4 @@ val bottom_up : bool ref
 val no_jump : bool ref
 val verbose : bool ref
 val text_index_type : int ref
+val do_perf : bool ref
-- 
2.17.1