let compute_using_cfg kf ~call_kinstr initial_state =
match kf.fundec with
| Declaration _ -> assert false
| Definition (f,_loc) ->
begin
let f_varinfo = f.svar in
let module Computer =
Eval_stmts.Computer
(struct
let current_kf = kf
let stmt_can_reach =
if Value_parameters.MemoryFootprint.get () >= 3
then stmt_can_reach_memo kf
else Stmts_graph.stmt_can_reach kf
let is_natural_loop = Loop.is_natural kf
let non_linear_assignments = Non_linear.find f
let slevel = get_slevel kf
let initial_state = initial_state
let active_behaviors =
Eval_logic.ActiveBehaviors.create initial_state kf
end)
in
let module Compute = Dataflow.Forwards(Computer) in
List.iter
(function {called_kf = g} ->
if kf == g
then begin
if Value_parameters.IgnoreRecursiveCalls.get()
then begin
warning_once_current
"ignoring recursive call during value analysis of %a (%a)"
Varinfo.pretty f_varinfo
pretty_call_stack (call_stack ());
Db.Value.recursive_call_occurred kf;
raise Leaf
end
else begin
warning_once_current
"@[recursive call@ during@ value@ analysis@ (%a <- %a)@.Use %s@ to@ ignore@ (beware@ this@ will@ make@ the analysis@ unsound)@]"
Varinfo.pretty f_varinfo
pretty_call_stack (call_stack ())
Value_parameters.IgnoreRecursiveCalls.option_name;
raise (Extlib.NotYetImplemented "recursive calls in value analysis")
end
end)
(call_stack ());
push_call_stack {called_kf = kf;
call_site = call_kinstr;
called_merge_current = Computer.merge_current};
match f.sbody.bstmts with
[] -> assert false
| start :: _ ->
let ret_id =
try Kernel_function.find_return kf
with Kernel_function.No_Statement -> assert false
in
Computer.StmtStartData.add
start
(Computer.computeFirstPredecessor
start
{
Computer.counter_unroll = 0;
value = initial_state});
begin try
Compute.compute [start]
with Db.Value.Aborted as e ->
pop_call_stack ();
raise e
end;
let last_ret,_,last_clob as last_state =
try
let _,state,_ as result =
try
Computer.externalize ret_id kf
with Not_found -> assert false
in
if Cvalue.Model.is_reachable state
then begin
try
if hasAttribute "noreturn" f_varinfo.vattr
then
warning_once_current
"function %a may terminate but has the noreturn attribute"
Kernel_function.pretty kf;
with Not_found -> assert false
end
else raise Not_found;
result
with Not_found -> begin
None,
Cvalue.Model.bottom,
Location_Bits.Top_Param.bottom
end
in
Value_parameters.debug
"@[RESULT FOR %a <-%a:@\n\\result -> %a@\nClobered set:%a@]"
Kernel_function.pretty kf
pretty_call_stack (call_stack ())
(fun fmt v ->
match v with
| None -> ()
| Some v -> V_Offsetmap.pretty fmt v)
last_ret
Location_Bits.Top_Param.pretty
last_clob;
pop_call_stack ();
last_state
end