+(* Yoann Padioleau
+ *
+ * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
+ * Copyright (C) 2008, 2009 University of Urbana Champaign
+ *
+ * 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
+(*****************************************************************************)
+(* Wrappers *)
+(*****************************************************************************)
+let pr2, pr2_once =
+ Common.mk_pr2_wrappers Flag_parsing_c.verbose_cpp_ast
+let pr2_debug,pr2_debug_once =
+ Common.mk_pr2_wrappers Flag_parsing_c.debug_cpp_ast
+
(*****************************************************************************)
(* Cpp Ast Manipulations *)
(*****************************************************************************)
(*
* cpp-include-expander-builtin.
- *
- * alternative1: parse and call cpp tour a tour ?
+ *
+ * alternative1: parse and call cpp tour a tour. So let cpp work at
+ * the token level. That's what most tools do.
* alternative2: apply cpp at the very end. Process that go through ast
- * and do the stuff such as #include, macro expand,
- * ifdef.
- *
+ * and do the stuff such as #include, macro expand,
+ * ifdef but on the ast!
+ *
* But need keep those info in ast at least, even bad
- * macro for instance, and for parse error region ? maybe can
+ * macro for instance, and for parse error region ? maybe can
* get another chance ?
* I think it's better to do the cpp-include-expander in a different step
- * rather than embedding it in the parser. The parser is already too complex.
+ * rather than embedding it in the parser. The parser is already too complex.
* Also keep with the tradition to try to parse as-is.
- *
+ *
* todo? but maybe could discover new info that could help reparse
* the ParseError in original file. Try again parsing it by
- * putting it in a minifile ?
- *
- *
+ * putting it in a minifile ?
+ *
+ *
* todo? maybe can do some pass that work at the ifdef level and for instance
* try to paren them, so have in Ast some stuff that are not
* present at parsing time but that can then be constructed after
* some processing (a little bit like my type for expression filler,
* or position info filler, or include relative position filler).
- *
+ *
* ??add such info about what was done somewhere ? could build new
* ??ast each time but too tedious (maybe need delta-programming!)
*
- *
- * TODO: macro expand,
+ * todo? maybe change cpp_ast_c to go deeper on local "" ?
+ *
+ *
+ * TODO: macro expand,
* TODO: handle ifdef
- *
- *
- *
+ *
+ *
+ *
* cpp_ifdef_statementize: again better to separate concern and in parser
* just add the directives in a flat way (IfdefStmt) and later do more
* processing and transform them in a tree with some IfdefStmt2.
(* Types *)
(*****************************************************************************)
-type cpp_option =
- | I of Common.filename
+type cpp_option =
+ | I of Common.dirname
| D of string * string option
-let i_of_cpp_options xs =
+let i_of_cpp_options xs =
xs +> Common.map_filter (function
| I f -> Some f
| D _ -> None
)
-let cpp_option_of_cmdline (xs, ys) =
+let cpp_option_of_cmdline (xs, ys) =
(xs +> List.map (fun s -> I s)) ++
- (ys +> List.map (fun s ->
+ (ys +> List.map (fun s ->
if s =~ "\\([A-Z][A-Z0-9_]*\\)=\\(.*\\)"
then
let (def, value) = matched2 s in
D (def, Some value)
- else
+ else
D (s, None)
))
+(*****************************************************************************)
+(* Debug *)
+(*****************************************************************************)
+let (show_cpp_i_opts: string list -> unit) = fun xs ->
+ if not (null xs) then begin
+ pr2 "-I";
+ xs +> List.iter pr2
+ end
+
+
+let (show_cpp_d_opts: string list -> unit) = fun xs ->
+ if not (null xs) then begin
+ pr2 "-D";
+ xs +> List.iter pr2
+ end
+
+(* ---------------------------------------------------------------------- *)
+let trace_cpp_process depth mark inc_file =
+ pr2_debug (spf "%s>%s %s"
+ (Common.repeat "-" depth +> Common.join "")
+ mark
+ (s_of_inc_file_bis inc_file));
+ ()
+
+
+
(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
+
+let _hcandidates = Hashtbl.create 101
+
+let init_adjust_candidate_header_files dir =
+ let ext = "[h]" in
+ let files = Common.files_of_dir_or_files ext [dir] in
+
+ files +> List.iter (fun file ->
+ let base = Filename.basename file in
+ pr2_debug file;
+ Hashtbl.add _hcandidates base file;
+ );
+ ()
+
+
+
(* may return a list of match ? *)
-let find_header_file cppopts dirname inc_file =
+let find_header_file1 cppopts dirname inc_file =
match inc_file with
- | Local f ->
- let finalfile =
+ | Local f ->
+ let finalfile =
Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in
- if Sys.file_exists finalfile
+ if Sys.file_exists finalfile
then [finalfile]
else []
- | NonLocal f ->
- i_of_cpp_options cppopts +> Common.map_filter (fun dirname ->
- let finalfile =
+ | NonLocal f ->
+ i_of_cpp_options cppopts +> Common.map_filter (fun dirname ->
+ let finalfile =
Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in
- if Sys.file_exists finalfile
+ if Sys.file_exists finalfile
then Some finalfile
else None
)
- | Wierd s ->
- pr2 ("CPPAST: wierd include not handled:" ^ s);
+ | Weird s ->
+ pr2 ("CPPAST: weird include not handled:" ^ s);
[]
+(* todo? can try find most precise ? first just use basename but
+ * then maybe look if have also some dir in common ?
+ *)
+let find_header_file2 inc_file =
+ match inc_file with
+ | Local f
+ | NonLocal f ->
+ let s = (Ast_c.s_of_inc_file inc_file) in
+ let base = Filename.basename s in
+
+ let res = Hashtbl.find_all _hcandidates base in
+ (match res with
+ | [file] ->
+ pr2_debug ("CPPAST: find header in other dir: " ^ file);
+ res
+ | [] ->
+ []
+ | x::y::xs -> res
+ )
+ | Weird s ->
+ []
+
+
+let find_header_file cppopts dirname inc_file =
+ let res1 = find_header_file1 cppopts dirname inc_file in
+ match res1 with
+ | [file] -> res1
+ | [] -> find_header_file2 inc_file
+ | x::y::xs -> res1
+
+
+
+
+(* ---------------------------------------------------------------------- *)
+let _headers_hash = Hashtbl.create 101
+
+(* On freebsd ocaml is trashing, use up to 1.6Go of memory and then
+ * building the database_c takes ages.
+ *
+ * So just limit with following threshold to avoid this trashing, simple.
+ *
+ * On netbsd, got a Out_of_memory exn on this file;
+ * /home/pad/software-os-src2/netbsd/dev/microcode/cyclades-z/
+ * even if the cache is small. That's because huge single
+ * ast element and probably the ast marshalling fail.
+ *)
+let default_threshold_cache_nb_files = 200
+
+let parse_c_and_cpp_cache
+ ?(threshold_cache_nb_files= default_threshold_cache_nb_files) file =
+
+ if Hashtbl.length _headers_hash > threshold_cache_nb_files
+ then Hashtbl.clear _headers_hash;
+
+ Common.memoized _headers_hash file (fun () ->
+ Parse_c.parse_c_and_cpp file
+ )
-let trace_cpp_process depth mark inc_file =
- pr2 (spf "%s>%s %s"
- (Common.repeat "-" depth +> Common.join "")
- mark
- (s_of_inc_file_bis inc_file));
- ()
(*****************************************************************************)
(*****************************************************************************)
-let (cpp_expand_include:
+let (cpp_expand_include2:
+ ?depth_limit:int option ->
+ ?threshold_cache_nb_files:int ->
cpp_option list -> Common.dirname -> Ast_c.program -> Ast_c.program) =
- fun iops dirname ast ->
+ fun ?(depth_limit=None) ?threshold_cache_nb_files iops dirname ast ->
+
+ if !Flag_parsing_c.debug_cpp_ast
+ then pr2_xxxxxxxxxxxxxxxxx();
- pr2_xxxxxxxxxxxxxxxxx();
let already_included = ref [] in
- let rec aux stack dirname ast =
+ let rec aux stack dirname ast =
let depth = List.length stack in
ast +> Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with
- Visitor_c.kcppdirective_s = (fun (k, bigf) cpp ->
- match cpp with
+ Visitor_c.kcppdirective_s = (fun (k, bigf) cpp ->
+ match cpp with
| Include {i_include = (inc_file, ii);
i_rel_pos = h_rel_pos;
i_is_in_ifdef = b;
i_content = copt;
- }
- ->
+ }
+ ->
+ (match depth_limit with
+ | Some limit when depth >= limit -> cpp
+ | _ ->
+
(match find_header_file iops dirname inc_file with
- | [file] ->
+ | [file] ->
if List.mem file !already_included
- then begin
+ then begin
(* pr2 ("already included: " ^ file); *)
trace_cpp_process depth "*" inc_file;
k cpp
trace_cpp_process depth "" inc_file;
Common.push2 file already_included;
(* CONFIG *)
- Flag_parsing_c.verbose_parsing := false;
- Flag_parsing_c.verbose_lexing := false;
- let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
+ Flag_parsing_c.verbose_parsing := false;
+ Flag_parsing_c.verbose_lexing := false;
+ let (ast2, _stat) =
+ parse_c_and_cpp_cache ?threshold_cache_nb_files file
+ in
let ast = Parse_c.program_of_program2 ast2 in
- let dirname' = Filename.dirname file in
+ let dirname' = Filename.dirname file in
(* recurse *)
let ast' = aux (file::stack) dirname' ast in
i_content = Some (file, ast');
}
end
- | [] ->
+ | [] ->
trace_cpp_process depth "!!" inc_file;
pr2 "CPPAST: file not found";
k cpp
- | x::y::zs ->
+ | x::y::zs ->
trace_cpp_process depth "!!" inc_file;
pr2 "CPPAST: too much candidates";
k cpp
)
+ )
| _ -> k cpp
);
}
in
aux [] dirname ast
-
-(*
+let cpp_expand_include ?depth_limit ?threshold_cache_nb_files a b c =
+ Common.profile_code "cpp_expand_include"
+ (fun () -> cpp_expand_include2 ?depth_limit ?threshold_cache_nb_files a b c)
+
+(*
let unparse_showing_include_content ?
*)
(*****************************************************************************)
-let is_ifdef_and_same_tag tag x =
+let is_ifdef_and_same_tag tag x =
match x with
- | IfdefStmt (IfdefDirective ((_, tag2),_)) ->
- tag = tag2
+ | IfdefStmt (IfdefDirective ((_, tag2),_)) ->
+ tag =*= tag2
| StmtElem _ | CppDirectiveStmt _ -> false
| IfdefStmt2 _ -> raise Impossible
* indice. Or simply count the number of directives with the same tag and
* put this information in the tag. Hence the total_with_this_tag below.
*)
-let should_ifdefize tag ifdefs_directives xxs =
+let should_ifdefize (tag,ii) ifdefs_directives xxs =
let IfdefTag (_tag, total_with_this_tag) = tag in
-
+
if total_with_this_tag <> List.length ifdefs_directives
then begin
- pr2 "CPPASTC: can not ifdefize, some of its directives were passed";
- false
- end else
+ let strloc = Ast_c.strloc_of_info (List.hd ii) in
+ pr2 (spf "CPPASTC: can not ifdefize ifdef at %s" strloc);
+ pr2 "CPPASTC: some of its directives were passed";
+ false
+ end else
(* todo? put more condition ? dont ifdefize declaration ? *)
true
-(* return a triple, (ifdefs directive * grouped xs * remaining sequencable)
- * XXX1 XXX2 elsif YYY1 else ZZZ1 endif WWW1 WWW2
+(* return a triple, (ifdefs directive * grouped xs * remaining sequencable)
+ * XXX1 XXX2 elsif YYY1 else ZZZ1 endif WWW1 WWW2
* => [elsif, else, endif], [XXX1 XXX2; YYY1; ZZZ1], [WWW1 WWW2]
*)
-let group_ifdef tag xs =
+let group_ifdef tag xs =
let (xxs, xs) = group_by_post (is_ifdef_and_same_tag tag) xs in
-
- xxs +> List.map snd +> List.map (fun x ->
- match x with
+
+ xxs +> List.map snd +> List.map (fun x ->
+ match x with
| IfdefStmt y -> y
| StmtElem _ | CppDirectiveStmt _ | IfdefStmt2 _ -> raise Impossible
),
- xxs +> List.map fst,
+ xxs +> List.map fst,
xs
-let rec cpp_ifdef_statementize ast =
+let rec cpp_ifdef_statementize ast =
Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with
- Visitor_c.kstatementseq_list_s = (fun (k, bigf) xs ->
-
- let rec aux xs =
+ Visitor_c.kstatementseq_list_s = (fun (k, bigf) xs ->
+ let rec aux xs =
match xs with
| [] -> []
- | stseq::xs ->
+ | stseq::xs ->
(match stseq with
- | StmtElem st ->
+ | StmtElem st ->
Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
- | CppDirectiveStmt directive ->
+ | CppDirectiveStmt directive ->
Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
- | IfdefStmt ifdef ->
+ | IfdefStmt ifdef ->
(match ifdef with
- | IfdefDirective ((Ifdef,tag),ii) ->
+ | IfdefDirective ((Ifdef,tag),ii) ->
let (restifdefs, xxs, xs') = group_ifdef tag xs in
- if should_ifdefize tag (ifdef::restifdefs) xxs
+ if should_ifdefize (tag,ii) (ifdef::restifdefs) xxs
then
let res = IfdefStmt2 (ifdef::restifdefs, xxs) in
Visitor_c.vk_statement_sequencable_s bigf res::aux xs'
- else
+ else
Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
-
- | IfdefDirective (((IfdefElseif|IfdefElse|IfdefEndif),b),ii) ->
- pr2 "wierd: first directive is not a ifdef";
- (* maybe not wierd, just that should_ifdefize
+
+ | IfdefDirective (((IfdefElseif|IfdefElse|IfdefEndif),b),ii) ->
+ pr2 "weird: first directive is not a ifdef";
+ (* maybe not weird, just that should_ifdefize
* returned false *)
Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
)
- | IfdefStmt2 (ifdef, xxs) ->
+ | IfdefStmt2 (ifdef, xxs) ->
failwith "already applied cpp_ifdef_statementize"
)
in
aux xs
);
} ast
+
+
+(*****************************************************************************)
+(* Macro *)
+(*****************************************************************************)
+
+let (cpp_expand_macro_expr:
+ Ast_c.define_kind -> Ast_c.argument Ast_c.wrap2 list ->
+ Ast_c.expression option) =
+ fun defkind args ->
+ raise Todo
HCoop / bpt / coccinelle.git / blobdiff