tools/dir_stats.ml

   1 (*
   2  * Copyright 2005-2009, 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 (* for each marked thing, how often does it occur and in what files and
  24 directories *)
  25
  26 let collect i =
  27   let info = ref [] in
  28   let rec loop _ =
  29     let l = input_line i in
  30     (if String.length l > 2 && String.get l 0 = '+'
  31     then info := (String.sub l 1 (String.length l - 1))::!info);
  32     loop() in
  33   try loop()
  34   with End_of_file -> List.rev !info
  35
  36 let split l =
  37   let rec loop acc = function
  38     [] -> acc
  39   | x::xs ->
  40       if String.get x 0 = '+' (* the start of a new file *)
  41       then
  42         (match Str.split (Str.regexp " ") x with
  43           _::x::_ -> loop ((x,[])::acc) xs
  44         | _ -> failwith ("no file: "^x))
  45       else
  46         let acc =
  47           match acc with
  48             (file,instances)::rest -> (file,x::instances)::rest
  49           | _ -> failwith "not possible" in
  50         loop acc xs in
  51   let res = List.rev (loop [] l) in
  52   List.map (function (x,l) -> (x,List.rev l)) res
  53
  54 let detect_alloc_free str l =
  55   let try_add a f l =
  56     let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in
  57     match same with
  58       [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff
  59     | _ -> (a,[f])::l in
  60   let rec loop acc = function
  61       [] -> acc
  62     | x::xs ->
  63         match Str.split (Str.regexp (str^"\", ")) x with
  64           _::matches ->
  65             let acc =
  66               List.fold_left
  67                 (function acc ->
  68                   function rest ->
  69                     (match Str.split (Str.regexp "[, )]+") rest with
  70                       alloc::free::_ -> try_add alloc free acc
  71                     | _ -> acc))
  72                 acc matches in
  73             loop acc xs
  74         | _ -> loop acc xs in
  75   List.sort compare
  76     (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l))
  77
  78 let rec iterate str = function
  79     [] -> []
  80   | (x,l)::xs ->
  81       List.fold_left
  82         (function rest ->
  83           function info ->
  84             let (same,diff) =
  85               List.partition (function (x1,l1) -> l1 = info) rest in
  86             match same with
  87               [(files,info)] -> (x::files,info)::diff
  88             |   _ -> ([x],info)::diff)
  89         (iterate str xs) (detect_alloc_free str l)
  90
  91 (* ------------------------------------------------------------------------ *)
  92
  93 let get_dir d = Filename.dirname d
  94
  95 let get_subsystem d =
  96   let pieces = Str.split (Str.regexp "/") d in
  97   let front = List.hd(List.tl pieces) in
  98   match front with
  99     "arch" | "drivers" -> front ^ "/" ^ (List.hd(List.tl(List.tl pieces)))
 100   | _ -> front
 101
 102 let rec remdup = function
 103     [] -> []
 104   | x::xs -> if List.mem x xs then remdup xs else x :: remdup xs
 105
 106 let inc tbl key =
 107   let cell =
 108     (try let cell = Hashtbl.find tbl key in cell
 109     with Not_found -> let c = ref 0 in Hashtbl.add tbl key c; c) in
 110   cell := !cell + 1
 111
 112 let files_per_protocol = Hashtbl.create(10)
 113 let dirs_per_protocol = Hashtbl.create(10)
 114 let subsystems_per_protocol = Hashtbl.create(10)
 115 let protocols_per_subsystem = Hashtbl.create(10)
 116
 117 let collect_counts l =
 118   List.iter
 119     (function (files,(a,fs)) ->
 120       let how_many_files = List.length files in
 121       let how_many_dirs = remdup (List.map get_dir files) in
 122       let how_many_subsystems = remdup (List.map get_subsystem files) in
 123       let ct =
 124         if how_many_files < 10
 125         then how_many_files
 126         else ((how_many_files / 10) * 10) in
 127       inc files_per_protocol ct;
 128       inc dirs_per_protocol (List.length how_many_dirs);
 129       inc subsystems_per_protocol (List.length how_many_subsystems);
 130       List.iter (inc protocols_per_subsystem) how_many_subsystems)
 131     l
 132
 133 let print_hashtable f tbl =
 134   let l =
 135     Hashtbl.fold
 136       (function key -> function vl -> function rest ->
 137         (key,!vl) :: rest)
 138       tbl [] in
 139   let l = List.sort compare l in
 140   List.iter
 141     (function (key,vl) ->
 142       Printf.printf "   "; f key; Printf.printf ": %d\n" vl)
 143     l
 144
 145 let print_range_int_hashtable range =
 146   print_hashtable
 147     (function x ->
 148       if x < range
 149       then Printf.printf "%d" x
 150       else Printf.printf "%d-%d" x (x + range - 1))
 151 let print_int_hashtable =
 152   print_hashtable (function x -> Printf.printf "%d" x)
 153 let print_string_hashtable =
 154   print_hashtable (function x -> Printf.printf "%s" x)
 155
 156 let histify _ =
 157   Printf.printf "files per protocol:\n";
 158   print_range_int_hashtable 10 files_per_protocol;
 159   Printf.printf "dirs per protocol:\n";
 160   print_int_hashtable dirs_per_protocol;
 161   Printf.printf "subsystems per protocol:\n";
 162   print_int_hashtable subsystems_per_protocol;
 163   Printf.printf "protocols per subsystem:\n";
 164   print_string_hashtable protocols_per_subsystem
 165
 166 (* ------------------------------------------------------------------------ *)
 167
 168 let dir = ref "p2"
 169 let file = ref ""
 170 let str = ref "detected allocator"
 171
 172 let options = []
 173 let usage = ""
 174
 175 let _ =
 176   Arg.parse (Arg.align options) (fun x -> file := x) usage;
 177   let i = open_in !file in
 178   let l = collect i in
 179   close_in i;
 180   let l = split l in
 181   let l = iterate !str l in
 182   collect_counts l;
 183   histify()
 184
 185