From 3112506dee8a230a215d19d065dadcd673dfc9f8 Mon Sep 17 00:00:00 2001 From: Henny Sipma Date: Tue, 19 Aug 2025 23:42:40 -0700 Subject: [PATCH 1/2] CHB:refine global variable field determination --- CodeHawk/CHB/bchlib/bCHFloc.ml | 59 +++++++++--- CodeHawk/CHB/bchlib/bCHFunctionInfo.ml | 3 +- CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml | 93 ++++++++++++++----- CodeHawk/CHB/bchlib/bCHLibTypes.mli | 4 + CodeHawk/CHB/bchlib/bCHVersion.ml | 4 +- .../bchlibarm32/bCHARMAssemblyInstructions.ml | 3 +- CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml | 6 +- .../CHB/bchlibarm32/bCHTranslateARMToCHIF.ml | 4 +- CodeHawk/CHB/bchlibmips32/bCHMIPSOperand.ml | 4 +- CodeHawk/CHB/bchlibx86/bCHOperand.ml | 6 +- .../bCHPredefinedDelphiRTLSemantics.ml | 6 +- .../bCHPredefinedLibInternalCRTSemantics.ml | 10 +- .../bCHPredefinedSettersSemantics.ml | 4 +- CodeHawk/CHB/bchlibx86/bCHPredefinedUtil.ml | 2 +- .../bchlib_tests/txbchlib/bCHFlocTest.ml | 9 +- 15 files changed, 148 insertions(+), 69 deletions(-) diff --git a/CodeHawk/CHB/bchlib/bCHFloc.ml b/CodeHawk/CHB/bchlib/bCHFloc.ml index 537b3d9d..0b69730e 100644 --- a/CodeHawk/CHB/bchlib/bCHFloc.ml +++ b/CodeHawk/CHB/bchlib/bCHFloc.ml @@ -687,7 +687,7 @@ object (self) (fun memoff -> TR.tbind ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) - self#env#mk_global_variable + (self#env#mk_global_variable self#l) (get_total_constant_offset memoff)) memoffset_r else if memref#is_stack_reference then @@ -736,7 +736,7 @@ object (self) let dw = numerical_mod_to_doubleword n in if system_info#get_image_base#le dw then tprop - (self#env#mk_global_variable ~size n) + (self#env#mk_global_variable self#l ~size n) (__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": memref:global") else Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": " @@ -791,7 +791,7 @@ object (self) (self#cia ^ " : constant: " ^ n#toString)) (fun v -> v) (default ()) - (self#env#mk_global_variable ~size n) + (self#env#mk_global_variable ~size self#l n) else default ()) (default ()) @@ -809,7 +809,7 @@ object (self) (default ()) (TR.tbind ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) - self#env#mk_global_variable + (self#env#mk_global_variable self#l) (get_total_constant_offset memoffset)) else (TR.tfold_default @@ -845,7 +845,7 @@ object (self) (fun memoff -> TR.tbind ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) - (self#env#mk_global_variable ~size) + (self#env#mk_global_variable ~size self#l) (get_total_constant_offset memoff)) memoff_r else @@ -946,7 +946,7 @@ object (self) (default ()) (TR.tbind ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) - self#env#mk_global_variable + (self#env#mk_global_variable self#l) (get_total_constant_offset memoffset)) else TR.tfold_default @@ -983,7 +983,7 @@ object (self) (self#cia ^ "; constant: " ^ n#toString)) (fun v -> v) (default ()) - (self#env#mk_global_variable n) + (self#env#mk_global_variable self#l n) else default ()) (default ()) @@ -1002,7 +1002,7 @@ object (self) (self#cia ^ ": constant: " ^ n#toString)) (fun v -> v) (default ()) - (self#env#mk_global_variable n) + (self#env#mk_global_variable self#l n) else default ()) (default ()) @@ -1266,9 +1266,32 @@ object (self) ~tag:"get_var_at_address" __FILE__ __LINE__ ["addrvalue: " ^ (x2s addrvalue); - "btype: " ^ (btype_to_string btype)] in + "btype: " ^ (btype_to_string btype); + "size: " ^ (if Option.is_some size then (string_of_int (Option.get size)) else "?")] in match self#normalize_addrvalue addrvalue with + | XOp ((Xf "addressofvar"), [XVar v]) when self#env#is_global_variable v -> + let gvaddr_r = self#f#env#get_global_variable_address v in + TR.tbind + ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) + (fun gvaddr -> + if memmap#has_location gvaddr then + let gloc = memmap#get_location gvaddr in + let varresult = + TR.tmap + ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) + (fun offset -> self#f#env#mk_gloc_variable gloc offset) + (gloc#address_offset_memory_offset + ~tgtsize:size ~tgtbtype:btype self#l zero_constant_expr) in + varresult + else + Error[__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": " + ^ (p2s self#l#toPretty) + ^ ": " + ^ "Global location at address " + ^ gvaddr#to_hex_string + ^ " not found"]) + gvaddr_r | XOp ((Xf "addressofvar"), [XVar v]) -> Ok v | XOp (XPlus, [XOp ((Xf "addressofvar"), [XVar v]); xoff]) when self#f#env#is_global_variable v -> @@ -1286,7 +1309,7 @@ object (self) (TR.tbind (fun xoff -> gloc#address_offset_memory_offset - ~tgtsize:size ~tgtbtype:btype xoff) + ~tgtsize:size ~tgtbtype:btype self#l xoff) cxoff_r) in let _ = log_diagnostics_result @@ -1312,7 +1335,7 @@ object (self) (TR.tmap ~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__)) (fun offset -> self#f#env#mk_gloc_variable gloc offset) - (gloc#address_memory_offset ~tgtsize:size ~tgtbtype:btype addrvalue)) + (gloc#address_memory_offset ~tgtsize:size ~tgtbtype:btype self#l addrvalue)) | _ -> let (memref_r, memoff_r) = self#decompose_memaddr addrvalue in TR.tmap2 @@ -2024,6 +2047,12 @@ object (self) * if not, identify the variable most likely to be the base pointer. *) method decompose_address (x:xpr_t):(memory_reference_int * memory_offset_t) = + let _ = + log_diagnostics_result + ~msg:(p2s self#l#toPretty) + ~tag:"decompose-address" + __FILE__ __LINE__ + ["x: " ^ (x2s x)] in let default () = (self#env#mk_unknown_memory_reference (x2s x), UnknownOffset) in let is_external_constant v = self#env#is_function_initial_value v in @@ -2184,7 +2213,7 @@ object (self) (self#cia ^ ": constant: " ^ n#toString)) (fun v -> v) (default ()) - (self#env#mk_global_variable n) + (self#env#mk_global_variable self#l n) else default ()) (default ()) @@ -2315,7 +2344,7 @@ object (self) ~tag:"assign global variable address" __FILE__ __LINE__ e; rhs end) - (self#f#env#mk_global_variable n) + (self#f#env#mk_global_variable self#l n) else rhs | _ -> rhs in @@ -2492,7 +2521,7 @@ object (self) let argvar = self#env#mk_register_variable r in self#rewrite_variable_to_external argvar | [GlobalParameter (a, _)] when not (a#equal wordzero) -> - let argvar = self#env#mk_global_variable a#to_numerical in + let argvar = self#env#mk_global_variable self#l a#to_numerical in (match argvar with | Error e -> raise @@ -2577,7 +2606,7 @@ object (self) (self#cia ^ ": constant: " ^ num#toString)) (fun v -> Some v) None - (self#env#mk_global_variable num) + (self#env#mk_global_variable self#l num) else None) None diff --git a/CodeHawk/CHB/bchlib/bCHFunctionInfo.ml b/CodeHawk/CHB/bchlib/bCHFunctionInfo.ml index a244914c..86222a12 100644 --- a/CodeHawk/CHB/bchlib/bCHFunctionInfo.ml +++ b/CodeHawk/CHB/bchlib/bCHFunctionInfo.ml @@ -843,6 +843,7 @@ object (self) method mk_global_variable ?(size=4) ?(btype=t_unknown) + (loc: location_int) (base: numerical_t): variable_t traceresult = let dw = numerical_mod_to_doubleword base in match memmap#containing_location dw with @@ -872,7 +873,7 @@ object (self) self#set_variable_name ivar (name ^ "_in"); gvar end) - (gloc#address_memory_offset ~tgtbtype:btype (num_constant_expr base)) + (gloc#address_memory_offset ~tgtbtype:btype loc (num_constant_expr base)) | _ -> let _ = memmap#add_location ~size:(Some size) ~btype dw in Ok (self#mk_variable (self#varmgr#make_global_variable dw#to_numerical)) diff --git a/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml b/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml index e9dd1fee..d3d6b491 100644 --- a/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml +++ b/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml @@ -52,6 +52,14 @@ let x2p = XprToPretty.xpr_formatter#pr_expr let p2s = CHPrettyUtil.pretty_to_string let x2s x = p2s (x2p x) +let opti2s (i: int option) = + if Option.is_some i then string_of_int (Option.get i) else "?" + +let ty2s (ty: btype_t) = + if is_unknown_type ty then "?" else btype_to_string ty +let optty2s (ty: btype_t option) = + if Option.is_some ty then btype_to_string (Option.get ty) else "?" + let bcd = BCHBCDictionary.bcdictionary @@ -144,6 +152,11 @@ object (self) | Ok (TArray _) -> true | _ -> false + method is_scalar: bool = + match resolve_type self#btype with + | Ok ty -> is_scalar ty + | _ -> false + method is_typed: bool = not (btype_equal self#btype t_unknown) method size: int option = grec.gloc_size @@ -196,18 +209,16 @@ object (self) method private get_field_memory_offset_at ~(tgtsize: int option) ~(tgtbtype: btype_t option) + (loc: location_int) (c: bcompinfo_t) (xoffset: xpr_t): memory_offset_t traceresult = let _ = log_diagnostics_result + ~msg:(p2s loc#toPretty) ~tag:"global:get-field-memory-offset-at" __FILE__ __LINE__ - ["tgtsize: " - ^ (if Option.is_some tgtsize then - string_of_int (Option.get tgtsize) else "?"); - "tgtbtype: " - ^ (if Option.is_some tgtbtype then - btype_to_string (Option.get tgtbtype) else "?"); + ["tgtsize: " ^ (opti2s tgtsize); + "tgtbtype: " ^ (optty2s tgtbtype); "compinfo: " ^ c.bcname; "xoffset: " ^ (x2s xoffset)] in let is_void_tgtbtype = @@ -286,14 +297,22 @@ object (self) Some (FieldOffset ((finfo.bfname, finfo.bfckey), suboff))) (self#structvar_memory_offset - ~tgtsize ~tgtbtype fldtype (int_constant_expr offset)) + ~tgtsize + ~tgtbtype + loc + fldtype + (int_constant_expr offset)) else if is_array_type fldtype then tmap (fun suboff -> Some (FieldOffset ((finfo.bfname, finfo.bfckey), suboff))) (self#arrayvar_memory_offset - ~tgtsize ~tgtbtype fldtype (int_constant_expr offset)) + ~tgtsize + ~tgtbtype + loc + fldtype + (int_constant_expr offset)) else Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": " ^ "Nonzero offset: " ^ (string_of_int offset) @@ -313,8 +332,18 @@ object (self) method private structvar_memory_offset ~(tgtsize: int option) ~(tgtbtype: btype_t option) + (loc: location_int) (btype: btype_t) (xoffset: xpr_t): memory_offset_t traceresult = + let _ = + log_diagnostics_result + ~msg:(p2s loc#toPretty) + ~tag:"mmap:structvar-memory-offset" + __FILE__ __LINE__ + ["tgtsize: " ^ (opti2s tgtsize); + "tgtbtype: " ^ (optty2s tgtbtype); + "btype: " ^ (btype_to_string btype); + "xoffset: " ^ (x2s xoffset)] in match xoffset with | XConst (IntConst n) when n#equal CHNumerical.numerical_zero @@ -324,7 +353,7 @@ object (self) | XConst (IntConst _) -> if is_struct_type btype then let compinfo = get_struct_type_compinfo btype in - (self#get_field_memory_offset_at ~tgtsize ~tgtbtype compinfo xoffset) + (self#get_field_memory_offset_at ~tgtsize ~tgtbtype loc compinfo xoffset) else Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ":" ^ " xoffset: " ^ (x2s xoffset) @@ -335,7 +364,7 @@ object (self) let fldoffset = XConst (IntConst m) in let memoffset_r = self#get_field_memory_offset_at - ~tgtsize:None ~tgtbtype:None compinfo fldoffset in + ~tgtsize:None ~tgtbtype:None loc compinfo fldoffset in TR.tbind (fun memoffset -> match memoffset with @@ -378,20 +407,16 @@ object (self) method private arrayvar_memory_offset ~(tgtsize: int option) ~(tgtbtype: btype_t option) + (loc: location_int) (btype: btype_t) (xoffset: xpr_t): memory_offset_t traceresult = let _ = log_diagnostics_result - ~tag:"global:arrayvar-memory-offset" + ~msg:(p2s loc#toPretty) + ~tag:"mmap:arrayvar-memory-offset" __FILE__ __LINE__ - ["tgtsize: " ^ (if (Option.is_some tgtsize) then - string_of_int (Option.get tgtsize) - else - "?"); - "tgtbtype: " ^ (if (Option.is_some tgtbtype) then - btype_to_string (Option.get tgtbtype) - else - "?"); + ["tgtsize: " ^ (opti2s tgtsize); + "tgtbtype: " ^ (optty2s tgtbtype); "btype: " ^ (btype_to_string btype); "xoffset: " ^ (x2s xoffset)] in let iszero x = @@ -424,11 +449,11 @@ object (self) let eltty = TR.tvalue (resolve_type eltty) ~default:t_unknown in tbind (fun suboff -> Ok (ArrayIndexOffset (indexxpr, suboff))) - (self#structvar_memory_offset ~tgtsize ~tgtbtype eltty rem) + (self#structvar_memory_offset ~tgtsize ~tgtbtype loc eltty rem) else if is_array_type eltty then tbind (fun suboff -> Ok (ArrayIndexOffset (indexxpr, suboff))) - (self#arrayvar_memory_offset ~tgtsize ~tgtbtype eltty rem) + (self#arrayvar_memory_offset ~tgtsize ~tgtbtype loc eltty rem) else if is_scalar eltty then if iszero rem then Ok (ArrayIndexOffset (indexxpr, NoOffset)) @@ -452,7 +477,16 @@ object (self) method address_offset_memory_offset ?(tgtsize=None) ?(tgtbtype=t_unknown) + (loc: location_int) (xoffset: xpr_t): memory_offset_t traceresult = + let _ = + log_diagnostics_result + ~msg:(p2s loc#toPretty) + ~tag:"mmap:address-offset-memory-offset" + __FILE__ __LINE__ + ["xoffset: " ^ (x2s xoffset) + ^ "; tgtsize: " ^ (opti2s tgtsize) + ^ "; tgtbtype: " ^ (ty2s tgtbtype)] in match xoffset with | XConst (IntConst n) when n#equal CHNumerical.numerical_zero @@ -462,6 +496,13 @@ object (self) | XConst (IntConst n) when n#equal CHNumerical.numerical_zero && (not self#is_typed) -> Ok NoOffset + | XConst (IntConst n) + when n#equal CHNumerical.numerical_zero + && self#is_scalar + && Option.is_some tgtsize + && Option.is_some self#size + && (Option.get tgtsize) = (Option.get self#size) -> + Ok NoOffset | XConst (IntConst n) when not self#is_typed -> Ok (ConstantOffset (n, NoOffset)) | _ -> @@ -469,10 +510,10 @@ object (self) if is_unknown_type tgtbtype then None else Some tgtbtype in if self#is_struct then let btype = TR.tvalue (resolve_type self#btype) ~default:t_unknown in - self#structvar_memory_offset ~tgtsize ~tgtbtype btype xoffset + self#structvar_memory_offset ~tgtsize ~tgtbtype loc btype xoffset else if self#is_array then let btype = TR.tvalue (resolve_type self#btype) ~default:t_unknown in - self#arrayvar_memory_offset ~tgtsize ~tgtbtype btype xoffset + self#arrayvar_memory_offset ~tgtsize ~tgtbtype loc btype xoffset else Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ":" ^ (btype_to_string self#btype) @@ -481,9 +522,10 @@ object (self) method address_memory_offset ?(tgtsize=None) ?(tgtbtype=t_unknown) + (loc: location_int) (xpr: xpr_t): memory_offset_t traceresult = TR.tbind - (self#address_offset_memory_offset ~tgtsize ~tgtbtype) + (self#address_offset_memory_offset ~tgtsize ~tgtbtype loc) (self#address_offset xpr) method initialvalue: globalvalue_t option = grec.gloc_initialvalue @@ -703,7 +745,8 @@ object (self) (btype: btype_t) = match self#xpr_containing_location gxpr with | Some gloc -> - let memoff = TR.to_option (gloc#address_memory_offset gxpr) in + let loc = BCHLocation.ctxt_string_to_location faddr iaddr in + let memoff = TR.to_option (gloc#address_memory_offset loc gxpr) in let garg = GAddressArgument (gloc#address, iaddr, argindex, gxpr, btype, memoff) in begin diff --git a/CodeHawk/CHB/bchlib/bCHLibTypes.mli b/CodeHawk/CHB/bchlib/bCHLibTypes.mli index 30d2be74..27a65a49 100644 --- a/CodeHawk/CHB/bchlib/bCHLibTypes.mli +++ b/CodeHawk/CHB/bchlib/bCHLibTypes.mli @@ -4399,6 +4399,7 @@ class type global_location_int = method is_typed: bool method is_struct: bool method is_array: bool + method is_scalar: bool method is_function_address: bool method initialvalue: globalvalue_t option method desc: string option @@ -4450,12 +4451,14 @@ class type global_location_int = method address_memory_offset: ?tgtsize:int option -> ?tgtbtype:btype_t + -> location_int -> xpr_t -> memory_offset_t traceresult method address_offset_memory_offset: ?tgtsize:int option -> ?tgtbtype:btype_t + -> location_int -> xpr_t -> memory_offset_t traceresult @@ -4787,6 +4790,7 @@ class type function_environment_int = method mk_global_variable: ?size:int -> ?btype:btype_t + -> location_int -> numerical_t -> variable_t traceresult diff --git a/CodeHawk/CHB/bchlib/bCHVersion.ml b/CodeHawk/CHB/bchlib/bCHVersion.ml index 965e2307..14942dfa 100644 --- a/CodeHawk/CHB/bchlib/bCHVersion.ml +++ b/CodeHawk/CHB/bchlib/bCHVersion.ml @@ -95,8 +95,8 @@ end let version = new version_info_t - ~version:"0.6.0_20250817" - ~date:"2025-08-17" + ~version:"0.6.0_20250819" + ~date:"2025-08-19" ~licensee: None ~maxfilesize: None () diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMAssemblyInstructions.ml b/CodeHawk/CHB/bchlibarm32/bCHARMAssemblyInstructions.ml index d2fe2a89..83662dbd 100644 --- a/CodeHawk/CHB/bchlibarm32/bCHARMAssemblyInstructions.ml +++ b/CodeHawk/CHB/bchlibarm32/bCHARMAssemblyInstructions.ml @@ -606,6 +606,7 @@ object (self) "" in let memorymap = BCHGlobalMemoryMap.global_memory_map in let get_memory_offset (gloc: global_location_int) (offset: xpr_t) = + let zeroloc = BCHLocation.make_location_by_address wordzero wordzero in TR.tfold ~ok:(fun memoffset -> " (" ^ (BCHMemoryReference.memory_offset_to_string memoffset) ^ ")" @@ -615,7 +616,7 @@ object (self) log_diagnostics_result __FILE__ __LINE__ e; "" end) - (gloc#address_memory_offset ~tgtsize:(Some 4) offset) in + (gloc#address_memory_offset ~tgtsize:(Some 4) zeroloc offset) in let vm1 (v: doubleword_int) = TR.to_option (v#subtract_int 1) in let render_gloc (a: doubleword_int) (v: doubleword_int): string = let addrprefix = " " ^ (fixed_length_string a#to_hex_string 10) in diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml b/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml index 8c31b4b6..939750b7 100644 --- a/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml +++ b/CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml @@ -471,7 +471,7 @@ object (self:'a) Ok (env#mk_arm_special_register_variable r) | ARMLiteralAddress dw -> TR.tprop - (floc#env#mk_global_variable dw#to_numerical) + (floc#env#mk_global_variable floc#l dw#to_numerical) (__FILE__ ^ ":" ^ (string_of_int __LINE__)) | ARMOffsetAddress (r, align, offset, isadd, _iswback, isindex, size) -> (match offset with @@ -506,7 +506,7 @@ object (self:'a) Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": " ^ "Illegal address (zero) for ARMOffsetAddress"] | (XConst (IntConst n), 0) -> - floc#env#mk_global_variable ~size n + floc#env#mk_global_variable ~size floc#l n | _ -> floc#get_memory_variable_varoffset ~size rvar ivar (mkNumerical i)) @@ -534,7 +534,7 @@ object (self:'a) let xoffset = simplify_xpr (XOp (XPlus, [rx; ivax])) in (match (xoffset, i) with | (XConst (IntConst n), 0) -> - floc#env#mk_global_variable ~size n + floc#env#mk_global_variable ~size floc#l n | _ -> floc#get_memory_variable_varoffset ~size rvar ivar (mkNumerical i)) diff --git a/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml b/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml index 2c29e2e0..02c42adb 100644 --- a/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml +++ b/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml @@ -4524,8 +4524,8 @@ object (self) (trerror_record (LBLOCK [STR "create_arg_asserts: "; STR name])) (string_to_doubleword name) in - let gv = TR.tget_ok (finfo#env#mk_global_variable namedw#to_numerical) in - (* let gv_in = finfo#env#mk_initial_memory_value gv in *) + let loc = BCHLocation.make_location_by_address finfo#a finfo#a in + let gv = TR.tget_ok (finfo#env#mk_global_variable loc namedw#to_numerical) in self#create_arg_scalar_asserts finfo gv optlb optub else let reg = armreg_from_string name in diff --git a/CodeHawk/CHB/bchlibmips32/bCHMIPSOperand.ml b/CodeHawk/CHB/bchlibmips32/bCHMIPSOperand.ml index 7d3c3be8..c173bd89 100644 --- a/CodeHawk/CHB/bchlibmips32/bCHMIPSOperand.ml +++ b/CodeHawk/CHB/bchlibmips32/bCHMIPSOperand.ml @@ -6,7 +6,7 @@ Copyright (c) 2005-2019 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 @@ -132,7 +132,7 @@ object (self:'a) let rvar = env#mk_mips_register_variable r in floc#get_memory_variable_1 rvar offset | MIPSAbsolute a -> - (match env#mk_global_variable a#to_numerical with + (match env#mk_global_variable floc#l a#to_numerical with | Error e -> raise (BCH_failure diff --git a/CodeHawk/CHB/bchlibx86/bCHOperand.ml b/CodeHawk/CHB/bchlibx86/bCHOperand.ml index dafb9de6..0c8046f8 100644 --- a/CodeHawk/CHB/bchlibx86/bCHOperand.ml +++ b/CodeHawk/CHB/bchlibx86/bCHOperand.ml @@ -6,7 +6,7 @@ Copyright (c) 2005-2019 Kestrel Technology LLC Copyright (c) 2020-2021 Henny 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 @@ -376,7 +376,7 @@ object (self:'a) | XmmReg regIndex -> env#mk_xmm_register_variable regIndex | DoubleReg (reg1,reg2) -> env#mk_double_register_variable reg1 reg2 | Absolute address -> - (match env#mk_global_variable address#to_numerical with + (match env#mk_global_variable floc#l address#to_numerical with | Error e -> raise (BCH_failure @@ -385,7 +385,7 @@ object (self:'a) STR (String.concat "; " e)])) | Ok var -> var) | FarAbsolute (_, addr) -> - (match env#mk_global_variable addr#to_numerical with + (match env#mk_global_variable floc#l addr#to_numerical with | Error e -> raise (BCH_failure diff --git a/CodeHawk/CHB/bchlibx86/bCHPredefinedDelphiRTLSemantics.ml b/CodeHawk/CHB/bchlibx86/bCHPredefinedDelphiRTLSemantics.ml index fcf4577c..d0e2c96e 100644 --- a/CodeHawk/CHB/bchlibx86/bCHPredefinedDelphiRTLSemantics.ml +++ b/CodeHawk/CHB/bchlibx86/bCHPredefinedDelphiRTLSemantics.ml @@ -6,7 +6,7 @@ Copyright (c) 2005-2020 Kestrel Technology LLC Copyright (c) 2020-2023 Henny B. Sipma - Copyright (c) 2024 Aarno Labs LLC + Copyright (c) 2024-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 @@ -951,7 +951,7 @@ object (self) method! get_commands (floc:floc_int) = let eaxv = get_reg_value Eax floc in - let vgv = TR.tget_ok (floc#env#mk_global_variable gv#to_numerical) in + let vgv = TR.tget_ok (floc#env#mk_global_variable floc#l gv#to_numerical) in floc#get_assign_commands vgv eaxv method get_parametercount = 0 @@ -1819,7 +1819,7 @@ object (self) let eaxv = get_reg_value Eax floc in let (eaxdlhs,eaxdlhscmds) = get_reg_deref_lhs Eax 0 floc in let gval = get_gv_value gv floc in - let gvar = TR.tget_ok (floc#env#mk_global_variable gv#to_numerical) in + let gvar = TR.tget_ok (floc#env#mk_global_variable floc#l gv#to_numerical) in let cmds1 = floc#get_assign_commands eaxdlhs gval in let cmds2 = floc#get_assign_commands gvar eaxv in let cmds3 = [floc#get_abstract_cpu_registers_command [Edx]] in diff --git a/CodeHawk/CHB/bchlibx86/bCHPredefinedLibInternalCRTSemantics.ml b/CodeHawk/CHB/bchlibx86/bCHPredefinedLibInternalCRTSemantics.ml index 4feb1a74..34b1c569 100644 --- a/CodeHawk/CHB/bchlibx86/bCHPredefinedLibInternalCRTSemantics.ml +++ b/CodeHawk/CHB/bchlibx86/bCHPredefinedLibInternalCRTSemantics.ml @@ -6,7 +6,7 @@ Copyright (c) 2005-2020 Kestrel Technology LLC Copyright (c) 2020-2021 Henny 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 @@ -464,7 +464,7 @@ object (self) (List.map (fun offset -> let v = TR.tget_ok - (floc#env#mk_global_variable (gv#add_int offset)#to_numerical) in + (floc#env#mk_global_variable floc#l (gv#add_int offset)#to_numerical) in floc#get_assign_commands v arg) [0; 4; 8; 16]) in let cmds2 = floc#get_assign_commands lhs arg in @@ -659,9 +659,9 @@ object (self) let arg1 = get_patternrhs_value rhs1 floc in let eaxv = get_reg_value Eax floc in let ebpv = get_reg_value Ebp floc in - let gv1 = TR.tget_ok (env#mk_global_variable (gv#add_int 4)#to_numerical) in - let gv2 = TR.tget_ok (env#mk_global_variable (gv#add_int 8)#to_numerical) in - let gv3 = TR.tget_ok (env#mk_global_variable (gv#add_int 12)#to_numerical) in + let gv1 = TR.tget_ok (env#mk_global_variable floc#l (gv#add_int 4)#to_numerical) in + let gv2 = TR.tget_ok (env#mk_global_variable floc#l (gv#add_int 8)#to_numerical) in + let gv3 = TR.tget_ok (env#mk_global_variable floc#l (gv#add_int 12)#to_numerical) in let cmds1 = floc#get_assign_commands gv1 arg1 in let cmds2 = floc#get_assign_commands gv2 eaxv in let cmds3 = floc#get_assign_commands gv3 ebpv in diff --git a/CodeHawk/CHB/bchlibx86/bCHPredefinedSettersSemantics.ml b/CodeHawk/CHB/bchlibx86/bCHPredefinedSettersSemantics.ml index c3aa72c3..f8015734 100644 --- a/CodeHawk/CHB/bchlibx86/bCHPredefinedSettersSemantics.ml +++ b/CodeHawk/CHB/bchlibx86/bCHPredefinedSettersSemantics.ml @@ -6,7 +6,7 @@ Copyright (c) 2005-2020 Kestrel Technology LLC Copyright (c) 2020-2023 Henny B. Sipma - Copyright (c) 2024 Aarno Labs LLC + Copyright (c) 2024-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 @@ -303,7 +303,7 @@ object (self) method get_name = "__set_gv_" ^ gv#to_hex_string method! get_annotation (floc:floc_int) = - let v = TR.tget_ok (floc#env#mk_global_variable gv#to_numerical) in + let v = TR.tget_ok (floc#env#mk_global_variable floc#l gv#to_numerical) in let args = floc#get_call_args in let xrhs = get_patternrhs_value ~args rhs floc in LBLOCK [v#toPretty; STR " := "; xpr_to_pretty floc xrhs] diff --git a/CodeHawk/CHB/bchlibx86/bCHPredefinedUtil.ml b/CodeHawk/CHB/bchlibx86/bCHPredefinedUtil.ml index d36cdc6a..8c8b1b0e 100644 --- a/CodeHawk/CHB/bchlibx86/bCHPredefinedUtil.ml +++ b/CodeHawk/CHB/bchlibx86/bCHPredefinedUtil.ml @@ -254,7 +254,7 @@ let get_reg_value (reg:cpureg_t) (floc:floc_int) = let get_gv_value (gv:doubleword_int) (floc:floc_int) = - let v = floc#env#mk_global_variable gv#to_numerical in + let v = floc#env#mk_global_variable floc#l gv#to_numerical in match v with | Error e -> raise diff --git a/CodeHawk/CHT/CHB_tests/bchlib_tests/txbchlib/bCHFlocTest.ml b/CodeHawk/CHT/CHB_tests/bchlib_tests/txbchlib/bCHFlocTest.ml index 575ffcda..bd76ca8e 100644 --- a/CodeHawk/CHT/CHB_tests/bchlib_tests/txbchlib/bCHFlocTest.ml +++ b/CodeHawk/CHT/CHB_tests/bchlib_tests/txbchlib/bCHFlocTest.ml @@ -5,7 +5,7 @@ ------------------------------------------------------------------------------ The MIT License (MIT) - Copyright (c) 2024 Aarno Labs LLC + Copyright (c) 2024-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 @@ -51,7 +51,7 @@ let mmap = BCHGlobalMemoryMap.global_memory_map let testname = "bCHFlocTest" -let lastupdated = "2024-08-20" +let lastupdated = "2025-08-19" let get_var_at_address_test () = @@ -64,6 +64,7 @@ let get_var_at_address_test () = let dwfaddr = TR.tget_ok (string_to_doubleword faddr) in let dwiaddr = TR.tget_ok (string_to_doubleword iaddr) in let dwgvaddr = TR.tget_ok (string_to_doubleword gvaddr) in + let loc = BCHLocation.make_location_by_address dwfaddr dwiaddr in let dwgvxpr = num_constant_expr dwgvaddr#to_numerical in begin TS.new_testsuite @@ -74,7 +75,7 @@ let get_var_at_address_test () = let compinfo = bcfiles#get_compinfo_by_name "x44_struct_t" in let finfo = get_function_info dwfaddr in let floc = get_floc_by_address dwfaddr dwiaddr in - let gvar = TR.tget_ok (finfo#env#mk_global_variable dwgvaddr#to_numerical) in + let gvar = TR.tget_ok (finfo#env#mk_global_variable loc dwgvaddr#to_numerical) in let indexvar = finfo#env#mk_initial_register_value (ARMRegister AR0) in let indexxpr1 = XOp (XMinus, [XVar indexvar; int_constant_expr 1]) in @@ -214,7 +215,7 @@ let get_var_at_address_test () = ~received:(Some received) () | Error e -> A.fail_msg ("Error: " ^ (String.concat "; " e))); - + TS.launch_tests () end From e4a6caa4fa934ed3cb7210c3b8b1901c56a5e91f Mon Sep 17 00:00:00 2001 From: Henny Sipma Date: Wed, 20 Aug 2025 00:09:09 -0700 Subject: [PATCH 2/2] CHB: handle void-typed target address --- CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml b/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml index d3d6b491..8d846515 100644 --- a/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml +++ b/CodeHawk/CHB/bchlib/bCHGlobalMemoryMap.ml @@ -491,7 +491,7 @@ object (self) | XConst (IntConst n) when n#equal CHNumerical.numerical_zero && Option.is_none tgtsize - && is_unknown_type tgtbtype -> + && ((is_unknown_type tgtbtype) || (is_void tgtbtype)) -> Ok NoOffset | XConst (IntConst n) when n#equal CHNumerical.numerical_zero && (not self#is_typed) ->