X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/485bce717a659e363d3bb74bf2ff76f1cd3b0ff7..7f339edd551eefcd6c99f379ce91c27df997cfe3:/parsing_c/flag_parsing_c.ml diff --git a/parsing_c/flag_parsing_c.ml b/parsing_c/flag_parsing_c.ml index 049e3ff..6b17c34 100644 --- a/parsing_c/flag_parsing_c.ml +++ b/parsing_c/flag_parsing_c.ml @@ -1,17 +1,28 @@ (*****************************************************************************) -(* convenient globals to pass to parse_c.init_defs *) +(* convenient globals. *) (*****************************************************************************) -let path = ref +let path = ref (try (Sys.getenv "YACFE_HOME") with Not_found-> "/home/pad/c-yacfe" ) -let std_h = ref (Filename.concat !path "data/standard.h") -let common_h = ref (Filename.concat !path "data/common_macros.h") +(*****************************************************************************) +(* macros *) +(*****************************************************************************) + +let macro_dir = "config/macros/" +let mk_macro_path ~cocci_path file = + Filename.concat cocci_path (macro_dir ^ file) + + +(* to pass to parse_c.init_defs *) +let std_h = ref (mk_macro_path ~cocci_path:!path "standard.h") +let common_h = ref (mk_macro_path ~cocci_path:!path "common_macros.h") -let cmdline_flags_macrofile () = + +let cmdline_flags_macrofile () = [ - "-macro_file", Arg.Set_string std_h, + "--macro-file-builtins", Arg.Set_string std_h, " (default=" ^ !std_h ^ ")"; ] @@ -29,6 +40,23 @@ let cmdline_flags_cpp () = [ " " ] +(*****************************************************************************) +(* types *) +(*****************************************************************************) +let std_envir = ref (Filename.concat !path "config/envos/environment_splint.h") + +let cmdline_flags_envfile () = + [ + "--env-file", Arg.Set_string std_envir, + " (default=" ^ !std_envir ^ ")"; + ] + +(*****************************************************************************) +(* show *) +(*****************************************************************************) + +let show_parsing_error = ref true + (*****************************************************************************) (* verbose *) (*****************************************************************************) @@ -36,6 +64,11 @@ let cmdline_flags_cpp () = [ let verbose_lexing = ref true let verbose_parsing = ref true let verbose_type = ref true +let verbose_cfg = ref true +let verbose_annotater = ref true +let verbose_unparsing = ref true +let verbose_visit = ref true +let verbose_cpp_ast = ref true let filter_msg = ref false let filter_msg_define_error = ref false @@ -45,27 +78,31 @@ let filter_define_error = ref false let filter_passed_level = ref 0 let pretty_print_type_info = ref false +let pretty_print_comment_info = ref false +let pretty_print_typedef_value = ref false (* cocci specific *) let show_flow_labels = ref true -let cmdline_flags_verbose () = +let cmdline_flags_verbose () = [ - "-no_parse_error_msg", Arg.Clear verbose_parsing, " "; - "-no_verbose_parsing", Arg.Clear verbose_parsing , " "; - "-no_verbose_lexing", Arg.Clear verbose_lexing , " "; - "-no_type_error_msg", Arg.Clear verbose_type, " "; - - - "-filter_msg", Arg.Set filter_msg , + "--no-verbose-parsing", Arg.Clear verbose_parsing , " "; + "--no-verbose-lexing", Arg.Clear verbose_lexing , " "; + "--no-verbose-annotater", Arg.Clear verbose_annotater , " "; + + "--no-parse-error-msg", Arg.Clear verbose_parsing, " "; + "--no-type-error-msg", Arg.Clear verbose_type, " "; + + + "--filter-msg", Arg.Set filter_msg , " filter some cpp message when the macro is a \"known\" cpp construct"; - "-filter_msg_define_error",Arg.Set filter_msg_define_error, + "--filter-msg-define-error",Arg.Set filter_msg_define_error, " filter the error msg"; - "-filter_define_error",Arg.Set filter_define_error, + "--filter-define-error",Arg.Set filter_define_error, " filter the error, which will not be added in the stat"; - "-filter_passed_level",Arg.Set_int filter_passed_level," "; + "--filter-passed-level",Arg.Set_int filter_passed_level," "; ] @@ -78,20 +115,33 @@ let debug_etdt = ref false let debug_typedef = ref false let debug_cpp = ref false +let debug_cpp_ast = ref false + let debug_unparsing = ref false let debug_cfg = ref false (* "debug C parsing/unparsing", "" *) -let cmdline_flags_debugging () = +let cmdline_flags_debugging () = [ - "-debug_cpp", Arg.Set debug_cpp, " "; - "-debug_lexer", Arg.Set debug_lexer , " "; - "-debug_etdt", Arg.Set debug_etdt , " "; - "-debug_typedef", Arg.Set debug_typedef, " "; + "--debug-cpp", Arg.Set debug_cpp, " "; + "--debug-lexer", Arg.Set debug_lexer , " "; + "--debug-etdt", Arg.Set debug_etdt , " "; + "--debug-typedef", Arg.Set debug_typedef, " "; + + "--debug-cfg", Arg.Set debug_cfg , " "; + "--debug-unparsing", Arg.Set debug_unparsing, " "; + ] + +(*****************************************************************************) +(* checks *) +(*****************************************************************************) - "-debug_cfg", Arg.Set debug_cfg , " "; - "-debug_unparsing", Arg.Set debug_unparsing, " "; +let check_annotater = ref true +let cmdline_flags_checks () = + [ + "--disable-check-annotater", Arg.Clear check_annotater, " "; + "--enable-check-annotater", Arg.Set check_annotater, " "; ] (*****************************************************************************) @@ -103,7 +153,7 @@ let label_strategy_2 = ref false let cmdline_flags_algos () = [ - "-l1", Arg.Clear label_strategy_2, " "; + "--l1", Arg.Clear label_strategy_2, " "; ] (*****************************************************************************) @@ -111,27 +161,32 @@ let cmdline_flags_algos () = (*****************************************************************************) let cpp_directive_passing = ref false -let ifdef_directive_passing = ref false +let ifdef_directive_passing = ref false -let disable_two_pass = ref false +let disable_multi_pass = ref false let disable_add_typedef = ref false let if0_passing = ref true let add_typedef_root = ref true +(* defined and undefined constants *) +let add c s = c := (Str.split (Str.regexp ",") s) @ !c +let defined = ref ([] : string list) +let undefined = ref ([] : string list) + let cmdline_flags_parsing_algos () = [ - "-directive_passing", Arg.Set cpp_directive_passing, + "--directive-passing", Arg.Set cpp_directive_passing, " pass most cpp directives, especially when inside function"; - "-ifdef_passing", Arg.Set ifdef_directive_passing, + "--ifdef-passing", Arg.Set ifdef_directive_passing, " pass ifdef directives "; - "-noif0_passing", Arg.Clear if0_passing, + "--noif0-passing", Arg.Clear if0_passing, " "; - "-noadd_typedef_root", Arg.Clear add_typedef_root, " "; - "-noadd_typedef", Arg.Set disable_add_typedef, " "; + "--noadd-typedef-root", Arg.Clear add_typedef_root, " "; + "--noadd-typedef", Arg.Set disable_add_typedef, " "; - "-disable_two_pass", Arg.Set disable_two_pass, " "; + "--disable-multi-pass", Arg.Set disable_multi_pass, " "; ] (*****************************************************************************) @@ -143,16 +198,71 @@ let diff_lines = ref (None : string option) (* number of lines of context *) (* for parse_c *) let use_cache = ref false +let cache_prefix = ref (None : string option) +let cache_limit = ref (None : int option) -let cmdline_flags_other () = +let cmdline_flags_other () = [ - "-U", Arg.Int (fun n -> diff_lines := Some (Common.i_to_s n)), + "-U", Arg.Int (fun n -> diff_lines := Some (Common.i_to_s n)), " set number of diff context lines"; - - "-use_cache", Arg.Set use_cache, + + "--use-cache", Arg.Set use_cache, " use .ast_raw pre-parsed cached C file"; ] +(*****************************************************************************) +(* for lexing of integer constants *) +(*****************************************************************************) + +let int_thresholds = + ref (None : + (int (*int_sz*) * int (*long_sz*) * + Big_int.big_int (*uint threshold*) * + Big_int.big_int (*long threshold*) * + Big_int.big_int (*ulong threshold*)) option) + +let set_int_bits n = + match !int_thresholds with + None -> + (*assume long is 2*int; this can be corrected by a subsequent long_bits*) + let uint_threshold = Big_int.power_int_positive_int 2 (n-1) in + let long_threshold = Big_int.power_int_positive_int 2 n in + let ulong_threshold = Big_int.power_int_positive_int 2 ((2*n)-1) in + int_thresholds := + Some (n,2*n,uint_threshold,long_threshold,ulong_threshold) + | Some(int_sz,long_sz,uint_threshold,long_threshold,ulong_threshold) -> + let uint_threshold = Big_int.power_int_positive_int 2 (n-1) in + let long_threshold = Big_int.power_int_positive_int 2 n in + int_thresholds := + Some (n,long_sz,uint_threshold,long_threshold,ulong_threshold) + +let set_long_bits n = + match !int_thresholds with + None -> + (*assume int is 1/2*int; this can be corrected by a subsequent int_bits*) + set_int_bits (n/2) + | Some(int_sz,long_sz,uint_threshold,long_threshold,ulong_threshold) -> + let ulong_threshold = Big_int.power_int_positive_int 2 (n-1) in + int_thresholds := + Some (int_sz,n,uint_threshold,long_threshold,ulong_threshold) (*****************************************************************************) +(* unparsing strategy *) +(*****************************************************************************) + +type spacing = LINUX | SMPL +let spacing = ref LINUX + +let set_linux_spacing _ = spacing := LINUX (*follow the conventions of Linux*) +let set_smpl_spacing _ = spacing := SMPL (*use spacing from the SP*) + +let max_width = 78 + +(*****************************************************************************) + +(* drop back edges made by proper loop constructs - + unsafe but more efficient *) +let no_loops = ref false +let no_gotos = ref false +let keep_comments = ref false (* unparsing *)