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