@ -65,7 +65,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
with Not_found -> None
with Not_found -> None
let is_owned access_path owned_set =
let is_owned access_path owned_set =
Domain . Ownership Domain. mem access_path owned_set
Domain . AccessPathSet Domain. mem access_path owned_set
let is_initializer tenv proc_name =
let is_initializer tenv proc_name =
Procname . is_constructor proc_name | |
Procname . is_constructor proc_name | |
@ -118,6 +118,15 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| Some rhs_access_path -> IdAccessPathMapDomain . add lhs_id rhs_access_path id_map
| Some rhs_access_path -> IdAccessPathMapDomain . add lhs_id rhs_access_path id_map
| None -> id_map
| None -> id_map
(* like PatternMatch.override_exists, but also applies [predicate] to [pname] *)
let proc_or_override_is_annotated pname tenv predicate =
let has_return_annot pn =
Annotations . pname_has_return_annot
pn
~ attrs_of_pname : Specs . proc_resolve_attributes
predicate in
has_return_annot pname | | PatternMatch . override_exists has_return_annot tenv pname
let exec_instr ( astate : Domain . astate ) { ProcData . pdesc ; tenv ; extras ; } _ =
let exec_instr ( astate : Domain . astate ) { ProcData . pdesc ; tenv ; extras ; } _ =
let pname = Procdesc . get_proc_name pdesc in
let pname = Procdesc . get_proc_name pdesc in
let is_allocation pn =
let is_allocation pn =
@ -164,32 +173,31 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
begin
begin
match AccessPath . of_lhs_exp ( Exp . Var lhs_id ) lhs_typ ~ f_resolve_id with
match AccessPath . of_lhs_exp ( Exp . Var lhs_id ) lhs_typ ~ f_resolve_id with
| Some lhs_access_path ->
| Some lhs_access_path ->
let owned = Ownership Domain. add lhs_access_path astate . owned in
let owned = AccessPathSet Domain. add lhs_access_path astate . owned in
{ astate with owned ; }
{ astate with owned ; }
| None ->
| None ->
astate
astate
end
end
| Sil . Call ( ret_opt , Const ( Cfun pn) , actuals , loc , _ ) ->
| Sil . Call ( ret_opt , Const ( Cfun callee_ pname ) , actuals , loc , _ ) ->
begin
let astate_callee =
(* assuming that modeled procedures do not have useful summaries *)
(* assuming that modeled procedures do not have useful summaries *)
match get_lock_model pn with
match get_lock_model callee_ pname with
| Lock ->
| Lock ->
{ astate with locks = true ; }
{ astate with locks = true ; }
| Unlock ->
| Unlock ->
{ astate with locks = false ; }
{ astate with locks = false ; }
| NoEffect ->
| NoEffect ->
if is_unprotected astate . locks && is_container_write pn tenv
if is_unprotected astate . locks && is_container_write callee_ pname tenv
then
then
match actuals with
match actuals with
| ( receiver_exp , receiver_typ ) :: _ ->
| ( receiver_exp , receiver_typ ) :: _ ->
add_container_write pn loc receiver_exp receiver_typ astate
add_container_write callee_ pname loc receiver_exp receiver_typ astate
| [] ->
| [] ->
failwithf
failwithf
" Call to %a is marked as a container write, but has no receiver "
" Call to %a is marked as a container write, but has no receiver "
Procname . pp pn
Procname . pp callee_ pname
else
else
begin
match Summary . read_summary pdesc callee_pname with
match Summary . read_summary pdesc pn with
| Some ( callee_locks ,
| Some ( callee_locks ,
callee_reads ,
callee_reads ,
callee_conditional_writes ,
callee_conditional_writes ,
@ -201,7 +209,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
( e . g . , constructors that access static fields ) * )
( e . g . , constructors that access static fields ) * )
if is_unprotected locks'
if is_unprotected locks'
then
then
let call_site = CallSite . make pn loc in
let call_site = CallSite . make callee_ pname loc in
(* add the conditional writes rooted in the callee formal at [index] to
(* add the conditional writes rooted in the callee formal at [index] to
the current state * )
the current state * )
let add_conditional_writes
let add_conditional_writes
@ -267,13 +275,26 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
astate in
astate in
let owned = match ret_opt with
let owned = match ret_opt with
| Some ( ret_id , ret_typ ) when is_retval_owned ->
| Some ( ret_id , ret_typ ) when is_retval_owned ->
Ownership Domain. add ( AccessPath . of_id ret_id ret_typ ) astate' . owned
AccessPathSet Domain. add ( AccessPath . of_id ret_id ret_typ ) astate' . owned
| _ ->
| _ ->
astate' . owned in
astate' . owned in
{ astate' with locks = locks' ; owned ; }
{ astate' with locks = locks' ; owned ; }
| None ->
| None ->
astate
astate in
end
begin
match ret_opt with
| Some ( _ , ( Typ . Tint ILong | Tfloat FDouble ) ) ->
(* writes to longs and doubles are not guaranteed to be atomic in Java, so don't
bother tracking whether a returned long or float value is functional * )
astate_callee
| Some ( ret_id , ret_typ ) when
proc_or_override_is_annotated callee_pname tenv Annotations . ia_is_functional ->
let functional =
AccessPathSetDomain . add
( AccessPath . of_id ret_id ret_typ ) astate_callee . functional in
{ astate_callee with functional ; }
| _ ->
astate_callee
end
end
| Sil . Store ( Exp . Lvar lhs_pvar , lhs_typ , rhs_exp , _ ) when Pvar . is_frontend_tmp lhs_pvar ->
| Sil . Store ( Exp . Lvar lhs_pvar , lhs_typ , rhs_exp , _ ) when Pvar . is_frontend_tmp lhs_pvar ->
@ -284,10 +305,15 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let get_formal_index exp typ = match AccessPath . of_lhs_exp exp typ ~ f_resolve_id with
let get_formal_index exp typ = match AccessPath . of_lhs_exp exp typ ~ f_resolve_id with
| Some ( base , _ ) -> FormalMap . get_formal_index base extras
| Some ( base , _ ) -> FormalMap . get_formal_index base extras
| None -> None in
| None -> None in
let is_marked_functional exp typ functional_set =
match AccessPath . of_lhs_exp exp typ ~ f_resolve_id with
| Some access_path -> AccessPathSetDomain . mem access_path functional_set
| None -> false in
let conditional_writes , unconditional_writes =
let conditional_writes , unconditional_writes =
match lhs_exp with
match lhs_exp with
| Lfield ( base_exp , _ , typ )
| Lfield ( base_exp , _ , typ )
when is_unprotected astate . locks -> (* abstracts no lock being held *)
when is_unprotected astate . locks (* abstracts no lock being held *) &&
not ( is_marked_functional rhs_exp lhs_typ astate . functional ) ->
begin
begin
match get_formal_index base_exp typ with
match get_formal_index base_exp typ with
| Some formal_index ->
| Some formal_index ->
@ -321,20 +347,25 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
end
end
| _ ->
| _ ->
astate . conditional_writes , astate . unconditional_writes in
astate . conditional_writes , astate . unconditional_writes in
(* if rhs is owned, propagate ownership to lhs. otherwise, remove lhs from ownership set
( since it may have previously held an owned memory loc and is now being reassigned * )
(* if rhs is owned/functional, propagate to lhs. otherwise, remove lhs from
let owned =
ownership / functional set ( since it may have previously held an owned / functional memory
match AccessPath . of_lhs_exp lhs_exp lhs_typ ~ f_resolve_id ,
loc and is now being reassigned * )
AccessPath . of_lhs_exp rhs_exp lhs_typ ~ f_resolve_id with
let lhs_access_path_opt = AccessPath . of_lhs_exp lhs_exp lhs_typ ~ f_resolve_id in
let rhs_access_path_opt = AccessPath . of_lhs_exp rhs_exp lhs_typ ~ f_resolve_id in
let update_access_path_set access_path_set =
match lhs_access_path_opt , rhs_access_path_opt with
| Some lhs_access_path , Some rhs_access_path ->
| Some lhs_access_path , Some rhs_access_path ->
if OwnershipDomain . mem rhs_access_path astate . owned
if AccessPathSetDomain. mem rhs_access_path access_path_set
then OwnershipDomain . add lhs_access_path astate . owned
then AccessPathSetDomain. add lhs_access_path access_path_set
else OwnershipDomain. remove lhs_access_path astate . owned
else AccessPathSetDomain. remove lhs_access_path access_path_set
| Some lhs_access_path , None ->
| Some lhs_access_path , None ->
OwnershipDomain. remove lhs_access_path astate . owned
AccessPathSetDomain. remove lhs_access_path access_path_set
| _ ->
| _ ->
astate . owned in
access_path_set in
{ astate with conditional_writes ; unconditional_writes ; owned ; }
let owned = update_access_path_set astate . owned in
let functional = update_access_path_set astate . functional in
{ astate with conditional_writes ; unconditional_writes ; owned ; functional ; }
| Sil . Load ( lhs_id , rhs_exp , rhs_typ , loc ) ->
| Sil . Load ( lhs_id , rhs_exp , rhs_typ , loc ) ->
let id_map = analyze_id_assignment ( Var . of_id lhs_id ) rhs_exp rhs_typ astate in
let id_map = analyze_id_assignment ( Var . of_id lhs_id ) rhs_exp rhs_typ astate in
@ -344,15 +375,19 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
add_path_to_state rhs_exp typ loc astate . reads astate . id_map astate . owned pname tenv
add_path_to_state rhs_exp typ loc astate . reads astate . id_map astate . owned pname tenv
| _ ->
| _ ->
astate . reads in
astate . reads in
(* if rhs is owned, propagate ownership to lhs *)
let owned =
(* if rhs is owned/functional, propagate to lhs *)
let owned , functional =
match AccessPath . of_lhs_exp rhs_exp rhs_typ ~ f_resolve_id with
match AccessPath . of_lhs_exp rhs_exp rhs_typ ~ f_resolve_id with
| Some rhs_access_path
| Some rhs_access_path ->
when OwnershipDomain . mem rhs_access_path astate . owned ->
let propagate_to_lhs access_path_set =
OwnershipDomain . add ( AccessPath . of_id lhs_id rhs_typ ) astate . owned
if AccessPathSetDomain . mem rhs_access_path access_path_set
then AccessPathSetDomain . add ( AccessPath . of_id lhs_id rhs_typ ) access_path_set
else access_path_set in
propagate_to_lhs astate . owned , propagate_to_lhs astate . functional
| _ ->
| _ ->
astate . owned in
astate . owned , astate . functional in
{ astate with Domain . reads ; id_map ; owned ; }
{ astate with Domain . reads ; id_map ; owned ; functional ; }
| Sil . Remove_temps ( ids , _ ) ->
| Sil . Remove_temps ( ids , _ ) ->
let id_map =
let id_map =
@ -484,7 +519,7 @@ let make_results_table get_proc_desc file_env =
AccessPath . of_pvar
AccessPath . of_pvar
( Pvar . get_ret_pvar ( Procdesc . get_proc_name pdesc ) )
( Pvar . get_ret_pvar ( Procdesc . get_proc_name pdesc ) )
( Procdesc . get_ret_type pdesc ) in
( Procdesc . get_ret_type pdesc ) in
let return_is_owned = Ownership Domain. mem return_var_ap owned in
let return_is_owned = AccessPathSet Domain. mem return_var_ap owned in
Some ( locks , reads , conditional_writes , unconditional_writes , return_is_owned )
Some ( locks , reads , conditional_writes , unconditional_writes , return_is_owned )
| None ->
| None ->
None
None