Commit | Line | Data |
---|---|---|
0708f913 C |
1 | (* Yoann Padioleau |
2 | * | |
3 | * Copyright (C) 2006, 2007 Ecole des Mines de Nantes | |
4 | * | |
5 | * This program is free software; you can redistribute it and/or | |
6 | * modify it under the terms of the GNU General Public License (GPL) | |
7 | * version 2 as published by the Free Software Foundation. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * file license.txt for more details. | |
13 | *) | |
34e49164 C |
14 | open Common |
15 | ||
16 | open Ast_c | |
17 | open Control_flow_c | |
18 | ||
19 | open Ograph_extended | |
20 | open Oassoc | |
21 | open Oassocb | |
22 | ||
708f4980 C |
23 | module Lib = Lib_parsing_c |
24 | ||
25 | (*****************************************************************************) | |
26 | (* Wrappers *) | |
27 | (*****************************************************************************) | |
28 | let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_cfg | |
34e49164 C |
29 | |
30 | (*****************************************************************************) | |
31 | (* todo?: compute target level with goto (but rare that different I think) | |
32 | * ver1: just do init, | |
33 | * ver2: compute depth of label (easy, intercept compound in the visitor) | |
34 | * | |
35 | * checktodo: after a switch, need check that all the st in the | |
36 | * compound start with a case: ? | |
37 | * | |
38 | * checktodo: how ensure that when we call aux_statement recursivly, we | |
39 | * pass it xi_lbl and not just auxinfo ? how enforce that ? | |
40 | * in fact we must either pass a xi_lbl or a newxi | |
41 | * | |
42 | * todo: can have code (and so nodes) in many places, in the size of an | |
43 | * array, in the init of initializer, but also in StatementExpr, ... | |
44 | * | |
45 | * todo?: steal code from CIL ? (but seems complicated ... again) *) | |
46 | (*****************************************************************************) | |
47 | ||
485bce71 C |
48 | (*****************************************************************************) |
49 | (* Types *) | |
50 | (*****************************************************************************) | |
51 | ||
34e49164 C |
52 | type error = |
53 | | DeadCode of Common.parse_info option | |
54 | | CaseNoSwitch of Common.parse_info | |
55 | | OnlyBreakInSwitch of Common.parse_info | |
708f4980 | 56 | | WeirdSwitch of Common.parse_info |
34e49164 C |
57 | | NoEnclosingLoop of Common.parse_info |
58 | | GotoCantFindLabel of string * Common.parse_info | |
59 | | NoExit of Common.parse_info | |
60 | | DuplicatedLabel of string | |
61 | | NestedFunc | |
62 | | ComputedGoto | |
91eba41f | 63 | | Define of Common.parse_info |
34e49164 C |
64 | |
65 | exception Error of error | |
66 | ||
67 | (*****************************************************************************) | |
68 | (* Helpers *) | |
69 | (*****************************************************************************) | |
70 | ||
71 | let add_node node labels nodestr g = | |
72 | g#add_node (Control_flow_c.mk_node node labels [] nodestr) | |
73 | let add_bc_node node labels parent_labels nodestr g = | |
74 | g#add_node (Control_flow_c.mk_node node labels parent_labels nodestr) | |
75 | let add_arc_opt (starti, nodei) g = | |
76 | starti +> do_option (fun starti -> g#add_arc ((starti, nodei), Direct)) | |
77 | ||
78 | ||
79 | let lbl_0 = [] | |
80 | ||
81 | let pinfo_of_ii ii = Ast_c.get_opi (List.hd ii).Ast_c.pinfo | |
82 | ||
83 | ||
84 | ||
85 | (*****************************************************************************) | |
86 | (* Contextual information passed in aux_statement *) | |
87 | (*****************************************************************************) | |
88 | ||
89 | (* Sometimes have a continue/break and we must know where we must jump. | |
90 | * | |
91 | * ctl_brace: The node list in context_info record the number of '}' at the | |
92 | * context point, for instance at the switch point. So that when deeper, | |
93 | * we can compute the difference between the number of '}' from root to | |
94 | * the context point to close the good number of '}' . For instance | |
95 | * where there is a 'continue', we must close only until the for. | |
96 | *) | |
97 | type context_info = | |
98 | | NoInfo | |
99 | | LoopInfo of nodei * nodei (* start, end *) * node list * int list | |
100 | | SwitchInfo of nodei * nodei (* start, end *) * node list * int list | |
101 | ||
102 | (* for the Compound case I need to do different things depending if | |
103 | * the compound is the compound of the function definition, the compound of | |
104 | * a switch, so this type allows to specify this and enable to factorize | |
105 | * code for the Compound | |
106 | *) | |
107 | and compound_caller = | |
108 | FunctionDef | Statement | Switch of (nodei -> xinfo -> xinfo) | |
109 | ||
110 | (* other information used internally in ast_to_flow and passed recursively *) | |
111 | and xinfo = { | |
112 | ||
113 | ctx: context_info; (* cf above *) | |
114 | ctx_stack: context_info list; | |
115 | ||
116 | (* are we under a ifthen[noelse]. Used for ErrorExit *) | |
117 | under_ifthen: bool; | |
118 | compound_caller: compound_caller; | |
119 | ||
120 | (* does not change recursively. Some kind of globals. *) | |
121 | labels_assoc: (string, nodei) oassoc; | |
122 | exiti: nodei option; | |
123 | errorexiti: nodei option; | |
124 | ||
125 | (* ctl_braces: the nodei list is to handle current imbrication depth. | |
126 | * It contains the must-close '}'. | |
127 | * update: now it is instead a node list. | |
128 | *) | |
129 | braces: node list; | |
130 | ||
131 | (* ctl: *) | |
132 | labels: int list; | |
133 | } | |
134 | ||
135 | ||
136 | let initial_info = { | |
137 | ctx = NoInfo; | |
138 | ctx_stack = []; | |
139 | under_ifthen = false; | |
140 | compound_caller = Statement; | |
141 | braces = []; | |
142 | labels = []; | |
143 | ||
144 | (* don't change when recurse *) | |
145 | labels_assoc = new oassocb []; | |
146 | exiti = None; | |
147 | errorexiti = None; | |
148 | } | |
149 | ||
150 | ||
151 | (*****************************************************************************) | |
152 | (* (Semi) Globals, Julia's style. *) | |
153 | (*****************************************************************************) | |
154 | (* global graph *) | |
155 | let g = ref (new ograph_mutable) | |
156 | ||
157 | let counter_for_labels = ref 0 | |
158 | let counter_for_braces = ref 0 | |
159 | ||
160 | (* For switch we use compteur too (or pass int ref) cos need know order of the | |
161 | * case if then later want to go from CFG to (original) AST. | |
162 | * update: obsolete now I think | |
163 | *) | |
164 | let counter_for_switch = ref 0 | |
165 | ||
166 | ||
167 | (*****************************************************************************) | |
168 | (* helpers *) | |
169 | (*****************************************************************************) | |
170 | ||
171 | (* alt: do via a todo list, so can do all in one pass (but more complex) | |
172 | * todo: can also count the depth level and associate it to the node, for | |
173 | * the ctl_braces: | |
174 | *) | |
175 | let compute_labels_and_create_them st = | |
176 | ||
177 | (* map C label to index number in graph *) | |
178 | let (h: (string, nodei) oassoc ref) = ref (new oassocb []) in | |
179 | ||
180 | begin | |
181 | st +> Visitor_c.vk_statement { Visitor_c.default_visitor_c with | |
182 | Visitor_c.kstatement = (fun (k, bigf) st -> | |
708f4980 C |
183 | match Ast_c.unwrap_st st with |
184 | | Labeled (Ast_c.Label (name, _st)) -> | |
185 | let ii = Ast_c.get_ii_st_take_care st in | |
34e49164 C |
186 | (* at this point I put a lbl_0, but later I will put the |
187 | * good labels. *) | |
b1b2de81 C |
188 | let s = Ast_c.str_of_name name in |
189 | let newi = !g +> add_node (Label (st,name, ((),ii))) lbl_0 (s^":") | |
190 | in | |
34e49164 C |
191 | begin |
192 | (* the C label already exists ? *) | |
193 | if (!h#haskey s) then raise (Error (DuplicatedLabel s)); | |
194 | h := !h#add (s, newi); | |
195 | (* not k _st !!! otherwise in lbl1: lbl2: i++; we miss lbl2 *) | |
196 | k st; | |
197 | end | |
708f4980 | 198 | | _st -> k st |
34e49164 C |
199 | ) |
200 | }; | |
201 | !h; | |
202 | end | |
203 | ||
204 | ||
205 | (* ctl_braces: *) | |
206 | let insert_all_braces xs starti = | |
207 | xs +> List.fold_left (fun acc node -> | |
208 | (* Have to build a new node (clone), cos cant share it. | |
209 | * update: This is now done by the caller. The clones are in xs. | |
210 | *) | |
211 | let newi = !g#add_node node in | |
212 | !g#add_arc ((acc, newi), Direct); | |
213 | newi | |
214 | ) starti | |
215 | ||
216 | (*****************************************************************************) | |
217 | (* Statement *) | |
218 | (*****************************************************************************) | |
219 | ||
220 | (* Take in a (optional) start node, return an (optional) end node. | |
221 | * | |
222 | * history: | |
223 | * | |
224 | * ver1: old code was returning an nodei, but goto has no end, so | |
225 | * aux_statement should return nodei option. | |
226 | * | |
227 | * ver2: old code was taking a nodei, but should also take nodei | |
228 | * option. | |
229 | * | |
230 | * ver3: deadCode detection. What is dead code ? When there is no | |
231 | * starti to start from ? So make starti an option too ? Si on arrive | |
232 | * sur un label: au moment d'un deadCode, on peut verifier les | |
233 | * predecesseurs de ce label, auquel cas si y'en a, ca veut dire | |
234 | * qu'en fait c'est pas du deadCode et que donc on peut se permettre | |
235 | * de partir d'un starti à None. Mais si on a xx; goto far:; near: | |
236 | * yy; zz; far: goto near:. Bon ca doit etre un cas tres tres rare, | |
237 | * mais a cause de notre parcours, on va rejeter ce programme car au | |
238 | * moment d'arriver sur near: on n'a pas encore de predecesseurs pour | |
239 | * ce label. De meme, meme le cas simple ou la derniere instruction | |
240 | * c'est un return, alors ca va generer un DeadCode :( | |
241 | * | |
242 | * So make a first pass where dont launch exn at all. Create nodes, | |
243 | * if starti is None then dont add arc. Then make a second pass that | |
244 | * just checks that all nodes (except enter) have predecessors. | |
245 | * So make starti an option too. So type is now | |
246 | * | |
247 | * nodei option -> statement -> nodei option. | |
248 | * | |
249 | * todo?: if the pb is at a fake node, then try first successos that | |
250 | * is non fake. | |
251 | * | |
252 | * ver4: because of special needs of coccinelle, need pass more info, cf | |
253 | * type additionnal_info defined above. | |
254 | * | |
255 | * - to complete (break, continue (and enclosing loop), switch (and | |
256 | * associated case, casedefault)) we need to pass additionnal info. | |
257 | * The start/exit when enter in a loop, to know the current 'for'. | |
258 | * | |
259 | * - to handle the braces, need again pass additionnal info. | |
260 | * | |
261 | * - need pass the labels. | |
262 | * | |
263 | * convention: xi for the auxinfo passed recursively | |
264 | * | |
265 | *) | |
266 | ||
267 | let rec (aux_statement: (nodei option * xinfo) -> statement -> nodei option) = | |
268 | fun (starti, xi) stmt -> | |
269 | ||
270 | if not !Flag_parsing_c.label_strategy_2 | |
271 | then incr counter_for_labels; | |
272 | ||
273 | let lbl = | |
274 | if !Flag_parsing_c.label_strategy_2 | |
275 | then xi.labels | |
276 | else xi.labels @ [!counter_for_labels] | |
277 | in | |
278 | ||
279 | (* Normally the new auxinfo to pass recursively to the next aux_statement. | |
280 | * But in some cases we add additionnal stuff in which case we don't use | |
281 | * this 'xi_lbl' but a 'newxi' specially built. | |
282 | *) | |
283 | let xi_lbl = | |
284 | if !Flag_parsing_c.label_strategy_2 | |
285 | then { xi with | |
286 | compound_caller = Statement; | |
287 | } | |
288 | else { xi with | |
289 | labels = xi.labels @ [ !counter_for_labels ]; | |
290 | compound_caller = Statement; | |
291 | } | |
292 | in | |
708f4980 C |
293 | let ii = Ast_c.get_ii_st_take_care stmt in |
294 | ||
34e49164 | 295 | (* ------------------------- *) |
708f4980 | 296 | match Ast_c.unwrap_st stmt with |
34e49164 C |
297 | |
298 | (* coupling: the Switch case copy paste parts of the Compound case *) | |
708f4980 | 299 | | Ast_c.Compound statxs -> |
34e49164 C |
300 | (* flow_to_ast: *) |
301 | let (i1, i2) = tuple_of_list2 ii in | |
302 | ||
303 | (* ctl_braces: *) | |
304 | incr counter_for_braces; | |
305 | let brace = !counter_for_braces in | |
306 | ||
307 | let s1 = "{" ^ i_to_s brace in | |
308 | let s2 = "}" ^ i_to_s brace in | |
309 | ||
310 | let lbl = match xi.compound_caller with | |
311 | | FunctionDef -> xi.labels (* share label with function header *) | |
312 | | Statement -> xi.labels @ [!counter_for_labels] | |
313 | | Switch _ -> xi.labels | |
314 | in | |
315 | ||
316 | let newi = !g +> add_node (SeqStart (stmt, brace, i1)) lbl s1 in | |
317 | let endnode = mk_node (SeqEnd (brace, i2)) lbl [] s2 in | |
318 | let endnode_dup = mk_fake_node (SeqEnd (brace, i2)) lbl [] s2 in | |
319 | (* | |
320 | let _endnode_dup = | |
321 | mk_node (SeqEnd (brace, Ast_c.fakeInfo())) lbl [] s2 in | |
322 | *) | |
323 | ||
324 | let newxi = { xi_lbl with braces = endnode_dup:: xi_lbl.braces } in | |
325 | ||
326 | let newxi = match xi.compound_caller with | |
327 | | Switch todo_in_compound -> | |
328 | (* note that side effect in todo_in_compound *) | |
329 | todo_in_compound newi newxi | |
330 | | FunctionDef | Statement -> newxi | |
331 | in | |
332 | ||
333 | !g +> add_arc_opt (starti, newi); | |
334 | let starti = Some newi in | |
335 | ||
485bce71 | 336 | aux_statement_list starti (xi, newxi) statxs |
34e49164 C |
337 | |
338 | (* braces: *) | |
339 | +> Common.fmap (fun starti -> | |
340 | (* subtil: not always return a Some. | |
341 | * Note that if starti is None, alors forcement ca veut dire | |
342 | * qu'il y'a eu un return (ou goto), et donc forcement les | |
343 | * braces auront au moins ete crée une fois, et donc flow_to_ast | |
344 | * marchera. | |
345 | * Sauf si le goto revient en arriere ? mais dans ce cas | |
346 | * ca veut dire que le programme boucle. Pour qu'il boucle pas | |
347 | * il faut forcement au moins un return. | |
348 | *) | |
349 | let endi = !g#add_node endnode in | |
350 | !g#add_arc ((starti, endi), Direct); | |
351 | endi | |
352 | ) | |
353 | ||
354 | ||
355 | (* ------------------------- *) | |
708f4980 | 356 | | Labeled (Ast_c.Label (name, st)) -> |
b1b2de81 | 357 | let s = Ast_c.str_of_name name in |
34e49164 C |
358 | let ilabel = xi.labels_assoc#find s in |
359 | let node = mk_node (unwrap (!g#nodes#find ilabel)) lbl [] (s ^ ":") in | |
360 | !g#replace_node (ilabel, node); | |
361 | !g +> add_arc_opt (starti, ilabel); | |
362 | aux_statement (Some ilabel, xi_lbl) st | |
363 | ||
364 | ||
708f4980 C |
365 | | Jump (Ast_c.Goto name) -> |
366 | let s = Ast_c.str_of_name name in | |
34e49164 | 367 | (* special_cfg_ast: *) |
b1b2de81 C |
368 | let newi = !g +> add_node (Goto (stmt, name, ((),ii))) lbl ("goto "^s^":") |
369 | in | |
34e49164 C |
370 | !g +> add_arc_opt (starti, newi); |
371 | ||
372 | let ilabel = | |
373 | try xi.labels_assoc#find s | |
374 | with Not_found -> | |
375 | (* jump vers ErrorExit a la place ? | |
376 | * pourquoi tant de "cant jump" ? pas detecté par gcc ? | |
377 | *) | |
378 | raise (Error (GotoCantFindLabel (s, pinfo_of_ii ii))) | |
379 | in | |
380 | (* !g +> add_arc_opt (starti, ilabel); | |
381 | * todo: special_case: suppose that always goto to toplevel of function, | |
382 | * hence the Common.init | |
383 | * todo?: can perhaps report when a goto is not a classic error_goto ? | |
384 | * that is when it does not jump to the toplevel of the function. | |
385 | *) | |
386 | let newi = insert_all_braces (Common.list_init xi.braces) newi in | |
387 | !g#add_arc ((newi, ilabel), Direct); | |
388 | None | |
389 | ||
708f4980 | 390 | | Jump (Ast_c.GotoComputed e) -> |
34e49164 C |
391 | raise (Error (ComputedGoto)) |
392 | ||
393 | (* ------------------------- *) | |
708f4980 | 394 | | Ast_c.ExprStatement opte -> |
34e49164 C |
395 | (* flow_to_ast: old: when opte = None, then do not add in CFG. *) |
396 | let s = | |
397 | match opte with | |
398 | | None -> "empty;" | |
399 | | Some e -> | |
708f4980 C |
400 | (match Ast_c.unwrap_expr e with |
401 | | FunCall (e, _args) -> | |
402 | (match Ast_c.unwrap_expr e with | |
403 | | Ident namef -> | |
404 | Ast_c.str_of_name namef ^ "(...)" | |
405 | | _ -> "statement" | |
406 | ) | |
407 | | Assignment (e1, SimpleAssign, e2) -> | |
408 | (match Ast_c.unwrap_expr e1 with | |
409 | | Ident namevar -> | |
410 | Ast_c.str_of_name namevar ^ " = ... ;" | |
411 | | RecordAccess(e, field) -> | |
412 | (match Ast_c.unwrap_expr e with | |
413 | | Ident namevar -> | |
414 | let sfield = Ast_c.str_of_name field in | |
415 | Ast_c.str_of_name namevar ^ "." ^ sfield ^ " = ... ;" | |
416 | | _ -> "statement" | |
417 | ) | |
418 | | _ -> "statement" | |
419 | ) | |
34e49164 | 420 | | _ -> "statement" |
708f4980 | 421 | ) |
34e49164 C |
422 | in |
423 | let newi = !g +> add_node (ExprStatement (stmt, (opte, ii))) lbl s in | |
424 | !g +> add_arc_opt (starti, newi); | |
425 | Some newi | |
426 | ||
427 | ||
428 | (* ------------------------- *) | |
708f4980 C |
429 | | Selection (Ast_c.If (e, st1, st2)) -> |
430 | ||
431 | let iist2 = Ast_c.get_ii_st_take_care st2 in | |
432 | (match Ast_c.unwrap_st st2 with | |
433 | | Ast_c.ExprStatement (None) when null iist2 -> | |
34e49164 C |
434 | (* sometome can have ExprStatement None but it is a if-then-else, |
435 | * because something like if() xx else ; | |
436 | * so must force to have [] in the ii associated with ExprStatement | |
437 | *) | |
438 | ||
439 | let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in | |
440 | let ii = [i1;i2;i3] in | |
441 | (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti | |
442 | * | | | |
443 | * |-> newfakeelse -> ... -> finalelse -| | |
444 | * update: there is now also a link directly to lasti. | |
445 | * | |
446 | * because of CTL, now do different things if we are in a ifthen or | |
447 | * ifthenelse. | |
448 | *) | |
449 | let newi = !g +> add_node (IfHeader (stmt, (e, ii))) lbl ("if") in | |
450 | !g +> add_arc_opt (starti, newi); | |
451 | let newfakethen = !g +> add_node TrueNode lbl "[then]" in | |
452 | let newfakeelse = !g +> add_node FallThroughNode lbl "[fallthrough]" in | |
453 | let afteri = !g +> add_node AfterNode lbl "[after]" in | |
454 | let lasti = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endif]" | |
455 | in | |
456 | ||
457 | (* for ErrorExit heuristic *) | |
458 | let newxi = { xi_lbl with under_ifthen = true; } in | |
459 | ||
460 | !g#add_arc ((newi, newfakethen), Direct); | |
461 | !g#add_arc ((newi, newfakeelse), Direct); | |
462 | !g#add_arc ((newi, afteri), Direct); | |
463 | !g#add_arc ((afteri, lasti), Direct); | |
464 | !g#add_arc ((newfakeelse, lasti), Direct); | |
465 | ||
466 | let finalthen = aux_statement (Some newfakethen, newxi) st1 in | |
467 | !g +> add_arc_opt (finalthen, lasti); | |
468 | Some lasti | |
469 | ||
708f4980 | 470 | | _unwrap_st2 -> |
34e49164 C |
471 | (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti |
472 | * | | | |
473 | * |-> newfakeelse -> ... -> finalelse -| | |
474 | * update: there is now also a link directly to lasti. | |
475 | *) | |
476 | let (iiheader, iielse, iifakeend) = | |
477 | match ii with | |
478 | | [i1;i2;i3;i4;i5] -> [i1;i2;i3], i4, i5 | |
479 | | _ -> raise Impossible | |
480 | in | |
481 | let newi = !g +> add_node (IfHeader (stmt, (e, iiheader))) lbl "if" in | |
482 | !g +> add_arc_opt (starti, newi); | |
483 | let newfakethen = !g +> add_node TrueNode lbl "[then]" in | |
484 | let newfakeelse = !g +> add_node FalseNode lbl "[else]" in | |
485 | let elsenode = !g +> add_node (Else iielse) lbl "else" in | |
486 | ||
487 | ||
488 | !g#add_arc ((newi, newfakethen), Direct); | |
489 | !g#add_arc ((newi, newfakeelse), Direct); | |
490 | ||
491 | !g#add_arc ((newfakeelse, elsenode), Direct); | |
492 | ||
493 | let finalthen = aux_statement (Some newfakethen, xi_lbl) st1 in | |
494 | let finalelse = aux_statement (Some elsenode, xi_lbl) st2 in | |
495 | ||
496 | (match finalthen, finalelse with | |
497 | | (None, None) -> None | |
498 | | _ -> | |
499 | let lasti = | |
500 | !g +> add_node (EndStatement(Some iifakeend)) lbl "[endif]" in | |
501 | let afteri = | |
502 | !g +> add_node AfterNode lbl "[after]" in | |
503 | !g#add_arc ((newi, afteri), Direct); | |
504 | !g#add_arc ((afteri, lasti), Direct); | |
505 | begin | |
506 | !g +> add_arc_opt (finalthen, lasti); | |
507 | !g +> add_arc_opt (finalelse, lasti); | |
508 | Some lasti | |
509 | end) | |
708f4980 | 510 | ) |
34e49164 | 511 | |
34e49164 | 512 | (* ------------------------- *) |
708f4980 | 513 | | Selection (Ast_c.Switch (e, st)) -> |
34e49164 C |
514 | let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in |
515 | let ii = [i1;i2;i3] in | |
516 | ||
517 | (* The newswitchi is for the labels to know where to attach. | |
518 | * The newendswitch (endi) is for the 'break'. *) | |
519 | let newswitchi= | |
520 | !g+> add_node (SwitchHeader(stmt,(e,ii))) lbl "switch" in | |
521 | let newendswitch = | |
522 | !g +> add_node (EndStatement (Some iifakeend)) lbl "[endswitch]" in | |
523 | ||
524 | !g +> add_arc_opt (starti, newswitchi); | |
525 | ||
526 | (* call compound case. Need special info to pass to compound case | |
527 | * because we need to build a context_info that need some of the | |
528 | * information build inside the compound case: the nodei of { | |
529 | *) | |
530 | let finalthen = | |
708f4980 C |
531 | match Ast_c.unwrap_st st with |
532 | | Ast_c.Compound statxs -> | |
533 | ||
534 | let statxs = Lib.stmt_elems_of_sequencable statxs in | |
34e49164 C |
535 | |
536 | (* todo? we should not allow to match a stmt that corresponds | |
537 | * to a compound of a switch, so really SeqStart (stmt, ...) | |
538 | * here ? so maybe should change the SeqStart labeling too. | |
539 | * So need pass a todo_in_compound2 function. | |
540 | *) | |
541 | let todo_in_compound newi newxi = | |
542 | let newxi' = { newxi with | |
543 | ctx = SwitchInfo (newi(*!!*), newendswitch, xi.braces, lbl); | |
544 | ctx_stack = newxi.ctx::newxi.ctx_stack | |
545 | } | |
546 | in | |
547 | !g#add_arc ((newswitchi, newi), Direct); | |
548 | (* new: if have not a default case, then must add an edge | |
549 | * between start to end. | |
550 | * todo? except if the case[range] coverthe whole spectrum | |
551 | *) | |
708f4980 C |
552 | if not (statxs +> List.exists (fun x -> |
553 | match Ast_c.unwrap_st x with | |
554 | | Labeled (Ast_c.Default _) -> true | |
555 | | _ -> false | |
34e49164 C |
556 | )) |
557 | then begin | |
558 | (* when there is no default, then a valid path is | |
559 | * from the switchheader to the end. In between we | |
560 | * add a Fallthrough. | |
561 | *) | |
562 | ||
563 | let newafter = !g+>add_node FallThroughNode lbl "[switchfall]" | |
564 | in | |
565 | !g#add_arc ((newafter, newendswitch), Direct); | |
566 | !g#add_arc ((newswitchi, newafter), Direct); | |
567 | (* old: | |
568 | !g#add_arc ((newswitchi, newendswitch), Direct) +> adjust_g; | |
569 | *) | |
570 | end; | |
571 | newxi' | |
572 | in | |
573 | let newxi = { xi with compound_caller = | |
574 | Switch todo_in_compound | |
575 | } | |
576 | in | |
577 | aux_statement (None (* no starti *), newxi) st | |
708f4980 C |
578 | | _x -> |
579 | (* apparently gcc allows some switch body such as | |
580 | * switch (i) case 0 : printf("here\n"); | |
581 | * cf tests-bis/switch_no_body.c | |
582 | * but I don't think it's worthwile to handle | |
583 | * such pathological and rare case. Not worth | |
584 | * the complexity. Safe to assume a coumpound. | |
585 | *) | |
586 | raise (Error (WeirdSwitch (pinfo_of_ii [i1]))) | |
34e49164 C |
587 | in |
588 | !g +> add_arc_opt (finalthen, newendswitch); | |
589 | ||
590 | ||
591 | (* what if has only returns inside. We must try to see if the | |
592 | * newendswitch has been used via a 'break;' or because no | |
593 | * 'default:') | |
594 | *) | |
595 | let res = | |
596 | (match finalthen with | |
597 | | Some finalthen -> | |
598 | ||
599 | let afteri = !g +> add_node AfterNode lbl "[after]" in | |
600 | !g#add_arc ((newswitchi, afteri), Direct); | |
601 | !g#add_arc ((afteri, newendswitch), Direct); | |
602 | ||
603 | ||
604 | !g#add_arc ((finalthen, newendswitch), Direct); | |
605 | Some newendswitch | |
606 | | None -> | |
607 | if (!g#predecessors newendswitch)#null | |
608 | then begin | |
609 | assert ((!g#successors newendswitch)#null); | |
610 | !g#del_node newendswitch; | |
611 | None | |
612 | end | |
613 | else begin | |
614 | ||
615 | let afteri = !g +> add_node AfterNode lbl "[after]" in | |
616 | !g#add_arc ((newswitchi, afteri), Direct); | |
617 | !g#add_arc ((afteri, newendswitch), Direct); | |
618 | ||
619 | ||
620 | Some newendswitch | |
621 | end | |
622 | ) | |
623 | in | |
624 | res | |
625 | ||
626 | ||
708f4980 C |
627 | | Labeled (Ast_c.Case (_, _)) |
628 | | Labeled (Ast_c.CaseRange (_, _, _)) -> | |
34e49164 C |
629 | |
630 | incr counter_for_switch; | |
631 | let switchrank = !counter_for_switch in | |
632 | let node, st = | |
708f4980 | 633 | match Ast_c.get_st_and_ii stmt with |
34e49164 C |
634 | | Labeled (Ast_c.Case (e, st)), ii -> |
635 | (Case (stmt, (e, ii))), st | |
636 | | Labeled (Ast_c.CaseRange (e, e2, st)), ii -> | |
637 | (CaseRange (stmt, ((e, e2), ii))), st | |
638 | | _ -> raise Impossible | |
639 | in | |
640 | ||
641 | let newi = !g +> add_node node lbl "case:" in | |
642 | ||
643 | (match Common.optionise (fun () -> | |
644 | (* old: xi.ctx *) | |
645 | (xi.ctx::xi.ctx_stack) +> Common.find_some (function | |
646 | | SwitchInfo (a, b, c, _) -> Some (a, b, c) | |
647 | | _ -> None | |
648 | )) | |
649 | with | |
650 | | Some (startbrace, switchendi, _braces) -> | |
651 | (* no need to attach to previous for the first case, cos would be | |
652 | * redundant. *) | |
653 | starti +> do_option (fun starti -> | |
654 | if starti <> startbrace | |
655 | then !g +> add_arc_opt (Some starti, newi); | |
656 | ); | |
657 | ||
658 | let s = ("[casenode] " ^ i_to_s switchrank) in | |
659 | let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in | |
660 | !g#add_arc ((startbrace, newcasenodei), Direct); | |
661 | !g#add_arc ((newcasenodei, newi), Direct); | |
662 | | None -> raise (Error (CaseNoSwitch (pinfo_of_ii ii))) | |
663 | ); | |
664 | aux_statement (Some newi, xi_lbl) st | |
665 | ||
666 | ||
708f4980 | 667 | | Labeled (Ast_c.Default st) -> |
34e49164 C |
668 | incr counter_for_switch; |
669 | let switchrank = !counter_for_switch in | |
670 | ||
671 | let newi = !g +> add_node (Default(stmt, ((),ii))) lbl "case default:" in | |
672 | !g +> add_arc_opt (starti, newi); | |
673 | ||
674 | (match xi.ctx with | |
675 | | SwitchInfo (startbrace, switchendi, _braces, _parent_lbl) -> | |
676 | let s = ("[casenode] " ^ i_to_s switchrank) in | |
677 | let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in | |
678 | !g#add_arc ((startbrace, newcasenodei), Direct); | |
679 | !g#add_arc ((newcasenodei, newi), Direct); | |
680 | | _ -> raise (Error (CaseNoSwitch (pinfo_of_ii ii))) | |
681 | ); | |
682 | aux_statement (Some newi, xi_lbl) st | |
683 | ||
684 | ||
685 | ||
686 | ||
687 | ||
688 | ||
689 | (* ------------------------- *) | |
708f4980 | 690 | | Iteration (Ast_c.While (e, st)) -> |
34e49164 C |
691 | (* starti -> newi ---> newfakethen -> ... -> finalthen - |
692 | * |---|-----------------------------------| | |
693 | * |-> newfakelse | |
694 | *) | |
695 | ||
696 | let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in | |
697 | let ii = [i1;i2;i3] in | |
698 | ||
699 | let newi = !g +> add_node (WhileHeader (stmt, (e,ii))) lbl "while" in | |
700 | !g +> add_arc_opt (starti, newi); | |
701 | let newfakethen = !g +> add_node InLoopNode lbl "[whiletrue]" in | |
702 | (* let newfakeelse = !g +> add_node FalseNode lbl "[endwhile]" in *) | |
703 | let newafter = !g +> add_node FallThroughNode lbl "[whilefall]" in | |
704 | let newfakeelse = | |
705 | !g +> add_node (EndStatement (Some iifakeend)) lbl "[endwhile]" in | |
706 | ||
707 | let newxi = { xi_lbl with | |
708 | ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); | |
709 | ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack | |
710 | } | |
711 | in | |
712 | ||
713 | !g#add_arc ((newi, newfakethen), Direct); | |
714 | !g#add_arc ((newafter, newfakeelse), Direct); | |
715 | !g#add_arc ((newi, newafter), Direct); | |
716 | let finalthen = aux_statement (Some newfakethen, newxi) st in | |
717 | !g +> add_arc_opt (finalthen, newi); | |
718 | Some newfakeelse | |
719 | ||
720 | ||
721 | (* This time, may return None, for instance if goto in body of dowhile | |
722 | * (whereas While cant return None). But if return None, certainly | |
723 | * some deadcode. | |
724 | *) | |
708f4980 | 725 | | Iteration (Ast_c.DoWhile (st, e)) -> |
34e49164 C |
726 | (* starti -> doi ---> ... ---> finalthen (opt) ---> whiletaili |
727 | * |--------- newfakethen ---------------| |---> newfakelse | |
728 | *) | |
729 | let is_zero = | |
730 | match Ast_c.unwrap_expr e with | |
708f4980 | 731 | | Constant (Int ("0",_)) -> true |
34e49164 C |
732 | | _ -> false |
733 | in | |
734 | ||
735 | let (iido, iiwhiletail, iifakeend) = | |
736 | match ii with | |
737 | | [i1;i2;i3;i4;i5;i6] -> i1, [i2;i3;i4;i5], i6 | |
738 | | _ -> raise Impossible | |
739 | in | |
740 | let doi = !g +> add_node (DoHeader (stmt, iido)) lbl "do" in | |
741 | !g +> add_arc_opt (starti, doi); | |
742 | let taili = !g +> add_node (DoWhileTail (e, iiwhiletail)) lbl "whiletail" | |
743 | in | |
744 | ||
745 | ||
746 | (*let newfakeelse = !g +> add_node FalseNode lbl "[enddowhile]" in *) | |
747 | let newafter = !g +> add_node FallThroughNode lbl "[dowhilefall]" in | |
748 | let newfakeelse = | |
749 | !g +> add_node (EndStatement (Some iifakeend)) lbl "[enddowhile]" in | |
750 | ||
751 | let newxi = { xi_lbl with | |
752 | ctx = LoopInfo (taili, newfakeelse, xi_lbl.braces, lbl); | |
753 | ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack | |
754 | } | |
755 | in | |
756 | ||
757 | if not is_zero | |
758 | then begin | |
759 | let newfakethen = !g +> add_node InLoopNode lbl "[dowhiletrue]" in | |
760 | !g#add_arc ((taili, newfakethen), Direct); | |
761 | !g#add_arc ((newfakethen, doi), Direct); | |
762 | end; | |
763 | ||
764 | !g#add_arc ((newafter, newfakeelse), Direct); | |
765 | !g#add_arc ((taili, newafter), Direct); | |
766 | ||
767 | ||
768 | let finalthen = aux_statement (Some doi, newxi) st in | |
769 | (match finalthen with | |
770 | | None -> | |
771 | if (!g#predecessors taili)#null | |
772 | then raise (Error (DeadCode (Some (pinfo_of_ii ii)))) | |
773 | else Some newfakeelse | |
774 | | Some finali -> | |
775 | !g#add_arc ((finali, taili), Direct); | |
776 | Some newfakeelse | |
777 | ) | |
778 | ||
779 | ||
780 | ||
708f4980 | 781 | | Iteration (Ast_c.For (e1opt, e2opt, e3opt, st)) -> |
34e49164 C |
782 | let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in |
783 | let ii = [i1;i2;i3] in | |
784 | ||
785 | let newi = | |
786 | !g+>add_node(ForHeader(stmt,((e1opt,e2opt,e3opt),ii))) lbl "for" in | |
787 | !g +> add_arc_opt (starti, newi); | |
788 | let newfakethen = !g +> add_node InLoopNode lbl "[fortrue]" in | |
789 | (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*) | |
790 | let newafter = !g +> add_node FallThroughNode lbl "[forfall]" in | |
791 | let newfakeelse = | |
792 | !g +> add_node (EndStatement (Some iifakeend)) lbl "[endfor]" in | |
793 | ||
794 | let newxi = { xi_lbl with | |
795 | ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); | |
796 | ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack | |
797 | } | |
798 | in | |
799 | ||
800 | !g#add_arc ((newi, newfakethen), Direct); | |
801 | !g#add_arc ((newafter, newfakeelse), Direct); | |
802 | !g#add_arc ((newi, newafter), Direct); | |
803 | let finalthen = aux_statement (Some newfakethen, newxi) st in | |
804 | !g +> add_arc_opt (finalthen, newi); | |
805 | Some newfakeelse | |
806 | ||
807 | ||
808 | (* to generate less exception with the breakInsideLoop, analyse | |
809 | * correctly the loop deguisé comme list_for_each. Add a case ForMacro | |
810 | * in ast_c (and in lexer/parser), and then do code that imitates the | |
811 | * code for the For. | |
812 | * update: the list_for_each was previously converted into Tif by the | |
813 | * lexer, now they are returned as Twhile so less pbs. But not perfect. | |
814 | * update: now I recognize the list_for_each macro so no more problems. | |
815 | *) | |
708f4980 | 816 | | Iteration (Ast_c.MacroIteration (s, es, st)) -> |
34e49164 C |
817 | let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in |
818 | let ii = [i1;i2;i3] in | |
819 | ||
820 | let newi = | |
821 | !g+>add_node(MacroIterHeader(stmt,((s,es),ii))) lbl "foreach" in | |
822 | !g +> add_arc_opt (starti, newi); | |
823 | let newfakethen = !g +> add_node InLoopNode lbl "[fortrue]" in | |
824 | (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*) | |
825 | let newafter = !g +> add_node FallThroughNode lbl "[foreachfall]" in | |
826 | let newfakeelse = | |
827 | !g +> add_node (EndStatement (Some iifakeend)) lbl "[endforeach]" in | |
828 | ||
829 | let newxi = { xi_lbl with | |
830 | ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); | |
831 | ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack | |
832 | } | |
833 | in | |
834 | ||
835 | !g#add_arc ((newi, newfakethen), Direct); | |
836 | !g#add_arc ((newafter, newfakeelse), Direct); | |
837 | !g#add_arc ((newi, newafter), Direct); | |
838 | let finalthen = aux_statement (Some newfakethen, newxi) st in | |
839 | !g +> add_arc_opt (finalthen, newi); | |
840 | Some newfakeelse | |
841 | ||
842 | ||
843 | ||
844 | (* ------------------------- *) | |
708f4980 | 845 | | Jump ((Ast_c.Continue|Ast_c.Break) as x) -> |
34e49164 C |
846 | let context_info = |
847 | match xi.ctx with | |
848 | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> | |
b1b2de81 | 849 | if x =*= Ast_c.Break |
34e49164 C |
850 | then xi.ctx |
851 | else | |
852 | (try | |
853 | xi.ctx_stack +> Common.find_some (function | |
854 | LoopInfo (_,_,_,_) as c -> Some c | |
855 | | _ -> None) | |
856 | with Not_found -> | |
857 | raise (Error (OnlyBreakInSwitch (pinfo_of_ii ii)))) | |
858 | | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> xi.ctx | |
859 | | NoInfo -> raise (Error (NoEnclosingLoop (pinfo_of_ii ii))) in | |
860 | ||
861 | let parent_label = | |
862 | match context_info with | |
863 | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> parent_lbl | |
864 | | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> parent_lbl | |
865 | | NoInfo -> raise Impossible in | |
866 | ||
867 | (* flow_to_ast: *) | |
868 | let (node_info, string) = | |
869 | let parent_string = | |
870 | String.concat "," (List.map string_of_int parent_label) in | |
871 | (match x with | |
872 | | Ast_c.Continue -> | |
873 | (Continue (stmt, ((), ii)), | |
874 | Printf.sprintf "continue; [%s]" parent_string) | |
875 | | Ast_c.Break -> | |
876 | (Break (stmt, ((), ii)), | |
877 | Printf.sprintf "break; [%s]" parent_string) | |
878 | | _ -> raise Impossible | |
879 | ) in | |
880 | ||
881 | (* idea: break or continue records the label of its parent loop or | |
882 | switch *) | |
883 | let newi = !g +> add_bc_node node_info lbl parent_label string in | |
884 | !g +> add_arc_opt (starti, newi); | |
885 | ||
886 | (* let newi = some starti in *) | |
887 | ||
888 | (match context_info with | |
889 | | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> | |
890 | let desti = | |
891 | (match x with | |
892 | | Ast_c.Break -> loopendi | |
893 | | Ast_c.Continue -> loopstarti | |
894 | | x -> raise Impossible | |
895 | ) in | |
896 | let difference = List.length xi.braces - List.length braces in | |
897 | assert (difference >= 0); | |
898 | let toend = take difference xi.braces in | |
899 | let newi = insert_all_braces toend newi in | |
900 | !g#add_arc ((newi, desti), Direct); | |
901 | None | |
902 | ||
903 | | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> | |
b1b2de81 | 904 | assert (x =*= Ast_c.Break); |
34e49164 C |
905 | let difference = List.length xi.braces - List.length braces in |
906 | assert (difference >= 0); | |
907 | let toend = take difference xi.braces in | |
908 | let newi = insert_all_braces toend newi in | |
909 | !g#add_arc ((newi, loopendi), Direct); | |
910 | None | |
911 | | NoInfo -> raise Impossible | |
912 | ) | |
913 | ||
708f4980 | 914 | | Jump ((Ast_c.Return | Ast_c.ReturnExpr _) as kind) -> |
34e49164 C |
915 | (match xi.exiti, xi.errorexiti with |
916 | | None, None -> raise (Error (NoExit (pinfo_of_ii ii))) | |
917 | | Some exiti, Some errorexiti -> | |
918 | ||
919 | (* flow_to_ast: *) | |
920 | let s = | |
921 | match kind with | |
922 | | Ast_c.Return -> "return" | |
923 | | Ast_c.ReturnExpr _ -> "return ..." | |
924 | | _ -> raise Impossible | |
925 | in | |
926 | let newi = | |
927 | !g +> add_node | |
928 | (match kind with | |
929 | | Ast_c.Return -> Return (stmt, ((),ii)) | |
930 | | Ast_c.ReturnExpr e -> ReturnExpr (stmt, (e, ii)) | |
931 | | _ -> raise Impossible | |
932 | ) | |
933 | lbl s | |
934 | in | |
935 | !g +> add_arc_opt (starti, newi); | |
936 | let newi = insert_all_braces xi.braces newi in | |
937 | ||
938 | if xi.under_ifthen | |
939 | then !g#add_arc ((newi, errorexiti), Direct) | |
940 | else !g#add_arc ((newi, exiti), Direct) | |
941 | ; | |
942 | None | |
943 | | _ -> raise Impossible | |
944 | ) | |
945 | ||
946 | ||
947 | (* ------------------------- *) | |
708f4980 | 948 | | Ast_c.Decl decl -> |
34e49164 C |
949 | let s = |
950 | match decl with | |
485bce71 | 951 | | (Ast_c.DeclList |
b1b2de81 C |
952 | ([{v_namei = Some (name, _); v_type = typ; v_storage = sto}, _], _)) -> |
953 | "decl:" ^ Ast_c.str_of_name name | |
34e49164 C |
954 | | _ -> "decl_novar_or_multivar" |
955 | in | |
956 | ||
957 | let newi = !g +> add_node (Decl (decl)) lbl s in | |
958 | !g +> add_arc_opt (starti, newi); | |
959 | Some newi | |
960 | ||
961 | (* ------------------------- *) | |
708f4980 | 962 | | Ast_c.Asm body -> |
34e49164 C |
963 | let newi = !g +> add_node (Asm (stmt, ((body,ii)))) lbl "asm;" in |
964 | !g +> add_arc_opt (starti, newi); | |
965 | Some newi | |
966 | ||
708f4980 | 967 | | Ast_c.MacroStmt -> |
34e49164 C |
968 | let newi = !g +> add_node (MacroStmt (stmt, ((),ii))) lbl "macro;" in |
969 | !g +> add_arc_opt (starti, newi); | |
970 | Some newi | |
971 | ||
972 | ||
973 | (* ------------------------- *) | |
708f4980 | 974 | | Ast_c.NestedFunc def -> |
34e49164 C |
975 | raise (Error NestedFunc) |
976 | ||
977 | ||
978 | ||
979 | ||
485bce71 C |
980 | |
981 | ||
982 | ||
983 | and aux_statement_list starti (xi, newxi) statxs = | |
984 | statxs | |
985 | +> List.fold_left (fun starti statement_seq -> | |
986 | if !Flag_parsing_c.label_strategy_2 | |
987 | then incr counter_for_labels; | |
988 | ||
989 | let newxi' = | |
990 | if !Flag_parsing_c.label_strategy_2 | |
991 | then { newxi with labels = xi.labels @ [ !counter_for_labels ] } | |
992 | else newxi | |
993 | in | |
994 | ||
995 | match statement_seq with | |
996 | | Ast_c.StmtElem statement -> | |
997 | aux_statement (starti, newxi') statement | |
998 | ||
999 | | Ast_c.CppDirectiveStmt directive -> | |
1000 | pr2_once ("ast_to_flow: filter a directive"); | |
1001 | starti | |
1002 | ||
1003 | | Ast_c.IfdefStmt ifdef -> | |
1004 | pr2_once ("ast_to_flow: filter a directive"); | |
1005 | starti | |
1006 | ||
1007 | | Ast_c.IfdefStmt2 (ifdefs, xxs) -> | |
1008 | ||
1009 | let (head, body, tail) = Common.head_middle_tail ifdefs in | |
1010 | ||
1011 | let newi = !g +> add_node (IfdefHeader (head)) newxi'.labels "[ifdef]" in | |
1012 | let taili = !g +> add_node (IfdefEndif (tail)) newxi'.labels "[endif]" in | |
1013 | !g +> add_arc_opt (starti, newi); | |
1014 | ||
1015 | let elsenodes = | |
1016 | body +> List.map (fun elseif -> | |
1017 | let elsei = | |
1018 | !g +> add_node (IfdefElse (elseif)) newxi'.labels "[elseif]" in | |
1019 | !g#add_arc ((newi, elsei), Direct); | |
1020 | elsei | |
1021 | ) in | |
1022 | ||
91eba41f | 1023 | let _finalxs = |
485bce71 C |
1024 | Common.zip (newi::elsenodes) xxs +> List.map (fun (start_nodei, xs)-> |
1025 | let finalthen = | |
1026 | aux_statement_list (Some start_nodei) (newxi, newxi) xs in | |
1027 | !g +> add_arc_opt (finalthen, taili); | |
1028 | ) | |
1029 | in | |
1030 | Some taili | |
1031 | ||
1032 | ) starti | |
1033 | ||
1034 | ||
34e49164 C |
1035 | (*****************************************************************************) |
1036 | (* Definition of function *) | |
1037 | (*****************************************************************************) | |
1038 | ||
1039 | let (aux_definition: nodei -> definition -> unit) = fun topi funcdef -> | |
1040 | ||
1041 | let lbl_start = [!counter_for_labels] in | |
1042 | ||
b1b2de81 | 1043 | let ({f_name = namefuncs; |
485bce71 C |
1044 | f_type = functype; |
1045 | f_storage= sto; | |
1046 | f_body= compound; | |
1047 | f_attr= attrs; | |
91eba41f | 1048 | f_old_c_style = oldstyle; |
485bce71 | 1049 | }, ii) = funcdef in |
34e49164 C |
1050 | let iifunheader, iicompound = |
1051 | (match ii with | |
b1b2de81 C |
1052 | | ioparen::icparen::iobrace::icbrace::iifake::isto -> |
1053 | ioparen::icparen::iifake::isto, | |
34e49164 C |
1054 | [iobrace;icbrace] |
1055 | | _ -> raise Impossible | |
1056 | ) | |
1057 | in | |
1058 | ||
708f4980 | 1059 | let topstatement = Ast_c.mk_st (Ast_c.Compound compound) iicompound in |
34e49164 | 1060 | |
485bce71 C |
1061 | let headi = !g +> add_node |
1062 | (FunHeader ({ | |
b1b2de81 | 1063 | Ast_c.f_name = namefuncs; |
485bce71 C |
1064 | f_type = functype; |
1065 | f_storage = sto; | |
1066 | f_attr = attrs; | |
91eba41f C |
1067 | f_body = [] (* empty body *); |
1068 | f_old_c_style = oldstyle; | |
485bce71 | 1069 | }, iifunheader)) |
b1b2de81 | 1070 | lbl_start ("function " ^ Ast_c.str_of_name namefuncs) in |
34e49164 C |
1071 | let enteri = !g +> add_node Enter lbl_0 "[enter]" in |
1072 | let exiti = !g +> add_node Exit lbl_0 "[exit]" in | |
1073 | let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in | |
1074 | ||
1075 | !g#add_arc ((topi, headi), Direct); | |
1076 | !g#add_arc ((headi, enteri), Direct); | |
1077 | ||
1078 | (* ---------------------------------------------------------------- *) | |
1079 | (* todocheck: assert ? such as we have "consommer" tous les labels *) | |
1080 | let info = | |
1081 | { initial_info with | |
1082 | labels = lbl_start; | |
1083 | labels_assoc = compute_labels_and_create_them topstatement; | |
1084 | exiti = Some exiti; | |
1085 | errorexiti = Some errorexiti; | |
1086 | compound_caller = FunctionDef; | |
1087 | } | |
1088 | in | |
1089 | ||
1090 | let lasti = aux_statement (Some enteri, info) topstatement in | |
1091 | !g +> add_arc_opt (lasti, exiti) | |
1092 | ||
1093 | (*****************************************************************************) | |
1094 | (* Entry point *) | |
1095 | (*****************************************************************************) | |
1096 | ||
1097 | (* Helpers for SpecialDeclMacro. | |
1098 | * | |
1099 | * could also force the coccier to define | |
1100 | * the toplevel macro statement as in @@ toplevel_declarator MACRO_PARAM;@@ | |
1101 | * and so I would not need this hack and instead I would to a cleaner | |
1102 | * match in cocci_vs_c_3.ml of a A.MacroTop vs B.MacroTop | |
708f4980 C |
1103 | * |
1104 | * todo: update: now I do what I just described, so can remove this code ? | |
34e49164 C |
1105 | *) |
1106 | let specialdeclmacro_to_stmt (s, args, ii) = | |
1107 | let (iis, iiopar, iicpar, iiptvirg) = tuple_of_list4 ii in | |
b1b2de81 | 1108 | let ident = Ast_c.RegularName (s, [iis]) in |
708f4980 C |
1109 | let identfinal = Ast_c.mk_e (Ast_c.Ident (ident)) Ast_c.noii in |
1110 | let f = Ast_c.mk_e (Ast_c.FunCall (identfinal, args)) [iiopar;iicpar] in | |
1111 | let stmt = Ast_c.mk_st (Ast_c.ExprStatement (Some f)) [iiptvirg] in | |
34e49164 C |
1112 | stmt, (f, [iiptvirg]) |
1113 | ||
1114 | ||
1115 | ||
1116 | let ast_to_control_flow e = | |
1117 | ||
1118 | (* globals (re)initialialisation *) | |
1119 | g := (new ograph_mutable); | |
1120 | counter_for_labels := 1; | |
1121 | counter_for_braces := 0; | |
1122 | counter_for_switch := 0; | |
1123 | ||
1124 | let topi = !g +> add_node TopNode lbl_0 "[top]" in | |
1125 | ||
1126 | match e with | |
485bce71 C |
1127 | | Ast_c.Definition ((defbis,_) as def) -> |
1128 | let _funcs = defbis.f_name in | |
1129 | let _c = defbis.f_body in | |
34e49164 C |
1130 | (* if !Flag.show_misc then pr2 ("build info function " ^ funcs); *) |
1131 | aux_definition topi def; | |
1132 | Some !g | |
1133 | ||
1134 | | Ast_c.Declaration _ | |
485bce71 | 1135 | | Ast_c.CppTop (Ast_c.Include _) |
34e49164 C |
1136 | | Ast_c.MacroTop _ |
1137 | -> | |
1138 | let (elem, str) = | |
1139 | match e with | |
1140 | | Ast_c.Declaration decl -> | |
1141 | (Control_flow_c.Decl decl), "decl" | |
485bce71 C |
1142 | | Ast_c.CppTop (Ast_c.Include inc) -> |
1143 | (Control_flow_c.Include inc), "#include" | |
34e49164 C |
1144 | | Ast_c.MacroTop (s, args, ii) -> |
1145 | let (st, (e, ii)) = specialdeclmacro_to_stmt (s, args, ii) in | |
1146 | (Control_flow_c.ExprStatement (st, (Some e, ii))), "macrotoplevel" | |
1147 | (*(Control_flow_c.MacroTop (s, args,ii), "macrotoplevel") *) | |
1148 | | _ -> raise Impossible | |
1149 | in | |
1150 | let ei = !g +> add_node elem lbl_0 str in | |
1151 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1152 | ||
1153 | !g#add_arc ((topi, ei),Direct); | |
1154 | !g#add_arc ((ei, endi),Direct); | |
1155 | Some !g | |
1156 | ||
485bce71 | 1157 | | Ast_c.CppTop (Ast_c.Define ((id,ii), (defkind, defval))) -> |
34e49164 C |
1158 | let s = ("#define " ^ id) in |
1159 | let headeri = !g+>add_node (DefineHeader ((id, ii), defkind)) lbl_0 s in | |
1160 | !g#add_arc ((topi, headeri),Direct); | |
1161 | ||
1162 | (match defval with | |
1163 | | Ast_c.DefineExpr e -> | |
1164 | let ei = !g +> add_node (DefineExpr e) lbl_0 "defexpr" in | |
1165 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1166 | !g#add_arc ((headeri, ei) ,Direct); | |
1167 | !g#add_arc ((ei, endi) ,Direct); | |
1168 | ||
1169 | | Ast_c.DefineType ft -> | |
1170 | let ei = !g +> add_node (DefineType ft) lbl_0 "deftyp" in | |
1171 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1172 | !g#add_arc ((headeri, ei) ,Direct); | |
1173 | !g#add_arc ((ei, endi) ,Direct); | |
1174 | ||
1175 | | Ast_c.DefineStmt st -> | |
1176 | ||
1177 | (* can have some return; inside the statement *) | |
1178 | let exiti = !g +> add_node Exit lbl_0 "[exit]" in | |
1179 | let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in | |
1180 | let goto_labels = compute_labels_and_create_them st in | |
1181 | ||
1182 | let info = { initial_info with | |
1183 | labels_assoc = goto_labels; | |
1184 | exiti = Some exiti; | |
1185 | errorexiti = Some errorexiti; | |
1186 | } | |
1187 | in | |
1188 | ||
1189 | let lasti = aux_statement (Some headeri , info) st in | |
1190 | lasti +> do_option (fun lasti -> | |
1191 | (* todo? if don't have a lasti ? no EndNode ? CTL will work ? *) | |
1192 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1193 | !g#add_arc ((lasti, endi), Direct) | |
1194 | ) | |
1195 | ||
1196 | ||
485bce71 | 1197 | | Ast_c.DefineDoWhileZero ((st,_e), ii) -> |
34e49164 C |
1198 | let headerdoi = |
1199 | !g +> add_node (DefineDoWhileZeroHeader ((),ii)) lbl_0 "do0" in | |
1200 | !g#add_arc ((headeri, headerdoi), Direct); | |
1201 | let info = initial_info in | |
1202 | let lasti = aux_statement (Some headerdoi , info) st in | |
1203 | lasti +> do_option (fun lasti -> | |
1204 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1205 | !g#add_arc ((lasti, endi), Direct) | |
1206 | ) | |
1207 | ||
1208 | | Ast_c.DefineFunction def -> | |
1209 | aux_definition headeri def; | |
1210 | ||
91eba41f C |
1211 | | Ast_c.DefineText (s, s_ii) -> |
1212 | raise (Error(Define(pinfo_of_ii ii))) | |
34e49164 C |
1213 | | Ast_c.DefineEmpty -> |
1214 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1215 | !g#add_arc ((headeri, endi),Direct); | |
485bce71 | 1216 | | Ast_c.DefineInit _ -> |
91eba41f | 1217 | raise (Error(Define(pinfo_of_ii ii))) |
485bce71 | 1218 | | Ast_c.DefineTodo -> |
91eba41f | 1219 | raise (Error(Define(pinfo_of_ii ii))) |
708f4980 C |
1220 | |
1221 | (* old: | |
1222 | | Ast_c.DefineText (s, ii) -> | |
1223 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1224 | !g#add_arc ((headeri, endi),Direct); | |
1225 | | Ast_c.DefineInit _ -> | |
1226 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1227 | !g#add_arc ((headeri, endi),Direct); | |
1228 | | Ast_c.DefineTodo -> | |
1229 | let endi = !g +> add_node EndNode lbl_0 "[end]" in | |
1230 | !g#add_arc ((headeri, endi),Direct); | |
1231 | *) | |
34e49164 C |
1232 | ); |
1233 | ||
1234 | Some !g | |
1235 | ||
1236 | ||
1237 | | _ -> None | |
1238 | ||
1239 | ||
1240 | (*****************************************************************************) | |
1241 | (* CFG loop annotation *) | |
1242 | (*****************************************************************************) | |
1243 | ||
1244 | let annotate_loop_nodes g = | |
1245 | let firsti = Control_flow_c.first_node g in | |
1246 | ||
1247 | (* just for opti a little *) | |
1248 | let already = Hashtbl.create 101 in | |
1249 | ||
1250 | g +> Ograph_extended.dfs_iter_with_path firsti (fun xi path -> | |
1251 | Hashtbl.add already xi true; | |
1252 | let succ = g#successors xi in | |
1253 | let succ = succ#tolist in | |
1254 | succ +> List.iter (fun (yi,_edge) -> | |
1255 | if Hashtbl.mem already yi && List.mem yi (xi::path) | |
1256 | then | |
1257 | let node = g#nodes#find yi in | |
1258 | let ((node2, nodeinfo), nodestr) = node in | |
1259 | let node' = ((node2, {nodeinfo with is_loop = true}), (nodestr ^ "*")) | |
1260 | in | |
1261 | g#replace_node (yi, node'); | |
1262 | ); | |
1263 | ); | |
1264 | ||
1265 | ||
1266 | g | |
1267 | ||
1268 | ||
1269 | (*****************************************************************************) | |
1270 | (* CFG checks *) | |
1271 | (*****************************************************************************) | |
1272 | ||
1273 | (* the second phase, deadcode detection. Old code was raising DeadCode if | |
1274 | * lasti = None, but maybe not. In fact if have 2 return in the then | |
1275 | * and else of an if ? | |
1276 | * | |
1277 | * alt: but can assert that at least there exist | |
1278 | * a node to exiti, just check #pred of exiti. | |
1279 | * | |
1280 | * Why so many deadcode in Linux ? Ptet que le label est utilisé | |
1281 | * mais dans le corps d'une macro et donc on le voit pas :( | |
1282 | * | |
1283 | *) | |
1284 | let deadcode_detection g = | |
1285 | ||
1286 | g#nodes#iter (fun (k, node) -> | |
1287 | let pred = g#predecessors k in | |
1288 | if pred#null then | |
1289 | (match unwrap node with | |
1290 | (* old: | |
1291 | * | Enter -> () | |
1292 | * | EndStatement _ -> pr2 "deadcode sur fake node, pas grave"; | |
1293 | *) | |
1294 | | TopNode -> () | |
1295 | | FunHeader _ -> () | |
1296 | | ErrorExit -> () | |
1297 | | Exit -> () (* if have 'loop: if(x) return; i++; goto loop' *) | |
1298 | | SeqEnd _ -> () (* todo?: certaines '}' deviennent orphelins *) | |
1299 | | x -> | |
1300 | (match Control_flow_c.extract_fullstatement node with | |
708f4980 C |
1301 | | Some st -> |
1302 | let ii = Ast_c.get_ii_st_take_care st in | |
1303 | raise (Error (DeadCode (Some (pinfo_of_ii ii)))) | |
0708f913 | 1304 | | _ -> pr2 "CFG: orphelin nodes, maybe something weird happened" |
34e49164 C |
1305 | ) |
1306 | ) | |
1307 | ) | |
1308 | ||
1309 | (*------------------------------------------------------------------------*) | |
1310 | (* special_cfg_braces: the check are really specific to the way we | |
1311 | * have build our control_flow, with the { } in the graph so normally | |
1312 | * all those checks here are useless. | |
1313 | * | |
1314 | * ver1: to better error reporting, to report earlier the message, pass | |
1315 | * the list of '{' (containing morover a brace_identifier) instead of | |
1316 | * just the depth. | |
1317 | *) | |
1318 | ||
1319 | let (check_control_flow: cflow -> unit) = fun g -> | |
1320 | ||
1321 | let nodes = g#nodes in | |
1322 | let starti = first_node g in | |
1323 | let visited = ref (new oassocb []) in | |
1324 | ||
1325 | let print_trace_error xs = pr2 "PB with flow:"; Common.pr2_gen xs; in | |
1326 | ||
1327 | let rec dfs (nodei, (* Depth depth,*) startbraces, trace) = | |
1328 | let trace2 = nodei::trace in | |
1329 | if !visited#haskey nodei | |
1330 | then | |
1331 | (* if loop back, just check that go back to a state where have same depth | |
1332 | number *) | |
1333 | let (*(Depth depth2)*) startbraces2 = !visited#find nodei in | |
1334 | if (*(depth = depth2)*) startbraces <> startbraces2 | |
1335 | then | |
1336 | begin | |
1337 | pr2 (sprintf "PB with flow: the node %d has not same braces count" | |
1338 | nodei); | |
1339 | print_trace_error trace2 | |
1340 | end | |
1341 | else | |
1342 | let children = g#successors nodei in | |
1343 | let _ = visited := !visited#add (nodei, (* Depth depth*) startbraces) in | |
1344 | ||
1345 | (* old: good, but detect a missing } too late, only at the end | |
1346 | let newdepth = | |
1347 | (match fst (nodes#find nodei) with | |
1348 | | StartBrace i -> Depth (depth + 1) | |
1349 | | EndBrace i -> Depth (depth - 1) | |
1350 | | _ -> Depth depth | |
1351 | ) | |
1352 | in | |
1353 | *) | |
1354 | let newdepth = | |
1355 | (match unwrap (nodes#find nodei), startbraces with | |
1356 | | SeqStart (_,i,_), xs -> i::xs | |
1357 | | SeqEnd (i,_), j::xs -> | |
b1b2de81 | 1358 | if i =|= j |
34e49164 C |
1359 | then xs |
1360 | else | |
1361 | begin | |
1362 | pr2 (sprintf ("PB with flow: not corresponding match between }%d and excpeted }%d at node %d") i j nodei); | |
1363 | print_trace_error trace2; | |
1364 | xs | |
1365 | end | |
1366 | | SeqEnd (i,_), [] -> | |
1367 | pr2 (sprintf "PB with flow: too much } at }%d " i); | |
1368 | print_trace_error trace2; | |
1369 | [] | |
1370 | | _, xs -> xs | |
1371 | ) | |
1372 | in | |
1373 | ||
1374 | ||
b1b2de81 | 1375 | if null children#tolist |
34e49164 C |
1376 | then |
1377 | if (* (depth = 0) *) startbraces <> [] | |
1378 | then print_trace_error trace2 | |
1379 | else | |
1380 | children#tolist +> List.iter (fun (nodei,_) -> | |
1381 | dfs (nodei, newdepth, trace2) | |
1382 | ) | |
1383 | in | |
1384 | ||
1385 | dfs (starti, (* Depth 0*) [], []) | |
1386 | ||
1387 | (*****************************************************************************) | |
1388 | (* Error report *) | |
1389 | (*****************************************************************************) | |
1390 | ||
1391 | let report_error error = | |
1392 | let error_from_info info = | |
1393 | Common.error_message_short info.file ("", info.charpos) | |
1394 | in | |
1395 | match error with | |
1396 | | DeadCode infoopt -> | |
1397 | (match infoopt with | |
1398 | | None -> pr2 "FLOW: deadcode detected, but cant trace back the place" | |
1399 | | Some info -> pr2 ("FLOW: deadcode detected: " ^ error_from_info info) | |
1400 | ) | |
1401 | | CaseNoSwitch info -> | |
1402 | pr2 ("FLOW: case without corresponding switch: " ^ error_from_info info) | |
1403 | | OnlyBreakInSwitch info -> | |
1404 | pr2 ("FLOW: only break are allowed in switch: " ^ error_from_info info) | |
708f4980 C |
1405 | | WeirdSwitch info -> |
1406 | pr2 ("FLOW: weird switch: " ^ error_from_info info) | |
34e49164 C |
1407 | | NoEnclosingLoop (info) -> |
1408 | pr2 ("FLOW: can't find enclosing loop: " ^ error_from_info info) | |
1409 | | GotoCantFindLabel (s, info) -> | |
1410 | pr2 ("FLOW: cant jump to " ^ s ^ ": because we can't find this label") | |
1411 | | NoExit info -> | |
1412 | pr2 ("FLOW: can't find exit or error exit: " ^ error_from_info info) | |
1413 | | DuplicatedLabel s -> | |
708f4980 | 1414 | pr2 ("FLOW: duplicate label " ^ s) |
34e49164 C |
1415 | | NestedFunc -> |
1416 | pr2 ("FLOW: not handling yet nested function") | |
1417 | | ComputedGoto -> | |
1418 | pr2 ("FLOW: not handling computed goto yet") | |
91eba41f C |
1419 | | Define info -> |
1420 | pr2 ("Unsupported form of #define: " ^ error_from_info info) |