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 =
State_set.add
(try
let _, functions =
resolv_func_vinfo ~with_alarms
None state funcexp
in
let actuals =
List.map
(fun e ->
let v =
eval_expr ~with_alarms
state e
in
if V.equal v V.bottom
then begin
Value_parameters.result ~current:true
"Non-termination in evaluation of function call argument";
raise Got_bottom
end;
(e,v))
argl
in
let treat_one_call (acc_rt,acc_res,acc_clobbered_set) f =
let caller =
match !call_stack with
| [] -> assert false
| {called_kf=ckf }::_ -> ckf,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 =
List.fold_left
treat_one_call
empty_interpretation_result
functions
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 {Cvalue_type.V_Or_Uninitialized.v=value;
initialized = init;
no_escaping_adr = no_esc}
=
V_Offsetmap.find_ival
~validity:Base.All
~with_alarms:CilE.warn_none_mode
Ival.zero
return
(Int.of_int (bitsSizeOf rtype))
Cvalue_type.V_Or_Uninitialized.bottom
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=
(V_Offsetmap.find_ival
~validity:Base.All
~with_alarms:CilE.warn_none_mode
Ival.zero
return
(Int.of_int (bitsSizeOf rtype))
Cvalue_type.V_Or_Uninitialized.bottom)
.Cvalue_type.V_Or_Uninitialized.v
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))
acc
in
State_set.fold
treat_one_state
d_value
State_set.empty