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