CMD: add cmdline option to fail on function analysis failure

Author: sipma

CodeHawk/CHB/bchanalyze/bCHAnalyzeApp.ml

@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)

CodeHawk/CHB/bchcmdline/bCHXBinaryAnalyzer.ml

@@ -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),
@@ -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

CodeHawk/CHB/bchlib/bCHFunctionStackframe.ml

@@ -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";
@@ -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";

CodeHawk/CHB/bchlib/bCHLibTypes.mli

@@ -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 *)
@@ -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

CodeHawk/CHB/bchlib/bCHSystemSettings.ml

@@ -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

CodeHawk/CHB/bchlib/bCHVersion.ml

@@ -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
   ()