@ -12,22 +12,38 @@ module MF = MarkupFormatter
let pname_pp = MF . wrap_monospaced Typ . Procname . pp
let pname_pp = MF . wrap_monospaced Typ . Procname . pp
module ThreadDomain = struct
module ThreadDomain = struct
type t = U IThread | AnyThread [ @@ deriving compare ]
type t = U nknownThread | U IThread | BG Thread | AnyThread [ @@ deriving compare , equal ]
let top = Any Thread
let bottom = Unknown Thread
let is_ top = function AnyThread -> true | UIThread -> false
let is_ bottom = function UnknownThread -> true | _ -> false
let join st1 st2 =
let join lhs rhs =
match ( st1 , st2 ) with AnyThread , _ | _ , AnyThread -> AnyThread | _ , _ -> UIThread
match ( lhs , rhs ) with
| UnknownThread , other | other , UnknownThread ->
other
| UIThread , UIThread | BGThread , BGThread ->
lhs
| _ , _ ->
AnyThread
let leq ~ lhs ~ rhs = match ( lhs , rhs ) with AnyThread , UIThread -> false | _ , _ -> true
(* type is just an int, so use [join] to define [leq] *)
let leq ~ lhs ~ rhs = equal ( join lhs rhs ) rhs
let widen ~ prev ~ next ~ num_iters : _ = join prev next
let widen ~ prev ~ next ~ num_iters : _ = join prev next
let pp fmt st =
let pp fmt st =
( match st with UIThread -> " UIThread " | AnyThread -> " AnyThread " ) | > F . pp_print_string fmt
( match st with
| UnknownThread ->
" UnknownThread "
| UIThread ->
" UIThread "
| BGThread ->
" BGThread "
| AnyThread ->
" AnyThread " )
| > F . pp_print_string fmt
(* * Can two thread statuses occur in parallel? Only [UIThread, UIThread] is forbidden.
(* * Can two thread statuses occur in parallel? Only [UIThread, UIThread] is forbidden.
@ -39,9 +55,30 @@ module ThreadDomain = struct
let is_uithread = function UIThread -> true | _ -> false
let is_uithread = function UIThread -> true | _ -> false
(* If we know that either the caller or the callee is on UIThread, keep it that way. *)
(* If we know that either the caller is a UI/BG thread or both, keep it that way.
let integrate_summary ~ caller ~ callee =
Otherwise , we have no info on caller , so use callee's info . * )
match ( caller , callee ) with UIThread , _ | _ , UIThread -> UIThread | _ , _ -> AnyThread
let integrate_summary ~ caller ~ callee = if is_bottom caller then callee else caller
(* * given the current thread state [caller_thread] and the thread state under which a critical pair
occurred , [ pair_thread ] , decide whether to throw away the pair ( returning [ None ] ) because it
cannot occur within a call from the current state , or adapt its thread state appropriately . * )
let apply_to_pair caller_thread pair_thread =
match ( caller_thread , pair_thread ) with
| UnknownThread , _ ->
(* callee pair knows more than us *)
Some pair_thread
| AnyThread , UnknownThread ->
(* callee pair knows nothing and caller has abstracted away info *)
Some AnyThread
| AnyThread , _ ->
(* callee pair is UI / BG / Any and caller has abstracted away info so use callee's knowledge *)
Some pair_thread
| UIThread , BGThread | BGThread , UIThread ->
(* annotations or assertions are incorrectly used in code, just drop the callee pair *)
None
| _ , _ ->
(* caller is UI or BG and callee does not disagree, so use that *)
Some caller_thread
end
end
module Lock = struct
module Lock = struct
@ -285,14 +322,15 @@ module CriticalPair = struct
)
)
let with_callsite t existing_acquisitions call_site thread =
let integrate_summary_opt existing_acquisitions call_site ( caller_thread : ThreadDomain . t )
( callee_pair : t ) =
ThreadDomain . apply_to_pair caller_thread callee_pair . elem . thread
| > Option . map ~ f : ( fun thread ->
let f ( elem : CriticalPairElement . t ) =
let f ( elem : CriticalPairElement . t ) =
{ elem with
let acquisitions = Acquisitions . union existing_acquisitions elem . acquisitions in
acquisitions = Acquisitions . union existing_acquisitions elem . acquisitions
( { elem with acquisitions ; thread } : elem_t )
; thread = ThreadDomain . integrate_summary ~ caller : thread ~ callee : elem . thread }
in
in
let new_t = map ~ f t in
with_callsite ( map ~ f callee_pair ) call_site )
with_callsite new_t call_site
let get_earliest_lock_or_call_loc ~ procname ( { elem = { acquisitions } } as t ) =
let get_earliest_lock_or_call_loc ~ procname ( { elem = { acquisitions } } as t ) =
@ -394,10 +432,8 @@ module CriticalPairs = struct
( fun ( { elem = { event } } as critical_pair : CriticalPair . t ) acc ->
( fun ( { elem = { event } } as critical_pair : CriticalPair . t ) acc ->
if should_skip ( Some tenv ) event lock_state then acc
if should_skip ( Some tenv ) event lock_state then acc
else
else
let new_pair =
CriticalPair . integrate_summary_opt existing_acquisitions call_site thread critical_pair
CriticalPair . with_callsite critical_pair existing_acquisitions call_site thread
| > Option . fold ~ init : acc ~ f : ( fun acc new_pair -> add new_pair acc ) )
in
add new_pair acc )
astate empty
astate empty
end
end
@ -448,14 +484,14 @@ let bottom =
; lock_state = LockState . top
; lock_state = LockState . top
; critical_pairs = CriticalPairs . empty
; critical_pairs = CriticalPairs . empty
; branch_guards = BranchGuardDomain . empty
; branch_guards = BranchGuardDomain . empty
; thread = ThreadDomain . top }
; thread = ThreadDomain . bottom }
let is_bottom { guard_map ; lock_state ; critical_pairs ; branch_guards ; thread } =
let is_bottom { guard_map ; lock_state ; critical_pairs ; branch_guards ; thread } =
GuardToLockMap . is_empty guard_map && LockState . is_top lock_state
GuardToLockMap . is_empty guard_map && LockState . is_top lock_state
&& CriticalPairs . is_empty critical_pairs
&& CriticalPairs . is_empty critical_pairs
&& BranchGuardDomain . is_top branch_guards
&& BranchGuardDomain . is_top branch_guards
&& ThreadDomain . is_ top thread
&& ThreadDomain . is_ bottom thread
let pp fmt { guard_map ; lock_state ; critical_pairs ; branch_guards ; thread } =
let pp fmt { guard_map ; lock_state ; critical_pairs ; branch_guards ; thread } =
@ -524,8 +560,6 @@ let release ({lock_state} as astate) locks =
lock_state = List . fold locks ~ init : lock_state ~ f : ( fun acc l -> LockState . release l acc ) }
lock_state = List . fold locks ~ init : lock_state ~ f : ( fun acc l -> LockState . release l acc ) }
let set_on_ui_thread astate = { astate with thread = ThreadDomain . UIThread }
let add_guard ~ acquire_now ~ procname ~ loc tenv astate guard lock =
let add_guard ~ acquire_now ~ procname ~ loc tenv astate guard lock =
let astate = { astate with guard_map = GuardToLockMap . add_guard ~ guard ~ lock astate . guard_map } in
let astate = { astate with guard_map = GuardToLockMap . add_guard ~ guard ~ lock astate . guard_map } in
if acquire_now then acquire tenv astate ~ procname ~ loc [ lock ] else astate
if acquire_now then acquire tenv astate ~ procname ~ loc [ lock ] else astate