|
|
@ -260,32 +260,63 @@ module ThreadsDomain = struct
|
|
|
|
match callee_astate with AnyThreadButSelf -> callee_astate | _ -> caller_astate
|
|
|
|
match callee_astate with AnyThreadButSelf -> callee_astate | _ -> caller_astate
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
module AccessSnapshot = struct
|
|
|
|
module OwnershipAbstractValue = struct
|
|
|
|
module OwnershipPrecondition = struct
|
|
|
|
type t = OwnedIf of IntSet.t | Unowned [@@deriving compare]
|
|
|
|
type t = Conjunction of IntSet.t | False [@@deriving compare]
|
|
|
|
|
|
|
|
|
|
|
|
let owned = OwnedIf IntSet.empty
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let is_owned = function OwnedIf set -> IntSet.is_empty set | _ -> false
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let unowned = Unowned
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let make_owned_if formal_index = OwnedIf (IntSet.singleton formal_index)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let leq ~lhs ~rhs =
|
|
|
|
|
|
|
|
phys_equal lhs rhs
|
|
|
|
|
|
|
|
||
|
|
|
|
|
|
|
|
match (lhs, rhs) with
|
|
|
|
|
|
|
|
| _, Unowned ->
|
|
|
|
|
|
|
|
true (* Unowned is top *)
|
|
|
|
|
|
|
|
| Unowned, _ ->
|
|
|
|
|
|
|
|
false
|
|
|
|
|
|
|
|
| OwnedIf s1, OwnedIf s2 ->
|
|
|
|
|
|
|
|
IntSet.subset s1 s2
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(* precondition is true if the conjunction of owned indexes is empty *)
|
|
|
|
let join astate1 astate2 =
|
|
|
|
let is_true = function False -> false | Conjunction set -> IntSet.is_empty set
|
|
|
|
if phys_equal astate1 astate2 then astate1
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
match (astate1, astate2) with
|
|
|
|
|
|
|
|
| _, Unowned | Unowned, _ ->
|
|
|
|
|
|
|
|
Unowned
|
|
|
|
|
|
|
|
| OwnedIf s1, OwnedIf s2 ->
|
|
|
|
|
|
|
|
OwnedIf (IntSet.union s1 s2)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let widen ~prev ~next ~num_iters:_ = join prev next
|
|
|
|
|
|
|
|
|
|
|
|
let pp fmt = function
|
|
|
|
let pp fmt = function
|
|
|
|
| Conjunction indexes ->
|
|
|
|
| Unowned ->
|
|
|
|
F.fprintf fmt "Owned(%a)"
|
|
|
|
F.pp_print_string fmt "Unowned"
|
|
|
|
|
|
|
|
| OwnedIf s ->
|
|
|
|
|
|
|
|
if IntSet.is_empty s then F.pp_print_string fmt "Owned"
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
F.fprintf fmt "OwnedIf%a"
|
|
|
|
(PrettyPrintable.pp_collection ~pp_item:Int.pp)
|
|
|
|
(PrettyPrintable.pp_collection ~pp_item:Int.pp)
|
|
|
|
(IntSet.elements indexes)
|
|
|
|
(IntSet.elements s)
|
|
|
|
| False ->
|
|
|
|
|
|
|
|
F.pp_print_string fmt "False"
|
|
|
|
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
module AccessSnapshot = struct
|
|
|
|
type t =
|
|
|
|
type t =
|
|
|
|
{ access: TraceElem.t
|
|
|
|
{ access: TraceElem.t
|
|
|
|
; thread: ThreadsDomain.t
|
|
|
|
; thread: ThreadsDomain.t
|
|
|
|
; lock: bool
|
|
|
|
; lock: bool
|
|
|
|
; ownership_precondition: OwnershipPrecondition.t }
|
|
|
|
; ownership_precondition: OwnershipAbstractValue.t }
|
|
|
|
[@@deriving compare]
|
|
|
|
[@@deriving compare]
|
|
|
|
|
|
|
|
|
|
|
|
let make_if_not_owned formals access lock thread ownership_precondition =
|
|
|
|
let make_if_not_owned formals access lock thread ownership_precondition =
|
|
|
|
if
|
|
|
|
if
|
|
|
|
(not (OwnershipPrecondition.is_true ownership_precondition))
|
|
|
|
(not (OwnershipAbstractValue.is_owned ownership_precondition))
|
|
|
|
&& TraceElem.should_keep formals access
|
|
|
|
&& TraceElem.should_keep formals access
|
|
|
|
then Some {access; lock; thread; ownership_precondition}
|
|
|
|
then Some {access; lock; thread; ownership_precondition}
|
|
|
|
else None
|
|
|
|
else None
|
|
|
@ -303,13 +334,13 @@ module AccessSnapshot = struct
|
|
|
|
let is_unprotected {thread; lock; ownership_precondition} =
|
|
|
|
let is_unprotected {thread; lock; ownership_precondition} =
|
|
|
|
(not (ThreadsDomain.is_any_but_self thread))
|
|
|
|
(not (ThreadsDomain.is_any_but_self thread))
|
|
|
|
&& (not lock)
|
|
|
|
&& (not lock)
|
|
|
|
&& not (OwnershipPrecondition.is_true ownership_precondition)
|
|
|
|
&& not (OwnershipAbstractValue.is_owned ownership_precondition)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let pp fmt {access; thread; lock; ownership_precondition} =
|
|
|
|
let pp fmt {access; thread; lock; ownership_precondition} =
|
|
|
|
F.fprintf fmt "Loc: %a Access: %a Thread: %a Lock: %b Pre: %a" Location.pp
|
|
|
|
F.fprintf fmt "Loc: %a Access: %a Thread: %a Lock: %b Pre: %a" Location.pp
|
|
|
|
(TraceElem.get_loc access) TraceElem.pp access ThreadsDomain.pp thread lock
|
|
|
|
(TraceElem.get_loc access) TraceElem.pp access ThreadsDomain.pp thread lock
|
|
|
|
OwnershipPrecondition.pp ownership_precondition
|
|
|
|
OwnershipAbstractValue.pp ownership_precondition
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
module AccessDomain = struct
|
|
|
|
module AccessDomain = struct
|
|
|
@ -327,50 +358,6 @@ module AccessDomain = struct
|
|
|
|
Option.fold snapshot_opt ~init:astate ~f:(fun acc s -> add s acc)
|
|
|
|
Option.fold snapshot_opt ~init:astate ~f:(fun acc s -> add s acc)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
module OwnershipAbstractValue = struct
|
|
|
|
|
|
|
|
type t = OwnedIf of IntSet.t | Unowned [@@deriving compare]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let owned = OwnedIf IntSet.empty
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let unowned = Unowned
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let make_owned_if formal_index = OwnedIf (IntSet.singleton formal_index)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let leq ~lhs ~rhs =
|
|
|
|
|
|
|
|
phys_equal lhs rhs
|
|
|
|
|
|
|
|
||
|
|
|
|
|
|
|
|
match (lhs, rhs) with
|
|
|
|
|
|
|
|
| _, Unowned ->
|
|
|
|
|
|
|
|
true (* Unowned is top *)
|
|
|
|
|
|
|
|
| Unowned, _ ->
|
|
|
|
|
|
|
|
false
|
|
|
|
|
|
|
|
| OwnedIf s1, OwnedIf s2 ->
|
|
|
|
|
|
|
|
IntSet.subset s1 s2
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let join astate1 astate2 =
|
|
|
|
|
|
|
|
if phys_equal astate1 astate2 then astate1
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
match (astate1, astate2) with
|
|
|
|
|
|
|
|
| _, Unowned | Unowned, _ ->
|
|
|
|
|
|
|
|
Unowned
|
|
|
|
|
|
|
|
| OwnedIf s1, OwnedIf s2 ->
|
|
|
|
|
|
|
|
OwnedIf (IntSet.union s1 s2)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let widen ~prev ~next ~num_iters:_ = join prev next
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let pp fmt = function
|
|
|
|
|
|
|
|
| Unowned ->
|
|
|
|
|
|
|
|
F.pp_print_string fmt "Unowned"
|
|
|
|
|
|
|
|
| OwnedIf s ->
|
|
|
|
|
|
|
|
if IntSet.is_empty s then F.pp_print_string fmt "Owned"
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
F.fprintf fmt "OwnedIf%a"
|
|
|
|
|
|
|
|
(PrettyPrintable.pp_collection ~pp_item:Int.pp)
|
|
|
|
|
|
|
|
(IntSet.elements s)
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
module OwnershipDomain = struct
|
|
|
|
module OwnershipDomain = struct
|
|
|
|
include AbstractDomain.Map (AccessExpression) (OwnershipAbstractValue)
|
|
|
|
include AbstractDomain.Map (AccessExpression) (OwnershipAbstractValue)
|
|
|
|
|
|
|
|
|
|
|
@ -426,16 +413,6 @@ module OwnershipDomain = struct
|
|
|
|
IntSet.fold get_ownership formal_indexes OwnershipAbstractValue.owned
|
|
|
|
IntSet.fold get_ownership formal_indexes OwnershipAbstractValue.owned
|
|
|
|
in
|
|
|
|
in
|
|
|
|
add ret_access_exp ret_ownership_wrt_actuals ownership
|
|
|
|
add ret_access_exp ret_ownership_wrt_actuals ownership
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let get_precondition exp t =
|
|
|
|
|
|
|
|
match get_owned exp t with
|
|
|
|
|
|
|
|
| OwnedIf formal_indexes ->
|
|
|
|
|
|
|
|
(* access expression conditionally owned if [formal_indexes] are owned *)
|
|
|
|
|
|
|
|
AccessSnapshot.OwnershipPrecondition.Conjunction formal_indexes
|
|
|
|
|
|
|
|
| Unowned ->
|
|
|
|
|
|
|
|
(* access expression not rooted in a formal and not conditionally owned *)
|
|
|
|
|
|
|
|
AccessSnapshot.OwnershipPrecondition.False
|
|
|
|
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
module Attribute = struct
|
|
|
|
module Attribute = struct
|
|
|
@ -582,5 +559,5 @@ let pp fmt {threads; locks; accesses; ownership; attribute_map} =
|
|
|
|
|
|
|
|
|
|
|
|
let add_unannotated_call_access formals pname loc (astate : t) =
|
|
|
|
let add_unannotated_call_access formals pname loc (astate : t) =
|
|
|
|
let access = TraceElem.make_unannotated_call_access pname loc in
|
|
|
|
let access = TraceElem.make_unannotated_call_access pname loc in
|
|
|
|
let snapshot = AccessSnapshot.make formals access astate.locks astate.threads False in
|
|
|
|
let snapshot = AccessSnapshot.make formals access astate.locks astate.threads Unowned in
|
|
|
|
{astate with accesses= AccessDomain.add_opt snapshot astate.accesses}
|
|
|
|
{astate with accesses= AccessDomain.add_opt snapshot astate.accesses}
|
|
|
|