let doInstr _stmt (i: instr) (d: t) =
!Db.progress ();
let kinstr = !current_stmt
in
let add_with_additional_var lv v d =
let deps, target =
(* The modified location is [target],
whose address is computed from [deps]. *)
!Values_To_Use.lval_to_loc_with_deps
~with_alarms:CilE.warn_none_mode
~deps:Zone.bottom
kinstr
lv
in
let deps = Zone.join
v
(Lmap_bitwise.From_Model.find d.deps_table deps)
in
let r = !Db.From.update
target
(Zone.join
d.additional_deps
deps)
d.deps_table
in
{d with deps_table=r; }
in
match i with
| Set (lv, exp, _) ->
Dataflow.Post
(fun state ->
let comp_vars = find_deps kinstr state.deps_table exp in
let result = add_with_additional_var lv comp_vars state in
result
)
| Call (lvaloption,funcexp,argl,_) ->
Dataflow.Post
(fun state ->
!Db.progress ();
let funcexp_deps, called_vinfos =
resolv_func_vinfo
~with_alarms:CilE.warn_none_mode
~deps:Zone.bottom
kinstr
funcexp
in
let funcexp_deps =
(* dependencies for the evaluation of [funcexp] *)
!Db.From.access funcexp_deps state.deps_table in
let additional_deps =
Zone.join d.additional_deps funcexp_deps
in
let args_froms =
List.map
(fun arg ->
match arg with
(* TODO : optimize the dependencies on subfields
| Lval lv ->
Lvalue
(From_Model.LBase.find
(Interp_loc.lval_to_loc_with_deps kinstr lv))
*)
| _ ->
Froms (find_deps kinstr d.deps_table arg))
argl
in
let do_on kernel_function =
let called_vinfo = Kernel_function.get_vi kernel_function in
if Ast_info.is_cea_function called_vinfo.vname then
state
else
let { Function_Froms.deps_return = return_from;
deps_table = called_func_froms } =
Froms_To_Use.get kernel_function kinstr
in
let formal_args =
Kernel_function.get_formals kernel_function
in
let name_to_from = VarinfoHashtbl.create 7 in
begin try
List.iter2
(VarinfoHashtbl.add name_to_from)
formal_args
args_froms;
with Invalid_argument "List.iter2" ->
From_parameters.warning ~once:true ~current:true
"variadic call detected. Using only %d argument(s)."
(min
(List.length formal_args)
(List.length args_froms))
end;
let substitute =
cached_substitute
state.deps_table
additional_deps
name_to_from
in
let new_state =
(* From state just after the call,
but before the result assigment *)
{state with
deps_table =
Lmap_bitwise.From_Model.map_and_merge substitute
called_func_froms
state.deps_table}
in
(* Treatement for the possible assignement
of the call result *)
(match lvaloption with
| None -> new_state
| Some lv ->
(try
Lmap_bitwise.From_Model.LOffset.fold
(fun itv (_,x) acc ->
let res = substitute x in
let deps, loc =
!Values_To_Use.lval_to_loc_with_deps
~with_alarms:CilE.warn_none_mode
~deps:Zone.bottom
kinstr
lv
in
let deps =
(Lmap_bitwise.From_Model.find acc.deps_table
deps)
in
let deps = Zone.join res deps in
let deps = Zone.join deps acc.additional_deps in
let base, range =
Location_Bits.find_lonely_binding loc.loc
in let start = match Ival.min_int range with
None -> assert false
| Some i -> i
in
let zones =
Int_Intervals.fold
(fun (lb,ub) acc ->
let zone =
Zone.inject base
(Int_Intervals.inject
[Int.add start lb,
Int.add start ub])
in
Zone.join zone acc)
itv Zone.bottom
in
let real_loc = Locations.filter_loc loc zones in
{ acc with deps_table =
!Db.From.update
real_loc
deps acc.deps_table}
)
return_from new_state
with Not_found -> (* from find_lonely_binding *)
let vars =
Lmap_bitwise.From_Model.LOffset.map
(fun (b,x) -> (b,substitute x))
return_from
in
add_with_additional_var
lv
(Lmap_bitwise.From_Model.LOffset.collapse vars)
new_state
))
in
let f f acc =
let p = do_on f in
match acc with
None -> Some p
| Some acc_memory ->
Some
{state with
deps_table = Lmap_bitwise.From_Model.join
p.deps_table
acc_memory.deps_table}
in
try
( match Kernel_function.Set.fold f called_vinfos None with
None -> state
| Some s -> s)
with Call_did_not_take_place -> state
)
| _ -> Dataflow.Default