tools/dir_stats.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (* for each marked thing, how often does it occur and in what files and
  26 directories *)
  27
  28 let collect i =
  29   let info = ref [] in
  30   let rec loop _ =
  31     let l = input_line i in
  32     (if String.length l > 2 && String.get l 0 = '+'
  33     then info := (String.sub l 1 (String.length l - 1))::!info);
  34     loop() in
  35   try loop()
  36   with End_of_file -> List.rev !info
  37
  38 let split l =
  39   let rec loop acc = function
  40     [] -> acc
  41   | x::xs ->
  42       if String.get x 0 = '+' (* the start of a new file *)
  43       then
  44         (match Str.split (Str.regexp " ") x with
  45           _::x::_ -> loop ((x,[])::acc) xs
  46         | _ -> failwith ("no file: "^x))
  47       else
  48         let acc =
  49           match acc with
  50             (file,instances)::rest -> (file,x::instances)::rest
  51           | _ -> failwith "not possible" in
  52         loop acc xs in
  53   let res = List.rev (loop [] l) in
  54   List.map (function (x,l) -> (x,List.rev l)) res
  55
  56 let detect_alloc_free str l =
  57   let try_add a f l =
  58     let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in
  59     match same with
  60       [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff
  61     | _ -> (a,[f])::l in
  62   let rec loop acc = function
  63       [] -> acc
  64     | x::xs ->
  65         match Str.split (Str.regexp (str^"\", ")) x with
  66           _::matches ->
  67             let acc =
  68               List.fold_left
  69                 (function acc ->
  70                   function rest ->
  71                     (match Str.split (Str.regexp "[, )]+") rest with
  72                       alloc::free::_ -> try_add alloc free acc
  73                     | _ -> acc))
  74                 acc matches in
  75             loop acc xs
  76         | _ -> loop acc xs in
  77   List.sort compare
  78     (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l))
  79
  80 let rec iterate str = function
  81     [] -> []
  82   | (x,l)::xs ->
  83       List.fold_left
  84         (function rest ->
  85           function info ->
  86             let (same,diff) =
  87               List.partition (function (x1,l1) -> l1 = info) rest in
  88             match same with
  89               [(files,info)] -> (x::files,info)::diff
  90             |   _ -> ([x],info)::diff)
  91         (iterate str xs) (detect_alloc_free str l)
  92
  93 (* ------------------------------------------------------------------------ *)
  94
  95 let get_dir d = Filename.dirname d
  96
  97 let get_subsystem d =
  98   let pieces = Str.split (Str.regexp "/") d in
  99   let front = List.hd(List.tl pieces) in
 100   match front with
 101     "arch" | "drivers" -> front ^ "/" ^ (List.hd(List.tl(List.tl pieces)))
 102   | _ -> front
 103
 104 let rec remdup = function
 105     [] -> []
 106   | x::xs -> if List.mem x xs then remdup xs else x :: remdup xs
 107
 108 let inc tbl key =
 109   let cell =
 110     (try let cell = Hashtbl.find tbl key in cell
 111     with Not_found -> let c = ref 0 in Hashtbl.add tbl key c; c) in
 112   cell := !cell + 1
 113
 114 let files_per_protocol = Hashtbl.create(10)
 115 let dirs_per_protocol = Hashtbl.create(10)
 116 let subsystems_per_protocol = Hashtbl.create(10)
 117 let protocols_per_subsystem = Hashtbl.create(10)
 118
 119 let collect_counts l =
 120   List.iter
 121     (function (files,(a,fs)) ->
 122       let how_many_files = List.length files in
 123       let how_many_dirs = remdup (List.map get_dir files) in
 124       let how_many_subsystems = remdup (List.map get_subsystem files) in
 125       let ct =
 126         if how_many_files < 10
 127         then how_many_files
 128         else ((how_many_files / 10) * 10) in
 129       inc files_per_protocol ct;
 130       inc dirs_per_protocol (List.length how_many_dirs);
 131       inc subsystems_per_protocol (List.length how_many_subsystems);
 132       List.iter (inc protocols_per_subsystem) how_many_subsystems)
 133     l
 134
 135 let print_hashtable f tbl =
 136   let l =
 137     Hashtbl.fold
 138       (function key -> function vl -> function rest ->
 139         (key,!vl) :: rest)
 140       tbl [] in
 141   let l = List.sort compare l in
 142   List.iter
 143     (function (key,vl) ->
 144       Printf.printf "   "; f key; Printf.printf ": %d\n" vl)
 145     l
 146
 147 let print_range_int_hashtable range =
 148   print_hashtable
 149     (function x ->
 150       if x < range
 151       then Printf.printf "%d" x
 152       else Printf.printf "%d-%d" x (x + range - 1))
 153 let print_int_hashtable =
 154   print_hashtable (function x -> Printf.printf "%d" x)
 155 let print_string_hashtable =
 156   print_hashtable (function x -> Printf.printf "%s" x)
 157
 158 let histify _ =
 159   Printf.printf "files per protocol:\n";
 160   print_range_int_hashtable 10 files_per_protocol;
 161   Printf.printf "dirs per protocol:\n";
 162   print_int_hashtable dirs_per_protocol;
 163   Printf.printf "subsystems per protocol:\n";
 164   print_int_hashtable subsystems_per_protocol;
 165   Printf.printf "protocols per subsystem:\n";
 166   print_string_hashtable protocols_per_subsystem
 167
 168 (* ------------------------------------------------------------------------ *)
 169
 170 let dir = ref "p2"
 171 let file = ref ""
 172 let str = ref "detected allocator"
 173
 174 let options = []
 175 let usage = ""
 176
 177 let _ =
 178   Arg.parse (Arg.align options) (fun x -> file := x) usage;
 179   let i = open_in !file in
 180   let l = collect i in
 181   close_in i;
 182   let l = split l in
 183   let l = iterate !str l in
 184   collect_counts l;
 185   histify()
 186
 187