add diagnostics

Author: sipma

CodeHawk/CHB/bchlib/bCHFloc.ml

@@ -1563,6 +1563,12 @@ object (self)
             ) coffset_r)
         cbasevar_r
     else
+      let _ =
+        log_diagnostics_result
+          ~msg:(p2s self#l#toPretty)
+          ~tag:"convert-variable-offsets:default"
+          __FILE__ __LINE__
+          [(p2s v#toPretty)] in
       Ok v
 
   method convert_value_offsets
@@ -1573,7 +1579,7 @@ object (self)
       let cbasevar_r =
         TR.tbind
           ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__))
-          self#convert_value_offsets
+          (self#convert_value_offsets ~size)
           basevar_r in
       let basetype_r = TR.tbind self#get_variable_type cbasevar_r in
       let tgttype_r =
@@ -1597,6 +1603,12 @@ object (self)
           (fun offset ->
             match offset with
             | NoOffset ->
+               let _ =
+                 log_diagnostics_result
+                   ~msg:(p2s self#l#toPretty)
+                   ~tag:"convert-value-offsets:NoOffset"
+                   __FILE__ __LINE__
+                   ["v: " ^ (p2s v#toPretty)] in
                TR.tbind
                  ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__))
                  (fun tgttype ->
@@ -1618,10 +1630,20 @@ object (self)
             (fun coffset ->
               let memvar_r =
                 self#env#mk_basevar_memory_variable cbasevar coffset in
-              TR.tbind self#env#mk_initial_memory_value memvar_r
+              TR.tbind
+                ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
+                      ^ "cbasevar: " ^ (p2s cbasevar#toPretty)
+                      ^ "; coffset: " ^ (memory_offset_to_string coffset))
+                self#env#mk_initial_memory_value memvar_r
             ) coffset_r)
         cbasevar_r
     else
+      let _ =
+        log_diagnostics_result
+          ~msg:(p2s self#l#toPretty)
+          ~tag:"convert-value-offsets:default"
+          __FILE__ __LINE__
+          ["v: " ^ (p2s v#toPretty)] in
       Ok v
 
   method convert_xpr_offsets ?(size=None) (x: xpr_t): xpr_t traceresult =
@@ -1650,7 +1672,14 @@ object (self)
       | XOp (op, [xx]) -> TR.tmap (fun x -> XOp (op, [x])) (aux xx)
       | XOp (op, [x1; x2]) ->
          TR.tmap2 (fun x1 x2 -> XOp (op, [x1; x2])) (aux x1) (aux x2)
-      | _ -> Ok exp in
+      | _ ->
+         let _ =
+           log_diagnostics_result
+             ~msg:(p2s self#l#toPretty)
+             ~tag:"convert-xpr-offsets:default"
+             __FILE__ __LINE__
+             ["x: " ^ (x2s x) ^ "; exp: " ^ (x2s exp)] in
+         Ok exp in
     aux x
 
   method get_xpr_type (x: xpr_t): btype_t traceresult =

CodeHawk/CHB/bchlib/bCHMemoryReference.ml

@@ -192,6 +192,11 @@ let rec address_memory_offset
   let rbasetype = TR.tvalue (resolve_type basetype) ~default:t_unknown in
   match xoffset with
   | XConst (IntConst n) when is_unknown_type rbasetype ->
+     let _ =
+       log_diagnostics_result
+         ~msg:"address-memory-offset:unknown basetype"
+         __FILE__ __LINE__
+         ["xoffset: " ^ n#toString] in
      Ok (ConstantOffset (n, NoOffset))
   | XConst (IntConst n) ->
      let tgtbtype =
@@ -201,7 +206,14 @@ let rec address_memory_offset
      else if is_array_type rbasetype then
        arrayvar_memory_offset ~tgtsize ~tgtbtype rbasetype xoffset
      else
-       Ok (ConstantOffset (n, NoOffset))
+       let _ =
+         log_diagnostics_result
+           ~msg:"address-memory-offset:scalar basetype"
+           __FILE__ __LINE__
+           ["base type: " ^ (btype_to_string rbasetype)
+            ^ "; xoffset: " ^ n#toString] in
+       (* Ok (ConstantOffset (n, NoOffset)) *)
+       Ok (BasePtrArrayIndexOffset (num_constant_expr n, NoOffset))
   | _ ->
      let tgtbtype =
        if is_unknown_type tgtbtype then None else Some tgtbtype in
@@ -436,6 +448,12 @@ let rec is_field_offset (offset: memory_offset_t): bool =
   | _ -> false
 
 
+let is_base_ptr_array_index_offset (offset: memory_offset_t): bool =
+  match offset with
+  | BasePtrArrayIndexOffset (_, suboffset) -> is_constant_offset suboffset
+  | _ -> false
+
+
 let rec is_index_offset (offset: memory_offset_t): bool =
   match offset with
   | IndexOffset (_, _, NoOffset) -> true

CodeHawk/CHB/bchlib/bCHMemoryReference.mli

@@ -101,6 +101,9 @@ val is_field_offset: memory_offset_t -> bool
 val is_index_offset: memory_offset_t -> bool
 
 
+val is_base_ptr_array_index_offset: memory_offset_t -> bool
+
+
 (** Returns [true] if [memoff] itself or one of its suboffsets is an unknown
     offset. *)
 val is_unknown_offset: memory_offset_t -> bool

CodeHawk/CHB/bchlib/bCHVariable.ml

@@ -1006,7 +1006,10 @@ object (self)
   method has_constant_offset (v: variable_t) =
     (self#is_memory_variable v)
     && (tfold_default
-          (fun off -> is_constant_offset off || is_field_offset off)
+          (fun off ->
+            (is_constant_offset off)
+            || (is_field_offset off)
+            || (is_base_ptr_array_index_offset off))
           false
           (self#get_memvar_offset v))
 

CodeHawk/CHB/bchlib/bCHVersion.ml

@@ -95,8 +95,8 @@ end
 
 
 let version = new version_info_t 
-  ~version:"0.6.0_20250325"
-  ~date:"2025-03-25"
+  ~version:"0.6.0_20250401"
+  ~date:"2025-04-01"
   ~licensee: None
   ~maxfilesize: None
   ()