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