extra/c_info.ml

   1 open Common
   2
   3 open Ast_c
   4
   5
   6 (* used both for storing the entities 'defined' and 'used' in a file, but
   7  * depending on the use, some fields may not be used
   8  *)
   9 type entities = {
  10   macros: string hashset; (* object-like or function-like *)
  11   variables: string hashset;
  12   static_variables: string hashset; (* for defined only *)
  13   functions: string hashset;
  14   static_functions: string hashset; (* for defined only *)
  15   structs: string hashset; (* union defs, enum defs, enum values *)
  16   typedefs: string hashset;
  17   include_c: filename hashset; (* for used only *)
  18 }
  19
  20 (* inverted index *)
  21 type idx_entities = {
  22   idx_macros: (string, (filename hashset)) Hashtbl.t;
  23   idx_variables: (string, (filename hashset)) Hashtbl.t;
  24   idx_functions: (string, (filename hashset)) Hashtbl.t;
  25   idx_structs: (string, (filename hashset)) Hashtbl.t;
  26   idx_typedefs: (string, (filename hashset)) Hashtbl.t;
  27 }
  28
  29 let empty_entities () = {
  30   macros = Hashtbl.create 101;
  31   variables = Hashtbl.create 101;
  32   static_variables = Hashtbl.create 101;
  33   functions = Hashtbl.create 101;
  34   static_functions = Hashtbl.create 101;
  35   structs = Hashtbl.create 101;
  36   typedefs = Hashtbl.create 101;
  37   include_c = Hashtbl.create 101;
  38 }
  39
  40 let empty_idx_entities () = {
  41   idx_macros = Hashtbl.create 101;
  42   idx_variables = Hashtbl.create 101;
  43   idx_functions = Hashtbl.create 101;
  44   idx_structs = Hashtbl.create 101;
  45   idx_typedefs = Hashtbl.create 101;
  46 }
  47
  48
  49 let h_to_l h = Common.hashset_to_list h
  50
  51 let print_entities e =
  52  begin
  53 (*  e.macros +> h_to_l +> List.iter (fun s -> pr("MACRO: " ^ s)); *)
  54   e.variables +> h_to_l +> List.iter (fun s -> pr("VAR: " ^ s));
  55   e.static_variables +> h_to_l +> List.iter (fun s -> pr("STATICVAR: " ^ s));
  56   e.functions +> h_to_l +> List.iter (fun s -> pr("FUNC: " ^ s));
  57   e.static_functions +> h_to_l +> List.iter (fun s -> pr("STATICFUNC: " ^ s));
  58   e.structs +> h_to_l +> List.iter (fun s -> pr("STRUCT: "^s));
  59   e.typedefs +> h_to_l +> List.iter (fun s -> pr("TYPEDEF: "^s));
  60   e.include_c +> h_to_l +> List.iter (fun s -> pr("INCLUDEC: "^s));
  61  end
  62
  63
  64 (* the defined_stuff and used_stuff may not be 100% correct. They don't handle
  65  * I think every dark corner of the C. It's possible to shadow in so many
  66  * ways.
  67  *)
  68
  69 (* look only for toplevel definition *)
  70 let defined_stuff xs =
  71   let e = empty_entities() in
  72   let add h s = Hashtbl.add h  s true in
  73
  74   (* look only for toplevel definition: don't recurse, don't call k *)
  75   let bigf = { Visitor_c.default_visitor_c with
  76     Visitor_c.ktoplevel = (fun (k,bigf) t ->
  77       match t with
  78       | Declaration decl ->
  79           (match decl with
  80           | DeclList (xs, ii) ->
  81               xs +> List.iter (fun ((var, t, sto, _local), iicomma) ->
  82                 Visitor_c.vk_type bigf t;
  83                 match var, sto with
  84                 | None, _ -> ()
  85                 | Some ((s, ini), ii_s_ini),  (StoTypedef,inline) ->
  86                     add e.typedefs s;
  87                 | Some ((s, ini), ii_s_ini),  (Sto Static,inline) ->
  88                     (* need add them to do the adjust_need *)
  89                     add e.static_variables s;
  90
  91                 | Some ((s, ini), ii_s_ini),  (Sto Extern,inline) ->
  92                     ()
  93                 | Some ((s, ini), ii_s_ini),  (_,inline) ->
  94                     add e.variables s;
  95               );
  96           | MacroDecl ((s, args),ii) -> ()
  97           )
  98
  99       | Definition def ->
 100           let ((s, typ, sto, cp), ii) = def in
 101           (match sto with
 102           | Sto Static, inline ->
 103               (* need add them to do the adjust_need *)
 104               add e.static_functions s
 105           | _ ->
 106               add e.functions s
 107           )
 108
 109       | Include includ -> ()
 110       | Define ((s,ii), body) -> add e.macros s
 111       | MacroTop (s, args, ii) -> ()
 112
 113       | EmptyDef _ | NotParsedCorrectly _ | FinalDef _ -> ()
 114     );
 115
 116     Visitor_c.ktype = (fun (k, bigf) t ->
 117       match Ast_c.unwrap_typeC t with
 118       | StructUnion (su, sopt, fields) ->
 119           sopt +> do_option (fun s ->
 120             add e.structs s;
 121           );
 122
 123       | _ -> ()
 124     );
 125
 126   } in
 127   xs +> List.iter (fun (p, info_item) -> Visitor_c.vk_toplevel bigf p);
 128   e
 129
 130
 131
 132
 133
 134
 135
 136
 137 (* look only for use of external stuff. Don't consider local vars,
 138  * typedefs, structures *)
 139 let used_stuff xs =
 140
 141   let e = empty_entities() in
 142   let add h s = Hashtbl.replace h s true in
 143
 144   let initial_env = [
 145     ["NULL";
 146      "do_gettimeofday";
 147      "le32_to_cpu";
 148      "udelay";
 149      "printk";
 150      (* !!! sometimes considered as VAR :( *)
 151      "u8"; "u16"; "u32";
 152      "s32";
 153     ] +> List.map (fun s -> s, true);
 154   ]
 155   in
 156   let regexp_macro =  Str.regexp
 157     "^[A-Z_][A-Z_0-9]*$"
 158   in
 159
 160   let (_env: (string, bool) Common.scoped_env ref) = ref initial_env in
 161
 162
 163   let bigf = { Visitor_c.default_visitor_c with
 164
 165     (* --------- handling scope of variables (and also some use) --------- *)
 166     Visitor_c.kstatement = (fun (k, bigf) st ->
 167       match st with
 168       | Compound statxs, ii -> Common.do_in_new_scope _env (fun () -> k st);
 169       | _ -> k st
 170     );
 171     Visitor_c.kdecl = (fun (k, bigf) d ->
 172       k d; (* to add possible definition in type found in Decl *)
 173       (match d with
 174       | (DeclList (xs, ii)) ->
 175           xs +> List.iter (fun ((var, t, sto, _local), iicomma) ->
 176             var +> do_option (fun ((s, ini), ii_s_ini) ->
 177               match sto with
 178               | StoTypedef, _inline ->
 179                   (* add_binding (TypeDef (s)) true; *)
 180                   ()
 181               | _ ->
 182                   Common.add_in_scope _env (s, true);
 183             );
 184           );
 185       | _ -> ()
 186       );
 187     );
 188     Visitor_c.ktoplevel = (fun (k, bigf) elem ->
 189       match elem with
 190       | Definition def ->
 191           let (funcs, ((returnt, (paramst, b))), sto, statxs),ii = def in
 192           Common.do_in_new_scope _env (fun () ->
 193             paramst +> List.iter (fun (((b, s, t), _),_) ->
 194               match s with
 195               | Some s -> Common.add_in_scope _env (s, true)
 196               | None -> pr2 "no type, certainly because Void type ?"
 197             );
 198             k elem
 199           );
 200       | Define (s, (defkind, defval)) ->
 201           Common.do_in_new_scope _env (fun () ->
 202             (match defkind with
 203             | DefineFunc (params, ii) ->
 204                 params +> List.iter (fun ((s,iis), iicomma) ->
 205                   Common.add_in_scope _env (s, true)
 206                 );
 207             | _ -> ()
 208             );
 209             k elem
 210           );
 211       | Include ((inc_file,ii), posref) ->
 212           (match inc_file with
 213           | Local [x] when x =~ ".*\\.c$" ->
 214               add e.include_c x
 215           | _ -> ()
 216           )
 217       | _ -> k elem
 218     );
 219
 220
 221     (* --------- and now looking for use --------- *)
 222     Visitor_c.kexpr = (fun (k,bigf) x ->
 223       match Ast_c.unwrap_expr x with
 224
 225       | FunCall (((Ident f, typ), ii), args) ->
 226           if not (Common.member_env_key f !_env)
 227           then
 228             if f ==~ regexp_macro
 229             then add e.macros f
 230             else add e.functions f
 231           ;
 232           args +> List.iter (fun (x,ii) ->
 233             Visitor_c.vk_argument bigf x
 234           );
 235       | Ident s ->
 236           if not (Common.member_env_key s !_env)
 237           then
 238             if s ==~ regexp_macro
 239             then add e.macros s
 240             else add e.variables s
 241
 242       | _ -> k x
 243     );
 244
 245     Visitor_c.ktype = (fun (k,bigf) t ->
 246       match Ast_c.unwrap_typeC t with
 247       | StructUnionName (su, s) ->
 248           if not (Common.member_env_key s !_env)
 249           then
 250             add e.structs s;
 251       | TypeName (s,_typ) ->
 252           if not (Common.member_env_key s !_env)
 253           then
 254             add e.typedefs s;
 255       | _ -> k t
 256     );
 257
 258   } in
 259   xs +> List.iter (fun (p, info_item) -> Visitor_c.vk_toplevel bigf p);
 260   e
 261
 262
 263
 264
 265 (* for the moment, just look if it looks like a linux module file *)
 266 let extra_stuff xs =
 267   let is_module = ref false in
 268
 269   (* look only for toplevel definition: don't recurse, don't call k *)
 270   let bigf = { Visitor_c.default_visitor_c with
 271     Visitor_c.ktoplevel = (fun (k,bigf) t ->
 272       match t with
 273       | MacroTop (s, args, ii) ->
 274           if s = "module_init"
 275           then is_module := true;
 276       | Definition def ->
 277           let ((s, typ, sto, cp), ii) = def in
 278           if s = "init_module"
 279           then is_module := true;
 280
 281       | _ -> ()
 282     );
 283   } in
 284   xs +> List.iter (fun (p, info_item) -> Visitor_c.vk_toplevel bigf p);
 285   !is_module
 286
 287
 288
 289 let adjust_used_only_external used defined =
 290  begin
 291   used.variables +> h_to_l +> List.iter (fun s ->
 292     if Hashtbl.mem defined.variables s ||
 293        Hashtbl.mem defined.static_variables s ||
 294        (* sometimes functions are used as variable, when for example
 295         * stored in a pointer variable, so look also for function here.
 296         *)
 297        Hashtbl.mem defined.functions s ||
 298        Hashtbl.mem defined.static_functions s
 299     then Hashtbl.remove used.variables s
 300   );
 301   used.functions +> h_to_l +> List.iter (fun s ->
 302     if Hashtbl.mem defined.functions s ||
 303        Hashtbl.mem defined.static_functions s
 304     then Hashtbl.remove used.functions s
 305   );
 306   used.structs +> h_to_l +> List.iter (fun s ->
 307     if Hashtbl.mem defined.structs s
 308     then Hashtbl.remove used.structs s
 309   );
 310   used.typedefs +> h_to_l +> List.iter (fun s ->
 311     if Hashtbl.mem defined.typedefs s
 312     then Hashtbl.remove used.typedefs s
 313   );
 314  end
 315
 316
 317
 318
 319 type file_info = {
 320   used: entities;
 321   defined: entities;
 322   is_module: bool;
 323 }
 324 type global_definitions = idx_entities
 325
 326 let mk_global_definitions_index xs =
 327   let idx = empty_idx_entities () in
 328   xs +> List.iter (fun (file, {defined = defined}) ->
 329     defined.variables +> h_to_l +> List.iter (fun s ->
 330       Common.hash_hashset_add s file idx.idx_variables;
 331     );
 332     defined.functions +> h_to_l +> List.iter (fun s ->
 333       Common.hash_hashset_add s file idx.idx_functions;
 334     );
 335     defined.structs +> h_to_l +> List.iter (fun s ->
 336       Common.hash_hashset_add s file idx.idx_structs;
 337     );
 338     defined.typedefs +> h_to_l +> List.iter (fun s ->
 339       Common.hash_hashset_add s file idx.idx_typedefs;
 340     );
 341   );
 342   idx
 343
 344 let known_duplicate =
 345   ["init_module"; "cleanup_module";
 346    "main";"usage";
 347   ]
 348
 349 let check_no_duplicate_global_definitions idx =
 350  begin
 351   pr2 "DUPLICATE processing:";
 352   idx.idx_functions +> hash_to_list +> List.iter (fun (f, set) ->
 353     let xs = hash_to_list set in
 354     if List.length xs <> 1 && not (List.mem f known_duplicate)
 355     then
 356       pr2 ("multiple def for : " ^ f ^ " in " ^
 357               (join " " (List.map (fun x -> basename (fst x)) xs)));
 358   );
 359  end
 360
 361 type dependencies_graph =
 362  ((filename * file_info) * string, bool) Ograph_extended.ograph_mutable
 363
 364
 365 let build_graph xs dep graphfile =
 366   let g = ref (new Ograph_extended.ograph_mutable)  in
 367   let h = Hashtbl.create 101 in
 368   let s_to_nodei s = Hashtbl.find h s in
 369
 370   pr2 "BUILDING graph:";
 371
 372   let arrow a b c d =
 373     (sprintf "%-20s -- %s:%25s --> %s" a b c d)
 374   in
 375   with_open_outfile (graphfile ^ ".graph") (fun (pr_no_nl,chan) ->
 376     let pr_arrow a b c d =
 377       pr2 (arrow a b c d);
 378       pr_no_nl (arrow a b c d  ^ "\n");
 379     in
 380
 381   (* build nodes *)
 382   xs +> List.iter (fun (file, cinfo) ->
 383     let s = (if cinfo.is_module then "[M]" else "") ^ Filename.basename file in
 384     let xi = !g#add_node ((file, cinfo), s) in
 385     Hashtbl.add h file xi;
 386   );
 387
 388   xs +> List.iter (fun (file, {used = used}) ->
 389
 390     used.functions +> h_to_l +> List.iter (fun s ->
 391       match Common.optionise (fun () -> Hashtbl.find dep.idx_functions s) with
 392       | None -> ()
 393       | Some hset ->
 394           hset +> h_to_l +> List.iter (fun file_defined ->
 395             !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 396             let (file, file_defined) = basename file, basename file_defined in
 397             pr_arrow file "f" s file_defined;
 398           );
 399     );
 400     (* sometime use functions as variable *)
 401     used.variables +> h_to_l +> List.iter (fun s ->
 402       match Common.optionise (fun () -> Hashtbl.find dep.idx_functions s) with
 403       | None -> ()
 404       | Some hset ->
 405           hset +> h_to_l +> List.iter (fun file_defined ->
 406             !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 407             let (file, file_defined) = basename file, basename file_defined in
 408             pr_arrow file "f" s file_defined;
 409           );
 410     );
 411
 412     used.variables +> h_to_l +> List.iter (fun s ->
 413       match Common.optionise (fun () -> Hashtbl.find dep.idx_variables s) with
 414       | None -> ()
 415       | Some hset ->
 416           hset +> h_to_l +> List.iter (fun file_defined ->
 417             !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 418             let (file, file_defined) = basename file, basename file_defined in
 419             pr_arrow file "v" s file_defined;
 420           );
 421     );
 422
 423     used.include_c +> h_to_l +> List.iter (fun local_file ->
 424       let file_defined = Filename.concat (dirname file) local_file in
 425       try (
 426         !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 427         let (file, file_defined) = basename file, basename file_defined in
 428         pr_arrow file "I" "include" file_defined;
 429       )
 430       with Not_found ->
 431         pr2 ("can't find included C file: " ^ file_defined)
 432     )
 433
 434 (*
 435     used.structs +> h_to_l +> List.iter (fun s ->
 436       match Common.optionise (fun () -> Hashtbl.find dep.idx_structs s) with
 437       | None -> ()
 438       | Some hset ->
 439           hset +> h_to_l +> List.iter (fun file_defined ->
 440             !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 441           );
 442     );
 443
 444     used.typedefs +> h_to_l +> List.iter (fun s ->
 445       match Common.optionise (fun () -> Hashtbl.find dep.idx_typedefs s) with
 446       | None -> ()
 447       | Some hset ->
 448           hset +> h_to_l +> List.iter (fun file_defined ->
 449             !g#add_arc ((s_to_nodei file, s_to_nodei file_defined), true);
 450           );
 451     );
 452 *)
 453   );
 454   );
 455   Ograph_extended.print_ograph_mutable !g graphfile (!Flag.show_misc);
 456   !g
 457
 458
 459
 460
 461
 462 let generate_makefile (g: dependencies_graph) file =
 463   pr2 "GENERATING makefile";
 464   with_open_outfile file (fun (pr_no_nl, chan) ->
 465
 466   let nodei_to_file xi =
 467     let ((file, cinfo ), s) = (g#nodes#assoc xi) in
 468     file
 469   in
 470   let all_nodes = g#nodes#tolist +> List.map fst in
 471   let visited_nodes_h = Hashtbl.create 101 in
 472
 473   let modules = all_nodes +> List.filter (fun xi ->
 474     let ((file, cinfo), s) = g#nodes#assoc xi in
 475     cinfo.is_module
 476   ) in
 477
 478   pr_no_nl "  # ---- modules files ---- \n";
 479   modules +> List.iter (fun xi ->
 480     pr2 (nodei_to_file xi);
 481     pr_no_nl " ";
 482     g +> Ograph_extended.dfs_iter xi (fun yi ->
 483       pr2 ("   " ^ (Filename.basename (nodei_to_file yi)));
 484       pr_no_nl (" " ^ (Filename.basename (nodei_to_file yi)));
 485       Hashtbl.add visited_nodes_h yi true;
 486     );
 487     pr_no_nl "\n";
 488   );
 489   let visited_nodes = Common.hashset_to_list visited_nodes_h in
 490   let rest = all_nodes $-$ visited_nodes in
 491
 492   let startfiles = rest +> List.filter (fun xi ->
 493     (g#predecessors xi)#null
 494   ) in
 495   pr_no_nl "  # ---- not module starting files ---- \n";
 496
 497   startfiles +> List.iter (fun xi ->
 498     pr2 (nodei_to_file xi);
 499     pr_no_nl " ";
 500     g +> Ograph_extended.dfs_iter xi (fun yi ->
 501       pr2 ("   " ^ (Filename.basename (nodei_to_file yi)));
 502       pr_no_nl (" " ^ (Filename.basename (nodei_to_file yi)));
 503       Hashtbl.add visited_nodes_h yi true;
 504     );
 505     pr_no_nl "\n";
 506   );
 507   let visited_nodes = Common.hashset_to_list visited_nodes_h in
 508   let rest = rest $-$ visited_nodes in
 509
 510   if not (null rest) then pr_no_nl "  # ---- files in cycle ---- \n";
 511   rest +> List.iter (fun xi ->
 512     if Hashtbl.mem visited_nodes_h xi then () (* already handled *)
 513     else begin
 514       pr2 (nodei_to_file xi);
 515       pr_no_nl " ";
 516       g +> Ograph_extended.dfs_iter xi (fun yi ->
 517         pr2 ("   " ^ (Filename.basename (nodei_to_file yi)));
 518         pr_no_nl (" " ^ (Filename.basename (nodei_to_file yi)));
 519         Hashtbl.add visited_nodes_h yi true;
 520       );
 521       pr_no_nl "\n";
 522     end
 523   )
 524   )
 525