CHB:ARM: update for change in global variables

sipma · sipma · commit 616854d893d3 · 2024-12-27T19:15:34.000-08:00
diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMAnalysisResults.ml b/CodeHawk/CHB/bchlibarm32/bCHARMAnalysisResults.ml
@@ -55,6 +55,7 @@ module H = Hashtbl
 
 let bd = BCHDictionary.bdictionary
 let bcd = BCHBCDictionary.bcdictionary
+let mmap = BCHGlobalMemoryMap.global_memory_map
 
 
 class fn_analysis_results_t (fn:arm_assembly_function_int) =
@@ -194,15 +195,17 @@ object (self)
     let dNode = xmlElement "instr-dictionary" in
     let iiNode = xmlElement "instructions" in
     let sfNode = xmlElement "stackframe" in
+    let grNode = xmlElement "global-references" in
     (* let bNode = xmlElement "btypes" in *)
     begin
       self#write_xml_cfg cNode;
       self#write_xml_jumptables jjNode;
       self#write_xml_instructions iiNode;
       finfo#stackframe#write_xml sfNode;
+      mmap#write_xml_references faddr vard grNode;
       (* self#write_xml_btypes bNode; *)
       id#write_xml dNode;
-      append [cNode; dNode; iiNode; jjNode; sfNode]
+      append [cNode; dNode; iiNode; jjNode; sfNode; grNode]
     end
 
   method write_xml_register_types
diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml b/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml
@@ -63,12 +63,6 @@ module TR = CHTraceResult
 let x2p = xpr_formatter#pr_expr
 let p2s = pretty_to_string
 
-let memmap = BCHGlobalMemoryMap.global_memory_map
-
-
-let log_error (tag: string) (msg: string): tracelogspec_t =
-  mk_tracelog_spec ~tag:("arm_operand:" ^ tag) msg
-
 
 let arm_operand_mode_to_string = function RD -> "RD" | WR -> "WR" | RW -> "RW"
 
@@ -509,20 +503,7 @@ object (self:'a)
                                            STR (String.concat "; " e)]))
                               | Ok v -> v) in
                            (v, [STR "ARMShiftedIndexOffset"; STR "explicit"])
