CHB: add error handling

Author: sipma

CodeHawk/CH/chutil/cHLogger.ml

@@ -6,7 +6,7 @@
  
    Copyright (c) 2005-2019 Kestrel Technology LLC
    Copyright (c) 2020      Henny B. 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
@@ -239,3 +239,16 @@ let log_error_result
   ch_error_log#add
     (tag ^ filename ^ ":" ^ (string_of_int linenumber))
     (LBLOCK [STR msg; STR (String.concat "; " error)])
+
+
+let log_result
+      ?(msg="")
+      ?(tag="")
+      (filename: string)
+      (linenumber: int)
+      (error: string list) =
+  let tag = if tag = "" then tag else tag ^ ":" in
+  let msg = if msg = "" then msg else msg ^ ":" in
+  chlog#add
+    (tag ^ filename ^ ":" ^ (string_of_int linenumber))
+    (LBLOCK [STR msg; STR (String.concat "; " error)])

CodeHawk/CH/chutil/cHLogger.mli

@@ -6,7 +6,7 @@
 
    Copyright (c) 2005-2019 Kestrel Technology LLC
    Copyright (c) 2020-2021 Henny B. Sipma
-   Copyright (c) 2022-2024 Aarno Labs LLC
+   Copyright (c) 2022-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
@@ -120,3 +120,11 @@ val log_tfold_default:
     making up [error].*)
 val log_error_result:
   ?msg:string -> ?tag:string -> string -> int -> string list -> unit
+
+
+(** [log_result msg tag filename linenumber error] writes an entry to
+    [chlog] with a tag that combines [tag], [filename], and [linenumber].
+    The entry is the concatenation of [msg] and the list of error messages
+    making up [error].*)
+val log_result:
+  ?msg:string -> ?tag:string -> string -> int -> string list -> unit

CodeHawk/CHB/bchlib/bCHFloc.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
@@ -1261,13 +1261,17 @@ object (self)
              Ok (IndexOffset (v, n#toInt, NoOffset))
           | _ ->
              Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
-                    ^ "Offset not recognized: " ^ (x2s offset)]) in
+                    ^ "Offset from base "
+                    ^ (x2s (XVar base))
+                    ^ " not recognized: " ^ (x2s offset)]) in
        (memref_r, memoff_r)
 
     (* no known pointers, have to find a base *)
     | [] ->
        let maxC = largest_constant_term x in
