CHB:ARM: make typing rules configurable

Author: sipma

CodeHawk/CHB/bchlib/bCHFunctionData.ml

@@ -280,31 +280,39 @@ object (self)
            __FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
            ^ "No stackvar annotation found at offset " ^ (string_of_int offset)]
 
-  method is_typing_rule_enabled (loc: string) (name: string): bool =
+  method is_typing_rule_enabled ?(rdef=None) (loc: string) (name: string): bool =
+    let rdefloc =
+      match rdef with
+      | None -> loc
+      | Some rdefaddr -> loc ^ ":" ^ rdefaddr in
     match self#get_function_annotation with
-    | None -> false
+    | None -> BCHSystemSettings.system_settings#is_typing_rule_enabled name
     | Some a ->
-       List.fold_left
-         (fun acc tra ->
-           acc ||
-             (if tra.tra_action = "enable" && tra.tra_name = name then
-                (List.mem "all" tra.tra_locations)
-                || (List.mem loc tra.tra_locations)
-              else
-                false)) false a.typingrules
-
-  method is_typing_rule_disabled (loc: string) (name: string): bool =
-    match self#get_function_annotation with
-    | None -> false
-    | Some a ->
-       List.fold_left
-         (fun acc tra ->
-           acc ||
-             (if tra.tra_action = "disable" && tra.tra_name = name then
-                (List.mem "all" tra.tra_locations)
-                || (List.mem loc tra.tra_locations)
-              else
-                false)) false a.typingrules
+       let is_user_enabled () =
+         List.fold_left
+           (fun acc tra ->
+             acc ||
+               (if tra.tra_action = "enable" && tra.tra_name = name then
+                  (List.mem "all" tra.tra_locations)
+                  || (List.mem loc tra.tra_locations)
+                else
+                  false)) false a.typingrules in
+       let is_user_disabled () =
+         List.fold_left
+           (fun acc tra ->
+             acc ||
+               (if tra.tra_action = "disable" && tra.tra_name = name then
+                  (List.mem "all" tra.tra_locations)
+                  || (List.mem loc tra.tra_locations)
+                  || (List.mem rdefloc tra.tra_locations)
+                else
+                  false)) false a.typingrules in
+       if is_user_enabled () then
+         true
+       else if is_user_disabled () then
+         false
+       else
+         BCHSystemSettings.system_settings#is_typing_rule_enabled name
 
   method add_inlined_block (baddr:doubleword_int) =
     inlined_blocks <- baddr :: inlined_blocks

CodeHawk/CHB/bchlib/bCHLibTypes.mli

@@ -1443,6 +1443,7 @@ object
   method is_elf: bool
   method is_pe: bool
   method is_verbose: bool
+  method is_typing_rule_enabled: string -> bool
   method is_debug_excluded: bool
   method is_sideeffects_on_global_enabled: string -> bool
   method is_abstract_stackvars_disabled: bool
@@ -1574,8 +1575,7 @@ class type function_data_int =
     method has_regvar_type_cast: doubleword_int -> bool
     method has_stackvar_type_annotation: int -> bool
     method has_stackvar_type_cast: int -> bool
-    method is_typing_rule_enabled: string -> string -> bool
-    method is_typing_rule_disabled: string -> string -> bool
+    method is_typing_rule_enabled: ?rdef:string option -> string -> string -> bool
     method has_class_info: bool
     method has_callsites: bool
     method has_path_contexts: bool

CodeHawk/CHB/bchlib/bCHSystemSettings.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
@@ -38,6 +38,7 @@ open BCHBasicTypes
 open BCHLibTypes
 open BCHUtilities
 
+module H = Hashtbl
 
 let fns_included = ref []
 let include_function (s: string) = fns_included := s :: !fns_included
@@ -49,6 +50,76 @@ let exclude_function (s: string) = fns_excluded := s :: !fns_excluded
 let excluded_functions () = !fns_excluded
 
 
+let arm_typingrules_settings = H.create 23
+
+let _ =
+  List.iter (fun (r, s) ->
+      H.add arm_typingrules_settings r s)
+    [(* propagation rules *)
+      ("ADD-c", "enable");
+      ("AND-rdef", "enable");      
+      ("ASR-rdef", "enable");
+      ("CMP-rdef", "enable");
+      ("LSL_rdef", "enable");
+      ("LSR_rdef", "enable");
+      ("MOV-c", "enable");
+      ("MOV-rdef", "enable");
+      ("MVN-rdef", "enable");
+      ("ORR-rdef", "enable");
+      ("POP-rdef", "enable");
+      ("RSB-rdef", "enable");
+      ("SMULL-rdef", "enable");
+      ("STR-rdef", "enable");
+      ("SUB-rdef", "enable");
+      ("UBFX-rdef", "enable");
+
+      (* load/store rules *)
+      ("LDR-load", "enable");
+      ("LDRB-load", "enable");
+      ("LDRH-load", "enable");
+      ("STR-store", "enable");
+      ("STRB-store", "enable");
+      ("STRH-store", "enable");
+
+      (* function return type back propagation *)
+      ("ADD-exituse", "enable");
+      ("AND-exituse", "enable");
+      ("ASR-exituse", "enable");
+      ("LDR-exituse", "enable");
+      ("LDRB-exituse", "enable");
+      ("LDRH-exituse", "enable");
+      ("LSL-exituse", "enable");
+      ("LSR-exituse", "enable");
+      ("MOV-exituse", "enable");
+      ("MVN-exituse", "enable");
+      ("ORR-exituse", "enable");
+      ("RSB-exituse", "enable");
+      ("SUB-exituse", "enable");
+      ("UBFX-exituse", "enable");
+      ("UXTH-exituse", "enable");
+
+      (* default setting of lhs *)
+      ("ASR-def-lhs", "enable");
+      ("LDRB-def-lhs", "enable");
+      ("LDRH-def-lhs", "enable");
+      ("MVN-def-lhs", "enable");
+      ("SMULL-def-lhs", "enable");
+      ("UXTH-def-lhs", "enable");
+
+      (* misc rules *)
+      ("ADD-global", "enable");
+      ("BL-sig-regarg", "enable");
+      ("BL-sig-stackarg", "enable");
+      ("BL-sig-rv", "enable");
+      ("LDR-array", "enable");
+      ("LDR-memop-tc", "enable");
+      ("LDR-stack-addr", "enable");
+      ("LDR-struct-field", "enable");
+      ("LDRH-memop-tc", "enable");
+      ("POP-sig-rv", "enable")
+    ]
+
+
 (* -------------------------------------------------------------------------
  * Command-line switches:
  * - set_vftables: for all jump tables, if one of the targets is a function entry
@@ -313,6 +384,13 @@ object (self)
         | [] -> not (List.mem gv not_record_sideeffects_on_globals)
         | l -> List.mem gv l)
 
+  method is_typing_rule_enabled (name: string) =
+    match self#get_architecture with
+    | "arm" ->
+       (H.mem arm_typingrules_settings name)
+       && (H.find arm_typingrules_settings name) == "enable"
+    | _ -> false
+
 end