Commit | Line | Data |
---|---|---|
f537ebc4 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 | ||
34e49164 C |
25 | (* The following finds out for each file, how it does deallocation for each |
26 | allocator *) | |
27 | ||
28 | let collect i = | |
29 | let info = ref [] in | |
30 | let rec loop _ = | |
31 | let l = input_line i in | |
32 | (if String.length l > 2 && String.get l 0 = '+' | |
33 | then info := (String.sub l 1 (String.length l - 1))::!info); | |
34 | loop() in | |
35 | try loop() | |
36 | with End_of_file -> List.rev !info | |
37 | ||
38 | let split l = | |
39 | let rec loop acc = function | |
40 | [] -> acc | |
41 | | x::xs -> | |
42 | if String.get x 0 = '+' (* the start of a new file *) | |
43 | then | |
44 | (match Str.split (Str.regexp " ") x with | |
45 | _::x::_ -> loop ((x,[])::acc) xs | |
46 | | _ -> failwith ("no file: "^x)) | |
47 | else | |
48 | let acc = | |
49 | match acc with | |
50 | (file,instances)::rest -> (file,x::instances)::rest | |
51 | | _ -> failwith "not possible" in | |
52 | loop acc xs in | |
53 | let res = List.rev (loop [] l) in | |
54 | List.map (function (x,l) -> (x,List.rev l)) res | |
55 | ||
56 | let detect_alloc_free str l = | |
57 | let try_add a f l = | |
58 | let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in | |
59 | match same with | |
60 | [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff | |
61 | | _ -> (a,[f])::l in | |
62 | let rec loop acc = function | |
63 | [] -> acc | |
64 | | x::xs -> | |
65 | match Str.split (Str.regexp (str^"\", ")) x with | |
66 | _::matches -> | |
67 | let acc = | |
68 | List.fold_left | |
69 | (function acc -> | |
70 | function rest -> | |
71 | (match Str.split (Str.regexp "[, )]+") rest with | |
72 | alloc::free::_ -> try_add alloc free acc | |
73 | | _ -> acc)) | |
74 | acc matches in | |
75 | loop acc xs | |
76 | | _ -> loop acc xs in | |
77 | List.sort compare | |
78 | (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l)) | |
79 | ||
80 | let rec iterate str = function | |
81 | [] -> [] | |
82 | | (x,l)::xs -> | |
83 | List.fold_left | |
84 | (function rest -> | |
85 | function info -> | |
86 | let (same,diff) = | |
87 | List.partition (function (x1,l1) -> l1 = info) rest in | |
88 | match same with | |
89 | [(files,info)] -> (x::files,info)::diff | |
90 | | _ -> ([x],info)::diff) | |
91 | (iterate str xs) (detect_alloc_free str l) | |
92 | ||
93 | (* ------------------------------------------------------------------------ *) | |
94 | (* The following prints that information *) | |
95 | ||
96 | let print_output l = | |
97 | List.iter | |
98 | (function (files,(a,fs)) -> | |
99 | List.iter (function x -> Printf.printf "%s\n" x) files; | |
100 | Printf.printf " alloc: %s, free: %s\n" a (String.concat ", " fs); | |
101 | Printf.printf "\n") | |
102 | l | |
103 | ||
104 | (* ------------------------------------------------------------------------ *) | |
105 | (* The following makes a semantic patch for that information *) | |
106 | ||
107 | let sedify o generic_file dir l = | |
108 | List.iter | |
109 | (function (files,(a,fs)) -> | |
110 | match fs with | |
111 | [f] -> | |
112 | let _ = | |
113 | Sys.command | |
114 | (Printf.sprintf | |
115 | "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s.cocci\n" | |
116 | a generic_file f dir a f) in () | |
117 | | _ -> ()) | |
118 | l; | |
119 | List.iter | |
120 | (function (files,(a,fs)) -> | |
121 | match fs with | |
122 | [f] -> Printf.fprintf o "mono_spatch_linux %s-%s.cocci &\n" a f | |
123 | | _ -> ()) | |
124 | l | |
125 | ||
126 | let collect_allocs l = | |
127 | let union = | |
128 | List.fold_left | |
129 | (function rest -> function x -> | |
130 | if List.mem x rest then rest else x::rest) in | |
131 | List.fold_left | |
132 | (function rest -> | |
133 | function (files,(a,fs)) -> | |
134 | let (same,diff) = | |
135 | List.partition (function (a1,fs1) -> a = a1) rest in | |
136 | match same with | |
137 | [(a1,fs1)] -> (a,union fs fs1)::diff | |
138 | | [] -> (a,fs)::rest | |
139 | | _ -> failwith "not possible") | |
140 | [] l | |
141 | ||
142 | let sedify_ors o generic_file dir l = | |
143 | let l = collect_allocs l in | |
144 | List.iter | |
145 | (function (a,fs) -> | |
146 | match fs with | |
147 | [_] | [] -> () | |
148 | | (f::_) -> | |
149 | let sfs = | |
150 | Printf.sprintf "\"\\\\\\(%s\\\\\\)\"" | |
151 | (String.concat "\\\\\\|" fs) in | |
152 | let _ = | |
153 | Sys.command | |
154 | (Printf.sprintf | |
155 | "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s_et_al.cocci\n" | |
156 | a generic_file sfs dir a f) in ()) | |
157 | l; | |
158 | List.iter | |
159 | (function (a,fs) -> | |
160 | match fs with | |
161 | [_] | [] -> () | |
162 | | (f::_) -> | |
163 | Printf.fprintf o "mono_spatch_linux %s-%s_et_al.cocci &\n" a f) | |
164 | l | |
165 | ||
166 | (* ------------------------------------------------------------------------ *) | |
167 | ||
168 | let sed = ref false | |
169 | let gen = ref "generic2.cocci" | |
170 | let dir = ref "p2" | |
171 | let file = ref "" | |
172 | let str = ref "detected allocator" | |
173 | ||
174 | let options = [ "-sed", Arg.Set sed, "sed output"; | |
175 | "-sp", Arg.String (function x -> gen := x), | |
176 | "detection string"; | |
177 | "-str", Arg.String (function x -> str := x), | |
178 | "cocci file for use with sed"; | |
179 | "-dir", Arg.String (function x -> dir := x), | |
180 | "dir for sed output"; ] | |
181 | let usage = "" | |
182 | ||
183 | let _ = | |
184 | Arg.parse (Arg.align options) (fun x -> file := x) usage; | |
185 | let i = open_in !file in | |
186 | let l = collect i in | |
187 | close_in i; | |
188 | let l = split l in | |
189 | let l = iterate !str l in | |
190 | (if !sed | |
191 | then | |
192 | begin | |
193 | let o = open_out (Printf.sprintf "%s/files" !dir) in | |
8ba84ae2 | 194 | Printf.fprintf o "#!/bin/sh\n\n"; |
34e49164 C |
195 | sedify o !gen !dir l; |
196 | sedify_ors o !gen !dir l; | |
197 | Printf.fprintf o "\nwait\n/bin/rm tmp*out\n"; | |
198 | close_out o | |
199 | end); | |
200 | if not !sed then print_output l |