File: control_flow_c_build.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (1675 lines) | stat: -rw-r--r-- 59,399 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
(* Yoann Padioleau, extensions by Julia Lawall
 *
 * Copyright (C) 2011, 2012, 2013, INRIA.
 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
 * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License (GPL)
 * version 2 as published by the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * file license.txt for more details.
 *)
open Common

open Ast_c
open Control_flow_c

module Lib = Lib_parsing_c

(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_cfg

(*****************************************************************************)
(* todo?: compute target level with goto (but rare that different I think)
 * ver1: just do init,
 * ver2: compute depth of label (easy, intercept compound in the visitor)
 *
 * checktodo: after a switch, need check that all the st in the
 * compound start with a case: ?
 *
 * checktodo: how ensure that when we call aux_statement recursively, we
 * pass it xi_lbl and not just auxinfo ? how enforce that ?
 * in fact we must either pass a xi_lbl or a newxi
 *
 * todo: can have code (and so nodes) in many places, in the size of an
 * array, in the init of initializer, but also in StatementExpr, ...
 *
 * todo?: steal code from CIL ? (but seems complicated ... again) *)
(*****************************************************************************)

(*****************************************************************************)
(* Types *)
(*****************************************************************************)

type error =
  | DeadCode          of Common.parse_info option
  | CaseNoSwitch      of Common.parse_info
  | OnlyBreakInSwitch of Common.parse_info
  | WeirdSwitch       of Common.parse_info
  | NoEnclosingLoop   of Common.parse_info
  | GotoCantFindLabel of string * Common.parse_info
  | NoExit of Common.parse_info
  | DuplicatedLabel of string
  | NestedFunc
  | ComputedGoto
  | Define of Common.parse_info

exception Error of error

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

let add_node node labels nodestr g =
   g#add_node (Control_flow_c.mk_node node labels [] nodestr)
let add_bc_node node labels parent_labels nodestr g =
   g#add_node (Control_flow_c.mk_node node labels parent_labels  nodestr)
let add_arc_opt (starti, nodei) g =
  starti +> do_option (fun starti -> g#add_arc ((starti, nodei), Direct))


let lbl_0 = []

let pinfo_of_ii ii = Ast_c.get_opi (List.hd ii).Ast_c.pinfo



(*****************************************************************************)
(* Contextual information passed in aux_statement *)
(*****************************************************************************)

(* Sometimes have a continue/break and we must know where we must jump.
 *
 * ctl_brace: The node list in context_info record the number of '}' at the
 * context point, for instance at the switch point. So that when deeper,
 * we can compute the difference between the number of '}' from root to
 * the context point to close the good number of '}' . For instance
 * where there is a 'continue', we must close only until the for.
 *)

type nodei = Control_flow_c.G.key 

module StringMap = Map.Make (String)

type braceinfo =
    (node * (after_type -> string -> nodei -> unit), node) Common.either

type context_info =
  | NoInfo
  | LoopInfo   of nodei * nodei (* start, end *) * braceinfo list * int list
  | SwitchInfo of nodei * nodei (* start, end *) * braceinfo list * int list

(* for the Compound case I need to do different things depending if
 * the compound is the compound of the function definition, the compound of
 * a switch, so this type allows to specify this and enable to factorize
 * code for the Compound
 *)
and compound_caller =
  FunctionDef | Statement | Switch of (nodei -> xinfo -> xinfo)

(* other information used internally in ast_to_flow and passed recursively *)
and xinfo =  {

  ctx: context_info; (* cf above *)
  ctx_stack: context_info list;

  (* are we under a ifthen[noelse]. Used for ErrorExit *)
  under_ifthen: bool;
  compound_caller: compound_caller;

  (* does not change recursively. Some kind of globals. *)
  labels_assoc: nodei StringMap.t;
  exiti:      nodei option;
  errorexiti: nodei option;

  (* ctl_braces: the nodei list is to handle current imbrication depth.
   * It contains the must-close '}'.
   * update: now it is instead a node list.
   *)
  braces: braceinfo list;

  (* ctl: *)
  labels: int list;
  }


let initial_info = {
  ctx = NoInfo;
  ctx_stack = [];
  under_ifthen = false;
  compound_caller = Statement;
  braces = [];
  labels = [];

  (* don't change when recurse *)
  labels_assoc = StringMap.empty;
  exiti = None;
  errorexiti = None;
}


(*****************************************************************************)
(* (Semi) Globals, Julia's style. *)
(*****************************************************************************)
(* global graph *)
let g = ref (new Control_flow_c.G.ograph_mutable)

let counter_for_labels = ref 0
let counter_for_braces = ref 0

(* For switch we use compteur too (or pass int ref) cos need know order of the
 * case if then later want to go from CFG to (original) AST.
 * update: obsolete now I think
 *)
let counter_for_switch = ref 0


(*****************************************************************************)
(* helpers *)
(*****************************************************************************)

(* alt: do via a todo list, so can do all in one pass (but more complex)
 * todo: can also count the depth level and associate it to the node, for
 * the ctl_braces:
 *)
let compute_labels_and_create_them st =

  (* map C label to index number in graph *)
  let h = ref StringMap.empty in

  begin
    st +> Visitor_c.vk_statement { Visitor_c.default_visitor_c with
      Visitor_c.kstatement = (fun (k, bigf) st ->
        match Ast_c.unwrap_st st with
        | Labeled (Ast_c.Label (name, _st)) ->
            let ii = Ast_c.get_ii_st_take_care st in
            (* at this point I put a lbl_0, but later I will put the
             * good labels. *)
            let s = Ast_c.str_of_name name in
            let newi = !g +> add_node (Label (st,name, ((),ii))) lbl_0  (s^":")
            in
            begin
              (* the C label already exists ? *)
              if (StringMap.mem s !h) then raise (Error (DuplicatedLabel s));
              h := StringMap.add s newi !h;
              (* not k _st !!! otherwise in lbl1: lbl2: i++; we miss lbl2 *)
              k st;
            end
        | _st -> k st
      )
    };
    !h;
  end


(* ctl_braces: *)
let insert_all_braces xs starti nodety str =
  xs  +> List.fold_left (fun acc nodeinfo ->
    (* Have to build a new node (clone), cos cannot share it.
     * update: This is now done by the caller. The clones are in xs.
     *)
    let (node,fn) =
      match nodeinfo with
	Common.Left(node,mkafter) ->
	  (node,mkafter) (* statements where after link needed *)
      | Common.Right node -> (node,fun _ _ _ -> ()) in (* ifdefs *)
    let newi = !g#add_node node in
    fn nodety str newi;
    !g#add_arc ((acc, newi), Direct);
    newi
  ) starti

(*****************************************************************************)
(* Statement *)
(*****************************************************************************)

(* Take in a (optional) start node, return an (optional) end node.
 *
 * history:
 *
 * ver1: old code was returning an nodei, but goto has no end, so
 * aux_statement should return nodei option.
 *
 * ver2: old code was taking a nodei, but should also take nodei
 * option.
 *
 * ver3: deadCode detection. What is dead code ? When there is no
 * starti to start from ? So make starti an option too ? Si on arrive
 * sur un label: au moment d'un deadCode, on peut verifier les
 * predecesseurs de ce label, auquel cas si y'en a, ca veut dire
 * qu'en fait c'est pas du deadCode et que donc on peut se permettre
 * de partir d'un starti à None. Mais si on a xx; goto far:; near:
 * yy; zz; far: goto near:. Bon ca doit etre un cas tres tres rare,
 * mais a cause de notre parcours, on va rejeter ce programme car au
 * moment d'arriver sur near: on n'a pas encore de predecesseurs pour
 * ce label. De meme, meme le cas simple ou la derniere instruction
 * c'est un return, alors ca va generer un DeadCode :(
 *
 * So make a first pass where don't launch exn at all. Create nodes,
 * if starti is None then don't add arc. Then make a second pass that
 * just checks that all nodes (except enter) have predecessors.
 * So make starti an option too. So type is now
 *
 *      nodei option -> statement -> nodei option.
 *
 * todo?: if the pb is at a fake node, then try first successos that
 * is non fake.
 *
 * ver4: because of special needs of coccinelle, need pass more info, cf
 * type additionnal_info defined above.
 *
 * - to complete (break, continue (and enclosing loop), switch (and
 * associated case, casedefault)) we need to pass additional info.
 * The start/exit when enter in a loop, to know the current 'for'.
 *
 * - to handle the braces, need again pass additional info.
 *
 * - need pass the labels.
 *
 * convention: xi for the auxinfo passed recursively
 *
 *)

let rec aux_statement : (nodei option * xinfo) -> statement -> nodei option =
 fun (starti, xi) stmt ->

  if not !Flag_parsing_c.label_strategy_2
  then incr counter_for_labels;

  let lbl =
    if !Flag_parsing_c.label_strategy_2
    then xi.labels
    else xi.labels @ [!counter_for_labels]
  in

  (* Normally the new auxinfo to pass recursively to the next aux_statement.
   * But in some cases we add additional stuff in which case we don't use
   * this 'xi_lbl' but a 'newxi' specially built.
   *)
  let xi_lbl =
    if !Flag_parsing_c.label_strategy_2
    then { xi with
      compound_caller = Statement;
    }
    else { xi with
      labels = xi.labels @ [ !counter_for_labels ];
      compound_caller = Statement;
    }
  in
  let ii = Ast_c.get_ii_st_take_care stmt in

  (* ------------------------- *)
  match Ast_c.unwrap_st stmt with

  (*  coupling: the Switch case copy paste parts of the Compound case *)
  | Ast_c.Compound statxs ->
      (* flow_to_ast: *)
      let (i1, i2) = tuple_of_list2 ii in

      (* ctl_braces: *)
      incr counter_for_braces;
      let brace = !counter_for_braces in

      let s1 = "{" ^ string_of_int brace in
      let s2 = "}" ^ string_of_int brace in

      let lbl = match xi.compound_caller with
        | FunctionDef -> xi.labels (* share label with function header *)
        | Statement -> xi.labels @ [!counter_for_labels]
        | Switch _ -> xi.labels
      in

      let newi = !g +> add_node (SeqStart (stmt, brace, i1)) lbl s1 in
      let endnode     = mk_node      (SeqEnd (brace, i2))    lbl [] s2 in
      let endnode_dup = mk_fake_node (SeqEnd (brace, i2))    lbl [] s2 in
(*
      let _endnode_dup =
	mk_node (SeqEnd (brace, Ast_c.fakeInfo())) lbl [] s2 in
*)

      (* This code makes a link from the top of the block to any } created
       * by a return from the braces list.  It is also called at the end
       * of treating the block.  If there is a non-return way out of the
       * block, then any link created by a } will be overwritten by a normal
       * one. This is the desired behavior. *)
      let ret_afters = ref [] in
      let mkafter ty str endi =
	if xi.compound_caller = Statement
	then
	  (let afteri = !g +> add_node (AfterNode ty) lbl str in
	  let a1 = ((newi, afteri), Control) in
	  !g#add_arc a1;
	  let a2 = ((afteri, endi), Control) in
	  !g#add_arc a2;
	  ret_afters := (afteri,a1,a2) :: !ret_afters) in

      let newxi = { xi_lbl with
            braces = Common.Left(endnode_dup,mkafter) :: xi_lbl.braces } in

      let newxi = match xi.compound_caller with
        | Switch todo_in_compound ->
            (* note that side effect in todo_in_compound *)
            todo_in_compound newi newxi
        | FunctionDef | Statement -> newxi
      in

      !g +> add_arc_opt (starti, newi);
      let finishi = Some newi in

      aux_statement_list finishi (xi, newxi) statxs

      (* braces: *)
      +> Common.fmap (fun finishi ->
            (* subtil: not always return a Some.
             * Note that if finishi is None, alors forcement ca veut dire
             * qu'il y'a eu un return (ou goto), et donc forcement les
             * braces auront au moins ete crée une fois, et donc flow_to_ast
             * marchera.
             * Sauf si le goto revient en arriere ? mais dans ce cas
             * ca veut dire que le programme boucle. Pour qu'il boucle pas
             * il faut forcement au moins un return.
             *)
            let endi = !g#add_node endnode in
	    List.iter
	      (function (node,a1,a2) ->
		!g#del_arc a1; !g#del_arc a2; !g#del_node node)
	      !ret_afters;
	    mkafter NormalAfterNode "[after]" endi;
            !g#add_arc ((finishi, endi), Direct);
            endi
           )


   (* ------------------------- *)
  | Labeled (Ast_c.Label (name, st)) ->
      let s = Ast_c.str_of_name name in
      let ilabel = StringMap.find s xi.labels_assoc in
      let node = mk_node (unwrap (KeyMap.find ilabel !g#nodes)) lbl [] (s ^ ":") in
      !g#replace_node (ilabel, node);
      !g +> add_arc_opt (starti, ilabel);
      aux_statement (Some ilabel, xi_lbl) st


  | Jump (Ast_c.Goto name) ->
     let s = Ast_c.str_of_name name in
     (* special_cfg_ast: *)
     let newi = !g +>
          add_node (Goto (stmt, name, ((),ii))) lbl ("goto "^s^":") in
     !g +> add_arc_opt (starti, newi);

     if !Flag_parsing_c.no_gotos
     then Some newi
     else begin
       let ilabel =
         try StringMap.find s xi.labels_assoc
         with Not_found ->
                  (* jump vers ErrorExit a la place ?
                   * pourquoi tant de "cant jump" ? pas detecté par gcc ?
                   *)
                 raise (Error (GotoCantFindLabel (s, pinfo_of_ii ii)))
         in
       (* !g +> add_arc_opt (starti, ilabel);
        * todo: special_case: suppose that always goto to toplevel of
        * function, hence the Common.init
        * todo?: can perhaps report when a goto is not a classic error_goto ?
        * that is when it does not jump to the toplevel of the function.
        *)
       let newi = insert_all_braces (Common.list_init xi.braces) newi
                                    GotoAfterNode "[goto after]" in
       !g#add_arc ((newi, ilabel), Direct);
       None
     end

  | Jump (Ast_c.GotoComputed e) ->
      raise (Error (ComputedGoto))

   (* ------------------------- *)
  | Ast_c.ExprStatement opte ->
      (* flow_to_ast:   old: when opte = None, then do not add in CFG. *)
      let s =
        match opte with
        | None -> "empty;"
        | Some e ->
            (match Ast_c.unwrap_expr e with
            | FunCall (e, _args) ->
                (match Ast_c.unwrap_expr e with
                | Ident namef ->
                    Ast_c.str_of_name namef ^ "(...)"
                | _ -> "statement"
                )
            | Assignment (e1, (SimpleAssign,_), e2) ->
                (match Ast_c.unwrap_expr e1 with
                | Ident namevar ->
                    Ast_c.str_of_name namevar ^ " = ... ;"
                | RecordAccess(e, field) ->
                    (match Ast_c.unwrap_expr e with
                    | Ident namevar ->
                        let sfield = Ast_c.str_of_name field in
                        Ast_c.str_of_name namevar ^ "." ^ sfield ^ " = ... ;"
                    | _ -> "statement"
                    )
                | _ -> "statement"
                )
            | _ -> "statement"
            )
      in
      let newi = !g +> add_node (ExprStatement (stmt, (opte, ii))) lbl s in
      !g +> add_arc_opt (starti, newi);
      Some newi

  | Ast_c.Exec(code) ->
      let s = "exec" in
      let newi = !g +> add_node (Exec (stmt, (code, ii))) lbl s in
      !g +> add_arc_opt (starti, newi);
      Some newi

   (* ------------------------- *)
  | Selection (Ast_c.If _) -> snd (mk_If starti lbl xi_lbl stmt)

   (* ------------------------- *)
  | Selection  (Ast_c.Switch (e, st)) ->
      let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in

      let ii = [i1;i2;i3] in

      (* The newswitchi is for the labels to know where to attach.
       * The newendswitch (endi) is for the 'break'. *)
      let newswitchi=
        !g +> add_node (SwitchHeader(stmt,(e,ii))) lbl "switch" in
      let newendswitch =
        !g +> add_node (EndStatement (Some iifakeend)) lbl "[endswitch]" in

      !g +> add_arc_opt (starti, newswitchi);

      (* allows multiple case labels to stack up *)
      let rec contains_default s =
	match Ast_c.unwrap_st s with
	  Labeled (Ast_c.Default _) -> true
	| Labeled (Ast_c.Case(e,s)) -> contains_default s
	| Labeled (Ast_c.CaseRange(e1,e2,s)) -> contains_default s
	| _ -> false in

       (* call compound case. Need special info to pass to compound case
        * because we need to build a context_info that need some of the
        * information build inside the compound case: the nodei of {
        *)
       let finalthen =
         match Ast_c.unwrap_st st with
         | Ast_c.Compound statxs ->

             let statxs = Lib.stmt_elems_of_sequencable statxs in

             (* todo? we should not allow to match a stmt that corresponds
              * to a compound of a switch, so really SeqStart (stmt, ...)
              * here ? so maybe should change the SeqStart labeling too.
              * So need pass a todo_in_compound2 function.
              *)
             let todo_in_compound newi newxi =
               let newxi' = { newxi with
                 ctx = SwitchInfo (newi(*!!*), newendswitch, xi.braces, lbl);
                 ctx_stack = newxi.ctx::newxi.ctx_stack
               }
               in
               !g#add_arc ((newswitchi, newi), Direct);
               (* new: if have not a default case, then must add an edge
                * between start to end.
                * todo? except if the case[range] coverthe whole spectrum
                *)
               if not (statxs +> List.exists contains_default)
               then begin
                 (* when there is no default, then a valid path is
                  * from the switchheader to the end. In between we
                  * add a Fallthrough.
                  *)

                 let newafter = !g+>add_node FallThroughNode lbl "[switchfall]"
                 in
                 !g#add_arc ((newafter, newendswitch), Direct);
                 !g#add_arc ((newswitchi, newafter), Direct);
                 (* old:
                    !g#add_arc ((newswitchi, newendswitch), Direct) +> adjust_g;
                 *)
               end;
               newxi'
             in
             let newxi = { xi_lbl with compound_caller = (* was xi *)
                 Switch todo_in_compound
             }
             in
             aux_statement (None (* no starti *), newxi) st
         | _x ->
             (* apparently gcc allows some switch body such as
              *   switch (i) case 0 : printf("here\n");
              *   cf tests-bis/switch_no_body.c
              * but I don't think it's worthwhile to handle
              * such pathological and rare case. Not worth
              * the complexity. Safe to assume a compound.
              *)
             raise (Error (WeirdSwitch (pinfo_of_ii [i1])))
       in
       !g +> add_arc_opt (finalthen, newendswitch);


       (* what if has only returns inside. We must  try to see if the
        * newendswitch has been used via a 'break;'  or because no
        * 'default:')
        *)
       let res =
         (match finalthen with
         | Some finalthen ->

             let afteri =
	       !g +> add_node (AfterNode NormalAfterNode) lbl "[after]" in
             !g#add_arc ((newswitchi, afteri),  Control);
             !g#add_arc ((afteri, newendswitch), Control);


             !g#add_arc ((finalthen, newendswitch), Direct);
             Some newendswitch
         | None ->
             if (KeyEdgeSet.is_empty (!g#predecessors newendswitch))
             then begin
                 assert (KeyEdgeSet.is_empty (!g#successors newendswitch));
                 !g#del_node newendswitch;
                 None
             end
             else begin

               let afteri =
		 !g +> add_node (AfterNode NormalAfterNode) lbl "[after]" in
               !g#add_arc ((newswitchi, afteri),  Control);
               !g#add_arc ((afteri, newendswitch), Control);


               Some newendswitch
             end
         )
       in
       res


  | Labeled (Ast_c.Case  (_, _))
  | Labeled (Ast_c.CaseRange  (_, _, _)) ->

      incr counter_for_switch;
      let switchrank = !counter_for_switch in
      let node, st =
        match Ast_c.get_st_and_ii stmt with
        | Labeled (Ast_c.Case  (e, st)), ii ->
            (Case (stmt, (e, ii))),  st
        | Labeled (Ast_c.CaseRange  (e, e2, st)), ii ->
            (CaseRange (stmt, ((e, e2), ii))), st
        | _ -> raise (Impossible 63)
      in

      let newi = !g +> add_node node  lbl "case:" in

      (match Common.optionise (fun () ->
        (* old: xi.ctx *)
        (xi.ctx::xi.ctx_stack) +> Common.find_some (function
        | SwitchInfo (a, b, c, _) -> Some (a, b, c)
        | _ -> None
        ))
      with
      | Some (startbrace, switchendi, _braces) ->
          (* no need to attach to previous for the first case, cos would be
           * redundant. *)
          starti +> do_option (fun starti ->
            if starti <> startbrace
            then !g +> add_arc_opt (Some starti, newi);
            );

          let s = ("[casenode] " ^ string_of_int switchrank) in
          let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in
          !g#add_arc ((startbrace, newcasenodei), Direct);
          !g#add_arc ((newcasenodei, newi), Direct);
      | None -> raise (Error (CaseNoSwitch (pinfo_of_ii ii)))
      );
      aux_statement (Some newi, xi_lbl) st


  | Labeled (Ast_c.Default st) ->
      incr counter_for_switch;
      let switchrank = !counter_for_switch in

      let newi = !g +> add_node (Default(stmt, ((),ii))) lbl "case default:" in
      !g +> add_arc_opt (starti, newi);

      (match xi.ctx with
      | SwitchInfo (startbrace, switchendi, _braces, _parent_lbl) ->
          let s = ("[casenode] " ^ string_of_int switchrank) in
          let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in
          !g#add_arc ((startbrace, newcasenodei), Direct);
          !g#add_arc ((newcasenodei, newi), Direct);
      | _ -> raise (Error (CaseNoSwitch (pinfo_of_ii ii)))
      );
      aux_statement (Some newi, xi_lbl) st






   (* ------------------------- *)
  | Selection (Ast_c.Ifdef_Ite _) -> mk_Ifdef_Ite starti lbl xi_lbl stmt
  | Selection (Ast_c.Ifdef_Ite2 _) -> mk_Ifdef_Ite2 starti lbl xi_lbl stmt

   (* ------------------------- *)
  | Iteration  (Ast_c.While (e, st)) ->
     (* starti -> newi ---> newfakethen -> ... -> finalthen -
      *             |---|-----------------------------------|
      *                 |-> newfakelse
      *)

      let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in
      let ii = [i1;i2;i3] in

      let newi = !g +> add_node (WhileHeader (stmt, (e,ii))) lbl "while" in
      !g +> add_arc_opt (starti, newi);
      let newfakethen = !g +> add_node InLoopNode  lbl "[whiletrue]" in
      (* let newfakeelse = !g +> add_node FalseNode lbl "[endwhile]" in *)
      let newafter = !g +> add_node LoopFallThroughNode lbl "[whilefall]" in
      let newfakeelse =
        !g +> add_node (EndStatement (Some iifakeend)) lbl "[endwhile]" in

      let newxi = { xi_lbl with
         ctx = LoopInfo (newi, newfakeelse,  xi_lbl.braces, lbl);
         ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack
        }
      in

      !g#add_arc ((newi, newfakethen), Direct);
      !g#add_arc ((newafter, newfakeelse), Direct);
      !g#add_arc ((newi, newafter), Direct);
      let finalthen = aux_statement (Some newfakethen, newxi) st in
      !g +> add_arc_opt
	(finalthen, if !Flag_parsing_c.no_loops then newafter else newi);
      Some newfakeelse


  (* This time, may return None, for instance if goto in body of dowhile
   * (whereas While cannot return None). But if return None, certainly
   * some deadcode.
   *)
  | Iteration  (Ast_c.DoWhile (st, e)) ->
     (* starti -> doi ---> ... ---> finalthen (opt) ---> whiletaili
      *             |--------- newfakethen ---------------|  |---> newfakelse
      *)
      let is_zero =
        match Ast_c.unwrap_expr e with
        | Constant (Int ("0",_)) -> true
        | _ -> false
      in

      let (iido, iiwhiletail, iifakeend) =
        match ii with
        | [i1;i2;i3;i4;i5;i6] -> i1, [i2;i3;i4;i5], i6
        | _ -> raise (Impossible 64)
      in
      let doi = !g +> add_node (DoHeader (stmt, iido))  lbl "do" in
      !g +> add_arc_opt (starti, doi);
      let taili = !g +> add_node (DoWhileTail (e, iiwhiletail)) lbl "whiletail"
      in


      (*let newfakeelse = !g +> add_node FalseNode lbl "[enddowhile]" in *)
      let newafter = !g +> add_node FallThroughNode lbl "[dowhilefall]" in
      let newfakeelse =
        !g +> add_node (EndStatement (Some iifakeend)) lbl "[enddowhile]" in

      let afteri = !g +> add_node (AfterNode NormalAfterNode) lbl "[after]" in
      !g#add_arc ((doi,afteri), Control);
      !g#add_arc ((afteri,newfakeelse), Control);

      let newxi = { xi_lbl with
         ctx = LoopInfo (taili, newfakeelse, xi_lbl.braces, lbl);
         ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack
        }
      in

      if not is_zero && (not !Flag_parsing_c.no_loops)
      then begin
        let newfakethen = !g +> add_node InLoopNode lbl "[dowhiletrue]" in
        !g#add_arc ((taili, newfakethen), Direct);
        !g#add_arc ((newfakethen, doi), Direct);
      end;

      !g#add_arc ((newafter, newfakeelse), Direct);
      !g#add_arc ((taili, newafter), Direct);


      let finalthen = aux_statement (Some doi, newxi) st in
      (match finalthen with
      | None ->
          if (KeyEdgeSet.is_empty (!g#predecessors taili))
          then raise (Error (DeadCode (Some (pinfo_of_ii ii))))
          else Some newfakeelse
      | Some finali ->
          !g#add_arc ((finali, taili), Direct);
          Some newfakeelse
      )



  | Iteration  (Ast_c.For (e1opt, e2opt, e3opt, st)) ->
      let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in
      let ii = [i1;i2;i3] in

      let newi =
        !g+>add_node(ForHeader(stmt,((e1opt,e2opt,e3opt),ii))) lbl "for" in
      !g +> add_arc_opt (starti, newi);
      let newfakethen = !g +> add_node InLoopNode  lbl "[fortrue]" in
      (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*)
      let newafter = !g +> add_node LoopFallThroughNode lbl "[forfall]" in
      let newfakeelse =
        !g +> add_node (EndStatement (Some iifakeend)) lbl "[endfor]" in

      let newxi = { xi_lbl with
           ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl);
           ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack
        }
      in

      !g#add_arc ((newi, newfakethen), Direct);
      !g#add_arc ((newafter, newfakeelse), Direct);
      !g#add_arc ((newi, newafter), Direct);
      let finalthen = aux_statement (Some newfakethen, newxi) st in
      !g +> add_arc_opt
	(finalthen,
	 if !Flag_parsing_c.no_loops then newafter else newi);
      Some newfakeelse


  (* to generate less exception with the breakInsideLoop, analyse
   * correctly the loop deguisé comme list_for_each. Add a case ForMacro
   * in ast_c (and in lexer/parser), and then do code that imitates the
   * code for the For.
   * update: the list_for_each was previously converted into Tif by the
   * lexer, now they are returned as Twhile so less pbs. But not perfect.
   * update: now I recognize the list_for_each macro so no more problems.
   *)
  | Iteration  (Ast_c.MacroIteration (s, es, st)) ->
      let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in
      let ii = [i1;i2;i3] in

      let newi =
        !g+>add_node(MacroIterHeader(stmt,((s,es),ii))) lbl "foreach" in
      !g +> add_arc_opt (starti, newi);
      let newfakethen = !g +> add_node InLoopNode  lbl "[fortrue]" in
      (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*)
      let newafter = !g +> add_node LoopFallThroughNode lbl "[foreachfall]" in
      let newfakeelse =
        !g +> add_node (EndStatement (Some iifakeend)) lbl "[endforeach]" in

      let newxi = { xi_lbl with
           ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl);
           ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack
        }
      in

      !g#add_arc ((newi, newfakethen), Direct);
      !g#add_arc ((newafter, newfakeelse), Direct);
      !g#add_arc ((newi, newafter), Direct);
      let finalthen = aux_statement (Some newfakethen, newxi) st in
      !g +> add_arc_opt (finalthen,
                          if !Flag_parsing_c.no_loops then newafter else newi);
      Some newfakeelse



   (* ------------------------- *)
  | Jump ((Ast_c.Continue|Ast_c.Break) as x) ->
      let context_info =
	match xi.ctx with
	  SwitchInfo (startbrace, loopendi, braces, parent_lbl) ->
            if x = Ast_c.Break
	    then xi.ctx
	    else
	      (try
                xi.ctx_stack +> Common.find_some (function
                    LoopInfo (_,_,_,_) as c ->  Some c
                  | _ -> None)
              with Not_found ->
                raise (Error (OnlyBreakInSwitch (pinfo_of_ii ii))))
        | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> xi.ctx
	| NoInfo -> raise (Error (NoEnclosingLoop (pinfo_of_ii ii))) in

      let parent_label =
	match context_info with
	  LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> parent_lbl
	| SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> parent_lbl
	| NoInfo -> raise (Impossible 65) in

      let from_switch =
	match context_info with
	  LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> false
	| SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> true
	| NoInfo -> raise (Impossible 65) in

      (* flow_to_ast: *)
      let (node_info, string) =
	let parent_string =
	  String.concat "," (List.map string_of_int parent_label) in
	(match x with
          | Ast_c.Continue ->
	      (Continue (stmt, ((), ii)),
	       Printf.sprintf "continue; [%s]" parent_string)
          | Ast_c.Break    ->
	      (Break    (stmt, ((), ii), from_switch),
	       Printf.sprintf "break; [%s]" parent_string)
          | _ -> raise (Impossible 66)
          ) in

      (* idea: break or continue records the label of its parent loop or
	 switch *)
      let newi = !g +> add_bc_node node_info lbl parent_label string in
      !g +> add_arc_opt (starti, newi);

      (* let newi = some starti in *)

      (match context_info with
      | LoopInfo (loopstarti, loopendi, braces, parent_lbl) ->
          let (desti,nodety,str) =
            (match x with
            | Ast_c.Break -> (loopendi,BreakAfterNode,"[break after]")
            | Ast_c.Continue ->
		(* if no loops, then continue behaves like break - just
		   one iteration *)
		((if !Flag_parsing_c.no_loops then loopendi else loopstarti),
		ContAfterNode, "[cont after]")
            | x -> raise (Impossible 67)
            ) in
          let difference = List.length xi.braces - List.length braces in
          assert (difference >= 0);
          let toend = take difference xi.braces in
          let newi = insert_all_braces toend newi nodety str in
          !g#add_arc ((newi, desti), Direct);
          None

      | SwitchInfo (startbrace, loopendi, braces, parent_lbl) ->
	  assert (x = Ast_c.Break);
          let difference = List.length xi.braces - List.length braces in
          assert (difference >= 0);
          let toend = take difference xi.braces in
          let newi =
	    insert_all_braces toend newi SWBreakAfterNode "[swbreak after]" in
          !g#add_arc ((newi, loopendi), Direct);
          None
      | NoInfo -> raise (Impossible 68)
      )

  | Jump ((Ast_c.Return | Ast_c.ReturnExpr _) as kind) ->
     (match xi.exiti, xi.errorexiti with
     | None, None -> raise (Error (NoExit (pinfo_of_ii ii)))
     | Some exiti, Some errorexiti ->

      (* flow_to_ast: *)
      let s =
        match kind with
        | Ast_c.Return -> "return"
        | Ast_c.ReturnExpr _ -> "return ..."
        | _ -> raise (Impossible 69)
      in
      let newi =
        !g +> add_node
          (match kind with
          | Ast_c.Return ->       Return (stmt, ((),ii))
          | Ast_c.ReturnExpr e -> ReturnExpr (stmt, (e, ii))
          | _ -> raise (Impossible 70)
          )
          lbl s
      in
      !g +> add_arc_opt (starti, newi);
      let newi = insert_all_braces xi.braces newi RetAfterNode "[ret after]" in

      if xi.under_ifthen
      then !g#add_arc ((newi, errorexiti), Direct)
      else !g#add_arc ((newi, exiti), Direct)
      ;
      None
     | _ -> raise (Impossible 71)
     )


  (* ------------------------- *)
  | Ast_c.Decl decl ->
     let s =
       match decl with
       | (Ast_c.DeclList
             ([{v_namei = Some (name, _); v_type = typ; v_storage = sto}, _], _)) ->
	   "decl:" ^ Ast_c.str_of_name name
       | _ -> "decl_novar_or_multivar"
     in

     let newi = !g +> add_node (Decl (decl)) lbl s in
     !g +> add_arc_opt (starti, newi);
     Some newi

  (* ------------------------- *)
  | Ast_c.Asm body ->
      let newi = !g +> add_node (Asm (stmt, ((body,ii)))) lbl "asm;" in
      !g +> add_arc_opt (starti, newi);
      Some newi

  | Ast_c.MacroStmt ->
      let newi = !g +> add_node (MacroStmt (stmt, ((),ii))) lbl "macro;" in
      !g +> add_arc_opt (starti, newi);
      Some newi

  | Ast_c.IfdefStmt1 (ifdefs, xs) ->
      aux_statement_list starti (xi,xi_lbl)
	[Ast_c.IfdefStmt2 (ifdefs, List.map (fun x -> [StmtElem x]) xs)]

  (* ------------------------- *)
  | Ast_c.NestedFunc def ->
      raise (Error NestedFunc)

and mk_If (starti :nodei option) (labels :int list) (xi_lbl :xinfo)
          (stmt :statement)
          : nodei (* first node of the else branch *)
          * nodei option =
  let ii = Ast_c.get_ii_st_take_care stmt in
  match Ast_c.unwrap_st stmt with
  | Selection (Ast_c.If (e, st1, st2)) ->
    let iist2 = Ast_c.get_ii_st_take_care st2 in begin
    match Ast_c.unwrap_st st2 with
    | Ast_c.ExprStatement None when iist2=[] ->
      (* We could have 'ExprStatement None' as a result of something like
       * 'if() xx else ;', so we must force to have a [] in the ii associated
       * with ExprStatement.
       *)

      let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in
      let ii' = [i1;i2;i3] in
      (* starti -> newi --->   newfakethen -> ... -> finalthen --> lasti
       *                  |                                      |
       *                  |->   newfakeelse -> ... -> finalelse -|
       * update: there is now also a link directly to lasti.
       *
       * because of CTL, now do different things if we are in a ifthen or
       * ifthenelse.
       *)

      (* starti -> newi *)
      let newi = !g +> add_node (IfHeader (stmt, (e, ii'))) labels "if" in
      !g +> add_arc_opt (starti, newi);

      (* newi ---> newfakethen -> ... -> lasti
       *       |                           |
       *       |-> newfakeelse ----------->|
       *)
      let escapes = ref false in
      let newfakethen = !g +> add_node (TrueNode escapes) labels "[then]" in
      let newfakeelse = !g +> add_node FallThroughNode labels "[fallthrough]" in
      let lasti  = !g +>
            add_node (EndStatement (Some iifakeend)) labels "[endif]" in
      !g#add_arc ((newi, newfakethen), Direct);
      !g#add_arc ((newi, newfakeelse), Direct);
      !g#add_arc ((newfakeelse, lasti), Direct);

      (* if -> [after] -> [endif] *)
      let afteri = !g +>
            add_node (AfterNode NormalAfterNode) labels "[after]" in
      !g#add_arc ((newi, afteri), Control);
      !g#add_arc ((afteri, lasti), Control);

      (* for ErrorExit heuristic *)
      let newxi = { xi_lbl with  under_ifthen = true; } in

      (* [then] -> {st1} -> lasti *)
      let finalthen = aux_statement (Some newfakethen, newxi) st1 in
      (match finalthen with None -> escapes := true | _ -> ());
      !g +> add_arc_opt (finalthen, lasti);
      lasti, Some lasti
    | __else__ ->
      (* starti -> newi --->   newfakethen -> ... -> finalthen --> lasti
       *                 |                                      |
       *                 |->   newfakeelse -> ... -> finalelse -|
       * update: there is now also a link directly to lasti.
       *)
      let (iiheader, iielse, iifakeend) =
        match ii with
        | [i1;i2;i3;i4;i5] -> [i1;i2;i3], i4, i5
        | _ -> raise (Impossible 62)
        in

      (* starti -> "if" *)
      let newi = !g +> add_node (IfHeader (stmt, (e, iiheader))) labels "if" in
      !g +> add_arc_opt (starti, newi);

      (* if ---> [then] -> ...
       *     |
       *     |-> [else] -> else -> ...
       *)
      let escapes = ref false in
      let newfakethen = !g +> add_node (TrueNode escapes) labels "[then]" in
      let newfakeelse = !g +> add_node FalseNode labels "[else]" in
      let elsenode = !g +> add_node (Else iielse) labels "else" in
      !g#add_arc ((newi, newfakethen), Direct);
      !g#add_arc ((newi, newfakeelse), Direct);
      !g#add_arc ((newfakeelse, elsenode), Direct);

      let endnode =
        mk_node (EndStatement(Some iifakeend)) labels [] "[endif]" in
      let endnode_dup =
        mk_node (EndStatement(Some iifakeend)) labels [] "[endif]" in

      let ret_afters = ref [] in
      let mkafter ty str lasti = begin
            (* if -> [after] -> [endif] *)
            let afteri = !g +> add_node (AfterNode ty) labels str in
            let a1 = ((newi, afteri), Control) in
            !g#add_arc a1;
            let a2 = ((afteri, lasti), Control) in
            !g#add_arc a2;
            ret_afters := (afteri,a1,a2) :: !ret_afters
        end in

      let newxi = { xi_lbl with
            braces = Common.Left (endnode_dup,mkafter) :: xi_lbl.braces
        } in

      let finalthen = aux_statement (Some newfakethen, newxi) st1 in
      let finalelse = aux_statement (Some elsenode, newxi) st2 in

      (match finalthen with None -> escapes := true | _ -> ());

      (* find the first node of the 'else' branch *)
      let elsenode_succ = match finalelse with
        | Some succ -> succ
        | None      -> elsenode
        in

      elsenode_succ, begin match finalthen, finalelse with
        | (None, None) -> None
        | __else__ ->
          let lasti = !g#add_node endnode in
          !ret_afters +> List.iter (function (node,a1,a2) ->
                            !g#del_arc a1; !g#del_arc a2; !g#del_node node);
          mkafter NormalAfterNode "[after]" lasti;
          begin
            !g +> add_arc_opt (finalthen, lasti);
            !g +> add_arc_opt (finalelse, lasti);
            Some lasti
          end
      end
    end
  | x -> error_cant_have x

(* Builds the CFG for an Ifdef_Ite selection statement, i.e.
 *
 *     #ifdef A if e S1 else #endif S2
 *
 * This function works in fact as a decorator for an If statement:
 *
 * 1. We construct the CFG for 'if e S1 else S2', which coincides with
 *    the _true_ branch for the #ifdef.
 * 2. The _false_ path of is just an edge from the IfdefIteHeader to the
 *    'else' branch of the if statement.
 *
 * Why doing it in this way:
 *
 * - Coccinelle cannot match #ifdef's so we can keep the CFG thin by
 *   avoiding all the extra plumbing. We don't need, for instance, an
 *   _after_ node.
 * - We still want Coccinelle to be able to match the if statement, and
 *   we don't want to replicate (aka copy-paste) code for this purpose.
 *
 * /Iago
 *)
and mk_Ifdef_Ite (starti :nodei option) (labels :int list) (xi_lbl :xinfo)
                 (stmt :statement)
                 : nodei option =
  (* starti -> #ifdef-if ---> if -> ... -> [else] -> ... -> [endif]
   *                      |                         ^
   *                      |_________________________|
   *)
  match Ast_c.get_ii_st_take_care stmt, Ast_c.unwrap_st stmt with
    [i1;i2;i3;i4;i5;i6;i7], Selection (Ast_c.Ifdef_Ite (e, st1, st2)) ->

      let if_sel = Ast_c.If (e,st1,st2) in
      let if_stmtbis = Selection if_sel in
      let if_ii = [i2;i3;i4;i5;i7] in
      let if_stmt = if_stmtbis, if_ii in

      (* starti -> #ifdef-if *)
      let ifdefite = !g +>
        add_node (IfdefIteHeader [i1;i6]) labels "#ifdef-if" in
      !g +> add_arc_opt (starti, ifdefite);

      begin
	match mk_If (Some ifdefite) labels xi_lbl if_stmt with
	  (elsenode,endnode_opt) ->
            !g#add_arc ((ifdefite, elsenode), Direct);
            endnode_opt
      end
  | x -> error_cant_have x

(* Builds the CFG for an Ifdef_Ite selection statement, i.e.
 *
 *     #ifdef A if e S1 else #else S2 #endif S3
 *
 * The true path of the #ifdef implies:
 *
 *     if e S1 else S3
 *
 * See mk_Ifdef_Ite for further details.
 *)
and mk_Ifdef_Ite2 (starti :nodei option) (labels :int list) (xi_lbl :xinfo)
                  (stmt :statement)
                  : nodei option =
  (* starti -> #ifdef-if ---> if -> {st1} -> [else] -> {st3} -> [endif]
   *                      |                              ^
   *                      |------------> {st2} ----------|
   *)
  match Ast_c.get_ii_st_take_care stmt, Ast_c.unwrap_st stmt with
    [i1;i2;i3;i4;i5;i6;i7;i8],
    Selection (Ast_c.Ifdef_Ite2 (e, st1, st2, st3)) ->

      let if_sel = Ast_c.If (e,st1,st3) in
      let if_stmtbis = Selection if_sel in
      let if_ii = [i2;i3;i4;i5;i8] in
      let if_stmt = if_stmtbis, if_ii in

      (* starti -> #ifdef-if *)
      let ifdefite = !g +>
        add_node (IfdefIteHeader [i1;i6;i7]) labels "#ifdef-if" in
      !g +> add_arc_opt (starti, ifdefite);

      begin
	match mk_If (Some ifdefite) labels xi_lbl if_stmt with
	  (elsenode,endnode_opt) ->
	    let finalelse = aux_statement (Some ifdefite, xi_lbl) st2 in
	    begin
	      match finalelse with
		Some st2_node -> !g#add_arc ((st2_node, elsenode), Direct)
	      | None -> ()
	    end;
	    endnode_opt
      end
  | x -> error_cant_have x

and aux_statement_list starti (xi, newxi) statxs =
  statxs
  +> List.fold_left (fun starti statement_seq ->
    if !Flag_parsing_c.label_strategy_2
    then incr counter_for_labels;

    let newxi' =
      if !Flag_parsing_c.label_strategy_2
      then { newxi with labels = xi.labels @ [ !counter_for_labels ] }
      else newxi
    in

    match statement_seq with
    | Ast_c.StmtElem statement ->
        aux_statement (starti, newxi') statement

    | Ast_c.CppDirectiveStmt directive ->
        pr2_once ("ast_to_flow: filter a directive");
        starti

    | Ast_c.IfdefStmt ifdef ->
        pr2_once ("ast_to_flow: filter a directive");
        starti

    | Ast_c.IfdefStmt2 (ifdefs, xxs) ->

        let (head, body, tail) = Common.head_middle_tail ifdefs in

        let newi =
          !g +> add_node (IfdefHeader (head)) newxi'.labels "[ifdef]" in
        let taili =
          !g +> add_node (IfdefEndif (tail)) newxi'.labels "[endif]" in
        (* do like for a close brace, see endi.{c,cocci} *)
        let taili_dup =
          mk_fake_node (IfdefEndif (tail)) newxi'.labels [] "[endif]" in
        !g +> add_arc_opt (starti, newi);

        if body = [] then
        begin
          let newfakeelse = !g +> add_node FallThroughNode newxi'.labels
                                           "[fallthrough]" in
          !g#add_arc ((newi, newfakeelse), Direct);
          !g#add_arc ((newfakeelse,taili), Direct);
        end;

        let elsenodes =
          body +> List.map (fun elseif ->
            let elsei =
              !g +> add_node (IfdefElse (elseif)) newxi'.labels "[elseif]" in
            !g#add_arc ((newi, elsei), Direct);
            elsei
          ) in

        let _finalxs =
          Common.zip (newi::elsenodes) xxs +> List.map (fun (start_nodei, xs)->
              (* not sure if this is correct... newxi seems to relate to
                 the assigned level number *)
              let newerxi =
                { newxi with braces = Common.Right taili_dup:: newxi.braces } in
              let finalthen =
                aux_statement_list (Some start_nodei) (newxi, newerxi) xs in
              !g +> add_arc_opt (finalthen, taili);
              )
        in

(*
        This is an attempt to let a statement metavariable match this
	construct, but it doesn't work because #ifdef is not a statement.
        Not sure if this is a good or bad thing, at least if there is no else
	because then no statement might be there.
	let afteri =
          !g +> add_node (AfterNode NormalAfterNode) newxi'.labels "[after]" in
	!g#add_arc ((newi, afteri), Control);
	!g#add_arc ((afteri, taili), Control);
*)

        Some taili

  ) starti


(*****************************************************************************)
(* Definition of function *)
(*****************************************************************************)

let aux_definition: nodei -> definition -> unit = fun topi funcdef ->

  let lbl_start = [!counter_for_labels] in

  let ({f_name = namefuncs;
        f_type = functype;
        f_storage= sto;
        f_body= compound;
        f_attr= attrs;
        f_old_c_style = oldstyle;
        }, ii) = funcdef in
  let iifunheader, iicompound =
    (match ii with
    | ioparen::icparen::iobrace::icbrace::iifake::isto ->
        ioparen::icparen::iifake::isto,
        [iobrace;icbrace]
    | _ -> raise (Impossible 72)
    )
  in

  let topstatement = Ast_c.mk_st (Ast_c.Compound compound) iicompound in

  let headi = !g +> add_node
    (FunHeader ({
      Ast_c.f_name = namefuncs;
      f_type = functype;
      f_storage = sto;
      f_attr = attrs;
      f_body = [] (* empty body *);
      f_old_c_style = oldstyle;
      }, iifunheader))
    lbl_start ("function " ^ Ast_c.str_of_name namefuncs) in
  let enteri     = !g +> add_node Enter     lbl_0 "[enter]"     in
  let exiti      = !g +> add_node Exit      lbl_0 "[exit]"      in
  let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in

  !g#add_arc ((topi, headi), Direct);
  !g#add_arc ((headi, enteri), Direct);

  (* ---------------------------------------------------------------- *)
  (* todocheck: assert ? such as we have "consommer" tous les labels  *)
  let info =
    { initial_info with
      labels = lbl_start;
      labels_assoc = compute_labels_and_create_them topstatement;
      exiti      = Some exiti;
      errorexiti = Some errorexiti;
      compound_caller = FunctionDef;
    }
  in

  let lasti = aux_statement (Some enteri, info) topstatement in
  !g +> add_arc_opt (lasti, exiti)

(*****************************************************************************)
(* Entry point *)
(*****************************************************************************)

(* Helpers for SpecialDeclMacro.
 *
 * could also force the coccier to define
 * the toplevel macro statement as in @@ toplevel_declarator MACRO_PARAM;@@
 * and so I would not need this hack and instead I would to a cleaner
 * match in cocci_vs_c_3.ml of a A.MacroTop vs B.MacroTop
 *
 * todo: update: now I do what I just described, so can remove this code ?
 *)
let specialdeclmacro_to_stmt (s, args, ii) =
  let (iis, iiopar, iicpar, iiptvirg) = tuple_of_list4 ii in
  let ident = Ast_c.RegularName (s, [iis]) in
  let identfinal = Ast_c.mk_e (Ast_c.Ident (ident)) Ast_c.noii in
  let f = Ast_c.mk_e (Ast_c.FunCall (identfinal, args)) [iiopar;iicpar] in
  let stmt = Ast_c.mk_st (Ast_c.ExprStatement (Some f)) [iiptvirg] in
  stmt,  (f, [iiptvirg])



let rec ast_to_control_flow e =

  (* globals (re)initialialisation *)
  g := (new Control_flow_c.G.ograph_mutable);
  counter_for_labels := 1;
  counter_for_braces := 0;
  counter_for_switch := 0;

  let topi = !g +> add_node TopNode lbl_0 "[top]" in

  match e with
  | Ast_c.Namespace (defs, _) ->
      (* todo: incorporate the other defs *)
      let rec loop defs =
	match defs with
	| [] -> None
	| def :: defs ->
	    match ast_to_control_flow def with
	    | None -> loop defs
	    | x -> x in
      loop defs
  | Ast_c.Definition ((defbis,_) as def) ->
      let _funcs = defbis.f_name in
      let _c = defbis.f_body in
      (* if !Flag.show_misc then pr2 ("build info function " ^ funcs); *)
      aux_definition topi def;
      Some !g

  | Ast_c.Declaration _
  | Ast_c.CppTop (Ast_c.Include _)
  | Ast_c.MacroTop _
    ->
      let (elem, str) =
        match e with
        | Ast_c.Declaration decl ->
            (Control_flow_c.Decl decl),  "decl"
        | Ast_c.CppTop (Ast_c.Include inc) ->
            (Control_flow_c.Include inc), "#include"
        | Ast_c.MacroTop (s, args, ii) ->
            let (st, (e, ii)) = specialdeclmacro_to_stmt (s, args, ii) in
            (Control_flow_c.ExprStatement (st, (Some e, ii))), "macrotoplevel"
          (*(Control_flow_c.MacroTop (s, args,ii), "macrotoplevel") *)
        | _ -> raise (Impossible 73)
      in
      let ei =   !g +> add_node elem    lbl_0 str in
      let endi = !g +> add_node EndNode lbl_0 "[end]" in

      !g#add_arc ((topi, ei),Direct);
      !g#add_arc ((ei, endi),Direct);
      Some !g

  | Ast_c.CppTop (Ast_c.Define ((id,ii), (defkind, defval)))  ->
      let s =
	match defkind with
	  Ast_c.Undef -> "#undef " ^ id
	| _ -> "#define " ^ id in
      let headeri = !g+>add_node (DefineHeader ((id, ii), defkind)) lbl_0 s in
      !g#add_arc ((topi, headeri),Direct);

      (match defval with
      | Ast_c.DefineExpr e ->
          let ei   = !g +> add_node (DefineExpr e) lbl_0 "defexpr" in
          let endi = !g +> add_node EndNode        lbl_0 "[end]" in
          !g#add_arc ((headeri, ei) ,Direct);
          !g#add_arc ((ei, endi) ,Direct);

      | Ast_c.DefineType ft ->
          let ei   = !g +> add_node (DefineType ft) lbl_0 "deftyp" in
          let endi = !g +> add_node EndNode         lbl_0 "[end]" in
          !g#add_arc ((headeri, ei) ,Direct);
          !g#add_arc ((ei, endi) ,Direct);

      | Ast_c.DefineStmt st ->
          (* can have some return; inside the statement *)
          let exiti      = !g +> add_node Exit      lbl_0 "[exit]"      in
          let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in
          let goto_labels = compute_labels_and_create_them st in

          let info = { initial_info with
            labels_assoc = goto_labels;
            exiti      = Some exiti;
            errorexiti = Some errorexiti;
          }
          in

          let lasti = aux_statement (Some headeri , info) st in
          lasti +> do_option (fun lasti ->
            (* todo? if don't have a lasti ? no EndNode ? CTL will work ? *)
            let endi = !g +> add_node EndNode lbl_0 "[end]" in
            !g#add_arc ((lasti, endi), Direct)
          )


      | Ast_c.DefineDoWhileZero ((st,_e), ii) ->
          let goto_labels = compute_labels_and_create_them st in
          let info = { initial_info with
            labels_assoc = goto_labels } in

          let headerdoi =
            !g +> add_node (DefineDoWhileZeroHeader ((),ii)) lbl_0 "do0" in
          !g#add_arc ((headeri, headerdoi), Direct);
          let lasti = aux_statement (Some headerdoi , info) st in
          lasti +> do_option (fun lasti ->
            let endi = !g +> add_node EndNode lbl_0 "[end]" in
            !g#add_arc ((lasti, endi), Direct)
          )

      | Ast_c.DefineFunction def ->
          aux_definition headeri def;

      | Ast_c.DefineText (s, s_ii) ->
          raise (Error(Define(pinfo_of_ii ii)))
      | Ast_c.DefineEmpty ->
          let endi = !g +> add_node EndNode lbl_0 "[end]" in
          !g#add_arc ((headeri, endi),Direct);
      | Ast_c.DefineInit i ->
          let ei   = !g +> add_node (DefineInit i) lbl_0 "definit" in
          let endi = !g +> add_node EndNode        lbl_0 "[end]" in
          !g#add_arc ((headeri, ei) ,Direct);
          !g#add_arc ((ei, endi) ,Direct);
      | Ast_c.DefineMulti sts -> (* christia: todo *)
          raise (Error(Define(pinfo_of_ii ii)))
      | Ast_c.DefineTodo ->
          raise (Error(Define(pinfo_of_ii ii)))

(* old:
      | Ast_c.DefineText (s, ii) ->
          let endi = !g +> add_node EndNode lbl_0 "[end]" in
          !g#add_arc ((headeri, endi),Direct);
      | Ast_c.DefineInit _ ->
          let endi = !g +> add_node EndNode lbl_0 "[end]" in
          !g#add_arc ((headeri, endi),Direct);
      | Ast_c.DefineTodo ->
          let endi = !g +> add_node EndNode lbl_0 "[end]" in
          !g#add_arc ((headeri, endi),Direct);
*)
      );

      Some !g

  | Ast_c.CppTop (Ast_c.Pragma ((id,rest),ii))  ->
      let elem = PragmaHeader ((id,rest),ii) in
      let str = "#pragma" in
      let ei =   !g +> add_node elem    lbl_0 str in
      let endi = !g +> add_node EndNode lbl_0 "[end]" in

      !g#add_arc ((topi, ei),Direct);
      !g#add_arc ((ei, endi),Direct);
      Some !g

  | _ -> None


(*****************************************************************************)
(* CFG loop annotation *)
(*****************************************************************************)

let annotate_loop_nodes g =
  let firsti = Control_flow_c.first_node g in

  (* just for opti a little *)
  let already = Hashtbl.create 101 in

  g +> Control_flow_c.G.dfs_iter_with_path firsti (fun xi path ->
    Hashtbl.add already xi true;
    let aux (yi, _) =
      if Hashtbl.mem already yi && List.mem yi (xi::path)
      then
        let node = KeyMap.find yi g#nodes in
        let ((node2, nodeinfo), nodestr) = node in
        let node' = ((node2, {nodeinfo with is_loop = true}), (nodestr ^ "*"))
        in g#replace_node (yi, node') in
    KeyEdgeSet.iter aux (g#successors xi);
  );
  g


(*****************************************************************************)
(* CFG checks *)
(*****************************************************************************)

(* the second phase, deadcode detection. Old code was raising DeadCode if
 * lasti = None, but maybe not. In fact if have 2 return in the then
 * and else of an if ?
 *
 * alt: but can assert that at least there exist
 * a node to exiti, just check #pred of exiti.
 *
 * Why so many deadcode in Linux ? Ptet que le label est utilisé
 * mais dans le corps d'une macro et donc on le voit pas :(
 *
 *)
let deadcode_detection (g : Control_flow_c.cflow) =

  KeyMap.iter  (fun k node ->
    if KeyEdgeSet.is_empty (g#predecessors k) then
      (match unwrap node with
      | TopNode -> ()
      | FunHeader _ -> ()
      | ErrorExit -> ()
      | Exit -> ()     (* if have 'loop: if(x) return; i++; goto loop' *)
      | SeqEnd _ -> () (* todo?: certaines '}' deviennent orphelins *)
      | x ->
          (match Control_flow_c.extract_fullstatement node with
          | Some st ->
              let ii = Ast_c.get_ii_st_take_care st in
              raise (Error (DeadCode (Some (pinfo_of_ii ii))))
          | _ -> pr2 "CFG: orphan nodes, maybe something weird happened"
          )
      )
  ) g#nodes

(*------------------------------------------------------------------------*)
(* special_cfg_braces: the check are really specific to the way we
 * have build our control_flow, with the { } in the graph so normally
 * all those checks here are useless.
 *
 * ver1: to better error reporting, to report earlier the message, pass
 * the list of '{' (containing morover a brace_identifier) instead of
 * just the depth.
 *)

let check_control_flow (g : cflow) : unit =
  let starti = first_node g in
  let visited = ref KeyMap.empty in

  let print_trace_error xs =  pr2 "PB with flow:";  Common.pr2_gen xs; in

  let rec dfs (nodei, (* Depth depth,*) startbraces,  trace)  =
    let trace2 = nodei::trace in
    if KeyMap.mem nodei !visited
    then
      (* if loop back, just check that go back to a state where have same depth
         number *)
      let (*(Depth depth2)*) startbraces2 = KeyMap.find nodei !visited in
      if  (*(depth = depth2)*) startbraces <> startbraces2
      then
        begin
	  let msg =
	    Printf.sprintf
	      "PB with flow: the node %d has not same braces count"
              nodei in
          pr2 msg;
          print_trace_error trace2
        end
    else
      let children = g#successors nodei in
      visited := KeyMap.add nodei startbraces !visited;
      let newdepth =
        (match unwrap (KeyMap.find nodei g#nodes),  startbraces with
        | SeqStart (_,i,_), xs  -> i::xs
        | SeqEnd (i,_), j::xs ->
            if i = j
            then xs
            else
              begin
                pr2 (Printf.sprintf ("PB with flow: not corresponding match between }%d and excpeted }%d at node %d") i j nodei);
                print_trace_error trace2;
                xs
              end
        | SeqEnd (i,_), [] ->
            pr2 (Printf.sprintf "PB with flow: too much } at }%d " i);
            print_trace_error trace2;
            []
        | _, xs ->  xs
        )
      in


      if KeyEdgeSet.is_empty children
      then
        if (* (depth = 0) *) startbraces <> []
        then print_trace_error trace2
      else
        let aux (key,_) = dfs (key, newdepth, trace2) in
        KeyEdgeSet.iter aux children
    in

  dfs (starti, (* Depth 0*) [], [])

(*****************************************************************************)
(* Error report *)
(*****************************************************************************)

let report_error error =
  if !Flag_parsing_c.verbose_cfg
  then
    let error_from_info info =
      Common.error_message_short info.file ("", info.charpos) in
    match error with
    | DeadCode          infoopt ->
	(match infoopt with
	| None -> pr2 "FLOW: deadcode detected, but can't trace back the place"
	| Some info ->
	    pr2 ("FLOW: deadcode detected: " ^ error_from_info info))
    | CaseNoSwitch      info ->
	pr2
	  ("FLOW: case without corresponding switch: " ^ error_from_info info)
    | OnlyBreakInSwitch info ->
	pr2 ("FLOW: only break are allowed in switch: " ^ error_from_info info)
    | WeirdSwitch info ->
	pr2 ("FLOW: weird switch: " ^ error_from_info info)
    | NoEnclosingLoop   (info) ->
	pr2 ("FLOW: can't find enclosing loop: " ^ error_from_info info)
    | GotoCantFindLabel (s, info) ->
	pr2 ("FLOW: can't jump to " ^ s ^ ": because we can't find this label")
    | NoExit info ->
	pr2 ("FLOW: can't find exit or error exit: " ^ error_from_info info)
    | DuplicatedLabel s ->
	pr2 ("FLOW: duplicate label " ^ s)
    | NestedFunc  ->
	pr2 ("FLOW: not handling yet nested function")
    | ComputedGoto ->
	pr2 ("FLOW: not handling computed goto yet")
    | Define info ->
	pr2 ("Unsupported form of #define: " ^ error_from_info info)