CHB: add support for arrays of function pointers

Author: sipma

CodeHawk/CHB/bchlib/bCHBCTypeUtil.ml

@@ -243,6 +243,19 @@ let get_element_type (t: btype_t) =
      raise (BCH_failure (LBLOCK [STR "Not an array type"]))
 
 
+let get_array_length (t: btype_t): int traceresult =
+  match t with
+  | TArray (_, Some len, _) ->
+     (match len with
+      | Const (CInt (i64, _, _)) -> Ok (Int64.to_int i64)
+      | _ ->
+         Error ["Array does not have a constant length: " ^ (exp_to_string len)])
+  | TArray _ ->
+     Error ["Array does not have a length"]
+  | _ ->
+     Error ["get_array_length: not an array: " ^ (btype_to_string t)]
+
+
 (* ======================================================= size and alignment *)
 
 let resolve_type (btype: btype_t) = bcfiles#resolve_type btype
@@ -1177,6 +1190,7 @@ let struct_field_categories (ty: btype_t): string list =
   | Error e -> e
   | Ok ty ->
      match ty with
+     | TArray (TComp (ckey, _), _, _)
      | TPtr (TPtr (TComp (ckey, _), _), _)
        | TPtr (TComp (ckey, _), _) ->
         let compinfo = bcfiles#get_compinfo ckey in
@@ -1187,6 +1201,8 @@ let struct_field_categories (ty: btype_t): string list =
             | TPtr (TFun _, _) -> "address"
             | _ -> "unknown") compinfo.bcfields
 
+     | TArray ((TFun _ | TPtr (TFun _, _)), _, _) -> ["address"]
+
      | rty -> [btype_to_string ty; btype_to_string rty]
 
 

CodeHawk/CHB/bchlib/bCHBCTypeUtil.mli

@@ -170,6 +170,12 @@ val size_of_int_ikind: ikind_t -> int
 
 val size_of_float_fkind: fkind_t -> int
 
+(** [get_array_length ty] returns the length (number of elements) of an array.
+
+    An error value is returned if the array does not have a constant length, or
+    does not have a length at all, of if the type is not an array. *)
+val get_array_length: btype_t -> int traceresult
+
 (** [size_of_btype ty] returns the size (in bytes) of type [ty].
 
     An error value is returned if the size cannot be determined. This may

CodeHawk/CHB/bchlib/bCHCallbackTables.ml

@@ -192,12 +192,21 @@ object (self)
             let compinfo = bcfiles#get_compinfo ckey in
             List.iteri (fun i fld ->
                 H.add table (i * 4) fld.bfname) compinfo.bcfields
+         | TArray (TComp (ckey, _), _, _) ->
+            let compinfo = bcfiles#get_compinfo ckey in
+            List.iteri (fun i fld ->
+                H.add table (i * 4) fld.bfname) compinfo.bcfields
+         | TArray ((TFun _ | TPtr (TFun _, _)), _, _) ->
+            H.add table 0 ("cbp_" ^ cba)
          | _ ->
-            raise
-              (BCH_failure
-                 (LBLOCK [
-                      STR "Unexpected type in creating callback table: ";
-                      btype_to_pretty recty])) in
+            let msg =
+              LBLOCK [
+                  STR "Unexpected type in creating callback table: ";
+                  btype_to_pretty recty] in
+            begin
+              ch_error_log#add "call-back-table problem" msg;
+              raise (BCH_failure msg)
+            end in
        table
 
   val offsettypes =
@@ -214,9 +223,12 @@ object (self)
        let _ =
          match recty with
          | TFun _ -> H.add table 0 ty
-         | TPtr (TFun (rty, args, b, attr), _) ->
+         | TPtr (TFun (rty, args, b, attr), _)
+           | TArray (TFun (rty, args, b, attr), _, _)
+           | TArray (TPtr (TFun (rty, args, b, attr), _), _, _) ->
             H.add table 0 (TFun (rty, args, b, attr))
-         | TPtr (TComp (ckey, _), _) ->
+         | TArray (TComp (ckey, _), _, _)
+           | TPtr (TComp (ckey, _), _) ->
             let compinfo = bcfiles#get_compinfo ckey in
             List.iteri (fun i fld ->
                 let offset = i * 4 in

CodeHawk/CHB/bchlib/bCHVersion.ml

@@ -95,8 +95,8 @@ end
 
 
 let version = new version_info_t 
-  ~version:"0.6.0_20241119"
-  ~date:"2024-11-19"
+  ~version:"0.6.0_20241125"
+  ~date:"2024-11-25"
   ~licensee: None
   ~maxfilesize: None
   ()

CodeHawk/CHB/bchlibelf/bCHELFHeader.ml

@@ -558,12 +558,15 @@ object(self)
     system_info#initialize_jumptables system_info#is_code_address xstrings
 
   method private extract_call_back_table
+                   ?(len=None)
                    (callbacktable: call_back_table_int)
                    (va: doubleword_int)
                    (fieldkinds: string list) =
     let nullrecord = ref false in
+    let count = ref 0 in
+    let bound = match len with Some len -> len | _ -> BCHDoubleword.e15 in
     let currva = ref va in
-    while not !nullrecord do
+    while not !nullrecord  && (!count < bound) do
       let cbvalues = ref [] in
       begin
         List.iteri (fun i s ->
@@ -582,7 +585,8 @@ object(self)
                     | _ -> CBTag "**unknown**")
                 | "value" -> CBValue (mkNumerical pv#to_int)
                 | _ -> CBValue numerical_zero in
-            cbvalues := ((i * 4), cbv) :: !cbvalues) fieldkinds;
+              cbvalues := ((i * 4), cbv) :: !cbvalues) fieldkinds;
+        count := !count + 1;
         (if List.for_all (fun (_, v) ->
                 match v with
                 | CBValue n -> n#equal numerical_zero || n#equal (mkNumerical (-1))
@@ -649,7 +653,12 @@ object(self)
             let fieldkinds = struct_field_categories varinfo.bvtype in
             let callbacktable = callbacktables#new_table addr varinfo.bvtype in
             let va = TR.tget_ok (string_to_doubleword addr) in
-            self#extract_call_back_table callbacktable va fieldkinds
+            if is_array_type varinfo.bvtype then
+              let len = get_array_length varinfo.bvtype in
+              self#extract_call_back_table
+                ~len:(TR.to_option len) callbacktable va fieldkinds
+            else
+              self#extract_call_back_table callbacktable va fieldkinds
           else
             chlog#add
               "call-back-table-variable"