Source file funcFunction.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
open GoblintCil
open Cabs2cil
let is_equal_funname_funid varinfo name id =
if String.compare varinfo.vname name = 0 || varinfo.vid = id then true
else false
let rec delete_elem list s =
match list with
| x :: xs ->
if String.compare x s = 0 then delete_elem xs s else x :: delete_elem xs s
| [] -> []
let rec delete_duplicates list acc =
match list with
| x :: xs -> delete_duplicates (delete_elem xs x) (x :: acc)
| [] -> acc
let map_gfun f = function GFun (dec, loc) -> f dec loc | _ -> None
let find_all_with_origname n =
let ns = Hashtbl.find_all environment n in
Util.list_filter_map (function | (EnvVar v,_) -> Some v.vname | _ -> None) ns
class fun_find_returns funname funid result : nopCilVisitor =
object
inherit nopCilVisitor
method! vfunc fundec =
if is_equal_funname_funid fundec.svar funname funid then DoChildren
else SkipChildren
method! vstmt stmt =
match stmt.skind with
| Return (Some exp, loc) ->
result :=
!result
@ [
( "",
loc,
String.trim (Pretty.sprint ~width:1 (d_type () (typeOf exp))),
-1 );
];
DoChildren
| Return (None, loc) ->
result := !result @ [ ("", loc, "void", -1) ];
DoChildren
| _ -> DoChildren
end
let find_returns funname funid file =
let result = ref [] in
let visitor = new fun_find_returns funname funid result in
ignore (visitCilFileSameGlobals visitor file);
!result
let find_returns_all file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ -> Some (find_returns "" fundec.svar.vid file)))
file.globals
class fun_find_sig funname funid result : nopCilVisitor =
object
inherit nopCilVisitor
method! vfunc fundec =
if is_equal_funname_funid fundec.svar funname funid then DoChildren
else SkipChildren
method! vstmt stmt =
match stmt.skind with
| Return (Some exp, loc) ->
result :=
!result
@ [
( "",
loc,
String.trim (Pretty.sprint ~width:1 (d_type () (typeOf exp))),
-1 );
];
SkipChildren
| Return (None, loc) ->
result := !result @ [ ("", loc, "void", -1) ];
SkipChildren
| _ -> DoChildren
end
let create_sig fundec file =
let result = ref [] in
let return_type =
match
visitCilFileSameGlobals
(new fun_find_sig fundec.svar.vname fundec.svar.vid result)
file;
!result
with
| (_, _, typ, _) :: _ -> typ
| [] ->
Printf.printf "This should never happen\n";
""
in
let rec input_type list =
match list with
| [ x ] ->
String.trim (Pretty.sprint ~width:1 (d_type () x.vtype)) ^ " " ^ x.vname
| x :: xs ->
String.trim (Pretty.sprint ~width:1 (d_type () x.vtype))
^ " " ^ x.vname ^ ", " ^ input_type xs
| [] -> ""
in
return_type ^ " " ^ fundec.svar.vname ^ " (" ^ input_type fundec.sformals
^ ")"
let find_def funname funid file =
let fn fundec loc =
if is_equal_funname_funid fundec.svar funname funid then
Some (fundec.svar.vname, loc, create_sig fundec file, fundec.svar.vid)
else None
in
Util.list_filter_map (map_gfun fn) file.globals
let find_def_all file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ -> Some (find_def "" fundec.svar.vid file)))
file.globals
let find_fundec funname funid list =
let gfun =
List.find_opt
(fun x ->
match x with
| GFun (dec, _) -> is_equal_funname_funid dec.svar funname funid
| _ -> false)
list
in
match gfun with Some (GFun (dec, _)) -> Some dec | _ -> None
class fun_find_uses funname funid file result : nopCilVisitor =
object
inherit nopCilVisitor
method! vinst instr =
match instr with
| Call (_, Lval (Var varinfo, NoOffset), _, loc, eloc) ->
if is_equal_funname_funid varinfo funname funid then (
match find_fundec funname funid file.globals with
| None -> SkipChildren
| Some dec ->
result :=
!result
@ [ (varinfo.vname, loc, create_sig dec file, varinfo.vid) ];
SkipChildren )
else SkipChildren
| _ -> SkipChildren
end
let find_uses funname funid file =
let result = ref [] in
let visitor = new fun_find_uses funname funid file result in
ignore (visitCilFileSameGlobals visitor file);
!result
let find_uses_all file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ -> Some (find_uses "" fundec.svar.vid file)))
file.globals
class fun_find_uses_in_fun funname funid funstrucname file result :
nopCilVisitor =
object
inherit nopCilVisitor
method! vfunc fundec =
if is_equal_funname_funid fundec.svar funstrucname (-1) then DoChildren
else SkipChildren
method! vinst instr =
match instr with
| Call (_, Lval (Var varinfo, NoOffset), _, loc, eloc) ->
if is_equal_funname_funid varinfo funname funid then (
match find_fundec funname funid file.globals with
| None -> SkipChildren
| Some dec ->
result :=
!result
@ [ (varinfo.vname, loc, create_sig dec file, varinfo.vid) ];
SkipChildren )
else SkipChildren
| _ -> SkipChildren
end
let find_uses_in_fun funname funid funstrucname file =
let result = ref [] in
let visitor =
new fun_find_uses_in_fun funname funid funstrucname file result
in
ignore (visitCilFileSameGlobals visitor file);
!result
let find_uses_in_fun_all funstrucname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some (find_uses_in_fun "" fundec.svar.vid funstrucname file)))
file.globals
let loc_default = locUnknown
class fun_find_usesvar_in_fun fundec funstrucname varname varid file result :
nopCilVisitor =
object
inherit nopCilVisitor
method! vfunc dec =
if is_equal_funname_funid dec.svar funstrucname (-1) then DoChildren
else SkipChildren
method! vinst instr =
match instr with
| Call (_, exp, list, loc, eloc) -> (
match exp with
| Lval (Var varinfo, _) ->
if
is_equal_funname_funid varinfo fundec.svar.vname fundec.svar.vid
then
if
List.length
(FuncVar.search_expression_list list varname loc_default
varid true)
> 0
then (
result :=
!result
@ [
(varinfo.vname, loc, create_sig fundec file, varinfo.vid);
];
SkipChildren )
else SkipChildren
else SkipChildren
| _ -> SkipChildren )
| _ -> SkipChildren
end
let find_usesvar_in_fun funname funid funstrucname varname file =
match find_fundec funname funid file.globals with
| None -> []
| Some fundec ->
let result = ref [] in
let dedup =
delete_duplicates (find_all_with_origname varname) []
in
List.iter
(fun x ->
visitCilFileSameGlobals
(new fun_find_usesvar_in_fun fundec funstrucname x (-1) file result)
file)
dedup;
!result
let find_usesvar_in_fun_all funstrucname varname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some
(find_usesvar_in_fun "" fundec.svar.vid funstrucname varname file)))
file.globals
let find_usesvar funname funid varname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some
(find_usesvar_in_fun funname funid fundec.svar.vname varname file)))
file.globals
let find_usesvar_all varname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some (find_usesvar "" fundec.svar.vid varname file)))
file.globals
let is_temporary id = Inthash.mem allTempVars id
class find_calls_with_tmp result funname funid : nopCilVisitor =
object
inherit nopCilVisitor
method! vinst instr =
match instr with
| Call (lval_opt, Lval (Var varinfo, _), _, _, _) ->
if is_equal_funname_funid varinfo funname funid then
match lval_opt with
| Some (Var tmpinfo, _) ->
if is_temporary tmpinfo.vid then
result := !result @ [ (tmpinfo.vid, varinfo.vid) ];
SkipChildren
| _ -> SkipChildren
else SkipChildren
| _ -> SkipChildren
end
let find_lval_of_calls funname funid file =
let result = ref [] in
let visitor = new find_calls_with_tmp result funname funid in
visitCilFileSameGlobals visitor file;
!result
let create_fun_res name id file loc =
let fundec_opt = find_fundec name id file.globals in
match fundec_opt with
| None -> ("", loc_default, "", -1)
| Some fundec ->
(fundec.svar.vname, loc, create_sig fundec file, fundec.svar.vid)
let find_uses_cond funname funid file =
let id_list = find_lval_of_calls funname funid file in
Util.list_filter_map
(fun (tmp, func) ->
match FuncVar.find_uses_in_cond "" tmp file true with
| (_, loc, _, _) :: _ -> Some (create_fun_res "" func file loc)
| _ -> None)
id_list
let find_uses_cond_all file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ -> Some (find_uses_cond "" fundec.svar.vid file)))
file.globals
let find_uses_noncond funname funid file =
let uses_cond = find_uses_cond funname funid file in
let all_uses = find_uses funname funid file in
List.filter (fun x -> not (List.mem x uses_cond)) all_uses
let find_uses_noncond_all file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some (find_uses_noncond "" fundec.svar.vid file)))
file.globals
class find_calls_usesvar_with_tmp result funname funid varname : nopCilVisitor =
object
inherit nopCilVisitor
method! vinst instr =
match instr with
| Call (lval_opt, Lval (Var varinfo, _), arg_list, loc, eloc) ->
if
is_equal_funname_funid varinfo funname funid
&& List.length
(List.flatten
(List.map
(fun x ->
FuncVar.search_expression_list arg_list x loc (-1) true)
(find_all_with_origname varname)))
> 0
then
match lval_opt with
| Some (Var tmpinfo, _) ->
if
String.length tmpinfo.vname > 2
&& String.compare "tmp" (String.sub tmpinfo.vname 0 3) = 0
then result := !result @ [ (tmpinfo.vid, varinfo.vid) ];
SkipChildren
| _ -> SkipChildren
else SkipChildren
| _ -> SkipChildren
end
let find_lval_of_calls_usesvar funname funid varname file =
let result = ref [] in
let visitor = new find_calls_usesvar_with_tmp result funname funid varname in
visitCilFileSameGlobals visitor file;
!result
let find_usesvar_cond funname funid varname file =
let id_list = find_lval_of_calls_usesvar funname funid varname file in
Util.list_filter_map
(fun (tmp, func) ->
match FuncVar.find_uses_in_cond "" tmp file true with
| (_, loc, _, _) :: _ -> Some (create_fun_res "" func file loc)
| _ -> None)
id_list
let find_usesvar_cond_all varname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some (find_usesvar_cond "" fundec.svar.vid varname file)))
file.globals
let find_usesvar_noncond funname funid varname file =
let uses_cond = find_usesvar_cond funname funid varname file in
let all_uses = find_usesvar funname funid varname file in
List.filter (fun x -> not (List.mem x uses_cond)) all_uses
let find_usesvar_noncond_all varname file =
List.flatten
@@ Util.list_filter_map
(map_gfun (fun fundec _ ->
Some (find_usesvar_noncond "" fundec.svar.vid varname file)))
file.globals