Commit | Line | Data |
---|---|---|
9f8e26f4 C |
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 | ||
34e49164 C |
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 |