@ -12,54 +12,77 @@ open! Utils
module F = Format
module L = Logging
module Domain = AbstractDomain . FiniteSet ( Pvar . Set )
module Summary = Summary . Make ( struct
type summary = Domain. astate
type summary = SiofDomain . astate
let update_payload astate payload =
{ payload with Specs . globals_read = Some astate }
{ payload with Specs . siof = Some astate }
let read_from_payload payload =
match payload . Specs . globals_read with
match payload . Specs . siof with
| Some astate -> astate
| None -> Domain. initial
| None -> Siof Domain. initial
end )
module TransferFunctions ( CFG : ProcCfg . S ) = struct
module CFG = CFG
module Domain = Domain
module Domain = Siof Domain
type extras = ProcData . no_extras
let get_globals e =
Exp . get_vars e | > snd | > IList . filter Pvar . is_global | > Domain . of_list
let is_semantically_compile_constant tenv pdesc pv =
match Pvar . get_initializer_pname pv with
| Some pname -> (
match Summary . read_summary tenv pdesc pname with
| Some ( Domain . NonBottom _ ) -> false
| Some Domain . Bottom | None -> true
)
| None -> true
let get_globals tenv pdesc e =
let is_dangerous_global pv =
Pvar . is_global pv
&& not ( Pvar . is_compile_constant pv
| | is_semantically_compile_constant tenv pdesc pv ) in
let globals = Exp . get_vars e | > snd | > IList . filter is_dangerous_global in
if globals = [] then
Domain . Bottom
else
Domain . NonBottom ( SiofDomain . PvarSetDomain . of_list globals )
let add_params_globals astate tenv pdesc params =
IList . map fst params
| > IList . map ( fun e -> get_globals tenv pdesc e )
| > IList . fold_left Domain . join astate
let at_least_bottom =
Domain . join ( Domain . NonBottom SiofDomain . PvarSetDomain . empty )
let exec_instr astate { ProcData . pdesc ; tenv } _ ( instr : Sil . instr ) = match instr with
| Load ( _ , exp , _ , _ )
| Store ( _ , _ , exp , _ )
| Prune ( exp , _ , _ , _ ) ->
let globals = get_globals exp in
Domain . union astate globals
Domain . join astate ( get_globals tenv pdesc exp )
| Call ( _ , Const ( Cfun callee_pname ) , params , _ , _ ) ->
let param_globals =
IList . map fst params
| > IList . map get_globals
| > IList . fold_left Domain . union astate in
let callee_globals =
Option . default Domain . initial
@@ Summary . read_summary tenv pdesc callee_pname in
Domain . union callee_globals param_globals
add_params_globals astate tenv pdesc params
| > Domain . join callee_globals
| >
(* make sure it's not Bottom: we made a function call so this needs initialization *)
at_least_bottom
| Call ( _ , _ , params , _ , _ ) ->
IList . map fst params
| > IList . map get_globals
| > IList . fold_left Domain . union astate
add_params_globals astate tenv pdesc params
| >
(* make sure it's not Bottom: we made a function call so this needs initialization *)
at_least_bottom
| Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ ->
astate
end
module Analyzer =
AbstractInterpreter . Make
( ProcCfg . Backward( ProcCfg . Exceptional ) )
( ProcCfg . Normal )
( Scheduler . ReversePostorder )
( TransferFunctions )
@ -88,19 +111,20 @@ let report_siof pname loc bad_globals =
let siof_check pdesc = function
| Some post ->
| Some ( SiofDomain . NonBottom post ) ->
let attrs = Cfg . Procdesc . get_attributes pdesc in
let is_orig_file f = match attrs . ProcAttributes . translation_unit with
| Some orig_file ->
let orig_path = DB . source_file_to_abs_path orig_file in
string_equal orig_path @@ DB . source_file_to_abs_path f
string_equal orig_path ( DB . source_file_to_abs_path f )
| None -> false in
let is_foreign v = Option . map_default
( fun f -> not @@ is_orig_file f ) false ( Pvar . get_source_file v ) in
let foreign_globals = Domain. filter is_foreign post in
if not ( Domain. is_empty foreign_globals ) then
( fun f -> not (is_orig_file f ) ) false ( Pvar . get_source_file v ) in
let foreign_globals = SiofDomain. PvarSet Domain. filter is_foreign post in
if not ( SiofDomain. PvarSet Domain. is_empty foreign_globals ) then
report_siof ( Cfg . Procdesc . get_proc_name pdesc ) attrs . ProcAttributes . loc foreign_globals ;
| None -> ()
| Some SiofDomain . Bottom | None ->
()
let checker callback =
let pdesc = callback . Callbacks . proc_desc in
@ -109,4 +133,5 @@ let checker callback =
match pname with
| Procname . C c when Procname . is_globals_initializer c ->
siof_check pdesc post
| _ -> ()
| _ ->
()