CHB: aggregate for LSL/ASR

sipma · sipma · commit af3ec25e0381 · 2024-12-12T21:17:47.000-08:00
diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMInstructionAggregate.ml b/CodeHawk/CHB/bchlibarm32/bCHARMInstructionAggregate.ml
@@ -46,6 +46,9 @@ open BCHLoadStoreMultipleSequence
 open BCHThumbITSequence
 
 
+module TR = CHTraceResult
+
+
 let arm_aggregate_kind_to_string (k: arm_aggregate_kind_t) =
   match k with
   | ARMJumptable jt ->
@@ -56,6 +59,8 @@ let arm_aggregate_kind_to_string (k: arm_aggregate_kind_t) =
      ^ " target addresses"
   | ThumbITSequence it -> it#toString
   | LDMSTMSequence s -> s#toString
+  | PseudoLDRSB (i1, _, _) -> "Pseudo LDRSB at " ^ i1#get_address#to_hex_string
+  | PseudoLDRSH (i1, _, _) -> "Pseudo LDRSH at " ^ i1#get_address#to_hex_string
   | BXCall (_, i2) -> "BXCall at " ^ i2#get_address#to_hex_string
 
 
@@ -115,6 +120,16 @@ object (self)
     | BXCall _ -> true
     | _ -> false
 
+  method is_pseudo_ldrsh =
+    match self#kind with
+    | PseudoLDRSH _ -> true
+    | _ -> false
+
+  method is_pseudo_ldrsb =
+    match self#kind with
+    | PseudoLDRSH _ -> true
+    | _ -> false
+
   method write_xml (_node: xml_element_int) = ()
 
   method toCHIF (_faddr: doubleword_int) = []
@@ -191,6 +206,32 @@ let make_bx_call_aggregate
     ~anchor:bxinstr
 
 
+let make_pseudo_ldrsh_aggregate
+      (ldrhinstr: arm_assembly_instruction_int)
+      (lslinstr: arm_assembly_instruction_int)
+      (asrinstr: arm_assembly_instruction_int): arm_instruction_aggregate_int =
+  let kind = PseudoLDRSH (ldrhinstr, lslinstr, asrinstr) in
+  make_arm_instruction_aggregate
+    ~kind
+    ~instrs:[ldrhinstr; lslinstr; asrinstr]
+    ~entry:ldrhinstr
+    ~exitinstr:asrinstr
+    ~anchor:asrinstr
+
+
+let make_pseudo_ldrsb_aggregate
+      (ldrbinstr: arm_assembly_instruction_int)
+      (lslinstr: arm_assembly_instruction_int)
+      (asrinstr: arm_assembly_instruction_int): arm_instruction_aggregate_int =
+  let kind = PseudoLDRSB (ldrbinstr, lslinstr, asrinstr) in
+  make_arm_instruction_aggregate
+    ~kind
+    ~instrs:[ldrbinstr; lslinstr; asrinstr]
+    ~entry:ldrbinstr
+    ~exitinstr:asrinstr
+    ~anchor:asrinstr
+
+
 let disassemble_arm_instructions
       (ch: pushback_stream_int) (iaddr: doubleword_int) (n: int) =
   for _i = 1 to n do
@@ -296,30 +337,153 @@ let identify_bx_call
   | _ -> None
 
 
