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 =
Computer
(struct
let stmt_can_reach = Stmts_graph.stmt_can_reach kf
let is_natural_loop = Loop.is_natural kf
let non_linear_assignments =
try
Non_linear_assignments.find f_varinfo
with
Not_found ->
let n = compute_non_linear_assignments f in
Non_linear_assignments.add f_varinfo n;
n
let slevel = get_slevel kf
let initial_state = initial_state
end)
in
let module Compute = Dataflow.ForwardsDataFlow(Computer) in
List.iter
(function {called_kf = g} ->
if kf == g
then begin
if Value_parameters.IgnoreRecursiveCalls.get()
then begin
Value_parameters.warning ~current:true ~once:true
"ignoring recursive call during value analysis of %a (%a)"
Ast_info.pretty_vname f_varinfo
pretty_call_stack (call_stack ());
raise Leaf
end
else
raise (Extlib.NotYetImplemented "recursive calls in value analysis")
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 = Kernel_function.find_return kf in
Computer.StmtStartData.add
start.sid
(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_s,last_clob as last_state =
try
let _,state,_ as result =
try
Computer.externalize (Kstmt ret_id) kf
with Not_found -> assert false
in
if Relations_type.Model.is_reachable state
then begin
try
if hasAttribute "noreturn" f_varinfo.vattr
then
Value_parameters.warning ~current:true ~once:true
"function %a may terminate but has the noreturn attribute"
Kernel_function.pretty_name kf;
with Not_found -> assert false
end
else raise Not_found;
result
with Not_found -> begin
None,
Relations_type.Model.bottom,
Location_Bits.Top_Param.bottom
end
in
Value_parameters.debug
"@[RESULT FOR %a <-%a:@\n\\result -> %a@\n%a@\nClobered set:%a@]"
Kernel_function.pretty_name kf
pretty_call_stack (call_stack ())
(fun fmt v ->
match v with
| None -> ()
| Some v -> V_Offsetmap.pretty fmt v)
last_ret
no_pretty last_s
Location_Bits.Top_Param.pretty
last_clob;
pop_call_stack ();
last_state
end