let interp_call stmt lval_to_assign funcexp argl d_value =
let call_site_loc = CurrentLoc.get () in
let with_alarms = warn_all_quiet_mode () in
let treat_one_state state acc =
let new_state_after_call =
try
let _, functions =
resolv_func_vinfo ~with_alarms
None state funcexp
in
let is_library_function kf =
not (Kernel_function.is_definition kf)
in
let calling_at_least_one_library_function =
Kernel_function.Hptset.exists
is_library_function
functions
in
let calling_all_library_functions =
calling_at_least_one_library_function &&
(Kernel_function.Hptset.for_all
is_library_function
functions)
in
let actuals =
List.map
(fun e ->
let interpreted_expr, o =
match e with
{ enode = Lval l } ->
let _, _, interpreted_expr =
eval_lval ~conflate_bottom:false ~with_alarms
None state l
in
if calling_at_least_one_library_function
then begin
let _, _, conf_expr =
eval_lval ~conflate_bottom:true ~with_alarms
None state l
in
ignore (conf_expr);
end;
if calling_all_library_functions &&
V.is_bottom interpreted_expr
then begin
Value_parameters.result ~current:true
"Non-termination in evaluation of library function call l-value argument";
raise Got_bottom;
end;
let r = do_cast ~with_alarms (typeOf e) interpreted_expr
in
let o =
offsetmap_of_lv ~with_alarms:(warn_all_quiet_mode ())
state
l
in
r, out_some o
| _ ->
let interpreted_expr =
eval_expr ~with_alarms state e
in
if V.equal interpreted_expr V.bottom
then begin
Value_parameters.result ~current:true
"Non-termination in evaluation of function call expression argument";
raise Got_bottom
end;
interpreted_expr,
Builtins.offsetmap_of_value ~typ:(Cil.typeOf e)
interpreted_expr
in
e,interpreted_expr,o)
argl
in
let treat_one_call f (acc_rt,acc_res,acc_clobbered_set) =
let caller = current_kf (), stmt in
Kf_state.add_caller f ~caller;
let return, result, clobbered_set =
!compute_call_ref
f
~call_kinstr:(Kstmt stmt)
state
actuals
in
CurrentLoc.set call_site_loc;
(match acc_rt,return with
| None,_ -> return
| Some _, None -> acc_rt
| Some acc_rt, Some return ->
Some (snd (V_Offsetmap.join
acc_rt
return))),
Relations_type.Model.join acc_res result,
Location_Bits.Top_Param.join acc_clobbered_set clobbered_set
in
let return,new_state,clobbered_set =
Kernel_function.Hptset.fold
treat_one_call
functions
empty_interpretation_result
in
bases_containing_locals :=
Location_Bits.Top_Param.join
!bases_containing_locals
clobbered_set;
match lval_to_assign with
| None -> new_state
| Some lv ->
begin match return with
| Some return ->
let loc =
lval_to_loc
~with_alarms new_state lv
in
let rtype =
getReturnType (typeOf funcexp)
in
let lvtyp = typeOfLval lv in
let default () =
let value_with_init
=
V_Offsetmap.find_ival
~conflate_bottom:false
~validity:Base.All
~with_alarms:CilE.warn_none_mode
Ival.zero
return
(Int.of_int (bitsSizeOf rtype))
in
let flags = V_Or_Uninitialized.get_flags value_with_init
in
let init = V_Or_Uninitialized.is_initialized flags in
let no_esc = V_Or_Uninitialized.is_noesc flags in
let value = V_Or_Uninitialized.get_v value_with_init in
if not init
then CilE.warn_uninitialized with_alarms;
if not no_esc
then CilE.warn_escapingaddr with_alarms;
if Cvalue_type.V.is_bottom value
&& not (init && no_esc)
then
Value_parameters.result ~current:true
"Function call returned an unspecified value. This path is assumed to be dead.";
let exact = valid_cardinal_zero_or_one loc in
let evaled_exp =
do_cast
~with_alarms:CilE.warn_none_mode
lvtyp
value
in
remember_bases_with_locals loc evaled_exp;
Relations_type.Model.add_binding
~with_alarms:CilE.warn_none_mode
~exact
new_state
loc
evaled_exp
in
if need_cast lvtyp rtype
then
default ()
else
(try
let result =
Relations_type.Model.paste_offsetmap
return
loc.loc
Int.zero
(Int_Base.project loc.size)
new_state
in
let evaled_exp=
Cvalue_type.V_Or_Uninitialized.get_v
(V_Offsetmap.find_ival
~conflate_bottom:false
~validity:Base.All
~with_alarms:CilE.warn_none_mode
Ival.zero
return
(Int.of_int (bitsSizeOf rtype))
)
in
remember_bases_with_locals loc evaled_exp;
result
with Lmap.Cannot_copy -> default ())
| None ->
(if Relations_type.Model.is_reachable new_state
then
Value_parameters.warning ~current:true
"In function %t: called function returns void but returned value is assigned; ignoring assignment"
pretty_current_cfunction_name;
new_state)
end
with
| Ignore ->
CurrentLoc.set call_site_loc;
state
| Got_bottom ->
CurrentLoc.set call_site_loc;
Relations_type.Model.bottom
| Leaf ->
CurrentLoc.set call_site_loc;
(match lval_to_assign with
| None -> state
| Some lv ->
let evaled_exp = V.top_leaf_origin () in
do_assign_abstract_value
~with_alarms
~former_state:state
state
lv
evaled_exp)
in
State_set.add new_state_after_call acc
in
State_set.fold
treat_one_state
d_value
State_set.empty