Reviewed By: jvillard Differential Revision: D10146134 fbshipit-source-id: 3874a403cmaster
parent
7fd21e056c
commit
10804588b2
@ -0,0 +1,96 @@
|
||||
(*
|
||||
* Copyright (c) 2018-present, Facebook, Inc.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
module Procname = struct
|
||||
type t = Typ.Procname.t [@@deriving compare]
|
||||
|
||||
let pp = Typ.Procname.pp
|
||||
end
|
||||
|
||||
module ProcnameSet = AbstractDomain.FiniteSet (Procname)
|
||||
module Domain = AbstractDomain.Map (String) (ProcnameSet)
|
||||
|
||||
module TransferFunctions (CFG : ProcCfg.S) = struct
|
||||
module CFG = CFG
|
||||
module Domain = Domain
|
||||
|
||||
type extras = ProcData.no_extras
|
||||
|
||||
let exec_instr astate _ _ = function
|
||||
| Sil.Load (lhs_id, _, _, _) when Ident.is_none lhs_id ->
|
||||
astate
|
||||
| Sil.Load (lhs_id, Exp.Lvar rhs_pvar, Typ.({desc= Tptr ({desc= Tfun _}, _)}), _) ->
|
||||
let fun_ptr =
|
||||
try Domain.find (Pvar.to_string rhs_pvar) astate with Caml.Not_found -> ProcnameSet.empty
|
||||
in
|
||||
Domain.add (Ident.to_string lhs_id) fun_ptr astate
|
||||
| Sil.Store (Lvar lhs_pvar, _, Exp.Const (Const.Cfun pn), _) ->
|
||||
(* strong update *)
|
||||
Domain.add (Pvar.to_string lhs_pvar) (ProcnameSet.singleton pn) astate
|
||||
| Sil.Abstract _ | Call _ | Load _ | Nullify _ | Prune _ | Remove_temps _ | Store _ ->
|
||||
astate
|
||||
|
||||
|
||||
let pp_session_name _node fmt = F.pp_print_string fmt "function pointers"
|
||||
end
|
||||
|
||||
module CFG = ProcCfg.Normal
|
||||
module Analyzer = AbstractInterpreter.MakeRPO (TransferFunctions (CFG))
|
||||
|
||||
let find_procname var astate =
|
||||
match Domain.find_opt (Ident.to_string var) astate with
|
||||
| Some procnames ->
|
||||
if ProcnameSet.is_empty procnames then None
|
||||
else Some (ProcnameSet.min_elt procnames)
|
||||
(* TODO: handle multiple procnames, e.g. with non-determinism branching *)
|
||||
| None ->
|
||||
None
|
||||
|
||||
|
||||
let substitute_expr astate expr =
|
||||
match expr with
|
||||
| Exp.Var var -> (
|
||||
match find_procname var astate with Some pname -> Exp.Const (Const.Cfun pname) | None -> expr )
|
||||
| _ ->
|
||||
expr
|
||||
|
||||
|
||||
let substitute_arg astate arg =
|
||||
let expr, typ = arg in
|
||||
let expr' = substitute_expr astate expr in
|
||||
if phys_equal expr' expr then arg else (expr', typ)
|
||||
|
||||
|
||||
let substitute_function_ptrs ~function_pointers node instr =
|
||||
match instr with
|
||||
| Sil.Call (ret, e_fun, args, loc, cfs) -> (
|
||||
let node_id = CFG.Node.id node in
|
||||
match Analyzer.extract_post node_id function_pointers with
|
||||
| None ->
|
||||
instr
|
||||
| Some astate ->
|
||||
let e_fun' = substitute_expr astate e_fun in
|
||||
let args' = IList.map_changed args ~equal:phys_equal ~f:(substitute_arg astate) in
|
||||
if phys_equal e_fun' e_fun && phys_equal args' args then instr
|
||||
else Sil.Call (ret, e_fun', args', loc, cfs) )
|
||||
| _ ->
|
||||
instr
|
||||
|
||||
|
||||
let get_function_pointers proc_desc tenv =
|
||||
let proc_data = ProcData.make_default proc_desc tenv in
|
||||
let cfg = CFG.from_pdesc proc_desc in
|
||||
Analyzer.exec_cfg cfg proc_data ~initial:Domain.empty
|
||||
|
||||
|
||||
let substitute_function_pointers proc_desc tenv =
|
||||
let function_pointers = get_function_pointers proc_desc tenv in
|
||||
let f = substitute_function_ptrs ~function_pointers in
|
||||
Procdesc.replace_instrs proc_desc ~f
|
Loading…
Reference in new issue