Improve MHP precision using ancestor locksets

src/analyses/creationLockset.ml

@@ -0,0 +1,163 @@
+(** creation lockset analysis [creationLockset]
+    constructs edges on the graph over all threads, where the edges are labelled with must-locksets:
+    (t_1) ---L--> (t_0) means that t_1 is protected by all members of L from t_0
+
+    @see https://github.com/goblint/analyzer/pull/1865
+*)
+
+open Analyses
+module TID = ThreadIdDomain.Thread
+module TIDs = ConcDomain.ThreadSet
+module LID = LockDomain.MustLock
+module LIDs = LockDomain.MustLockset
+
+module Spec = struct
+  include IdentityUnitContextsSpec
+  module D = Lattice.Unit
+
+  module V = struct
+    include TID
+    include StdV
+  end
+
+  module G = MapDomain.MapBot (TID) (LIDs)
+
+  let name () = "creationLockset"
+  let startstate _ = D.bot ()
+  let exitstate _ = D.bot ()
+
+  (** register a global contribution: global.[child_tid] \supseteq [to_contribute]
+      @param man man at program point
+      @param to_contribute new edges from [child_tid] to ego thread to register
+      @param child_tid
+  *)
+  let contribute_locks man to_contribute child_tid = man.sideg child_tid to_contribute
+
+  (** reflexive-transitive closure of child relation applied to [tid]
+      and filtered to only include threads, where [tid] is a must-ancestor
+      @param ask any ask
+      @param tid
+  *)
+  let unique_descendants_closure (ask : Queries.ask) tid =
+    let descendants = ask.f @@ Queries.DescendantThreads tid in
+    let unique_descendants = TIDs.filter (TID.must_be_ancestor tid) descendants in
+    TIDs.add tid unique_descendants
+
+  let threadspawn man ~multiple lval f args fman =
+    let ask = ask_of_man man in
+    let tid_lifted = ask.f Queries.CurrentThreadId in
+    let child_ask = ask_of_man fman in
+    let child_tid_lifted = child_ask.f Queries.CurrentThreadId in
+    match tid_lifted, child_tid_lifted with
+    | `Lifted tid, `Lifted child_tid when TID.must_be_ancestor tid child_tid ->
+      let unique_descendants = unique_descendants_closure child_ask child_tid in
+      let lockset = ask.f Queries.MustLockset in
+      let to_contribute = G.singleton tid lockset in
+      TIDs.iter (contribute_locks man to_contribute) unique_descendants
+    | _ -> ()
+
+  (** compute all descendant threads that may run along with the ego thread at a program point.
+      for all of them, tid must be an ancestor
+      @param tid ego thread id
+      @param ask ask of ego thread at the program point
+  *)
+  let get_unique_running_descendants tid (ask : Queries.ask) =
+    let may_created_tids = ask.f Queries.CreatedThreads in
+    let may_unique_created_tids =
+      TIDs.filter (TID.must_be_ancestor tid) may_created_tids
+    in
+    let may_transitively_created_tids =
+      TIDs.fold
+        (fun child_tid acc -> TIDs.union acc (unique_descendants_closure ask child_tid))
+        may_unique_created_tids
+        (TIDs.empty ())
+    in
+    let must_joined_tids = ask.f Queries.MustJoinedThreads in
+    TIDs.diff may_transitively_created_tids must_joined_tids
+
+  (** handle unlock of mutex [lock] *)
+  let unlock man tid possibly_running_tids lock =
+    let shrink_locksets des_tid =
+      let old_creation_lockset = G.find tid (man.global des_tid) in
+      (* Bot - {something} = Bot. This is exactly what we want in this case! *)
+      let updated_creation_lockset = LIDs.remove lock old_creation_lockset in
+      let to_contribute = G.singleton tid updated_creation_lockset in
+      man.sideg des_tid to_contribute
+    in
+    TIDs.iter shrink_locksets possibly_running_tids
+
+  (** handle unlock of an unknown mutex. Assumes that any mutex could have been unlocked *)
+  let unknown_unlock man tid possibly_running_tids =
+    let evaporate_locksets des_tid =
+      let to_contribute = G.singleton tid (LIDs.empty ()) in
+      man.sideg des_tid to_contribute
+    in
+    TIDs.iter evaporate_locksets possibly_running_tids
+
+  let event man e _ =
+    match e with
+    | Events.Unlock addr ->
+      let ask = ask_of_man man in
+      let tid_lifted = ask.f Queries.CurrentThreadId in
+      (match tid_lifted with
+       | `Lifted tid ->
+         let possibly_running_tids = get_unique_running_descendants tid ask in
+         let lock_opt = LockDomain.MustLock.of_addr addr in
+         (match lock_opt with
+          | Some lock -> unlock man tid possibly_running_tids lock
+          | None -> unknown_unlock man tid possibly_running_tids)
+       | _ -> ())
+    | _ -> ()
+
+  module A = struct
+    (** ego tid * must-lockset * creation-lockset *)
+    include Printable.Prod3 (TID) (LIDs) (G)
+
+    let name () = "creationLockset"
+
+    (** checks if [cl1] has a member ([tp1] |-> [ls1]) and [cl2] has a member ([tp2] |-> [ls2])
+        such that [ls1] and [ls2] are not disjoint and [tp1] != [tp2]
+        @param cl1 creation-lockset of first thread [t1]
+        @param cl2 creation-lockset of second thread [t2]
+        @returns whether [t1] and [t2] must be running mutually exclusive
+    *)
+    let both_protected_inter_threaded cl1 cl2 =
+      let cl2_has_same_lock_other_tid tp1 ls1 =
+        G.exists (fun tp2 ls2 -> not (LIDs.disjoint ls1 ls2 || TID.equal tp1 tp2)) cl2
+      in
+      G.exists cl2_has_same_lock_other_tid cl1
+
+    (** checks if [cl1] has a mapping ([tp1] |-> [ls1])
+        such that [ls1] and [ls2] are not disjoint and [tp1] != [t2]
+        @param cl1 creation-lockset of thread [t1] at first program point
+        @param t2 thread id at second program point
+        @param ls2 lockset at second program point
+        @returns whether [t1] must be running mutually exclusive with second program point
+    *)
+    let one_protected_inter_threaded_other_intra_threaded cl1 t2 ls2 =
+      G.exists (fun tp1 ls1 -> not (LIDs.disjoint ls1 ls2 || TID.equal tp1 t2)) cl1
+
+    let may_race (t1, ls1, cl1) (t2, ls2, cl2) =
+      not
+        (both_protected_inter_threaded cl1 cl2
+         || one_protected_inter_threaded_other_intra_threaded cl1 t2 ls2
+         || one_protected_inter_threaded_other_intra_threaded cl2 t1 ls1)
+
+    let should_print (_t, _ls, cl) = not @@ G.is_empty cl
+  end
+
+  let access man _ =
+    let ask = ask_of_man man in
+    let tid_lifted = ask.f Queries.CurrentThreadId in
+    match tid_lifted with
+    | `Lifted tid ->
+      let lockset = ask.f Queries.MustLockset in
+      let creation_lockset = man.global tid in
+      tid, lockset, creation_lockset
+    | _ -> ThreadIdDomain.UnknownThread, LIDs.empty (), G.empty ()
+end
+
+let _ =
+  MCP.register_analysis
+    ~dep:[ "threadid"; "mutex"; "threadJoins"; "threadDescendants" ]
+    (module Spec : MCPSpec)

src/analyses/creationLocksetAlternative.ml

@@ -0,0 +1,210 @@
+(** alternative creation lockset analysis
+    @see https://github.com/goblint/analyzer/pull/1865
+*)
+
+open Analyses
+module TID = ThreadIdDomain.Thread
+module TIDs = ConcDomain.MustThreadSet
+module LID = LockDomain.MustLock
+module LIDs = LockDomain.MustLockset
+
+(** [creationLocksetAlternative]
+    collects parent threads, which could protect the ego thread and its descendants,
+    since the creation must happen with a lock held.
+*)
+module CreationLocksetAlternative = struct
+  include IdentityUnitContextsSpec
+  module D = Lattice.Unit
+
+  module V = struct
+    include TID
+    include StdV
+  end
+
+  module G = Queries.CLS
+
+  let name () = "creationLocksetAlternative"
+  let startstate _ = D.bot ()
+  let exitstate _ = D.bot ()
+
+  let threadspawn man ~multiple lval f args fman =
+    let ask = ask_of_man man in
+    let tid_lifted = ask.f Queries.CurrentThreadId in
+    let child_ask = ask_of_man fman in
+    let child_tid_lifted = child_ask.f Queries.CurrentThreadId in
+    match tid_lifted, child_tid_lifted with
+    | `Lifted tid, `Lifted child_tid when TID.must_be_ancestor tid child_tid ->
+      let lockset = ask.f Queries.MustLockset in
+      let to_contribute = G.singleton tid lockset in
+      man.sideg child_tid to_contribute
+    | _ -> ()
+
+  let query man (type a) (x : a Queries.t) : a Queries.result =
+    match x with
+    | Queries.CreationLocksetAlternative tid -> (man.global tid : G.t)
+    | _ -> Queries.Result.top x
+end
+
+(** [taintedCreationLocksetAlternative]
+    collects parent threads, which cannot protect the ego thread and its descendants,
+    since an unlock could happen before joining
+*)
+module TaintedCreationLocksetAlternative = struct
+  include IdentityUnitContextsSpec
+  module D = Lattice.Unit
+
+  module V = struct
+    include TID
+    include StdV
+  end
+
+  module LockToThreads = MapDomain.MapBot (LID) (TIDs)
+  module G = MapDomain.MapBot (TID) (LockToThreads)
+
+  let name () = "taintedCreationLocksetAlternative"
+  let startstate _ = D.bot ()
+  let exitstate _ = D.bot ()
+
+  let get_unique_created_children tid (ask : Queries.ask) =
+    let created_threads = ask.f Queries.CreatedThreads in
+    TIDs.filter (TID.must_be_ancestor tid) created_threads
+
+  (** handle unlock of mutex [lock] *)
+  let unlock man tid created_tids joined_tids lock =
+    let contribute_lock child_tid =
+      let to_contribute = G.singleton tid (LockToThreads.singleton lock joined_tids) in
+      man.sideg child_tid to_contribute
+    in
+    TIDs.iter contribute_lock created_tids
+
+  (** handle unlock of an unknown mutex. Assumes that any mutex could have been unlocked *)
+  let unknown_unlock man tid created_tids joined_tids =
+    let ask = ask_of_man man in
+    let contribute_all_locks child_tid =
+      let all_creation_locksets = ask.f @@ Queries.CreationLocksetAlternative child_tid in
+      let creation_lockset = CreationLocksetAlternative.G.find tid all_creation_locksets in
+      let to_contribute_value =
+        LIDs.fold
+          (fun lock acc ->
+             LockToThreads.join acc (LockToThreads.singleton lock joined_tids))
+          creation_lockset
+          (LockToThreads.empty ())
+      in
+      let to_contribute = G.singleton tid to_contribute_value in
+      man.sideg child_tid to_contribute
+    in
+    TIDs.iter contribute_all_locks created_tids
+
+  let event man e _ =
+    match e with
+    | Events.Unlock addr ->
+      let ask = ask_of_man man in
+      let tid_lifted = ask.f Queries.CurrentThreadId in
+      (match tid_lifted with
+       | `Lifted tid ->
+         let created_tids = get_unique_created_children tid ask in
+         let joined_tids = ask.f Queries.MustJoinedThreads in
+         let lock_opt = LockDomain.MustLock.of_addr addr in
+         (match lock_opt with
+          | Some lock -> unlock man tid created_tids joined_tids lock
+          | None -> unknown_unlock man tid created_tids joined_tids)
+       | _ -> ())
+    | _ -> ()
+
+  module A = struct
+    (** ego tid * must-lockset * creation-lockset *)
+    include Printable.Prod3 (TID) (LIDs) (Queries.CLS)
+
+    let name () = "creationLockset"
+
+    (** checks if [il1] has a member ([tp1] |-> [ls1]) and [il2] has a member ([tp2] |-> [ls2])
+        such that [ls1] and [ls2] are not disjoint and [tp1] != [tp2]
+        @param il1 creation-lockset of first thread [t1]
+        @param il2 creation-lockset of second thread [t2]
+        @returns whether [t1] and [t2] must be running mutually exclusive
+    *)
+    let both_protected_inter_threaded il1 il2 =
+      let cl2_has_same_lock_other_tid tp1 ls1 =
+        Queries.CLS.exists
+          (fun tp2 ls2 -> not (LIDs.disjoint ls1 ls2 || TID.equal tp1 tp2))
+          il2
+      in
+      Queries.CLS.exists cl2_has_same_lock_other_tid il1
+
+    (** checks if [il1] has a mapping ([tp1] |-> [ls1])
+        such that [ls1] and [ls2] are not disjoint and [tp1] != [t2]
+        @param il1 creation-lockset of thread [t1] at first program point
+        @param t2 thread id at second program point
+        @param ls2 lockset at second program point
+        @returns whether [t1] must be running mutually exclusive with second program point
+    *)
+    let one_protected_inter_threaded_other_intra_threaded il1 t2 ls2 =
+      Queries.CLS.exists
+        (fun tp1 ls1 -> not (LIDs.disjoint ls1 ls2 || TID.equal tp1 t2))
+        il1
+
+    let may_race (t1, ls1, il1) (t2, ls2, il2) =
+      not
+        (both_protected_inter_threaded il1 il2
+         || one_protected_inter_threaded_other_intra_threaded il1 t2 ls2
+         || one_protected_inter_threaded_other_intra_threaded il2 t1 ls1)
+
+    let should_print (_t, _ls, cl) = not @@ Queries.CLS.is_empty cl
+  end
+
+  let access man _ =
+    let ask = Analyses.ask_of_man man in
+    let tid_lifted = ask.f Queries.CurrentThreadId in
+    match tid_lifted with
+    | `Lifted td ->
+      let must_ancestors = TID.must_ancestors td in
+
+      let compute_cl_transitive () =
+        let cl_td = ask.f @@ Queries.CreationLocksetAlternative td in
+        List.fold_left
+          (fun acc t1 ->
+             Queries.CLS.join acc (ask.f @@ Queries.CreationLocksetAlternative t1))
+          cl_td
+          must_ancestors
+      in
+
+      let compute_tcl_transitive () =
+        let tcl_td = man.global td in
+        List.fold_left (fun acc t1 -> G.join acc (man.global t1)) tcl_td must_ancestors
+      in
+
+      let compute_tcl_lockset tcl_transitive t0 =
+        let tcl_transitive_t0 = G.find t0 tcl_transitive in
+        LockToThreads.fold
+          (fun l j acc -> if TIDs.mem td j then acc else LIDs.add l acc)
+          tcl_transitive_t0
+          (LIDs.empty ())
+      in
+
+      let compute_il cl_transitive tcl_transitive =
+        Queries.CLS.fold
+          (fun t0 l_cl acc ->
+             let l_tcl = compute_tcl_lockset tcl_transitive t0 in
+             let l_il = LIDs.diff l_cl l_tcl in
+             Queries.CLS.add t0 l_il acc)
+          cl_transitive
+          (Queries.CLS.empty ())
+      in
+
+      let lockset = ask.f Queries.MustLockset in
+      let cl_transitive = compute_cl_transitive () in
+      let tcl_transitive = compute_tcl_transitive () in
+      let il = compute_il cl_transitive tcl_transitive in
+      td, lockset, il
+    | _ -> ThreadIdDomain.UnknownThread, LIDs.empty (), Queries.CLS.empty ()
+end
+
+let _ =
+  MCP.register_analysis
+    ~dep:[ "threadid"; "mutex"; "threadJoins" ]
+    (module CreationLocksetAlternative : MCPSpec)
+
+let _ =
+  MCP.register_analysis
+    ~dep:[ "threadid"; "mutex"; "threadJoins"; "creationLocksetAlternative" ]
+    (module TaintedCreationLocksetAlternative : MCPSpec)