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