-(*
- * Copyright 2010, INRIA, University of Copenhagen
- * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
- * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
- * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
- * This file is part of Coccinelle.
- *
- * Coccinelle is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, according to version 2 of the License.
- *
- * Coccinelle 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
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
- *
- * The authors reserve the right to distribute this or future versions of
- * Coccinelle under other licenses.
- *)
-
-
open Common
module CCI = Ctlcocci_integration
(* --------------------------------------------------------------------- *)
(* C related *)
(* --------------------------------------------------------------------- *)
-let cprogram_of_file file =
- let (program2, _stat) = Parse_c.parse_c_and_cpp file in
+let cprogram_of_file saved_typedefs saved_macros file =
+ let (program2, _stat) =
+ Parse_c.parse_c_and_cpp_keep_typedefs
+ (Some saved_typedefs) (Some saved_macros) file in
program2
let cprogram_of_file_cached file =
- let (program2, _stat) = Parse_c.parse_cache file in
+ let ((program2,typedefs,macros), _stat) = Parse_c.parse_cache file in
if !Flag_cocci.ifdef_to_if
then
- program2 +> Parse_c.with_program2 (fun asts ->
- Cpp_ast_c.cpp_ifdef_statementize asts
- )
- else program2
+ let p2 =
+ program2 +> Parse_c.with_program2 (fun asts ->
+ Cpp_ast_c.cpp_ifdef_statementize asts
+ ) in
+ (p2,typedefs,macros)
+ else (program2,typedefs,macros)
let cfile_of_program program2_with_ppmethod outf =
Unparse_c.pp_program program2_with_ppmethod outf
(* for memoization, contains only one entry, the one for the SP *)
let _hparse = Hashtbl.create 101
+let _h_ocaml_init = Hashtbl.create 101
let _hctl = Hashtbl.create 101
(* --------------------------------------------------------------------- *)
(* Cocci related *)
(* --------------------------------------------------------------------- *)
-let sp_of_file2 file iso =
- Common.memoized _hparse (file, iso) (fun () ->
- let (_,xs,_,_,_,_,_) as res = Parse_cocci.process file iso false in
- (match Prepare_ocamlcocci.prepare file xs with
- None -> ()
- | Some ocaml_script_file ->
- (* compile file *)
- Prepare_ocamlcocci.load_file ocaml_script_file;
- if not !Common.save_tmp_files
- then Prepare_ocamlcocci.clean_file ocaml_script_file);
- res)
+(* for a given pair (file,iso), only keep an instance for the most recent
+virtual rules and virtual_env *)
+
+let sp_of_file2 file iso =
+ let redo _ =
+ let new_code =
+ let (_,xs,_,_,_,_,_) as res = Parse_cocci.process file iso false in
+ (* if there is already a compiled ML code, do nothing and use that *)
+ try let _ = Hashtbl.find _h_ocaml_init (file,iso) in res
+ with Not_found ->
+ begin
+ Hashtbl.add _h_ocaml_init (file,iso) ();
+ match Prepare_ocamlcocci.prepare file xs with
+ None -> res
+ | Some ocaml_script_file ->
+ (* compile file *)
+ Prepare_ocamlcocci.load_file ocaml_script_file;
+ (if not !Common.save_tmp_files
+ then Prepare_ocamlcocci.clean_file ocaml_script_file);
+ res
+ end in
+ Hashtbl.add _hparse (file,iso)
+ (!Flag.defined_virtual_rules,!Flag.defined_virtual_env,new_code);
+ new_code in
+ try
+ let (rules,env,code) = Hashtbl.find _hparse (file,iso) in
+ if rules = !Flag.defined_virtual_rules && env = !Flag.defined_virtual_env
+ then code
+ else (Hashtbl.remove _hparse (file,iso); redo())
+ with Not_found -> redo()
+
let sp_of_file file iso =
Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
* For the moment we base in part our heuristic on the name of the file, e.g.
* serio.c is related we think to #include <linux/serio.h>
*)
-let rec search_include_path searchlist relpath =
- match searchlist with
- [] -> Some relpath
- | hd::tail ->
- let file = Filename.concat hd relpath in
- if Sys.file_exists file then
- Some file
- else
- search_include_path tail relpath
+let include_table = Hashtbl.create(100)
let interpret_include_path relpath =
+ let maxdepth = List.length relpath in
+ let unique_file_exists dir f =
+ let cmd =
+ Printf.sprintf "find %s -maxdepth %d -mindepth %d -path \"*/%s\""
+ dir maxdepth maxdepth f in
+ match Common.cmd_to_list cmd with
+ [x] -> Some x
+ | _ -> None in
+ let native_file_exists dir f =
+ let f = Filename.concat dir f in
+ if Sys.file_exists f
+ then Some f
+ else None in
+ let rec search_include_path exists searchlist relpath =
+ match searchlist with
+ [] -> None
+ | hd::tail ->
+ (match exists hd relpath with
+ Some x -> Some x
+ | None -> search_include_path exists tail relpath) in
+ let rec search_path exists searchlist = function
+ [] ->
+ let res = Common.concat "/" relpath in
+ Hashtbl.add include_table (searchlist,relpath) res;
+ Some res
+ | (hd::tail) as relpath1 ->
+ let relpath1 = Common.concat "/" relpath1 in
+ (match search_include_path exists searchlist relpath1 with
+ None -> search_path unique_file_exists searchlist tail
+ | Some f ->
+ Hashtbl.add include_table (searchlist,relpath) f;
+ Some f) in
let searchlist =
match !Flag_cocci.include_path with
- [] -> ["include"]
- | x -> List.rev x
- in
- search_include_path searchlist relpath
+ [] -> ["include"]
+ | x -> List.rev x in
+ try Some(Hashtbl.find include_table (searchlist,relpath))
+ with Not_found ->
+ search_path native_file_exists searchlist relpath
let (includes_to_parse:
- (Common.filename * Parse_c.program2) list ->
+ (Common.filename * Parse_c.extended_program2) list ->
Flag_cocci.include_options -> 'a) = fun xs choose_includes ->
match choose_includes with
Flag_cocci.I_UNSPECIFIED -> failwith "not possible"
let all_includes =
List.mem x
[Flag_cocci.I_ALL_INCLUDES; Flag_cocci.I_REALLY_ALL_INCLUDES] in
+ let xs = List.map (function (file,(cs,_,_)) -> (file,cs)) xs in
xs +> List.map (fun (file, cs) ->
let dir = Common.dirname file in
(match x with
| Ast_c.Local xs ->
let relpath = Common.join "/" xs in
- let f = Filename.concat dir (relpath) in
+ let f = Filename.concat dir relpath in
if (Sys.file_exists f) then
Some f
else
let attempt2 = Filename.concat dir (Common.last xs) in
if not (Sys.file_exists attempt2) && all_includes
then
- interpret_include_path relpath
+ interpret_include_path xs
else Some attempt2
else
- if all_includes then interpret_include_path relpath
+ if all_includes then interpret_include_path xs
else None
| Ast_c.NonLocal xs ->
- let relpath = Common.join "/" xs in
if all_includes ||
Common.fileprefix (Common.last xs) =$= Common.fileprefix file
then
- interpret_include_path relpath
+ interpret_include_path xs
else None
| Ast_c.Weird _ -> None
)
was_modified: bool ref;
+ all_typedefs: (string, Lexer_parser.identkind) Common.scoped_h_env;
+ all_macros: (string, Cpp_token_c.define_def) Hashtbl.t;
+
(* id: int *)
}
(* --------------------------------------------------------------------- *)
-let build_info_program cprogram env =
+let build_info_program (cprogram,typedefs,macros) env =
let (cs, parseinfos) =
Common.unzip cprogram in
env_typing_after = envb;
was_modified = ref false;
+
+ all_typedefs = typedefs;
+ all_macros = macros;
}
)
file;
(* Common.command2 ("cat " ^ file); *)
- let cprogram = cprogram_of_file file in
+ let cprogram = cprogram_of_file c.all_typedefs c.all_macros file in
let xs = build_info_program cprogram c.env_typing_before in
(* TODO: assert env has not changed,
if not (Common.lfile_exists hpath)
then
begin
- pr2 ("TYPE: header " ^ hpath ^ " not found");
+ pr2_once ("TYPE: header " ^ hpath ^ " not found");
[]
end
else
else None
with e -> (pr2 ("Failure in " ^ r.scr_rule_info.rulename); raise e)
+(* returns Left in case of dependency failure, Right otherwise *)
let apply_script_rule r cache newes e rules_that_have_matched
rules_that_have_ever_matched script_application =
Common.profile_code r.language (fun () ->
| _ -> languages)
[] cocci_infos in
+ let runrule r =
+ let rlang = r.language in
+ let rname = r.scr_rule_info.rulename in
+ try
+ let _ = List.assoc (rlang,rname) !Iteration.initialization_stack in
+ ()
+ with Not_found ->
+ begin
+ Iteration.initialization_stack :=
+ ((rlang,rname),!Flag.defined_virtual_rules) ::
+ !Iteration.initialization_stack;
+ initial_final_bigloop Initial
+ (fun (x,_,_,y) -> fun deps ->
+ Ast_cocci.InitialScriptRule(rname,x,deps,y))
+ r
+ end in
+
let initialized_languages =
List.fold_left
(function languages ->
- function
- InitialScriptRuleCocciInfo(r) ->
- (if List.mem r.language languages
- then
- failwith
- ("double initializer found for "^r.language));
- if interpret_dependencies [] [] r.scr_rule_info.dependencies
- then
- begin
- initial_final_bigloop Initial
- (fun (x,_,_,y) -> fun deps ->
- Ast_cocci.InitialScriptRule(r.scr_rule_info.rulename,x,deps,y))
- r;
- r.language::languages
- end
- else languages
- | _ -> languages)
+ function
+ InitialScriptRuleCocciInfo(r) ->
+ let rlang = r.language in
+ (if List.mem rlang languages
+ then failwith ("double initializer found for "^rlang));
+ if interpret_dependencies [] [] r.scr_rule_info.dependencies
+ then begin runrule r; rlang::languages end
+ else languages
+ | _ -> languages)
[] cocci_infos in
let uninitialized_languages =
List.filter
(fun used -> not (List.mem used initialized_languages))
used_languages in
+
List.iter
(fun lgg ->
let rule_info =
used_after = [];
ruleid = (-1);
was_matched = ref false;} in
- initial_final_bigloop Initial
- (fun (x,_,_,y) -> fun deps ->
- Ast_cocci.InitialScriptRule("",x,deps,y))
- (make_init lgg "" rule_info))
+ runrule (make_init lgg "" rule_info))
uninitialized_languages;
(cocci_infos,toks)
(fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res)
let post_engine2 (cocci_infos,_) =
- let _ =
- List.fold_left
- (function languages ->
- function
- FinalScriptRuleCocciInfo(r) ->
- (if List.mem r.language languages
- then failwith ("double finalizer found for "^r.language));
- initial_final_bigloop Final
- (fun (x,_,_,y) -> fun deps ->
- Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename,x,deps,y))
- r;
- r.language::languages
- | _ -> languages)
- [] cocci_infos in
- ()
+ List.iter
+ (function ((language,_),virt_rules) ->
+ Flag.defined_virtual_rules := virt_rules;
+ let _ =
+ List.fold_left
+ (function languages ->
+ function
+ FinalScriptRuleCocciInfo(r) ->
+ (if r.language = language && List.mem r.language languages
+ then failwith ("double finalizer found for "^r.language));
+ initial_final_bigloop Final
+ (fun (x,_,_,y) -> fun deps ->
+ Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename,
+ x,deps,y))
+ r;
+ r.language::languages
+ | _ -> languages)
+ [] cocci_infos in
+ ())
+ !Iteration.initialization_stack
let post_engine a =
Common.profile_code "post_engine" (fun () -> post_engine2 a)
HCoop / bpt / coccinelle.git / blobdiff