-       if maxC#gt system_info#get_image_base#to_numerical then
+       let maxCdw = TR.tvalue (numerical_to_doubleword maxC) ~default:wordzero in
+       (* if maxC#gt system_info#get_image_base#to_numerical then *)
+       if system_info#is_code_address maxCdw then
          (* global base *)
          let memref_r = Ok self#env#mk_global_memory_reference in
          let offset = simplify_xpr (XOp (XMinus, [x; num_constant_expr maxC])) in
@@ -1282,7 +1286,10 @@ object (self)
               Ok (IndexOffset (v, n#toInt, NoOffset))
            | _ ->
               Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
-                     ^ "Offset not recognized: " ^ (x2s offset)] in
+                     ^ (p2s self#l#toPretty) ^ ": "
+                     ^ "Offset from global base "
+                     ^ maxC#toString
+                     ^ " not recognized: " ^ (x2s offset)] in
          let memoff_r =
            tmap
              (fun gmemoff -> ConstantOffset (maxC, gmemoff))
@@ -1304,7 +1311,10 @@ object (self)
                   Ok (IndexOffset (v, n#toInt, NoOffset))
               | _ ->
                  Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
-                        ^ "Offset not recognized: " ^ (x2s offset)] in
+                        ^ (p2s self#l#toPretty) ^ ": "
+                        ^ "Offset from base "
+                        ^ (x2s (XVar base))
+                        ^ " not recognized: " ^ (x2s offset)] in
              (memref_r, memoff_r)
 
           | [base] when (self#env#is_stack_parameter_variable base)
@@ -1330,13 +1340,17 @@ object (self)
                       Ok (IndexOffset (v, n#toInt, NoOffset))
                    | _ ->
                       Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
-                             ^ "Offset not recognized: " ^ (x2s offset)])
+                             ^ (p2s self#l#toPretty) ^ ": "
+                             ^ "Offset from base "
+                             ^ (x2s (XVar base))
+                             ^ " not recognized: " ^ (x2s offset)])
                  base_r in
              (memref_r, memoff_r)
 
           | [v] ->
              let memref_r =
                Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
+                      ^ (p2s self#l#toPretty) ^ ": "
                       ^ "No candidate base pointers. Only variable found: "
                       ^ (p2s v#toPretty)] in
              let memoff_r =
@@ -1346,6 +1360,7 @@ object (self)
           | [] ->
              let memref_r =
                Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
+                      ^ (p2s self#l#toPretty) ^ ": "
                       ^ "No candidate pointers. Left with maxC: "
                       ^ maxC#toString] in
              let memoff_r =
@@ -1356,6 +1371,7 @@ object (self)
           | _ ->
              let memref_r =
                Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
+                      ^ (p2s self#l#toPretty) ^ ": "
                       ^ "Multiple variables: "
                       ^ (String.concat "; "
                            (List.map (fun v -> p2s v#toPretty) vars))] in
@@ -1367,6 +1383,7 @@ object (self)
     | _ ->
        let memref_r =
          Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
+                ^ (p2s self#l#toPretty) ^ ": "
                 ^ "Multiple known pointers: "
                 ^ (String.concat "; "
                      (List.map (fun v -> p2s v#toPretty) knownpointers))] in

CodeHawk/CHB/bchlib/bCHFunctionInfo.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
@@ -82,6 +82,7 @@ module TR = CHTraceResult
 
 let x2p = xpr_formatter#pr_expr
 let p2s = CHPrettyUtil.pretty_to_string
+let x2s x = p2s (x2p x)
 
 
 let log_error (tag: string) (msg: string): tracelogspec_t =
@@ -1761,38 +1762,32 @@ object (self)
   method save_register
            (vmem: variable_t) (iaddr:ctxt_iaddress_t) (reg:register_t) =
     if self#env#is_stack_variable vmem then
-      log_tfold
-        (log_error "save_register" "invalid offset")
+      TR.tfold
         ~ok:(fun offset ->
           match offset with
           | ConstantOffset (n, NoOffset) ->
              self#stackframe#add_register_spill ~offset:n#toInt reg iaddr
           | _ ->
-             ch_error_log#add
-               "save_register:no offset"
-               (LBLOCK [
-                    self#get_address#toPretty;
-                    STR " ";
-                    STR iaddr;
-                    STR ": ";
-                    vmem#toPretty;
-                    STR " (";
-                    STR (register_to_string reg);
-                    STR ")"]))
-        ~error:(fun _ -> ())
+             log_error_result
+               ~msg:"save_register:not a constant offset"
+               __FILE__ __LINE__
+               ["(" ^ (p2s self#get_address#toPretty) ^ "," ^ iaddr ^ "): ";
+                (p2s vmem#toPretty) ^ " with " ^ (register_to_string reg)
+                ^ " and offset " ^ (memory_offset_to_string offset)])
+        ~error:(fun e ->
+          log_error_result
+            ~msg:"save_register"
+            __FILE__ __LINE__
+            (["(" ^ (p2s self#get_address#toPretty) ^ "," ^ iaddr ^ "): ";
+              (p2s vmem#toPretty) ^ " with " ^ (register_to_string reg)] @ e))
         (self#env#get_memvar_offset vmem)
     else
-      ch_error_log#add
-        "save_register:not a stack variable"
-        (LBLOCK [
-             self#get_address#toPretty;
-             STR " ";
-             STR iaddr;
-             STR ": ";
-             vmem#toPretty;
-             STR " (";
-             STR (register_to_string reg);
-             STR ")"])
+      log_error_result
+        ~msg:"save register:not a stack variable"
+        __FILE__ __LINE__
+        ["(" ^ (p2s self#get_address#toPretty) ^ "," ^ iaddr ^ "): ";
+         "not a stack variable: "
+         ^ (p2s vmem#toPretty) ^ " with " ^ (register_to_string reg)]
 
   method restore_register
            (memaddr: xpr_t) (iaddr:ctxt_iaddress_t) (reg:register_t) =
@@ -1803,54 +1798,30 @@ object (self)
          | XConst (IntConst n) ->
             self#stackframe#add_register_restore ~offset:n#neg#toInt reg iaddr
          | _ ->
-            ch_error_log#add
-              "restore_register:no offset"
-              (LBLOCK [
-                   self#get_address#toPretty;
-                   STR " ";
-                   STR iaddr;
-                   STR ": ";
-                   x2p memaddr;
-                   STR " (";
-                   STR (register_to_string reg);
-                   STR ")"])
+            log_error_result
+              ~msg:"restore register:not a constant offset"
+              __FILE__ __LINE__
+              ["(" ^ (p2s self#get_address#toPretty) ^ "," ^ iaddr ^ ")";
+               (x2s memaddr)]
        else
-         ch_error_log#add
-           "restore_register:not an initial value"
-           (LBLOCK [
-                self#get_address#toPretty;
-                STR " ";
-                STR iaddr;
-                STR ": ";
-                x2p memaddr;
-                STR " (";
-                STR (register_to_string reg);
-                STR ")"])
+         ()
     | _ ->
-       ch_error_log#add
-         "restore_register:not a stack address"
-         (LBLOCK [
-              self#get_address#toPretty;
-              STR " ";
-              STR iaddr;
-              STR ": ";
-              x2p memaddr;
-              STR " (";
-              STR (register_to_string reg);
-              STR ")"])
+       ()
 
   method saved_registers_to_pretty =
     let p = ref [] in
     let _ =
-      H.iter (fun _ s -> p := (LBLOCK [ s#toPretty ; NL ]) :: !p) saved_registers in
+      H.iter (fun _ s -> p := (LBLOCK [s#toPretty; NL]) :: !p) saved_registers in
     match !p with
       [] ->
-      LBLOCK [ STR (string_repeat "~" 80) ; NL ; STR "No saved registers" ; NL ;
-	       STR (string_repeat "~" 80) ; NL ]
+       LBLOCK [
+           STR (string_repeat "~" 80); NL; STR "No saved registers"; NL;
+	   STR (string_repeat "~" 80); NL]
     | l ->
-       LBLOCK [ STR "Saved Registers" ; NL ; STR (string_repeat "~" 80) ; NL ;
-                LBLOCK l ; NL ;
-		STR (string_repeat "~" 80) ; NL]
+       LBLOCK [
+           STR "Saved Registers"; NL; STR (string_repeat "~" 80); NL;
+           LBLOCK l; NL;
+	   STR (string_repeat "~" 80); NL]
 
   method set_nonreturning =
     if nonreturning then () else
@@ -1877,7 +1848,8 @@ object (self)
         (LBLOCK [
              function_interface_to_pretty fs#get_function_interface;
              STR " with function signature ";
-             STR (btype_to_string fs#get_function_interface.fintf_type_signature.fts_returntype)])
+             STR (btype_to_string
+                    fs#get_function_interface.fintf_type_signature.fts_returntype)])
     end
 
   method read_xml_user_summary (node:xml_element_int) =

CodeHawk/CHB/bchlib/bCHMemoryRecorder.ml

@@ -51,6 +51,7 @@ module TR = CHTraceResult
 
 let x2p = xpr_formatter#pr_expr
 let p2s = CHPrettyUtil.pretty_to_string
+let x2s x = p2s (x2p x)
 
 let mmap = BCHGlobalMemoryMap.global_memory_map
 
@@ -263,9 +264,15 @@ object (self)
                    when mmap#is_global_data_address
                           (numerical_mod_to_doubleword n) ->
                  mmap#add_gload self#faddr iaddr addr size signed
+              | XConst (IntConst n) ->
+                 log_result __FILE__ __LINE__
+                   ["memrecorder:literal load not recorded";
+                    p2s self#loc#toPretty;
+                    p2s (numerical_mod_to_doubleword n)#toPretty]
               | _ ->
-                 log_error_result __FILE__ __LINE__
-                   ["memrecorder:global"; p2s self#loc#toPretty])
+                 log_result __FILE__ __LINE__
+                   ["memrecorder:load not recorded";
+                    p2s self#loc#toPretty; (x2s addr)])
             ~error:(fun e -> log_error_result __FILE__ __LINE__ e)
             addr_r)
       ~error:(fun e -> log_error_result __FILE__ __LINE__ e)
@@ -367,7 +374,8 @@ object (self)
                  mmap#add_gstore self#faddr iaddr addr size optvalue
               | _ ->
                  log_error_result __FILE__ __LINE__
-                   ["memrecorder:global"; p2s self#loc#toPretty])
+                   ["memrecorder: store not recorded";
+                    p2s self#loc#toPretty; (x2s addr)])
             ~error:(fun e -> log_error_result __FILE__ __LINE__ e)
             addr_r)
       ~error:(fun e -> log_error_result __FILE__ __LINE__ e)