tools/dir_stats.ml

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