Skip to content

Cmdlineoptions #209

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Aug 13, 2025
Merged

Cmdlineoptions #209

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
22e070e
CHB: force functiondata add with function annotation
sipma Aug 13, 2025
861206d
CMD: add cmdline option to fail on function analysis failure
sipma Aug 13, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 23 additions & 6 deletions CodeHawk/CHB/bchanalyze/bCHAnalyzeApp.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@

Copyright (c) 2005-2020 Kestrel Technology LLC
Copyright (c) 2020 Henny Sipma
Copyright (c) 2021-2024 Aarno Labs LLC
Copyright (c) 2021-2025 Aarno Labs LLC

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
Expand Down Expand Up @@ -184,7 +184,12 @@ let analyze starttime =
faddr#toPretty;
STR ": ";
p]);
failedfunctions := faddr :: !failedfunctions
if system_settings#fail_on_function_failure then
raise
(BCH_failure
(LBLOCK [STR "Function failure of "; faddr#toPretty; STR ": "; p]))
else
failedfunctions := faddr :: !failedfunctions
end in

begin
Expand Down Expand Up @@ -414,7 +419,12 @@ let analyze_mips starttime =
faddr#toPretty;
STR ": ";
p]);
failedfunctions := faddr :: !failedfunctions
if system_settings#fail_on_function_failure then
raise
(BCH_failure
(LBLOCK [STR "Function failure of "; faddr#toPretty; STR "; "; p]))
else
failedfunctions := faddr :: !failedfunctions
end in
begin
(if (List.length fns_included) > 0 then
Expand Down Expand Up @@ -566,7 +576,12 @@ let analyze_arm starttime =
faddr#toPretty;
STR ": ";
p]);
failedfunctions := faddr :: !failedfunctions
if system_settings#fail_on_function_failure then
raise
(BCH_failure
(LBLOCK [STR "Function failure of "; faddr#toPretty; STR ": "; p]))
else
failedfunctions := faddr :: !failedfunctions
end in
begin
(if (List.length fns_included) > 0 then
Expand Down Expand Up @@ -606,9 +621,11 @@ let analyze_arm starttime =
pr_interval_timing [STR "functions analyzed: "; INT !count] 60.0
with
| Failure s -> functionfailure "Failure" faddr (STR s)
| Invalid_argument s -> functionfailure "Invalid argument" faddr (STR s)
| Invalid_argument s ->
functionfailure "Invalid argument" faddr (STR s)
| Internal_error s -> functionfailure "Internal error" faddr (STR s)
| Invocation_error s -> functionfailure "Invocation error" faddr (STR s)
| Invocation_error s ->
functionfailure "Invocation error" faddr (STR s)
| CHFailure p -> functionfailure "CHFailure" faddr p
| BCH_failure p -> functionfailure "BCHFailure" faddr p));
file_metrics#record_runtime ((Unix.gettimeofday ()) -. starttime)
Expand Down
10 changes: 7 additions & 3 deletions CodeHawk/CHB/bchcmdline/bCHXBinaryAnalyzer.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -119,11 +119,14 @@ let show_chif = ref None
let set_chif s = show_chif := Some s

let speclist =
[ ("-version", Arg.Unit (fun () -> ()), "show version information and exit") ;
[ ("-version", Arg.Unit (fun () -> ()), "show version information and exit");
("-gc", Arg.Unit (fun () -> cmd := "gc"),
"show ocaml garbage collector settings and exit") ;
"show ocaml garbage collector settings and exit");
("-fail_on_function_failure",
Arg.Unit (fun () -> system_settings#set_fail_on_function_failure),
"fail immediately if analysis of one of the functions fails");
("-set_vftables",Arg.Unit (fun () -> system_settings#set_vftables),
"declare jumptable targets as funcion entry points") ;
"declare jumptable targets as funcion entry points");
("-extracthex", Arg.Unit (fun () -> cmd := "extracthex"),
"extract executable content from lisphex encoded executable");
("-ssa", Arg.Unit (fun () -> system_settings#set_ssa),
Expand Down Expand Up @@ -878,6 +881,7 @@ let main () =
(* function annotations in userdata should be loaded after the header
files are parsed, so types in the function annotations can be resolved.*)
let _ = system_info#initialize_function_annotations in
let _ = pr_timing [STR "function annotations initialized"] in

let index = file_metrics#get_index in
let logcmd = "analyze_" ^ (string_of_int index) in
Expand Down
160 changes: 79 additions & 81 deletions CodeHawk/CHB/bchlib/bCHFunctionData.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -738,87 +738,85 @@ let read_xml_function_annotation (node: xml_element_int) =
let faddr = get "faddr" in
TR.titer
~ok:(fun dw ->
if functions_data#has_function dw then
let fndata = functions_data#get_function dw in
let stackvintros =
if hasc "stackvar-intros" then
let svintros = getc "stackvar-intros" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun svi -> svi :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_stackvar_intro n))
[]
(svintros#getTaggedChildren "vintro")
else
[] in
let regvintros =
if hasc "regvar-intros" then
let rvintros = getc "regvar-intros" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun rvi -> rvi :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_regvar_intro n))
[]
(rvintros#getTaggedChildren "vintro")
else
[] in
let typingrules =
if hasc "typing-rules" then
let trules = getc "typing-rules" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun tr -> tr :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_typing_rule n))
[]
(trules#getTaggedChildren "typingrule")
else
[] in
let rdefspecs =
if hasc "remove-rdefs" then
let rrds = getc "remove-rdefs" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun rds -> rds :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_reachingdef_spec n))
[]
(rrds#getTaggedChildren "remove-var-rdefs")
else
[] in
fndata#set_function_annotation
{regvarintros = regvintros;
stackvarintros = stackvintros;
typingrules = typingrules;
reachingdefspecs = rdefspecs
}
else
log_error_result
~tag:"function annotation faddr not found"
__FILE__ __LINE__
["Function annotation address: " ^ faddr ^ " not known"])
let fndata =
if functions_data#has_function dw then
functions_data#get_function dw
else
functions_data#add_function dw in
let stackvintros =
if hasc "stackvar-intros" then
let svintros = getc "stackvar-intros" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun svi -> svi :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_stackvar_intro n))
[]
(svintros#getTaggedChildren "vintro")
else
[] in
let regvintros =
if hasc "regvar-intros" then
let rvintros = getc "regvar-intros" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun rvi -> rvi :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_regvar_intro n))
[]
(rvintros#getTaggedChildren "vintro")
else
[] in
let typingrules =
if hasc "typing-rules" then
let trules = getc "typing-rules" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun tr -> tr :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_typing_rule n))
[]
(trules#getTaggedChildren "typingrule")
else
[] in
let rdefspecs =
if hasc "remove-rdefs" then
let rrds = getc "remove-rdefs" in
List.fold_left
(fun acc n ->
TR.tfold
~ok:(fun rds -> rds :: acc)
~error:(fun e ->
begin
log_error_result __FILE__ __LINE__ e;
acc
end)
(read_xml_reachingdef_spec n))
[]
(rrds#getTaggedChildren "remove-var-rdefs")
else
[] in
fndata#set_function_annotation
{regvarintros = regvintros;
stackvarintros = stackvintros;
typingrules = typingrules;
reachingdefspecs = rdefspecs
})
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
(string_to_doubleword faddr)

Expand Down
30 changes: 28 additions & 2 deletions CodeHawk/CHB/bchlib/bCHFunctionStackframe.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -471,7 +471,20 @@ object (self)
if (H.find stackslots offset)#is_spill then
()
else
raise (BCH_failure (LBLOCK [STR "Stackslot already taken"]))
let sslot = H.find stackslots offset in
raise
(BCH_failure
(LBLOCK [
STR "Add register spill at address ";
STR iaddr;
STR " for register ";
STR (register_to_string reg);
STR " at offset ";
INT offset;
STR " cannot be completed, because another stackslot ";
STR "at this offset, with name: ";
STR sslot#name;
STR " already exists"]))
else
let ssrec = {
sslot_name = (register_to_string reg) ^ "_spill";
Expand All @@ -494,7 +507,20 @@ object (self)
if (H.find stackslots offset)#is_spill then
()
else
raise (BCH_failure (LBLOCK [STR "Stackslot already taken"]))
let sslot = H.find stackslots offset in
raise
(BCH_failure
(LBLOCK [
STR "Add register restore at address ";
STR iaddr;
STR " for register ";
STR (register_to_string reg);
STR " at offset ";
INT offset;
STR " cannot be completed, because another stackslot ";
STR "at this offset, with name: ";
STR sslot#name;
STR " already exists"]))
else
let ssrec = {
sslot_name = (register_to_string reg) ^ "_spill";
Expand Down
2 changes: 2 additions & 0 deletions CodeHawk/CHB/bchlib/bCHLibTypes.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1417,6 +1417,7 @@ object
method enable_sideeffects_on_globals : string list -> unit
method disable_sideeffects_on_globals: string list -> unit
method set_no_varinvs: unit
method set_fail_on_function_failure: unit
method set_abstract_stackvars_disabled: unit
method set_apps_dir: string -> unit
method set_app_summary_jars: string -> unit (* application name *)
Expand Down Expand Up @@ -1451,6 +1452,7 @@ object
method has_thumb: bool
method use_ssa: bool
method collect_data: bool
method fail_on_function_failure: bool
method generate_varinvs: bool
method include_arm_extension_registers: bool
method show_function_timing: bool
Expand Down
5 changes: 5 additions & 0 deletions CodeHawk/CHB/bchlib/bCHSystemSettings.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -181,9 +181,14 @@ object (self)
val mutable ssa = false
val mutable collectdata = false
val mutable generate_varinvs = true
val mutable fail_on_function_failure = false

method set_collect_data = collectdata <- true

method set_fail_on_function_failure = fail_on_function_failure <- true

method fail_on_function_failure = fail_on_function_failure

method set_no_varinvs = generate_varinvs <- false

method collect_data = collectdata
Expand Down
4 changes: 2 additions & 2 deletions CodeHawk/CHB/bchlib/bCHVersion.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -95,8 +95,8 @@ end


let version = new version_info_t
~version:"0.6.0_20250811"
~date:"2025-08-11"
~version:"0.6.0_20250812"
~date:"2025-08-12"
~licensee: None
~maxfilesize: None
()