From 48cdbd358ec6d97314a0d4637934eb6f6524ad40 Mon Sep 17 00:00:00 2001
From: Ivan Gotovchits <ivg@ieee.org>
Date: Fri, 23 Aug 2019 16:35:31 -0400
Subject: [PATCH] fixes falls after conditional calls (#977)

Two cases were missed in #975, both about conditional calls, an extra
jump for the non-taken branch should be added if the call is conditional.
---
 lib/bap_sema/bap_sema_lift.ml | 58 +++++++++++++++++++++--------------
 1 file changed, 35 insertions(+), 23 deletions(-)

diff --git a/lib/bap_sema/bap_sema_lift.ml b/lib/bap_sema/bap_sema_lift.ml
index bd64980bb..2cd7c018b 100644
--- a/lib/bap_sema/bap_sema_lift.ml
+++ b/lib/bap_sema/bap_sema_lift.ml
@@ -123,17 +123,26 @@ module IrBuilder = struct
   let insert_inter_fall alt blk =
     Term.append jmp_t blk @@ Ir_jmp.reify ~alt ()
 
+  let is_conditional jmp = match Ir_jmp.cond jmp with
+    | Bil.Int _ ->  false
+    | _ -> true
+
   let is_last_jump_nonconditional blk =
     match Term.last jmp_t blk with
     | None -> false
-    | Some jmp -> match Ir_jmp.cond jmp with
-      | Bil.Int x -> Word.equal Word.b1 x
-      | _ -> false
+    | Some jmp -> not (is_conditional jmp)
 
-  let fall_if_possible blk fall =
+  let fall_if_possible dst blk =
     if is_last_jump_nonconditional blk
     then blk
-    else Term.append jmp_t blk fall
+    else
+      Term.append jmp_t blk @@
+      Ir_jmp.reify ~dst ()
+
+  let concat_map_fst_and_rev xs f =
+    List.rev @@ match xs with
+    | [] -> []
+    | x :: xs -> f x @ xs
 
   let blk ?symtab cfg block : blk term list =
     let tid = Tid.for_addr (Block.addr block) in
@@ -147,24 +156,27 @@ module IrBuilder = struct
     let is_call = Insn.(is call x) || has_explicit_call symtab block
     and is_barrier = Insn.(is barrier x) in
     with_first_blk_addressed (Block.addr block) @@
-    List.rev @@ match blks,fall with
-    | [],_ -> []
-    | blks,_ when is_barrier -> blks
-    | x::xs, Some dst ->
-      if is_call
-      then turn_into_call fall x :: xs
-      else fall_if_possible x (Ir_jmp.reify ~dst ()) :: xs
-    | x::xs, None -> match inter_fall symtab block with
-      | None ->
-        (if is_call then turn_into_call None x else x)::xs
-      | Some dst ->
-        if is_call then
-          let next = Ir_blk.create () in
-          let fall = Some (Ir_jmp.resolved (Term.tid next)) in
-          let next = insert_inter_fall dst next in
-          next :: turn_into_call fall x :: xs
-        else
-          insert_inter_fall dst x :: xs
+    concat_map_fst_and_rev blks @@ function
+    | x when is_barrier -> [x]
+    | x -> match fall with
+      | Some dst -> [
+          fall_if_possible dst @@
+          if is_call
+          then turn_into_call fall x
+          else x
+        ]
+      | None -> match inter_fall symtab block with
+        | None -> [if is_call then turn_into_call None x else x]
+        | Some dst ->
+          if is_call then
+            let next = Ir_blk.create () in
+            let fall = Ir_jmp.resolved (Term.tid next) in
+            let next = insert_inter_fall dst next in [
+              next;
+              fall_if_possible fall @@
+              turn_into_call (Some fall) x
+            ]
+          else [insert_inter_fall dst x]
 end
 
 let blk cfg block = IrBuilder.blk cfg block