CHB:ARM: add aggregate for BX indirect call

Author: sipma

CodeHawk/CHB/bchlibarm32/bCHARMInstructionAggregate.ml

@@ -56,6 +56,7 @@ let arm_aggregate_kind_to_string (k: arm_aggregate_kind_t) =
      ^ " target addresses"
   | ThumbITSequence it -> it#toString
   | LDMSTMSequence s -> s#toString
+  | BXCall (_, i2) -> "BXCall at " ^ i2#get_address#to_hex_string
 
 
 class arm_instruction_aggregate_t
@@ -109,6 +110,11 @@ object (self)
     | LDMSTMSequence _ -> true
     | _ -> false
 
+  method is_bx_call =
+    match self#kind with
+    | BXCall _ -> true
+    | _ -> false
+
   method write_xml (_node: xml_element_int) = ()
 
   method toCHIF (_faddr: doubleword_int) = []
@@ -173,6 +179,18 @@ let make_ldm_stm_sequence_aggregate
     ~anchor:(List.hd (List.tl ldmstmseq#instrs))
 
 
+let make_bx_call_aggregate
+      (movinstr: arm_assembly_instruction_int)
+      (bxinstr: arm_assembly_instruction_int): arm_instruction_aggregate_int =
+  let kind = BXCall (movinstr, bxinstr) in
+  make_arm_instruction_aggregate
+    ~kind
+    ~instrs:[movinstr; bxinstr]
+    ~entry:movinstr
+    ~exitinstr:bxinstr
+    ~anchor:bxinstr
+
+
 let disassemble_arm_instructions
       (ch: pushback_stream_int) (iaddr: doubleword_int) (n: int) =
   for _i = 1 to n do
@@ -232,6 +250,52 @@ let identify_ldmstm_sequence
   | _ -> None
 
 
+(* format of BX-Call (in ARM)
+
+   An indirect jump combined with a MOV of the PC into the LR converts
+   into an indirect call (because PC holds the instruction-address + 8)
+
+   MOV LR, PC
+   BX Rx
+ *)
+let identify_bx_call
+      (ch: pushback_stream_int)
+      (instr: arm_assembly_instruction_int):
+      (arm_assembly_instruction_int * arm_assembly_instruction_int) option =
+  let disassemble (iaddr: doubleword_int) =
+    let instrpos = ch#pos in
+    let bytes = ch#read_doubleword in
+    let opcode =
+      try
+        disassemble_arm_instruction ch iaddr bytes
+      with
+      | _ ->
+         let _ =
+           chlog#add
+             "bx-call disassemble-instruction"
+             (LBLOCK [iaddr#toPretty]) in
+         OpInvalid in
+    let instrbytes = ch#sub instrpos 4 in
+    let instr = make_arm_assembly_instruction iaddr true opcode instrbytes in
+    begin
+      set_arm_assembly_instruction instr;
+      instr
+    end in
+  match instr#get_opcode with
+  | Move (_, ACCAlways, dst, src, _, _)
+       when src#is_register
+            && dst#get_register = ARLR
+            && src#get_register = ARPC ->
+     begin
+       let bxinstr = disassemble (instr#get_address#add_int 4) in
+       match bxinstr#get_opcode with
+       | BranchExchange (ACCAlways, op) when op#is_register ->
+          Some (instr, bxinstr)
+       | _ -> None
+     end
+  | _ -> None
+
+
 let identify_arm_aggregate
       (ch: pushback_stream_int)
       (instr: arm_assembly_instruction_int):
@@ -254,4 +318,8 @@ let identify_arm_aggregate
         match identify_ldmstm_sequence ch instr with
         | Some ldmstmseq ->
            Some (make_ldm_stm_sequence_aggregate ldmstmseq)
-        | _ -> None
+        | _ ->
+           match identify_bx_call ch instr with
+           | Some (movinstr, bxinstr) ->
+              Some (make_bx_call_aggregate movinstr bxinstr)
+           | _ -> None

CodeHawk/CHB/bchlibarm32/bCHARMTypes.mli

@@ -1523,6 +1523,7 @@ type arm_aggregate_kind_t =
   | ARMJumptable of arm_jumptable_int
   | ThumbITSequence of thumb_it_sequence_int
   | LDMSTMSequence of ldm_stm_sequence_int
+  | BXCall of arm_assembly_instruction_int * arm_assembly_instruction_int
 
 
 class type arm_instruction_aggregate_int =
@@ -1544,6 +1545,7 @@ class type arm_instruction_aggregate_int =
     method is_jumptable: bool
     method is_it_sequence: bool
     method is_ldm_stm_sequence: bool
+    method is_bx_call: bool
 
     (* i/o *)
     method write_xml: xml_element_int -> unit

CodeHawk/CHB/bchlibarm32/bCHConstructARMFunction.ml

@@ -256,7 +256,8 @@ let get_successors
                    else
                      let floc = get_floc_by_address faddr instr#get_address in
                      begin
-                       floc#f#set_unknown_jumptarget instr#get_address#to_hexstring;
+                       floc#f#set_unknown_jumptarget
+                         instr#get_address#to_hex_string;
                        []
                      end)
                  []

CodeHawk/CHB/bchlibarm32/bCHDisassembleARM.ml

@@ -719,7 +719,8 @@ let set_block_boundaries () =
           | Branch _ | BranchExchange _ ->
              (* Don't break up TBB/TBH and other jumptable sequences *)
              (match instr#is_in_aggregate with
-              | Some dw -> not (get_aggregate dw)#is_jumptable
+              | Some dw when (get_aggregate dw)#is_jumptable -> false
+              | Some dw when (get_aggregate dw)#is_bx_call -> false
               | _ -> true)
           | CompareBranchZero _ | CompareBranchNonzero _ -> true
           | LoadRegister (_, dst, _, _, _, _)

CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml

@@ -403,6 +403,20 @@ object (self)
               agginstr#get_address#to_hex_string :: acc) [] agg#instrs in
       tags @ ("subsumes" :: deps) in
 
+    let add_bx_call_defs
+          ?(xprs: xpr_t list = [])
+          ?(rdefs: int list = [])
+          (tags: string list)
+          (args: int list): (string list * int list) =
+      let tagstring = List.hd tags in
+      let xprcount = List.length xprs in
+      let rdefcount = List.length rdefs in
+      let tagstring = tagstring ^ (string_repeat "x" xprcount) in
+      let tagstring = tagstring ^ (string_repeat "r" rdefcount) in
+      let args = args @ (List.map xd#index_xpr xprs) @ rdefs in
+      let tags = (tagstring :: (List.tl tags)) @ ["bx-call"] in
+      (tags, args) in
+
     let register_function_prototype (name: string) =
       if function_summary_library#has_so_function name then
         let fs = function_summary_library#get_so_function name in
@@ -844,7 +858,7 @@ object (self)
          let tags = add_optional_subsumption [tagstring] in
          (tags, args)
 
-      | BranchExchange _ when instr#is_aggregate_anchor ->
+      | BranchExchange (_, tgt) when instr#is_aggregate_anchor ->
          let iaddr = instr#get_address in
          let agg = (!arm_assembly_instructions)#get_aggregate iaddr in
          if agg#is_jumptable then
@@ -861,6 +875,18 @@ object (self)
            let tags = tagstring :: ["agg-jt"] in
            let tags = add_subsumption_dependents agg tags in
            (tags, args)
+         else if agg#is_bx_call then
+           let (tags, args) = callinstr_key() in
+           let xtgt = tgt#to_expr floc in
+           let xxtgt = rewrite_expr xtgt in
+           let rdefs = (get_rdef xtgt) :: (get_all_rdefs xxtgt) in
+           let (tags, args) =
+             add_bx_call_defs ~xprs:[xtgt; xxtgt] ~rdefs tags args in
+           (* let (tagstring, args) =
+             mk_instrx_data ~xprs:[xtgt; xxtgt] ~rdefs () in
+           let tags = tagstring :: ["agg-bxcall"] in *)
+           let tags = add_subsumption_dependents agg tags in
+           (tags, args)
          else
            raise
              (BCH_failure