3 * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License (GPL)
7 * version 2 as published by the Free Software Foundation.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * file license.txt for more details.
24 (*****************************************************************************)
25 (* todo?: compute target level with goto (but rare that different I think)
27 * ver2: compute depth of label (easy, intercept compound in the visitor)
29 * checktodo: after a switch, need check that all the st in the
30 * compound start with a case: ?
32 * checktodo: how ensure that when we call aux_statement recursivly, we
33 * pass it xi_lbl and not just auxinfo ? how enforce that ?
34 * in fact we must either pass a xi_lbl or a newxi
36 * todo: can have code (and so nodes) in many places, in the size of an
37 * array, in the init of initializer, but also in StatementExpr, ...
39 * todo?: steal code from CIL ? (but seems complicated ... again) *)
40 (*****************************************************************************)
42 (*****************************************************************************)
44 (*****************************************************************************)
47 | DeadCode
of Common.parse_info
option
48 | CaseNoSwitch
of Common.parse_info
49 | OnlyBreakInSwitch
of Common.parse_info
50 | NoEnclosingLoop
of Common.parse_info
51 | GotoCantFindLabel
of string * Common.parse_info
52 | NoExit
of Common.parse_info
53 | DuplicatedLabel
of string
56 | Define
of Common.parse_info
58 exception Error
of error
60 (*****************************************************************************)
62 (*****************************************************************************)
64 let add_node node labels nodestr g
=
65 g#
add_node (Control_flow_c.mk_node node labels
[] nodestr
)
66 let add_bc_node node labels parent_labels nodestr g
=
67 g#
add_node (Control_flow_c.mk_node node labels parent_labels nodestr
)
68 let add_arc_opt (starti
, nodei
) g
=
69 starti
+> do_option
(fun starti
-> g#add_arc
((starti
, nodei
), Direct
))
74 let pinfo_of_ii ii
= Ast_c.get_opi
(List.hd ii
).Ast_c.pinfo
78 (*****************************************************************************)
79 (* Contextual information passed in aux_statement *)
80 (*****************************************************************************)
82 (* Sometimes have a continue/break and we must know where we must jump.
84 * ctl_brace: The node list in context_info record the number of '}' at the
85 * context point, for instance at the switch point. So that when deeper,
86 * we can compute the difference between the number of '}' from root to
87 * the context point to close the good number of '}' . For instance
88 * where there is a 'continue', we must close only until the for.
92 | LoopInfo
of nodei
* nodei
(* start, end *) * node list
* int list
93 | SwitchInfo
of nodei
* nodei
(* start, end *) * node list
* int list
95 (* for the Compound case I need to do different things depending if
96 * the compound is the compound of the function definition, the compound of
97 * a switch, so this type allows to specify this and enable to factorize
98 * code for the Compound
100 and compound_caller
=
101 FunctionDef
| Statement
| Switch
of (nodei
-> xinfo
-> xinfo
)
103 (* other information used internally in ast_to_flow and passed recursively *)
106 ctx
: context_info
; (* cf above *)
107 ctx_stack
: context_info list
;
109 (* are we under a ifthen[noelse]. Used for ErrorExit *)
111 compound_caller
: compound_caller
;
113 (* does not change recursively. Some kind of globals. *)
114 labels_assoc
: (string, nodei
) oassoc
;
116 errorexiti
: nodei
option;
118 (* ctl_braces: the nodei list is to handle current imbrication depth.
119 * It contains the must-close '}'.
120 * update: now it is instead a node list.
132 under_ifthen
= false;
133 compound_caller
= Statement
;
137 (* don't change when recurse *)
138 labels_assoc
= new oassocb
[];
144 (*****************************************************************************)
145 (* (Semi) Globals, Julia's style. *)
146 (*****************************************************************************)
148 let g = ref (new ograph_mutable
)
150 let counter_for_labels = ref 0
151 let counter_for_braces = ref 0
153 (* For switch we use compteur too (or pass int ref) cos need know order of the
154 * case if then later want to go from CFG to (original) AST.
155 * update: obsolete now I think
157 let counter_for_switch = ref 0
160 (*****************************************************************************)
162 (*****************************************************************************)
164 (* alt: do via a todo list, so can do all in one pass (but more complex)
165 * todo: can also count the depth level and associate it to the node, for
168 let compute_labels_and_create_them st
=
170 (* map C label to index number in graph *)
171 let (h
: (string, nodei
) oassoc
ref) = ref (new oassocb
[]) in
174 st
+> Visitor_c.vk_statement
{ Visitor_c.default_visitor_c
with
175 Visitor_c.kstatement
= (fun (k
, bigf
) st
->
177 | Labeled
(Ast_c.Label
(name
, _st
)),ii
->
178 (* at this point I put a lbl_0, but later I will put the
180 let s = Ast_c.str_of_name name
in
181 let newi = !g +> add_node (Label
(st
,name
, ((),ii
))) lbl_0 (s^
":")
184 (* the C label already exists ? *)
185 if (!h#haskey
s) then raise
(Error
(DuplicatedLabel
s));
186 h
:= !h#add
(s, newi);
187 (* not k _st !!! otherwise in lbl1: lbl2: i++; we miss lbl2 *)
198 let insert_all_braces xs starti
=
199 xs
+> List.fold_left
(fun acc node
->
200 (* Have to build a new node (clone), cos cant share it.
201 * update: This is now done by the caller. The clones are in xs.
203 let newi = !g#
add_node node
in
204 !g#add_arc
((acc
, newi), Direct
);
208 (*****************************************************************************)
210 (*****************************************************************************)
212 (* Take in a (optional) start node, return an (optional) end node.
216 * ver1: old code was returning an nodei, but goto has no end, so
217 * aux_statement should return nodei option.
219 * ver2: old code was taking a nodei, but should also take nodei
222 * ver3: deadCode detection. What is dead code ? When there is no
223 * starti to start from ? So make starti an option too ? Si on arrive
224 * sur un label: au moment d'un deadCode, on peut verifier les
225 * predecesseurs de ce label, auquel cas si y'en a, ca veut dire
226 * qu'en fait c'est pas du deadCode et que donc on peut se permettre
227 * de partir d'un starti à None. Mais si on a xx; goto far:; near:
228 * yy; zz; far: goto near:. Bon ca doit etre un cas tres tres rare,
229 * mais a cause de notre parcours, on va rejeter ce programme car au
230 * moment d'arriver sur near: on n'a pas encore de predecesseurs pour
231 * ce label. De meme, meme le cas simple ou la derniere instruction
232 * c'est un return, alors ca va generer un DeadCode :(
234 * So make a first pass where dont launch exn at all. Create nodes,
235 * if starti is None then dont add arc. Then make a second pass that
236 * just checks that all nodes (except enter) have predecessors.
237 * So make starti an option too. So type is now
239 * nodei option -> statement -> nodei option.
241 * todo?: if the pb is at a fake node, then try first successos that
244 * ver4: because of special needs of coccinelle, need pass more info, cf
245 * type additionnal_info defined above.
247 * - to complete (break, continue (and enclosing loop), switch (and
248 * associated case, casedefault)) we need to pass additionnal info.
249 * The start/exit when enter in a loop, to know the current 'for'.
251 * - to handle the braces, need again pass additionnal info.
253 * - need pass the labels.
255 * convention: xi for the auxinfo passed recursively
259 let rec (aux_statement
: (nodei
option * xinfo
) -> statement
-> nodei
option) =
260 fun (starti
, xi
) stmt
->
262 if not
!Flag_parsing_c.label_strategy_2
263 then incr
counter_for_labels;
266 if !Flag_parsing_c.label_strategy_2
268 else xi
.labels
@ [!counter_for_labels]
271 (* Normally the new auxinfo to pass recursively to the next aux_statement.
272 * But in some cases we add additionnal stuff in which case we don't use
273 * this 'xi_lbl' but a 'newxi' specially built.
276 if !Flag_parsing_c.label_strategy_2
278 compound_caller
= Statement
;
281 labels
= xi
.labels
@ [ !counter_for_labels ];
282 compound_caller
= Statement
;
286 (* ------------------------- *)
289 (* coupling: the Switch case copy paste parts of the Compound case *)
290 | Ast_c.Compound statxs
, ii
->
292 let (i1
, i2
) = tuple_of_list2 ii
in
295 incr
counter_for_braces;
296 let brace = !counter_for_braces in
298 let s1 = "{" ^ i_to_s
brace in
299 let s2 = "}" ^ i_to_s
brace in
301 let lbl = match xi
.compound_caller
with
302 | FunctionDef
-> xi
.labels
(* share label with function header *)
303 | Statement
-> xi
.labels
@ [!counter_for_labels]
304 | Switch _
-> xi
.labels
307 let newi = !g +> add_node (SeqStart
(stmt
, brace, i1
)) lbl s1 in
308 let endnode = mk_node
(SeqEnd
(brace, i2
)) lbl [] s2 in
309 let endnode_dup = mk_fake_node
(SeqEnd
(brace, i2
)) lbl [] s2 in
312 mk_node (SeqEnd (brace, Ast_c.fakeInfo())) lbl [] s2 in
315 let newxi = { xi_lbl with braces
= endnode_dup:: xi_lbl.braces
} in
317 let newxi = match xi
.compound_caller
with
318 | Switch todo_in_compound
->
319 (* note that side effect in todo_in_compound *)
320 todo_in_compound
newi newxi
321 | FunctionDef
| Statement
-> newxi
324 !g +> add_arc_opt (starti
, newi);
325 let starti = Some
newi in
327 aux_statement_list
starti (xi
, newxi) statxs
330 +> Common.fmap
(fun starti ->
331 (* subtil: not always return a Some.
332 * Note that if starti is None, alors forcement ca veut dire
333 * qu'il y'a eu un return (ou goto), et donc forcement les
334 * braces auront au moins ete crée une fois, et donc flow_to_ast
336 * Sauf si le goto revient en arriere ? mais dans ce cas
337 * ca veut dire que le programme boucle. Pour qu'il boucle pas
338 * il faut forcement au moins un return.
340 let endi = !g#
add_node endnode in
341 !g#add_arc
((starti, endi), Direct
);
346 (* ------------------------- *)
347 | Labeled
(Ast_c.Label
(name
, st
)), ii
->
348 let s = Ast_c.str_of_name name
in
349 let ilabel = xi
.labels_assoc#find
s in
350 let node = mk_node
(unwrap
(!g#nodes#find
ilabel)) lbl [] (s ^
":") in
351 !g#replace_node
(ilabel, node);
352 !g +> add_arc_opt (starti, ilabel);
353 aux_statement
(Some
ilabel, xi_lbl) st
356 | Jump
(Ast_c.Goto name
), ii
->
357 let s = Ast_c.str_of_name name
in
358 (* special_cfg_ast: *)
359 let newi = !g +> add_node (Goto
(stmt
, name
, ((),ii
))) lbl ("goto "^
s^
":")
361 !g +> add_arc_opt (starti, newi);
364 try xi
.labels_assoc#find
s
366 (* jump vers ErrorExit a la place ?
367 * pourquoi tant de "cant jump" ? pas detecté par gcc ?
369 raise
(Error
(GotoCantFindLabel
(s, pinfo_of_ii ii
)))
371 (* !g +> add_arc_opt (starti, ilabel);
372 * todo: special_case: suppose that always goto to toplevel of function,
373 * hence the Common.init
374 * todo?: can perhaps report when a goto is not a classic error_goto ?
375 * that is when it does not jump to the toplevel of the function.
377 let newi = insert_all_braces (Common.list_init xi
.braces
) newi in
378 !g#add_arc
((newi, ilabel), Direct
);
381 | Jump
(Ast_c.GotoComputed e
), ii
->
382 raise
(Error
(ComputedGoto
))
384 (* ------------------------- *)
385 | Ast_c.ExprStatement opte
, ii
->
386 (* flow_to_ast: old: when opte = None, then do not add in CFG. *)
391 let ((unwrap_e
, typ
), ii
) = e
in
393 | FunCall
(((Ident
(namef
), _typ
), _ii
), _args
) ->
394 Ast_c.str_of_name namef ^
"(...)"
395 | Assignment
(((Ident
(namevar
), _typ
), _ii
), SimpleAssign
, e
) ->
396 Ast_c.str_of_name namevar ^
" = ... ;"
398 (((RecordAccess
(((Ident
(namevar
), _typ
), _ii
), field
), _typ2
),
402 let sfield = Ast_c.str_of_name field
in
403 Ast_c.str_of_name namevar ^
"." ^
sfield ^
" = ... ;"
408 let newi = !g +> add_node (ExprStatement
(stmt
, (opte
, ii
))) lbl s in
409 !g +> add_arc_opt (starti, newi);
413 (* ------------------------- *)
414 | Selection
(Ast_c.If
(e
, st1
, (Ast_c.ExprStatement
(None
), []))), ii
->
415 (* sometome can have ExprStatement None but it is a if-then-else,
416 * because something like if() xx else ;
417 * so must force to have [] in the ii associated with ExprStatement
420 let (i1
,i2
,i3
, iifakeend
) = tuple_of_list4 ii
in
421 let ii = [i1
;i2
;i3
] in
422 (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti
424 * |-> newfakeelse -> ... -> finalelse -|
425 * update: there is now also a link directly to lasti.
427 * because of CTL, now do different things if we are in a ifthen or
430 let newi = !g +> add_node (IfHeader
(stmt
, (e
, ii))) lbl ("if") in
431 !g +> add_arc_opt (starti, newi);
432 let newfakethen = !g +> add_node TrueNode
lbl "[then]" in
433 let newfakeelse = !g +> add_node FallThroughNode
lbl "[fallthrough]" in
434 let afteri = !g +> add_node AfterNode
lbl "[after]" in
435 let lasti = !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endif]"
438 (* for ErrorExit heuristic *)
439 let newxi = { xi_lbl with under_ifthen
= true; } in
441 !g#add_arc
((newi, newfakethen), Direct
);
442 !g#add_arc
((newi, newfakeelse), Direct
);
443 !g#add_arc
((newi, afteri), Direct
);
444 !g#add_arc
((afteri, lasti), Direct
);
445 !g#add_arc
((newfakeelse, lasti), Direct
);
447 let finalthen = aux_statement
(Some
newfakethen, newxi) st1
in
448 !g +> add_arc_opt (finalthen, lasti);
452 | Selection
(Ast_c.If
(e
, st1
, st2
)), ii ->
453 (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti
455 * |-> newfakeelse -> ... -> finalelse -|
456 * update: there is now also a link directly to lasti.
458 let (iiheader
, iielse
, iifakeend
) =
460 | [i1
;i2
;i3
;i4
;i5
] -> [i1
;i2
;i3
], i4
, i5
461 | _
-> raise Impossible
463 let newi = !g +> add_node (IfHeader
(stmt
, (e
, iiheader
))) lbl "if" in
464 !g +> add_arc_opt (starti, newi);
465 let newfakethen = !g +> add_node TrueNode
lbl "[then]" in
466 let newfakeelse = !g +> add_node FalseNode
lbl "[else]" in
467 let elsenode = !g +> add_node (Else iielse
) lbl "else" in
470 !g#add_arc
((newi, newfakethen), Direct
);
471 !g#add_arc
((newi, newfakeelse), Direct
);
473 !g#add_arc
((newfakeelse, elsenode), Direct
);
475 let finalthen = aux_statement
(Some
newfakethen, xi_lbl) st1
in
476 let finalelse = aux_statement
(Some
elsenode, xi_lbl) st2
in
478 (match finalthen, finalelse with
479 | (None
, None
) -> None
482 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endif]" in
484 !g +> add_node AfterNode
lbl "[after]" in
485 !g#add_arc
((newi, afteri), Direct
);
486 !g#add_arc
((afteri, lasti), Direct
);
488 !g +> add_arc_opt (finalthen, lasti);
489 !g +> add_arc_opt (finalelse, lasti);
494 (* ------------------------- *)
495 | Selection
(Ast_c.Switch
(e
, st
)), ii ->
496 let (i1
,i2
,i3
, iifakeend
) = tuple_of_list4
ii in
497 let ii = [i1
;i2
;i3
] in
499 (* The newswitchi is for the labels to know where to attach.
500 * The newendswitch (endi) is for the 'break'. *)
502 !g+> add_node (SwitchHeader
(stmt
,(e
,ii))) lbl "switch" in
504 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endswitch]" in
506 !g +> add_arc_opt (starti, newswitchi);
508 (* call compound case. Need special info to pass to compound case
509 * because we need to build a context_info that need some of the
510 * information build inside the compound case: the nodei of {
514 | Ast_c.Compound statxs
, ii ->
515 let statxs = Ast_c.stmt_elems_of_sequencable
statxs in
517 (* todo? we should not allow to match a stmt that corresponds
518 * to a compound of a switch, so really SeqStart (stmt, ...)
519 * here ? so maybe should change the SeqStart labeling too.
520 * So need pass a todo_in_compound2 function.
522 let todo_in_compound newi newxi =
523 let newxi'
= { newxi with
524 ctx
= SwitchInfo
(newi(*!!*), newendswitch, xi
.braces
, lbl);
525 ctx_stack
= newxi.ctx
::newxi.ctx_stack
528 !g#add_arc
((newswitchi, newi), Direct
);
529 (* new: if have not a default case, then must add an edge
530 * between start to end.
531 * todo? except if the case[range] coverthe whole spectrum
533 if not
(statxs +> List.exists
(function
534 | (Labeled
(Ast_c.Default _
), _
) -> true
538 (* when there is no default, then a valid path is
539 * from the switchheader to the end. In between we
543 let newafter = !g+>add_node FallThroughNode
lbl "[switchfall]"
545 !g#add_arc
((newafter, newendswitch), Direct
);
546 !g#add_arc
((newswitchi, newafter), Direct
);
548 !g#add_arc ((newswitchi, newendswitch), Direct) +> adjust_g;
553 let newxi = { xi
with compound_caller
=
554 Switch
todo_in_compound
557 aux_statement
(None
(* no starti *), newxi) st
558 | x
-> raise Impossible
560 !g +> add_arc_opt (finalthen, newendswitch);
563 (* what if has only returns inside. We must try to see if the
564 * newendswitch has been used via a 'break;' or because no
568 (match finalthen with
571 let afteri = !g +> add_node AfterNode
lbl "[after]" in
572 !g#add_arc
((newswitchi, afteri), Direct
);
573 !g#add_arc
((afteri, newendswitch), Direct
);
576 !g#add_arc
((finalthen, newendswitch), Direct
);
579 if (!g#predecessors
newendswitch)#null
581 assert ((!g#successors
newendswitch)#null
);
582 !g#del_node
newendswitch;
587 let afteri = !g +> add_node AfterNode
lbl "[after]" in
588 !g#add_arc
((newswitchi, afteri), Direct
);
589 !g#add_arc
((afteri, newendswitch), Direct
);
599 | Labeled
(Ast_c.Case
(_
, _
)), ii
600 | Labeled
(Ast_c.CaseRange
(_
, _
, _
)), ii ->
602 incr
counter_for_switch;
603 let switchrank = !counter_for_switch in
606 | Labeled
(Ast_c.Case
(e
, st
)), ii ->
607 (Case
(stmt
, (e
, ii))), st
608 | Labeled
(Ast_c.CaseRange
(e
, e2
, st
)), ii ->
609 (CaseRange
(stmt
, ((e
, e2
), ii))), st
610 | _
-> raise Impossible
613 let newi = !g +> add_node node lbl "case:" in
615 (match Common.optionise
(fun () ->
617 (xi
.ctx
::xi
.ctx_stack
) +> Common.find_some
(function
618 | SwitchInfo
(a
, b
, c
, _
) -> Some
(a
, b
, c
)
622 | Some
(startbrace
, switchendi
, _braces
) ->
623 (* no need to attach to previous for the first case, cos would be
625 starti +> do_option
(fun starti ->
626 if starti <> startbrace
627 then !g +> add_arc_opt (Some
starti, newi);
630 let s = ("[casenode] " ^ i_to_s
switchrank) in
631 let newcasenodei = !g +> add_node (CaseNode
switchrank) lbl s in
632 !g#add_arc
((startbrace
, newcasenodei), Direct
);
633 !g#add_arc
((newcasenodei, newi), Direct
);
634 | None
-> raise
(Error
(CaseNoSwitch
(pinfo_of_ii ii)))
636 aux_statement
(Some
newi, xi_lbl) st
639 | Labeled
(Ast_c.Default st
), ii ->
640 incr
counter_for_switch;
641 let switchrank = !counter_for_switch in
643 let newi = !g +> add_node (Default
(stmt
, ((),ii))) lbl "case default:" in
644 !g +> add_arc_opt (starti, newi);
647 | SwitchInfo
(startbrace
, switchendi
, _braces
, _parent_lbl
) ->
648 let s = ("[casenode] " ^ i_to_s
switchrank) in
649 let newcasenodei = !g +> add_node (CaseNode
switchrank) lbl s in
650 !g#add_arc
((startbrace
, newcasenodei), Direct
);
651 !g#add_arc
((newcasenodei, newi), Direct
);
652 | _
-> raise
(Error
(CaseNoSwitch
(pinfo_of_ii ii)))
654 aux_statement
(Some
newi, xi_lbl) st
661 (* ------------------------- *)
662 | Iteration
(Ast_c.While
(e
, st
)), ii ->
663 (* starti -> newi ---> newfakethen -> ... -> finalthen -
664 * |---|-----------------------------------|
668 let (i1
,i2
,i3
, iifakeend
) = tuple_of_list4
ii in
669 let ii = [i1
;i2
;i3
] in
671 let newi = !g +> add_node (WhileHeader
(stmt
, (e
,ii))) lbl "while" in
672 !g +> add_arc_opt (starti, newi);
673 let newfakethen = !g +> add_node InLoopNode
lbl "[whiletrue]" in
674 (* let newfakeelse = !g +> add_node FalseNode lbl "[endwhile]" in *)
675 let newafter = !g +> add_node FallThroughNode
lbl "[whilefall]" in
677 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endwhile]" in
679 let newxi = { xi_lbl with
680 ctx
= LoopInfo
(newi, newfakeelse, xi_lbl.braces
, lbl);
681 ctx_stack
= xi_lbl.ctx
::xi_lbl.ctx_stack
685 !g#add_arc
((newi, newfakethen), Direct
);
686 !g#add_arc
((newafter, newfakeelse), Direct
);
687 !g#add_arc
((newi, newafter), Direct
);
688 let finalthen = aux_statement
(Some
newfakethen, newxi) st
in
689 !g +> add_arc_opt (finalthen, newi);
693 (* This time, may return None, for instance if goto in body of dowhile
694 * (whereas While cant return None). But if return None, certainly
697 | Iteration
(Ast_c.DoWhile
(st
, e
)), ii ->
698 (* starti -> doi ---> ... ---> finalthen (opt) ---> whiletaili
699 * |--------- newfakethen ---------------| |---> newfakelse
702 match Ast_c.unwrap_expr e
with
703 | Constant
(Int
"0") -> true
707 let (iido
, iiwhiletail
, iifakeend
) =
709 | [i1
;i2
;i3
;i4
;i5
;i6
] -> i1
, [i2
;i3
;i4
;i5
], i6
710 | _
-> raise Impossible
712 let doi = !g +> add_node (DoHeader
(stmt
, iido
)) lbl "do" in
713 !g +> add_arc_opt (starti, doi);
714 let taili = !g +> add_node (DoWhileTail
(e
, iiwhiletail
)) lbl "whiletail"
718 (*let newfakeelse = !g +> add_node FalseNode lbl "[enddowhile]" in *)
719 let newafter = !g +> add_node FallThroughNode
lbl "[dowhilefall]" in
721 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[enddowhile]" in
723 let newxi = { xi_lbl with
724 ctx
= LoopInfo
(taili, newfakeelse, xi_lbl.braces
, lbl);
725 ctx_stack
= xi_lbl.ctx
::xi_lbl.ctx_stack
731 let newfakethen = !g +> add_node InLoopNode
lbl "[dowhiletrue]" in
732 !g#add_arc
((taili, newfakethen), Direct
);
733 !g#add_arc
((newfakethen, doi), Direct
);
736 !g#add_arc
((newafter, newfakeelse), Direct
);
737 !g#add_arc
((taili, newafter), Direct
);
740 let finalthen = aux_statement
(Some
doi, newxi) st
in
741 (match finalthen with
743 if (!g#predecessors
taili)#null
744 then raise
(Error
(DeadCode
(Some
(pinfo_of_ii ii))))
745 else Some
newfakeelse
747 !g#add_arc
((finali
, taili), Direct
);
753 | Iteration
(Ast_c.For
(e1opt
, e2opt
, e3opt
, st
)), ii ->
754 let (i1
,i2
,i3
, iifakeend
) = tuple_of_list4
ii in
755 let ii = [i1
;i2
;i3
] in
758 !g+>add_node(ForHeader
(stmt
,((e1opt
,e2opt
,e3opt
),ii))) lbl "for" in
759 !g +> add_arc_opt (starti, newi);
760 let newfakethen = !g +> add_node InLoopNode
lbl "[fortrue]" in
761 (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*)
762 let newafter = !g +> add_node FallThroughNode
lbl "[forfall]" in
764 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endfor]" in
766 let newxi = { xi_lbl with
767 ctx
= LoopInfo
(newi, newfakeelse, xi_lbl.braces
, lbl);
768 ctx_stack
= xi_lbl.ctx
::xi_lbl.ctx_stack
772 !g#add_arc
((newi, newfakethen), Direct
);
773 !g#add_arc
((newafter, newfakeelse), Direct
);
774 !g#add_arc
((newi, newafter), Direct
);
775 let finalthen = aux_statement
(Some
newfakethen, newxi) st
in
776 !g +> add_arc_opt (finalthen, newi);
780 (* to generate less exception with the breakInsideLoop, analyse
781 * correctly the loop deguisé comme list_for_each. Add a case ForMacro
782 * in ast_c (and in lexer/parser), and then do code that imitates the
784 * update: the list_for_each was previously converted into Tif by the
785 * lexer, now they are returned as Twhile so less pbs. But not perfect.
786 * update: now I recognize the list_for_each macro so no more problems.
788 | Iteration
(Ast_c.MacroIteration
(s, es
, st
)), ii ->
789 let (i1
,i2
,i3
, iifakeend
) = tuple_of_list4
ii in
790 let ii = [i1
;i2
;i3
] in
793 !g+>add_node(MacroIterHeader
(stmt
,((s,es
),ii))) lbl "foreach" in
794 !g +> add_arc_opt (starti, newi);
795 let newfakethen = !g +> add_node InLoopNode
lbl "[fortrue]" in
796 (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*)
797 let newafter = !g +> add_node FallThroughNode
lbl "[foreachfall]" in
799 !g +> add_node (EndStatement
(Some iifakeend
)) lbl "[endforeach]" in
801 let newxi = { xi_lbl with
802 ctx
= LoopInfo
(newi, newfakeelse, xi_lbl.braces
, lbl);
803 ctx_stack
= xi_lbl.ctx
::xi_lbl.ctx_stack
807 !g#add_arc
((newi, newfakethen), Direct
);
808 !g#add_arc
((newafter, newfakeelse), Direct
);
809 !g#add_arc
((newi, newafter), Direct
);
810 let finalthen = aux_statement
(Some
newfakethen, newxi) st
in
811 !g +> add_arc_opt (finalthen, newi);
816 (* ------------------------- *)
817 | Jump
((Ast_c.Continue
|Ast_c.Break
) as x
),ii ->
820 SwitchInfo
(startbrace
, loopendi
, braces
, parent_lbl
) ->
825 xi
.ctx_stack
+> Common.find_some
(function
826 LoopInfo
(_
,_
,_
,_
) as c
-> Some c
829 raise
(Error
(OnlyBreakInSwitch
(pinfo_of_ii ii))))
830 | LoopInfo
(loopstarti
, loopendi
, braces
, parent_lbl
) -> xi
.ctx
831 | NoInfo
-> raise
(Error
(NoEnclosingLoop
(pinfo_of_ii ii))) in
834 match context_info with
835 LoopInfo
(loopstarti
, loopendi
, braces
, parent_lbl
) -> parent_lbl
836 | SwitchInfo
(startbrace
, loopendi
, braces
, parent_lbl
) -> parent_lbl
837 | NoInfo
-> raise Impossible
in
840 let (node_info
, string) =
842 String.concat
"," (List.map string_of_int
parent_label) in
845 (Continue
(stmt
, ((), ii)),
846 Printf.sprintf
"continue; [%s]" parent_string)
848 (Break
(stmt
, ((), ii)),
849 Printf.sprintf
"break; [%s]" parent_string)
850 | _
-> raise Impossible
853 (* idea: break or continue records the label of its parent loop or
855 let newi = !g +> add_bc_node node_info
lbl parent_label string in
856 !g +> add_arc_opt (starti, newi);
858 (* let newi = some starti in *)
860 (match context_info with
861 | LoopInfo
(loopstarti
, loopendi
, braces
, parent_lbl
) ->
864 | Ast_c.Break
-> loopendi
865 | Ast_c.Continue
-> loopstarti
866 | x
-> raise Impossible
868 let difference = List.length xi
.braces
- List.length braces
in
869 assert (difference >= 0);
870 let toend = take
difference xi
.braces
in
871 let newi = insert_all_braces toend newi in
872 !g#add_arc
((newi, desti), Direct
);
875 | SwitchInfo
(startbrace
, loopendi
, braces
, parent_lbl
) ->
876 assert (x
=*= Ast_c.Break
);
877 let difference = List.length xi
.braces
- List.length braces
in
878 assert (difference >= 0);
879 let toend = take
difference xi
.braces
in
880 let newi = insert_all_braces toend newi in
881 !g#add_arc
((newi, loopendi
), Direct
);
883 | NoInfo
-> raise Impossible
886 | Jump
((Ast_c.Return
| Ast_c.ReturnExpr _
) as kind
), ii ->
887 (match xi
.exiti
, xi
.errorexiti
with
888 | None
, None
-> raise
(Error
(NoExit
(pinfo_of_ii ii)))
889 | Some exiti
, Some errorexiti
->
894 | Ast_c.Return
-> "return"
895 | Ast_c.ReturnExpr _
-> "return ..."
896 | _
-> raise Impossible
901 | Ast_c.Return
-> Return
(stmt
, ((),ii))
902 | Ast_c.ReturnExpr e
-> ReturnExpr
(stmt
, (e
, ii))
903 | _
-> raise Impossible
907 !g +> add_arc_opt (starti, newi);
908 let newi = insert_all_braces xi
.braces
newi in
911 then !g#add_arc
((newi, errorexiti
), Direct
)
912 else !g#add_arc
((newi, exiti
), Direct
)
915 | _
-> raise Impossible
919 (* ------------------------- *)
920 | Ast_c.Decl decl
, ii ->
924 ([{v_namei
= Some
(name
, _
); v_type
= typ
; v_storage
= sto
}, _
], _
)) ->
925 "decl:" ^
Ast_c.str_of_name name
926 | _
-> "decl_novar_or_multivar"
929 let newi = !g +> add_node (Decl
(decl
)) lbl s in
930 !g +> add_arc_opt (starti, newi);
933 (* ------------------------- *)
934 | Ast_c.Asm body
, ii ->
935 let newi = !g +> add_node (Asm
(stmt
, ((body
,ii)))) lbl "asm;" in
936 !g +> add_arc_opt (starti, newi);
939 | Ast_c.MacroStmt
, ii ->
940 let newi = !g +> add_node (MacroStmt
(stmt
, ((),ii))) lbl "macro;" in
941 !g +> add_arc_opt (starti, newi);
945 (* ------------------------- *)
946 | Ast_c.NestedFunc def
, ii ->
947 raise
(Error NestedFunc
)
955 and aux_statement_list
starti (xi
, newxi) statxs =
957 +> List.fold_left
(fun starti statement_seq
->
958 if !Flag_parsing_c.label_strategy_2
959 then incr
counter_for_labels;
962 if !Flag_parsing_c.label_strategy_2
963 then { newxi with labels
= xi
.labels
@ [ !counter_for_labels ] }
967 match statement_seq
with
968 | Ast_c.StmtElem statement
->
969 aux_statement
(starti, newxi'
) statement
971 | Ast_c.CppDirectiveStmt directive
->
972 pr2_once
("ast_to_flow: filter a directive");
975 | Ast_c.IfdefStmt ifdef
->
976 pr2_once
("ast_to_flow: filter a directive");
979 | Ast_c.IfdefStmt2
(ifdefs
, xxs
) ->
981 let (head
, body
, tail
) = Common.head_middle_tail ifdefs
in
983 let newi = !g +> add_node (IfdefHeader
(head
)) newxi'
.labels
"[ifdef]" in
984 let taili = !g +> add_node (IfdefEndif
(tail
)) newxi'
.labels
"[endif]" in
985 !g +> add_arc_opt (starti, newi);
988 body
+> List.map
(fun elseif
->
990 !g +> add_node (IfdefElse
(elseif
)) newxi'
.labels
"[elseif]" in
991 !g#add_arc
((newi, elsei), Direct
);
996 Common.zip
(newi::elsenodes) xxs
+> List.map
(fun (start_nodei
, xs
)->
998 aux_statement_list
(Some start_nodei
) (newxi, newxi) xs
in
999 !g +> add_arc_opt (finalthen, taili);
1007 (*****************************************************************************)
1008 (* Definition of function *)
1009 (*****************************************************************************)
1011 let (aux_definition
: nodei
-> definition
-> unit) = fun topi funcdef
->
1013 let lbl_start = [!counter_for_labels] in
1015 let ({f_name
= namefuncs
;
1020 f_old_c_style
= oldstyle
;
1022 let iifunheader, iicompound
=
1024 | ioparen
::icparen
::iobrace
::icbrace
::iifake
::isto
->
1025 ioparen
::icparen
::iifake
::isto
,
1027 | _
-> raise Impossible
1031 let topstatement = Ast_c.Compound compound
, iicompound
in
1033 let headi = !g +> add_node
1035 Ast_c.f_name
= namefuncs
;
1039 f_body
= [] (* empty body *);
1040 f_old_c_style
= oldstyle
;
1042 lbl_start ("function " ^
Ast_c.str_of_name namefuncs
) in
1043 let enteri = !g +> add_node Enter
lbl_0 "[enter]" in
1044 let exiti = !g +> add_node Exit
lbl_0 "[exit]" in
1045 let errorexiti = !g +> add_node ErrorExit
lbl_0 "[errorexit]" in
1047 !g#add_arc
((topi
, headi), Direct
);
1048 !g#add_arc
((headi, enteri), Direct
);
1050 (* ---------------------------------------------------------------- *)
1051 (* todocheck: assert ? such as we have "consommer" tous les labels *)
1055 labels_assoc
= compute_labels_and_create_them topstatement;
1057 errorexiti = Some
errorexiti;
1058 compound_caller
= FunctionDef
;
1062 let lasti = aux_statement
(Some
enteri, info) topstatement in
1063 !g +> add_arc_opt (lasti, exiti)
1065 (*****************************************************************************)
1067 (*****************************************************************************)
1069 (* Helpers for SpecialDeclMacro.
1071 * could also force the coccier to define
1072 * the toplevel macro statement as in @@ toplevel_declarator MACRO_PARAM;@@
1073 * and so I would not need this hack and instead I would to a cleaner
1074 * match in cocci_vs_c_3.ml of a A.MacroTop vs B.MacroTop
1076 let specialdeclmacro_to_stmt (s, args
, ii) =
1077 let (iis
, iiopar
, iicpar
, iiptvirg
) = tuple_of_list4
ii in
1078 let ident = Ast_c.RegularName
(s, [iis
]) in
1079 let identfinal = (Ast_c.Ident
(ident), Ast_c.noType
()), [] in
1080 let f = (Ast_c.FunCall
(identfinal, args
), Ast_c.noType
()), [iiopar
;iicpar
] in
1081 let stmt = Ast_c.ExprStatement
(Some
f), [iiptvirg
] in
1082 stmt, (f, [iiptvirg
])
1086 let ast_to_control_flow e
=
1088 (* globals (re)initialialisation *)
1089 g := (new ograph_mutable
);
1090 counter_for_labels := 1;
1091 counter_for_braces := 0;
1092 counter_for_switch := 0;
1094 let topi = !g +> add_node TopNode
lbl_0 "[top]" in
1097 | Ast_c.Definition
((defbis
,_
) as def
) ->
1098 let _funcs = defbis
.f_name
in
1099 let _c = defbis
.f_body
in
1100 (* if !Flag.show_misc then pr2 ("build info function " ^ funcs); *)
1101 aux_definition
topi def
;
1104 | Ast_c.Declaration _
1105 | Ast_c.CppTop
(Ast_c.Include _
)
1110 | Ast_c.Declaration decl
->
1111 (Control_flow_c.Decl decl
), "decl"
1112 | Ast_c.CppTop
(Ast_c.Include inc
) ->
1113 (Control_flow_c.Include inc
), "#include"
1114 | Ast_c.MacroTop
(s, args
, ii) ->
1115 let (st
, (e
, ii)) = specialdeclmacro_to_stmt (s, args
, ii) in
1116 (Control_flow_c.ExprStatement
(st
, (Some e
, ii))), "macrotoplevel"
1117 (*(Control_flow_c.MacroTop (s, args,ii), "macrotoplevel") *)
1118 | _
-> raise Impossible
1120 let ei = !g +> add_node elem
lbl_0 str
in
1121 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1123 !g#add_arc
((topi, ei),Direct
);
1124 !g#add_arc
((ei, endi),Direct
);
1127 | Ast_c.CppTop
(Ast_c.Define
((id
,ii), (defkind
, defval
))) ->
1128 let s = ("#define " ^ id
) in
1129 let headeri = !g+>add_node (DefineHeader
((id
, ii), defkind
)) lbl_0 s in
1130 !g#add_arc
((topi, headeri),Direct
);
1133 | Ast_c.DefineExpr e
->
1134 let ei = !g +> add_node (DefineExpr e
) lbl_0 "defexpr" in
1135 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1136 !g#add_arc
((headeri, ei) ,Direct
);
1137 !g#add_arc
((ei, endi) ,Direct
);
1139 | Ast_c.DefineType ft
->
1140 let ei = !g +> add_node (DefineType ft
) lbl_0 "deftyp" in
1141 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1142 !g#add_arc
((headeri, ei) ,Direct
);
1143 !g#add_arc
((ei, endi) ,Direct
);
1145 | Ast_c.DefineStmt st
->
1147 (* can have some return; inside the statement *)
1148 let exiti = !g +> add_node Exit
lbl_0 "[exit]" in
1149 let errorexiti = !g +> add_node ErrorExit
lbl_0 "[errorexit]" in
1150 let goto_labels = compute_labels_and_create_them st
in
1152 let info = { initial_info with
1153 labels_assoc
= goto_labels;
1155 errorexiti = Some
errorexiti;
1159 let lasti = aux_statement
(Some
headeri , info) st
in
1160 lasti +> do_option
(fun lasti ->
1161 (* todo? if don't have a lasti ? no EndNode ? CTL will work ? *)
1162 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1163 !g#add_arc
((lasti, endi), Direct
)
1167 | Ast_c.DefineDoWhileZero
((st
,_e
), ii) ->
1169 !g +> add_node (DefineDoWhileZeroHeader
((),ii)) lbl_0 "do0" in
1170 !g#add_arc
((headeri, headerdoi), Direct
);
1171 let info = initial_info in
1172 let lasti = aux_statement
(Some
headerdoi , info) st
in
1173 lasti +> do_option
(fun lasti ->
1174 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1175 !g#add_arc
((lasti, endi), Direct
)
1178 | Ast_c.DefineFunction def
->
1179 aux_definition
headeri def
;
1181 | Ast_c.DefineText
(s, s_ii
) ->
1182 raise
(Error
(Define
(pinfo_of_ii ii)))
1183 | Ast_c.DefineEmpty
->
1184 let endi = !g +> add_node EndNode
lbl_0 "[end]" in
1185 !g#add_arc
((headeri, endi),Direct
);
1186 | Ast_c.DefineInit _
->
1187 raise
(Error
(Define
(pinfo_of_ii ii)))
1188 | Ast_c.DefineTodo
->
1189 raise
(Error
(Define
(pinfo_of_ii ii)))
1198 (*****************************************************************************)
1199 (* CFG loop annotation *)
1200 (*****************************************************************************)
1202 let annotate_loop_nodes g =
1203 let firsti = Control_flow_c.first_node
g in
1205 (* just for opti a little *)
1206 let already = Hashtbl.create
101 in
1208 g +> Ograph_extended.dfs_iter_with_path
firsti (fun xi path
->
1209 Hashtbl.add
already xi
true;
1210 let succ = g#successors xi
in
1211 let succ = succ#tolist
in
1212 succ +> List.iter
(fun (yi
,_edge
) ->
1213 if Hashtbl.mem
already yi
&& List.mem yi
(xi
::path
)
1215 let node = g#nodes#find yi
in
1216 let ((node2
, nodeinfo
), nodestr
) = node in
1217 let node'
= ((node2
, {nodeinfo
with is_loop
= true}), (nodestr ^
"*"))
1219 g#replace_node
(yi
, node'
);
1227 (*****************************************************************************)
1229 (*****************************************************************************)
1231 (* the second phase, deadcode detection. Old code was raising DeadCode if
1232 * lasti = None, but maybe not. In fact if have 2 return in the then
1233 * and else of an if ?
1235 * alt: but can assert that at least there exist
1236 * a node to exiti, just check #pred of exiti.
1238 * Why so many deadcode in Linux ? Ptet que le label est utilisé
1239 * mais dans le corps d'une macro et donc on le voit pas :(
1242 let deadcode_detection g =
1244 g#nodes#iter
(fun (k
, node) ->
1245 let pred = g#predecessors k
in
1247 (match unwrap
node with
1250 * | EndStatement _ -> pr2 "deadcode sur fake node, pas grave";
1255 | Exit
-> () (* if have 'loop: if(x) return; i++; goto loop' *)
1256 | SeqEnd _
-> () (* todo?: certaines '}' deviennent orphelins *)
1258 (match Control_flow_c.extract_fullstatement
node with
1259 | Some
(st
, ii) -> raise
(Error
(DeadCode
(Some
(pinfo_of_ii ii))))
1260 | _
-> pr2
"CFG: orphelin nodes, maybe something weird happened"
1265 (*------------------------------------------------------------------------*)
1266 (* special_cfg_braces: the check are really specific to the way we
1267 * have build our control_flow, with the { } in the graph so normally
1268 * all those checks here are useless.
1270 * ver1: to better error reporting, to report earlier the message, pass
1271 * the list of '{' (containing morover a brace_identifier) instead of
1275 let (check_control_flow
: cflow
-> unit) = fun g ->
1277 let nodes = g#
nodes in
1278 let starti = first_node
g in
1279 let visited = ref (new oassocb
[]) in
1281 let print_trace_error xs
= pr2
"PB with flow:"; Common.pr2_gen xs
; in
1283 let rec dfs (nodei
, (* Depth depth,*) startbraces
, trace
) =
1284 let trace2 = nodei
::trace
in
1285 if !visited#haskey nodei
1287 (* if loop back, just check that go back to a state where have same depth
1289 let (*(Depth depth2)*) startbraces2
= !visited#find nodei
in
1290 if (*(depth = depth2)*) startbraces
<> startbraces2
1293 pr2
(sprintf
"PB with flow: the node %d has not same braces count"
1295 print_trace_error trace2
1298 let children = g#successors nodei
in
1299 let _ = visited := !visited#add
(nodei
, (* Depth depth*) startbraces
) in
1301 (* old: good, but detect a missing } too late, only at the end
1303 (match fst (nodes#find nodei) with
1304 | StartBrace i -> Depth (depth + 1)
1305 | EndBrace i -> Depth (depth - 1)
1311 (match unwrap
(nodes#find nodei
), startbraces
with
1312 | SeqStart
(_,i
,_), xs
-> i
::xs
1313 | SeqEnd
(i
,_), j
::xs
->
1318 pr2
(sprintf
("PB with flow: not corresponding match between }%d and excpeted }%d at node %d") i j nodei
);
1319 print_trace_error trace2;
1322 | SeqEnd
(i
,_), [] ->
1323 pr2
(sprintf
"PB with flow: too much } at }%d " i
);
1324 print_trace_error trace2;
1331 if null
children#tolist
1333 if (* (depth = 0) *) startbraces
<> []
1334 then print_trace_error trace2
1336 children#tolist
+> List.iter
(fun (nodei
,_) ->
1337 dfs (nodei
, newdepth, trace2)
1341 dfs (starti, (* Depth 0*) [], [])
1343 (*****************************************************************************)
1345 (*****************************************************************************)
1347 let report_error error
=
1348 let error_from_info info =
1349 Common.error_message_short
info.file
("", info.charpos
)
1352 | DeadCode infoopt
->
1354 | None
-> pr2
"FLOW: deadcode detected, but cant trace back the place"
1355 | Some
info -> pr2
("FLOW: deadcode detected: " ^
error_from_info info)
1357 | CaseNoSwitch
info ->
1358 pr2
("FLOW: case without corresponding switch: " ^
error_from_info info)
1359 | OnlyBreakInSwitch
info ->
1360 pr2
("FLOW: only break are allowed in switch: " ^
error_from_info info)
1361 | NoEnclosingLoop
(info) ->
1362 pr2
("FLOW: can't find enclosing loop: " ^
error_from_info info)
1363 | GotoCantFindLabel
(s, info) ->
1364 pr2
("FLOW: cant jump to " ^
s ^
": because we can't find this label")
1366 pr2
("FLOW: can't find exit or error exit: " ^
error_from_info info)
1367 | DuplicatedLabel
s ->
1368 pr2
("FLOW: duplicate label" ^
s)
1370 pr2
("FLOW: not handling yet nested function")
1372 pr2
("FLOW: not handling computed goto yet")
1374 pr2
("Unsupported form of #define: " ^
error_from_info info)