CHB: create more expressive memory-variable representation

Author: sipma

CodeHawk/CHB/bchlib/bCHBCTypeUtil.ml

@@ -928,6 +928,10 @@ let get_struct_type_compinfo (ty: btype_t): bcompinfo_t =
           (LBLOCK [STR "Type is not a struct: "; btype_to_pretty ty]))
 
 
+let get_compinfo_by_key (ckey: int): bcompinfo_t =
+  bcfiles#get_compinfo ckey
+
+
 let get_compinfo_field (c: bcompinfo_t) (fname: string): bfieldinfo_t =
   try
     List.find (fun finfo -> finfo.bfname = fname) c.bcfields

CodeHawk/CHB/bchlib/bCHBCTypeUtil.mli

@@ -234,6 +234,8 @@ val get_compinfo_field: bcompinfo_t -> string -> bfieldinfo_t
 
 val get_compinfo_scalar_type_at_offset: bcompinfo_t -> int -> btype_t option
 
+val get_compinfo_by_key: int -> bcompinfo_t
+
 
 (** {2 Fieldinfos}*)
 

CodeHawk/CHB/bchlib/bCHFloc.ml

@@ -686,8 +686,8 @@ object (self)
       match address with
       | XConst (IntConst n) ->
          log_tfold_default
-           (mk_tracelog_spec
-              ~tag:"get_memory_variable_1"
+           (log_error
+              "get_memory_variable_1"
               (self#cia ^ ": constant: " ^ n#toString))
            (fun base ->
              if system_info#get_image_base#le base then
@@ -697,9 +697,24 @@ object (self)
            (default ())
            (numerical_to_doubleword n)
       | XVar v when self#f#env#is_memory_address_variable v ->
-         self#f#env#mk_memory_address_deref_variable v
+         log_tfold_default
+           (log_error
+              "get_memory_variable_1"
+              (self#cia ^ ": memory address variable: " ^ (p2s var#toPretty)))
+           (fun v -> v)
+           (default ())
+           (self#env#mk_memory_address_deref_variable v)
+      | XOp (XPlus, [XVar v; XConst (IntConst n)])
+           when self#f#env#is_memory_address_variable v ->
+         log_tfold_default
+           (log_error
+              "get_memory_variable_1"
+              (self#cia ^ ": memory address variable: " ^ (p2s var#toPretty)))
+           (fun v -> v)
+           (default ())
+           (self#env#mk_memory_address_deref_variable ~offset:n#toInt v)
       | _ ->
-         let (memref, memoffset) = self#decompose_address  address in
+         let (memref, memoffset) = self#decompose_address address in
          if is_constant_offset memoffset then
            let memvar =
              if memref#is_global_reference then
@@ -1069,7 +1084,7 @@ object (self)
 
   method get_fts_parameter_expr (_p: fts_parameter_t) = None
 
-  method decompose_array_address
+  method decompose_memvar_address
            (x: xpr_t): (memory_reference_int * memory_offset_t) option =
     let _ = chlog#add "decompose_array_address" (LBLOCK [STR "xpr: "; x2p x]) in
     let vars = vars_as_positive_terms x in
@@ -1078,15 +1093,15 @@ object (self)
       match memaddrs with
       | [base] ->
          let (_, _, _, optty) =
-           self#f#env#varmgr#get_memory_address_meminfo base in
+           TR.tget_ok (self#f#env#varmgr#get_memory_address_meminfo base) in
          let offset = simplify_xpr (XOp (XMinus, [x; XVar base])) in
          Some (XVar base, offset, optty)
       | _ ->
          None in
     match optbase with
     | None -> None
     | Some (_, _, None) -> None
-    | Some (XVar base, xoffset, Some ty) ->
+    | Some (XVar base, xoffset, Some ty) when is_array_type ty ->
        let _ =
          chlog#add
            "decompose_array_address" (LBLOCK [STR "xoffset: "; x2p xoffset]) in
@@ -1112,6 +1127,25 @@ object (self)
        (match (optmemref, memoffset) with
         | (_, UnknownOffset) -> None
         | (Some memref, memoffset) -> Some (memref, memoffset)
+        | _ ->
+           None)
+    | Some (XVar base, xoffset, Some ty) when is_struct_type ty ->
+       let _ =
+         chlog#add
+           "decompose_struct_address" (LBLOCK [STR "xoffset: "; x2p xoffset]) in
+       let optmemref = TR.to_option (self#env#mk_base_variable_reference base) in
+       let cinfo = get_struct_type_compinfo ty in
+       (match xoffset with
+        | XConst (IntConst n) ->
+           let optfinfo = get_struct_field_at_offset cinfo n#toInt in
+           (match optfinfo with
+            | None -> None
+            | Some (finfo, rem) when rem = 0 ->
+               let memoffset = FieldOffset ((finfo.bfname, cinfo.bckey), NoOffset) in
+               (match optmemref with
+                | Some memref -> Some (memref, memoffset)
+                | _ -> None)
+            | _ -> None)
         | _ -> None)
     | _ -> None
 

CodeHawk/CHB/bchlib/bCHFunctionInfo.ml

@@ -85,6 +85,7 @@ module TR = CHTraceResult
 let bcd = BCHBCDictionary.bcdictionary
 
 let x2p = xpr_formatter#pr_expr
+let p2s = pretty_to_string
 
 
 let log_error (tag: string) (msg: string): tracelogspec_t =
@@ -687,6 +688,10 @@ object (self)
     else
       Error ["env#get_variable: index not found: " ^ (string_of_int index)]
 
+  method get_variable_type (var: variable_t): btype_t option =
+    varmgr#get_variable_type var
+
+
   (* -------------------------------------------------------- transactions -- *)
 
   val mutable in_transaction = false
@@ -788,26 +793,25 @@ object (self)
   method mk_memory_address_deref_variable
            ?(size=4)
            ?(offset=0)
-           (var: variable_t): variable_t =
-    if offset = 0 then
-      if self#is_memory_address_variable var then
-        let (memrefix, memoffset, optname, _optty) =
-          varmgr#get_memory_address_meminfo var in
-        let memref = TR.tget_ok (varmgr#memrefmgr#get_memory_reference memrefix) in
-        let v = self#mk_index_offset_memory_variable ~size memref memoffset in
-        let _ =
-          match optname with
-          | Some name -> self#set_variable_name v name
-          | _ -> () in
-        v
-      else
-        raise
-          (BCH_failure
-             (LBLOCK [STR "Not a memory address variable"; var#toPretty]))
+           (var: variable_t): variable_t traceresult =
+    if self#is_memory_address_variable var then
+      let memref_r = varmgr#make_memref_from_basevar var in
+      let optty = tfold_default (fun memref -> memref#get_type) None memref_r in
+      match optty with
+      | None ->
+         Error ["Unknown type for memory address variable: " ^ (p2s var#toPretty)]
+      | Some ty when is_struct_type ty ->
+         let memoffset = mk_maximal_memory_offset (mkNumerical offset) ty in
+         tmap
+           (fun memref ->
+             self#mk_index_offset_memory_variable ~size memref memoffset)
+           memref_r
+      | Some ty ->
+         Error [
+             "mk_memory_address_deref_variable: type is not a struct type: "
+             ^ (p2s var#toPretty) ^ " (" ^ (btype_to_string ty) ^ ")"]
     else
-      raise
-        (BCH_failure
-           (LBLOCK [STR "Nonstandard size or offset not yet supported"]))
+      Error ["Not a memory address variable: " ^ (p2s var#toPretty)]
 
   method mk_index_offset_global_memory_variable
            ?(elementsize=4)