-                        | XVar v when floc#f#env#is_memory_address_variable v ->
-                           log_tfold_default
-                             (log_error "ARMShiftedIndexOffset" (p2s v#toPretty))
-                             (fun v ->
-                               (v, [STR "ARMShiftedIndexOffset";
-                                    v#toPretty]))
-                             (env#mk_unknown_memory_variable "operand",
-                              [STR "ARMShiftedIndexOffset";
-                               self#toPretty;
-                               STR "; rx: ";
-                               x2p rx;
-                               STR ": ivax: ";
-                               x2p ivax])
-                             (floc#f#env#mk_memory_address_deref_variable v)
+                           (*
                         | XOp (XPlus, [XVar basevar; XVar memoffset]) ->
                            let optmemvaraddr = floc#decompose_memvar_address xoffset in
                            (match optmemvaraddr with
@@ -542,7 +523,7 @@ object (self:'a)
                                  STR "; basevar: ";
                                  basevar#toPretty;
                                  STR "; memoffset: ";
-                                 memoffset#toPretty]))
+                                 memoffset#toPretty])) *)
                         | _ ->
                            (env#mk_unknown_memory_variable "operand",
                             [STR "ARMShiftedIndexOffset";
@@ -616,17 +597,7 @@ object (self:'a)
     match kind with
     | ARMImmediate imm ->
        let imm = if unsigned then imm#to_unsigned else imm in
-       (match imm#to_doubleword with
-        | Some dw ->
-           if memmap#has_location dw then
-             let name = memmap#get_location_name dw in
-             let var =
-               floc#f#env#mk_global_memory_address
-                 ~optname:(Some name) imm#to_numerical in
-             XVar var
-           else
-             num_constant_expr imm#to_numerical
-        | _ -> num_constant_expr imm#to_numerical)
+       num_constant_expr imm#to_numerical
     | ARMFPConstant _ -> XConst XRandom
     | ARMReg _ | ARMWritebackReg _ -> XVar (self#to_variable floc)
     | ARMDoubleReg _ -> XVar (self#to_variable floc)
@@ -639,19 +610,7 @@ object (self:'a)
        num_constant_expr a#to_numerical
     | ARMLiteralAddress a ->
        if elf_header#is_readonly_address a then
-         let dw = elf_header#get_program_value a in
-         if memmap#has_location dw then
-           let name = memmap#get_location_name dw in
-           let ty = memmap#get_location_type dw in
-           if is_struct_type ty || is_array_type ty then
-             let var =
-               floc#f#env#mk_global_memory_address
-                 ~optname:(Some name) ~opttype:(Some ty) dw#to_numerical in
-             XVar var
-           else
-             num_constant_expr (elf_header#get_program_value a)#to_numerical
-         else
-           num_constant_expr (elf_header#get_program_value a)#to_numerical
+         num_constant_expr (elf_header#get_program_value a)#to_numerical
        else
          begin
            ch_error_log#add
diff --git a/CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml b/CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml
@@ -104,8 +104,8 @@ object (self)
     ]
 
   method index_sp_offset (o:(int * interval_t)) =
-    let (level,offset) = o in
-    let key = ([],[level; xd#index_interval offset]) in
+    let (level, offset) = o in
+    let key = ([], [level; xd#index_interval offset]) in
     sp_offset_table#add key
 
   method get_sp_offset (index:int) =
@@ -478,15 +478,19 @@ object (self)
                           floc#l#toPretty;
                           STR ": Parameter type not recognized in call ";
                           STR "instruction"])) in
+            let ptype = get_parameter_type p in
             let xx = rewrite_expr ?restrict:(Some 4) x in
-            let _ = floc#memrecorder#record_argument xx index in
             let xx =
-              let optmemvar = floc#decompose_memvar_address xx in
-              match optmemvar with
-              | Some (memref, memoff) ->
-                 XOp ((Xf "addressofvar"),
-                      [XVar (floc#f#env#mk_index_offset_memory_variable memref memoff)])
-              | _ -> xx in
+              if is_pointer ptype then
+                let _ = floc#memrecorder#record_argument xx index in
+                let xx =
+                  TR.tfold_default
+                    (fun v -> XOp ((Xf "addressofvar"), [(XVar v)]))
+                    xx
+                    (floc#get_var_at_address ~btype:ptype xx) in
+                xx
+              else
+                xx in
             let rdef = get_rdef xvar in
             (xx :: xprs, xvar :: xvars, rdef :: rdefs, index + 1))
           ([], [], [], 1) callargs in
@@ -568,14 +572,11 @@ object (self)
          let rdefs = [get_rdef xrn; get_rdef xrm] @ (get_all_rdefs rresult) in
          let uses = get_def_use vrd in
          let useshigh = get_def_use_high vrd in
-         let optmemvar = floc#decompose_memvar_address rresult in
          let rresult =
-           match optmemvar with
-           | Some (memref, memoff) ->
-              let memvar =
-                floc#f#env#mk_index_offset_memory_variable memref memoff in
-              XOp ((Xf "addressofvar"), [XVar memvar])
-           | _ -> rresult in
+           TR.tfold_default
+             (fun v -> XOp ((Xf "addressofvar"), [(XVar v)]))
+             rresult
+             (floc#get_var_at_address rresult) in
          let (tagstring, args) =
            mk_instrx_data
              ~vars:[vrd]
@@ -2061,13 +2062,10 @@ object (self)
            let xxsrc = rewrite_floc_expr srcfloc xsrc in
            let xxdst = rewrite_expr ?restrict:(Some 4) xdst in
            let xxdst =
-             let optmemvar = floc#decompose_memvar_address xxdst in
-             match optmemvar with
-             | Some (memref, memoff) ->
-                let memvar =
-                  floc#f#env#mk_index_offset_memory_variable memref memoff in
-                XOp ((Xf "addressofvar"), [XVar memvar])
-             | _ -> xxdst in
+             TR.tfold_default
+               (fun v -> XOp ((Xf "addressofvar"), [(XVar v)]))
+               xxdst
+               (floc#get_var_at_address xxdst) in
            let rdefs = [(get_rdef xsrc); (get_rdef xdst)] in
            let _ =
              match get_string_reference srcfloc xxsrc with
