provides the new liveness analysis (#1446)

* provides the new liveness analysis

The new liveness analysis works with functions in the SSA and non-SSA
form and provides the extended interface that gives an easy access to
live-ins, liveouts, live and dead blocks.

The phi-nodes semantics is clearly specified and the `Blk.free_vars`
function is updated to be in line with the semantics of the SSA
nodes. The printing function of the phi-nodes is also updated. To
reflect that the phi-node is not an assignment but a selection, we use
the `<-` symbol instead of `:=` to separate the asignment operand from
the right-hand side.

* refines the definition of live-out

Author: ivg

lib/bap/bap.mli

@@ -7682,7 +7682,6 @@ module Std : sig
       val is_barrier : jump -> bool
     end
 
-
     (** A set of subroutines.
 
         A partition of a whole program control-flow graph into a
@@ -8040,6 +8039,151 @@ module Std : sig
     include Regular.S with type t := t
   end
 
+  (** Live Variables.
+
+      Computes the set of live variables for each block in a
+      subroutine, taking into account subroutine arguments.
+
+      A variable [v] is {i live} at a program point [x] if there exists a
+      path from [x] to a use of [v] that doesn't go through a
+      definition of [v].
+
+      This module computes liveness on the block granularity, which
+      gives rise to the following notions.
+
+      A variable is {i live-in} at a basic block [x] if it is live at the
+      begining of the block [x].
+
+      A variable is {i live-out} at a basic block [x] if it is live on
+      any of the outcoming edges of [x].
+
+      A variable is {i live-through} at a basic block [x] if it is
+      both live-in and live-out at it.
+
+      {3 Liveness in the SSA form}
+
+      The algorithm works with the SSA form. From the perspective of
+      liveness, the phi-nodes define their right-hand sides on the
+      edges incoming from the corresponding blocks. More formally, for
+      a phi-node at block [b0], [x0 := phi([b1,x1; b2,x2;...;bN,xN])],
+      the defined variable [x0] is considered to be defined at blocks
+      [bi] and the variable [xi] live-out of basic block [bi], for
+      [0 < i <= N].
+
+      Intuitively, this can be visualized as if the following program,
+
+      {v
+
+        b1:
+        x.1 := 1
+        goto b3
+
+        b2:
+        x.2 := 2
+        goto b3
+
+        b3:
+        x.3 <- phi([b1,x1]; [b2, x2])
+        ...
+      v}
+
+      is rewritten to an equivalent (but not in SSA) program,
+
+      {v
+
+        b1:
+        x.1 := 1
+        x.3 := x1
+        goto b3
+
+        b2:
+        x.2 := 2
+        x.3 := x2
+        goto b3
+
+        b3:
+        ...
+      v}
+
+      That means that a variable defined by a phi-node in a block [x]
+      could be live-in at the block [x].
+
+      The {!Live.defs} and {!Live.uses} includes the variables from
+      the corresponding phi-nodes, e.g., [Live.defs b1] will is
+      [{x1,x3}] and [Live.uses b1] is [{x1}].
+
+      @since 2.5.0
+      @before 2.5.0 see {!Sub.compute_liveness}  *)
+  module Live : sig
+    type t
+
+    (** [compute sub] computes the subroutine liveness information.
+
+        Variables specified by [keep] will be kept live at the exit
+        from the function. In addition to the variables in [keep],
+        all free variables used by in and in/out arguments of the
+        subroutine will be kept alive at the exit.*)
+    val compute : ?keep:Var.Set.t -> sub term -> t
+
+    (** [vars live] the variables that are live in the subroutine.
+
+        The set of variables that are live-in on the entry block of
+        the subroutine that was used to compute [live]. The live
+        variables of the subroutine also called free variables or
+        upper-exposed variables. They may be used in the subroutine
+        before they are assigned. *)
+    val vars : t -> Var.Set.t
+
+    (** [ins live blk] the set of live-in variables at [blk].
+
+        The set of variables that are live at the entry to the basic
+        block [blk].
+
+        Returns an empty set if [blk] doesn't belong to the [sub] graph.
+    *)
+    val ins : t -> tid -> Var.Set.t
+
+    (** [outs live blk] the set of live-outs variables at [blk].
+
+        The set of variables that are live at the exist from the basic
+        block [blk].
+
+        Returns an empty set if [blk] doesn't belong to the [sub] graph.*)
+    val outs : t -> tid -> Var.Set.t
+
+    (** [blks live var] the set of blks where [var] is live-in. *)
+    val blks : t -> var -> Set.M(Tid).t
+
+    (** [defs live blk] the set of variables defined by [blk].
+
+        Aka the {i KILL} set, i.e., the set of variables whose
+        liveness is killed in the block [blk].    *)
+    val defs : t -> tid -> Var.Set.t
+
+    (** [uses live blk] the set of variables used by [blk].
+
+        Aka the {i GEN} set, i.e., the set of variables generated by
+        the block [blk].    *)
+    val uses : t -> tid -> Var.Set.t
+
+    (** [fold live ~init ~f] folds over live-ins of blocks.
+
+        Applies [f] to live-in set of variables of each block of the
+        subroutine.
+
+        Note, pseudo start and exit nodes are not folded over. *)
+    val fold : t -> init:'a -> f:('a -> tid -> Var.Set.t -> 'a) -> 'a
+
+    (** [solution live] returns the fixed point solution.
+
+        The solution is the mapping from blocks to their live-outs.*)
+    val solution : t -> (tid, Var.Set.t) Solution.t
+
+
+    (** [pp ppf live] prints the live-in sets of each basic block.  *)
+    val pp : Format.formatter -> t -> unit
+  end
+
   (** IR language term.
 
       Term is a building block of the
@@ -8530,22 +8674,17 @@ module Std : sig
         [Graphs.Tid.start] node.
 
         When the subroutine is in the SSA form then the phi-nodes have
-        the following semantics. For a phi-node at block [b0],
-        [x0 := phi([b1,x1; b2,x2;...;bN,xN])], the defined variable
-        [x0] is considered to be at the entry of [b0], i.e., [x0] is
-        live-in of [b0], and the variable [xi] is live-out of basic
-        block [bi], for [i > 0].
+        the following semantics.
 
         Informally, a phi-node defines the values on the corresponding
         edges of the predecessors.
 
-
         @since 2.1
         @since 2.5.0 supports SSA
         @before 2.5.0 the subroutine must not be in the SSA form
     *)
     val compute_liveness : t -> (tid, Var.Set.t) Solution.t
-
+    [@@deprecated "[since 2022-03] use Live.compute"]
 
     (** [flatten sub] returns [sub] in flattened form in which all
         operands are trivial.

lib/bap_sema/bap_sema.ml

@@ -41,6 +41,7 @@ module Std = struct
     let flatten = Flatten.flatten_sub
   end
 
+  module Live = FV.Live
   module Taint = Bap_sema_taint
 
   module Graphs = struct

lib/bap_sema/bap_sema_free_vars.ml

@@ -7,64 +7,123 @@ module Ssa = Bap_sema_ssa
 module G = Bap_tid_graph
 
 let (++) = Set.union and (--) = Set.diff
-let blk = G.Node.label
 
 let ssa_free_vars sub =
   let is_undefined v = Var.index v = 0 in
   Term.enum blk_t sub |> Seq.fold ~init:Var.Set.empty ~f:(fun vars blk ->
       vars ++ Set.filter (Ir_blk.free_vars blk) ~f:is_undefined)
 
-let defined_by_blk b =
-  Ir_blk.elts b |> Seq.fold ~init:Var.Set.empty ~f:(fun kill -> function
-      | `Phi phi -> Set.add kill @@ Ir_phi.lhs phi
-      | `Def def -> Set.add kill @@ Ir_def.lhs def
-      | `Jmp _ -> kill)
-
-type blk_transfer = {
-  defs : Var.Set.t;
-  uses : Var.Set.t;
-}
-
-let blk_defs blk =
-  Term.enum def_t blk |>
-  Seq.fold ~init:Var.Set.empty  ~f:(fun defs def ->
-      Set.add defs (Ir_def.lhs def))
-
-let update blk defs uses trans = Map.update trans blk ~f:(function
-    | None -> {defs; uses}
-    | Some had -> {
-        defs = Set.union had.defs defs;
-        uses = Set.union had.uses uses
-      })
-
-let block_transitions sub =
-  Term.enum blk_t sub |>
-  Seq.fold ~init:Tid.Map.empty ~f:(fun fs blk ->
-      let init = update
-          (Term.tid blk)
-          (blk_defs blk)
-          (Ir_blk.free_vars blk) fs in
-      Term.enum phi_t blk |>
-      Seq.fold ~init ~f:(fun init phi ->
-          let defs = Var.Set.singleton @@ Ir_phi.lhs phi in
-          Ir_phi.values phi |>
-          Seq.fold ~init ~f:(fun fs (src,exp) ->
-              update src defs (Exp.free_vars exp) fs)))
+module Live = struct
+  type tran = {
+    defs : Var.Set.t;
+    uses : Var.Set.t;
+  }
+
+  type t = {
+    blks : tran Tid.Map.t;
+    outs : (tid, Var.Set.t) Solution.t
+  }
+
+  let pp_vars ppf vars =
+    Format.pp_print_list
+      ~pp_sep:Format.pp_print_space
+      Var.pp
+      ppf (Set.to_list vars)
+
+  let pp_transfer ppf {uses; defs} =
+    Format.fprintf ppf "(%a) / (%a)"
+      pp_vars uses pp_vars defs
+
+  let blk_defs blk =
+    Term.enum def_t blk |>
+    Seq.fold ~init:Var.Set.empty  ~f:(fun defs def ->
+        Set.add defs (Ir_def.lhs def))
+
+  let update blk trans ~f = Map.update trans blk ~f:(function
+      | None -> f {defs=Var.Set.empty; uses=Var.Set.empty}
+      | Some had -> f had)
+
+  let block_transitions sub =
+    Term.enum blk_t sub |>
+    Seq.fold ~init:Tid.Map.empty ~f:(fun fs blk ->
+        Map.add_exn fs (Term.tid blk) {
+          defs = blk_defs blk;
+          uses = Ir_blk.free_vars blk;
+        }) |> fun trans ->
+    Term.enum blk_t sub |>
+    Seq.fold ~init:trans ~f:(fun init blk ->
+        Term.enum phi_t blk |>
+        Seq.fold ~init ~f:(fun init phi ->
+            Ir_phi.values phi |>
+            Seq.fold ~init ~f:(fun fs (src,exp) ->
+                update src fs ~f:(fun {defs; uses} -> {
+                      defs = Set.add defs (Ir_phi.lhs phi);
+                      uses = uses ++ (Exp.free_vars exp -- defs)
+                    }))))
+
+  let lookup blks n = match Map.find blks n with
+    | None -> {defs = Var.Set.empty; uses = Var.Set.empty}
+    | Some t -> t
+
+  let is_pseudo n = Tid.equal n G.exit || Tid.equal n G.start
+  let apply {defs;uses} vars = vars -- defs ++ uses
+  let transfer blks n vars =
+    if is_pseudo n then vars
+    else apply (lookup blks n) vars
+
+  let initialize ?(init=Var.Set.empty) sub =
+    Tid.Map.singleton G.exit @@
+    Seq.fold (Term.enum arg_t sub) ~init ~f:(fun vars arg ->
+        match Ir_arg.intent arg with
+        | None | Some In -> vars
+        | Some (Out | Both) ->
+          vars ++ Exp.free_vars (Ir_arg.rhs arg))
+
+  let compute ?keep:init sub =
+    let g = G.create sub in
+    let init = Solution.create (initialize ?init sub) Var.Set.empty in
+    let blks = block_transitions sub in {
+      blks;
+      outs = Graphlib.fixpoint (module G) ~init ~start:G.exit ~rev:true g
+          ~merge:Set.union
+          ~equal:Var.Set.equal
+          ~f:(transfer blks)
+    }
+
+  let outs {outs} blk = Solution.get outs blk
+  let ins {outs; blks} blk =
+    transfer blks blk (Solution.get outs blk)
+
+  let defs {blks} blk = (lookup blks blk).defs
+  let uses {blks} blk = (lookup blks blk).uses
+
+  let fold live ~init ~f =
+    Map.fold live.blks ~init ~f:(fun ~key:blk ~data:trans init ->
+        let outs = Solution.get live.outs blk in
+        f init blk (apply trans outs))
+
+  let blks live var =
+    fold live ~init:Tid.Set.empty ~f:(fun blks blk ins ->
+        if Set.mem ins var
+        then Set.add blks blk
+        else blks)
+
+  let vars live = outs live G.start
+
+  let solution {outs=x} = x
+
+  let pp ppf live =
+    Format.pp_open_vbox ppf 0;
+    fold live ~init:() ~f:(fun () blk live ->
+        Format.fprintf ppf "@[<h>%a: @[<hov 2>(%a)@]@]@;"
+          Tid.pp blk pp_vars live);
+    Format.pp_close_box ppf ()
+end
 
 let compute_liveness sub =
-  let g = G.create sub in
-  let init = Solution.create Tid.Map.empty Var.Set.empty in
-  let tran = block_transitions sub in
-  Graphlib.fixpoint (module G) ~init ~start:G.exit ~rev:true g
-    ~merge:Set.union
-    ~equal:Var.Set.equal
-    ~f:(fun n vars ->
-        if Tid.equal n G.exit || Tid.equal n G.start  then vars
-        else
-          let {defs; uses} = Map.find_exn tran n in
-          vars -- defs ++ uses)
+  Live.(solution@@compute sub)
 
 let free_vars_of_sub sub  =
   if Ssa.is_transformed sub
   then ssa_free_vars sub
-  else Solution.get (compute_liveness sub) G.start
+  else Live.(vars@@compute sub)

lib/bap_sema/bap_sema_free_vars.mli

@@ -2,5 +2,19 @@ open Bap_types.Std
 open Graphlib.Std
 open Bap_ir
 
+module Live : sig
+  type t
+  val compute : ?keep:Var.Set.t -> sub term -> t
+  val ins : t -> tid -> Var.Set.t
+  val vars : t -> Var.Set.t
+  val outs : t -> tid -> Var.Set.t
+  val defs : t -> tid -> Var.Set.t
+  val uses : t -> tid -> Var.Set.t
+  val fold : t -> init:'a -> f:('a -> tid -> Var.Set.t -> 'a) -> 'a
+  val blks : t -> var -> Tid.Set.t
+  val solution : t -> (tid, Var.Set.t) Solution.t
+  val pp : Format.formatter -> t -> unit
+end
+
 val compute_liveness : sub term -> (tid, Var.Set.t) Solution.t
 val free_vars_of_sub : sub term -> Var.Set.t