+(* format of pseudo LDRSH (in ARM)
+
+   An LDRH combined with LSL 16, ASR 16 converts into (effectively) an
+   LDRSH:
+
+   LDRH Rx, mem
+   LSL  Rx, Rx, #0x10
+   ASR  Rx, Rx, #0x10
+ *)
+let identify_pseudo_ldrsh
+      (ch: pushback_stream_int)
+      (instr: arm_assembly_instruction_int):
+      (arm_assembly_instruction_int
+       * arm_assembly_instruction_int
+       * arm_assembly_instruction_int) option =
+  let sixteen = CHNumerical.mkNumerical 16 in
+  match instr#get_opcode with
+  | ArithmeticShiftRight (_, ACCAlways, rd, rs, imm, _)
+       when imm#is_immediate
+            && imm#to_numerical#equal sixteen
+            && (rd#get_register = rs#get_register) ->
+     let addr = instr#get_address in
+     let lslinstr_r = get_arm_assembly_instruction (addr#add_int (-4)) in
+     let ldrhinstr_r = get_arm_assembly_instruction (addr#add_int (-8)) in
+     (match (TR.to_option lslinstr_r, TR.to_option ldrhinstr_r) with
+      | (Some lslinstr, Some ldrhinstr) ->
+         if
+           (match lslinstr#get_opcode with
+            | LogicalShiftLeft (_, ACCAlways, rd1, rs1, imm, _)
+                 when imm#is_immediate
+                      && imm#to_numerical#equal sixteen
+                      && (rd1#get_register = rd#get_register)
+                      && (rs1#get_register = rd#get_register) -> true
+            | _ -> false)
+           && (match ldrhinstr#get_opcode with
+               | LoadRegisterHalfword (ACCAlways, rd2, _, _, _, _)
+                    when rd2#get_register = rd#get_register -> true
+               | _ -> false)
+         then
+           Some (TR.tget_ok ldrhinstr_r, TR.tget_ok lslinstr_r, instr)
+         else
+           None
+      | _ -> None)
+  | _ -> None
+
+
+(* format of pseudo LDRSB (in ARM)
+
+   An LDRH combined with LSL 16, ASR 16 converts into (effectively) an
+   LDRSH:
+
+   LDRB Rx, mem
+   LSL  Rx, Rx, #0x18
+   ASR  Rx, Rx, #0x18
+ *)
+let identify_pseudo_ldrsb
+      (ch: pushback_stream_int)
+      (instr: arm_assembly_instruction_int):
+      (arm_assembly_instruction_int
+       * arm_assembly_instruction_int
+       * arm_assembly_instruction_int) option =
+  let twentyfour = CHNumerical.mkNumerical 24 in
+  match instr#get_opcode with
+  | ArithmeticShiftRight (_, ACCAlways, rd, rs, imm, _)
+       when imm#is_immediate
+            && imm#to_numerical#equal twentyfour
+            && (rd#get_register = rs#get_register) ->
+     let addr = instr#get_address in
+     let lslinstr_r = get_arm_assembly_instruction (addr#add_int (-4)) in
+     let ldrbinstr_r = get_arm_assembly_instruction (addr#add_int (-8)) in
+     (match (TR.to_option lslinstr_r, TR.to_option ldrbinstr_r) with
+      | (Some lslinstr, Some ldrbinstr) ->
+         if
+           (match lslinstr#get_opcode with
+            | LogicalShiftLeft (_, ACCAlways, rd1, rs1, imm, _)
+                 when imm#is_immediate
+                      && imm#to_numerical#equal twentyfour
+                      && (rd1#get_register = rd#get_register)
+                      && (rs1#get_register = rd#get_register) -> true
+            | _ -> false)
+           && (match ldrbinstr#get_opcode with
+               | LoadRegisterByte (ACCAlways, rd2, _, _, _, _)
+                    when rd2#get_register = rd#get_register -> true
+               | _ -> false)
+         then
+           Some (TR.tget_ok ldrbinstr_r, TR.tget_ok lslinstr_r, instr)
+         else
+           None
+      | _ -> None)
+  | _ -> None
+
+
+
 let identify_arm_aggregate
       (ch: pushback_stream_int)
       (instr: arm_assembly_instruction_int):
       arm_instruction_aggregate_int option =
-  match identify_jumptable ch instr with
-  | Some (instrs, jt) ->
-     let anchor = List.nth instrs ((List.length instrs) - 1) in
-     let entry = List.hd instrs in
-     let exitinstr = anchor in
-     Some (make_arm_jumptable_aggregate ~jt ~instrs ~entry ~exitinstr ~anchor)
-  | _ ->
-     match identify_it_sequence ch instr with
-     | Some its ->
-        let instrs = its#instrs in
-        let entry = List.hd instrs in
-        let exitinstr = List.hd (List.rev instrs) in
-        Some (make_it_sequence_aggregate
-                ~its ~instrs ~entry ~exitinstr ~anchor:entry)
-     | _ ->
-        match identify_ldmstm_sequence ch instr with
-        | Some ldmstmseq ->
-           Some (make_ldm_stm_sequence_aggregate ldmstmseq)
-        | _ ->
-           match identify_bx_call ch instr with
-           | Some (movinstr, bxinstr) ->
-              Some (make_bx_call_aggregate movinstr bxinstr)
-           | _ -> None
+  let result =
+    match identify_jumptable ch instr with
+    | Some (instrs, jt) ->
+       let anchor = List.nth instrs ((List.length instrs) - 1) in
+       let entry = List.hd instrs in
+       let exitinstr = anchor in
+       Some (make_arm_jumptable_aggregate ~jt ~instrs ~entry ~exitinstr ~anchor)
+    | _ -> None in
+  let result =
+    match result with
+    | Some _ -> result
+    | _ ->
+       match identify_it_sequence ch instr with
+       | Some its ->
+          let instrs = its#instrs in
+          let entry = List.hd instrs in
+          let exitinstr = List.hd (List.rev instrs) in
+          Some (make_it_sequence_aggregate
+                  ~its ~instrs ~entry ~exitinstr ~anchor:entry)
+       | _ -> None in
+  let result =
+    match result with
+    | Some _ -> result
+    | _ ->
+       match identify_ldmstm_sequence ch instr with
+       | Some ldmstmseq ->
+          Some (make_ldm_stm_sequence_aggregate ldmstmseq)
+       | _ -> None in
+  let result =
+    match result with
+    | Some _ -> result
+    | _ ->
+       match identify_bx_call ch instr with
+       | Some (movinstr, bxinstr) ->
+          Some (make_bx_call_aggregate movinstr bxinstr)
+       | _ -> None in
+  let result =
+    match result with
+    | Some _ -> result
+    | _ ->
+       match identify_pseudo_ldrsh ch instr with
+       | Some (ldrhinstr, lslinstr, asrinstr) ->
+          Some (make_pseudo_ldrsh_aggregate ldrhinstr lslinstr asrinstr)
+       | _ -> None in
+  let result =
+    match result with
+    | Some _ -> result
+    | _ ->
+       match identify_pseudo_ldrsb ch instr with
+       | Some (ldrbinstr, lslinstr, asrinstr) ->
+          Some (make_pseudo_ldrsb_aggregate ldrbinstr lslinstr asrinstr)
+       | _ -> None in
+  result
diff --git a/CodeHawk/CHB/bchlibarm32/bCHARMTypes.mli b/CodeHawk/CHB/bchlibarm32/bCHARMTypes.mli
@@ -1523,6 +1523,14 @@ type arm_aggregate_kind_t =
   | ARMJumptable of arm_jumptable_int
   | ThumbITSequence of thumb_it_sequence_int
   | LDMSTMSequence of ldm_stm_sequence_int
+  | PseudoLDRSH of
+      arm_assembly_instruction_int
+      * arm_assembly_instruction_int
+      * arm_assembly_instruction_int
+  | PseudoLDRSB of
+      arm_assembly_instruction_int
+      * arm_assembly_instruction_int
+      * arm_assembly_instruction_int
   | BXCall of arm_assembly_instruction_int * arm_assembly_instruction_int
 
 
@@ -1546,6 +1554,8 @@ class type arm_instruction_aggregate_int =
     method is_it_sequence: bool
     method is_ldm_stm_sequence: bool
     method is_bx_call: bool
+    method is_pseudo_ldrsh: bool
+    method is_pseudo_ldrsb: bool
 
     (* i/o *)
     method write_xml: xml_element_int -> unit
diff --git a/CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml b/CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml
@@ -643,6 +643,7 @@ object (self)
              ~useshigh:[get_def_use_high vrd]
              () in
          let (tags, args) = add_optional_instr_condition tagstring args c in
+         let tags = add_optional_subsumption tags in
          (tags, args)
 
       | BitFieldClear (c, rd, _, _, _) ->
@@ -1310,6 +1311,11 @@ object (self)
                addr_r
            else
              (tags, args) in
+         let tags =
+           match instr#is_in_aggregate with
+           | Some dw when (get_aggregate dw)#is_pseudo_ldrsb ->
+              add_subsumption_dependents (get_aggregate dw) tags
+           | _ -> tags in
          (tags, args)
 
       | LoadRegisterDual (c, rt, rt2, rn, rm, mem, mem2) ->
@@ -1426,6 +1432,11 @@ object (self)
                addr_r
            else
              (tags, args) in
+         let tags =
+           match instr#is_in_aggregate with
+           | Some dw when (get_aggregate dw)#is_pseudo_ldrsh ->
+              add_subsumption_dependents (get_aggregate dw) tags
+           | _ -> tags in
          (tags, args)
 
       | LoadRegisterSignedByte (c, rt, rn, rm, mem, _) ->
diff --git a/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml b/CodeHawk/CHB/bchlibarm32/bCHTranslateARMToCHIF.ml
@@ -899,6 +899,14 @@ let translate_arm_instruction
       | ACCAlways -> default cmds
       | _ -> make_conditional_commands c cmds)
 
+  | ArithmeticShiftRight _
+       when (match instr#is_in_aggregate with
+             | Some dw ->
+                let agg = get_aggregate dw in
+                agg#is_pseudo_ldrsh || agg#is_pseudo_ldrsb
+             | _ -> false) ->
+     default []
+
   | ArithmeticShiftRight(_, c, rd, rn, rm, _) ->
      let floc = get_floc loc in
      let rdreg = rd#to_register in
@@ -1890,6 +1898,14 @@ let translate_arm_instruction
       | ACCAlways -> default cmds
       | _ -> make_conditional_commands c cmds)
 
+  | LogicalShiftLeft _
+       when (match instr#is_in_aggregate with
+             | Some dw ->
+                let agg = get_aggregate dw in
+                agg#is_pseudo_ldrsh || agg#is_pseudo_ldrsb
+             | _ -> false) ->
+     default []
+
   | LogicalShiftLeft (_, c, rd, rn, rm, _) when rm#is_small_immediate ->
      let floc = get_floc loc in
      let vrd = rd#to_register in
