Refactor Sil.call_flags into separate CallFlags module

Summary:
Move Sil.call_flags type and operations into separate CallFlags
module.

Reviewed By: dulmarod

Differential Revision: D3548086

fbshipit-source-id: 6d264e9
master
Josh Berdine 8 years ago committed by Facebook Github Bot 7
parent eefe05b240
commit ccd32690d7

@ -0,0 +1,53 @@
/*
* vim: set ft=rust:
* vim: set ft=reason:
*
* Copyright (c) 2009 - 2013 Monoidics ltd.
* Copyright (c) 2013 - present Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD style license found in the
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*/
open! Utils;
/** The Smallfoot Intermediate Language: Call Flags */
let module L = Logging;
let module F = Format;
/** Flags for a procedure call */
type t = {
cf_virtual: bool,
cf_interface: bool,
cf_noreturn: bool,
cf_is_objc_block: bool,
cf_targets: list Procname.t
};
let compare cflag1 cflag2 =>
bool_compare cflag1.cf_virtual cflag2.cf_virtual |>
next bool_compare cflag1.cf_interface cflag2.cf_interface |>
next bool_compare cflag1.cf_noreturn cflag2.cf_noreturn |>
next bool_compare cflag1.cf_is_objc_block cflag2.cf_is_objc_block;
let pp f cf => {
if cf.cf_virtual {
F.fprintf f " virtual"
};
if cf.cf_noreturn {
F.fprintf f " noreturn"
}
};
let default = {
cf_virtual: false,
cf_interface: false,
cf_noreturn: false,
cf_is_objc_block: false,
cf_targets: []
};

@ -0,0 +1,38 @@
/*
* vim: set ft=rust:
* vim: set ft=reason:
*
* Copyright (c) 2009 - 2013 Monoidics ltd.
* Copyright (c) 2013 - present Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD style license found in the
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*/
open! Utils;
/** The Smallfoot Intermediate Language: Call Flags */
let module L = Logging;
let module F = Format;
/** Flags for a procedure call */
type t = {
cf_virtual: bool,
cf_interface: bool,
cf_noreturn: bool,
cf_is_objc_block: bool,
cf_targets: list Procname.t
};
let compare: t => t => int;
let pp: F.formatter => t => unit;
/** Default value where all fields are set to false */
let default: t;

@ -704,7 +704,7 @@ let module Node = {
[(Sil.Var id, _), ...origin_args]
loc
call_flags
when call_flags.Sil.cf_virtual && redirected_class_name id != None => {
when call_flags.CallFlags.cf_virtual && redirected_class_name id != None => {
let redirected_typ = Option.get (redirected_class_name id);
let redirected_pname =
Procname.replace_class

@ -65,24 +65,6 @@ type dangling_kind =
/** position in a path: proc name, node id */
type path_pos = (Procname.t, int);
/** Flags for a procedure call */
type call_flags = {
cf_virtual: bool,
cf_interface: bool,
cf_noreturn: bool,
cf_is_objc_block: bool,
cf_targets: list Procname.t
};
let cf_default = {
cf_virtual: false,
cf_interface: false,
cf_noreturn: false,
cf_is_objc_block: false,
cf_targets: []
};
type taint_kind =
| Tk_unverified_SSL_socket
| Tk_shared_preferences_data
@ -100,14 +82,14 @@ type dexp =
| Dconst of Const.t
| Dsizeof of Typ.t (option dexp) Subtype.t
| Dderef of dexp
| Dfcall of dexp (list dexp) Location.t call_flags
| Dfcall of dexp (list dexp) Location.t CallFlags.t
| Darrow of dexp Ident.fieldname
| Ddot of dexp Ident.fieldname
| Dpvar of Pvar.t
| Dpvaraddr of Pvar.t
| Dunop of Unop.t dexp
| Dunknown
| Dretcall of dexp (list dexp) Location.t call_flags;
| Dretcall of dexp (list dexp) Location.t CallFlags.t;
/** Value paths: identify an occurrence of a value in a symbolic heap
@ -213,7 +195,7 @@ type instr =
/** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions
[ret_id1..ret_idn = e_fun(arg_ts);]
where n = 0 for void return and n > 1 for struct return */
| Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t call_flags
| Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t CallFlags.t
/** nullify stack variable */
| Nullify of Pvar.t Location.t
| Abstract of Location.t /** apply abstraction */
@ -1363,17 +1345,6 @@ let instr_get_exps =
| Declare_locals _ => [];
/** Pretty print call flags */
let pp_call_flags f cf => {
if cf.cf_virtual {
F.fprintf f " virtual"
};
if cf.cf_noreturn {
F.fprintf f " noreturn"
}
};
/** Pretty print an instruction. */
let pp_instr pe0 f instr => {
let (pe, changed) = color_pre_wrapper pe0 f instr;
@ -1396,7 +1367,7 @@ let pp_instr pe0 f instr => {
e
(pp_comma_seq (pp_exp_typ pe))
arg_ts
pp_call_flags
CallFlags.pp
cf
Location.pp
loc
@ -2995,12 +2966,6 @@ let instr_sub_ids sub_id_binders::sub_id_binders (f: Ident.t => exp) instr => {
/** apply [subst] to all id's in [instr], including binder id's */
let instr_sub (subst: subst) instr => instr_sub_ids sub_id_binders::true (apply_sub subst) instr;
let call_flags_compare cflag1 cflag2 =>
bool_compare cflag1.cf_virtual cflag2.cf_virtual |>
next bool_compare cflag1.cf_interface cflag2.cf_interface |>
next bool_compare cflag1.cf_noreturn cflag2.cf_noreturn |>
next bool_compare cflag1.cf_is_objc_block cflag2.cf_is_objc_block;
let exp_typ_compare (exp1, typ1) (exp2, typ2) => {
let n = exp_compare exp1 exp2;
if (n != 0) {
@ -3086,7 +3051,7 @@ let instr_compare instr1 instr2 =>
if (n != 0) {
n
} else {
call_flags_compare cf1 cf2
CallFlags.compare cf1 cf2
}
}
}
@ -3332,7 +3297,7 @@ let instr_compare_structural instr1 instr2 exp_map => {
if (n != 0) {
n
} else {
call_flags_compare cf1 cf2
CallFlags.compare cf1 cf2
},
exp_map
)

@ -53,20 +53,6 @@ type dangling_kind =
/** position in a path: proc name, node id */
type path_pos = (Procname.t, int);
/** Flags for a procedure call */
type call_flags = {
cf_virtual: bool,
cf_interface: bool,
cf_noreturn: bool,
cf_is_objc_block: bool,
cf_targets: list Procname.t
};
/** Default value for call_flags where all fields are set to false */
let cf_default: call_flags;
type taint_kind =
| Tk_unverified_SSL_socket
| Tk_shared_preferences_data
@ -84,14 +70,14 @@ type dexp =
| Dconst of Const.t
| Dsizeof of Typ.t (option dexp) Subtype.t
| Dderef of dexp
| Dfcall of dexp (list dexp) Location.t call_flags
| Dfcall of dexp (list dexp) Location.t CallFlags.t
| Darrow of dexp Ident.fieldname
| Ddot of dexp Ident.fieldname
| Dpvar of Pvar.t
| Dpvaraddr of Pvar.t
| Dunop of Unop.t dexp
| Dunknown
| Dretcall of dexp (list dexp) Location.t call_flags;
| Dretcall of dexp (list dexp) Location.t CallFlags.t;
/** Value paths: identify an occurrence of a value in a symbolic heap
@ -213,7 +199,7 @@ type instr =
/** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions
[ret_id1..ret_idn = e_fun(arg_ts);]
where n = 0 for void return and n > 1 for struct return */
| Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t call_flags
| Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t CallFlags.t
/** nullify stack variable */
| Nullify of Pvar.t Location.t
| Abstract of Location.t /** apply abstraction */
@ -472,8 +458,6 @@ let exp_equal: exp => exp => bool;
/** exp_is_array_index_of index arr returns true is index is an array index of arr. */
let exp_is_array_index_of: exp => exp => bool;
let call_flags_compare: call_flags => call_flags => int;
let exp_typ_compare: (exp, Typ.t) => (exp, Typ.t) => int;
let instr_compare: instr => instr => int;

@ -145,7 +145,7 @@ let id_is_assigned_then_dead node id =
and return the function name and arguments *)
let find_normal_variable_funcall
(node: Cfg.Node.t)
(id: Ident.t): (Sil.exp * (Sil.exp list) * Location.t * Sil.call_flags) option =
(id: Ident.t): (Sil.exp * (Sil.exp list) * Location.t * CallFlags.t) option =
let find_declaration _ = function
| Sil.Call ([id0], fun_exp, args, loc, call_flags) when Ident.equal id id0 ->
Some (fun_exp, IList.map fst args, loc, call_flags)

@ -25,7 +25,7 @@ val hpred_is_open_resource : 'a Prop.t -> Sil.hpred -> Sil.resource option
(** Find the function call instruction used to initialize normal variable [id],
and return the function name and arguments *)
val find_normal_variable_funcall :
Cfg.Node.t -> Ident.t -> (Sil.exp * (Sil.exp list) * Location.t * Sil.call_flags) option
Cfg.Node.t -> Ident.t -> (Sil.exp * (Sil.exp list) * Location.t * CallFlags.t) option
(** Find a program variable assignment in the current node or straightline predecessor. *)
val find_program_variable_assignment : Cfg.Node.t -> Pvar.t -> (Cfg.Node.t * Ident.t) option

@ -1165,7 +1165,8 @@ let execute_objc_alloc_no_fail
| Some pname -> [Sil.Const (Const.Cfun pname), Typ.Tvoid]
| None -> [] in
let alloc_instr =
Sil.Call (ret_ids, alloc_fun, [(sizeof_typ, ptr_typ)] @ alloc_fun_exp, loc, Sil.cf_default) in
Sil.Call
(ret_ids, alloc_fun, [(sizeof_typ, ptr_typ)] @ alloc_fun_exp, loc, CallFlags.default) in
SymExec.instrs tenv pdesc [alloc_instr] symb_state
let mk_objc_class_method class_name method_name =

@ -16,8 +16,8 @@ let add_dispatch_calls pdesc cg tenv =
(* TODO: handle dynamic dispatch for virtual calls as well *)
let call_flags_is_dispatch call_flags =
(* if sound dispatch is turned off, only consider dispatch for interface calls *)
(Config.sound_dynamic_dispatch && call_flags.Sil.cf_virtual) ||
call_flags.Sil.cf_interface in
(Config.sound_dynamic_dispatch && call_flags.CallFlags.cf_virtual) ||
call_flags.CallFlags.cf_interface in
let instr_is_dispatch_call = function
| Sil.Call (_, _, _, _, call_flags) -> call_flags_is_dispatch call_flags
| _ -> false in
@ -28,7 +28,7 @@ let add_dispatch_calls pdesc cg tenv =
(((_, receiver_typ) :: _) as args), loc, call_flags) as instr
when call_flags_is_dispatch call_flags ->
(* the frontend should not populate the list of targets *)
assert (call_flags.Sil.cf_targets = []);
assert (call_flags.CallFlags.cf_targets = []);
let receiver_typ_no_ptr = match receiver_typ with
| Typ.Tptr (typ', _) ->
typ'
@ -49,7 +49,7 @@ let add_dispatch_calls pdesc cg tenv =
IList.iter
(fun target_pname -> Cg.add_edge cg caller_pname target_pname)
targets_to_add;
let call_flags' = { call_flags with Sil.cf_targets = targets_to_add; } in
let call_flags' = { call_flags with CallFlags.cf_targets = targets_to_add; } in
Sil.Call (ret_ids, call_exp, args, loc, call_flags')
| [] -> instr)

@ -566,7 +566,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t
then resolve receiver_exp called_pname prop
else called_pname in
match actuals with
| _ when not (call_flags.Sil.cf_virtual || call_flags.Sil.cf_interface) ->
| _ when not (call_flags.CallFlags.cf_virtual || call_flags.CallFlags.cf_interface) ->
(* if this is not a virtual or interface call, there's no need for resolution *)
[callee_pname]
| (receiver_exp, actual_receiver_typ) :: _ ->
@ -575,13 +575,13 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t
[do_resolve callee_pname receiver_exp actual_receiver_typ]
else if Config.sound_dynamic_dispatch then
let targets =
if call_flags.Sil.cf_virtual
if call_flags.CallFlags.cf_virtual
then
(* virtual call--either [called_pname] or an override in some subtype may be called *)
callee_pname :: call_flags.Sil.cf_targets
callee_pname :: call_flags.CallFlags.cf_targets
else
(* interface call--[called_pname] has no implementation), we don't want to consider *)
call_flags.Sil.cf_targets in (* interface call, don't want to consider *)
call_flags.CallFlags.cf_targets in (* interface call, don't want to consider *)
(* return true if (receiver typ of [target_pname]) <: [actual_receiver_typ] *)
let may_dispatch_to target_pname =
let target_receiver_typ = get_receiver_typ target_pname actual_receiver_typ in
@ -594,8 +594,8 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t
else resolved_pname :: feasible_targets
else
begin
match call_flags.Sil.cf_targets with
| target :: _ when call_flags.Sil.cf_interface &&
match call_flags.CallFlags.cf_targets with
| target :: _ when call_flags.CallFlags.cf_interface &&
receiver_types_equal callee_pname actual_receiver_typ ->
(* "production mode" of dynamic dispatch for Java: unsound, but faster. the handling
is restricted to interfaces: if we can't resolve an interface call, we pick the
@ -628,7 +628,7 @@ let resolve_java_pname tenv prop args pname_java call_flags : Procname.java =
match args with
| [] ->
pname_java, []
| (first_arg, _) :: other_args when call_flags.Sil.cf_virtual ->
| (first_arg, _) :: other_args when call_flags.CallFlags.cf_virtual ->
let resolved =
begin
match resolve_typename prop first_arg with
@ -1222,10 +1222,10 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
IList.flatten (IList.map do_call sentinel_result)
| Sil.Call (ret_ids, fun_exp, actual_params, loc, call_flags) -> (** Call via function pointer *)
let (prop_r, n_actual_params) = normalize_params current_pname prop_ actual_params in
if call_flags.Sil.cf_is_objc_block then
if call_flags.CallFlags.cf_is_objc_block then
Rearrange.check_call_to_objc_block_error current_pdesc prop_r fun_exp loc;
Rearrange.check_dereference_error current_pdesc prop_r fun_exp loc;
if call_flags.Sil.cf_noreturn then begin
if call_flags.CallFlags.cf_noreturn then begin
L.d_str "Unknown function pointer with noreturn attribute ";
Sil.d_exp fun_exp; L.d_strln ", diverging.";
diverge prop_r path
@ -1424,7 +1424,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
IList.fold_left do_attribute p (Prop.get_exp_attributes p e) in
let filtered_args =
match args, instr with
| _:: other_args, Sil.Call (_, _, _, _, { Sil.cf_virtual }) when cf_virtual ->
| _:: other_args, Sil.Call (_, _, _, _, { CallFlags.cf_virtual }) when cf_virtual ->
(* Do not remove the file attribute on the reciver for virtual calls *)
other_args
| _ -> args in

@ -170,7 +170,8 @@ module Match = struct
else false
| CodeQueryAst.Call _, _ -> false
| CodeQueryAst.MethodCall (ae1, ae2, ael_opt),
Sil.Call (_, Sil.Const (Const.Cfun pn), (_e1, _):: params, loc, { Sil.cf_virtual = true }) ->
Sil.Call (_, Sil.Const (Const.Cfun pn), (_e1, _) :: params,
loc, { CallFlags.cf_virtual = true }) ->
let e1 = Idenv.expand_expr idenv _e1 in
let vl = IList.map (function _e, _ -> Vval (Idenv.expand_expr idenv _e)) params in
if exp_match env ae1 (Vval e1) && exp_match env ae2 (Vfun pn) && opt_match exp_list_match env ael_opt vl then

@ -29,7 +29,7 @@ struct
(* ignore return ids and call flags *)
let n = Sil.exp_compare e1 e2 in
if n <> 0 then n else let n = IList.compare Sil.exp_typ_compare etl1 etl2 in
if n <> 0 then n else Sil.call_flags_compare cf1 cf2
if n <> 0 then n else CallFlags.compare cf1 cf2
| _ -> Sil.instr_compare i1 i2
end)

@ -27,7 +27,7 @@ let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl =
let autorelease_pname = ModelBuiltins.__set_autorelease_attribute in
let mk_call procname e t =
let bi_retain = Sil.Const (Const.Cfun procname) in
Sil.Call([], bi_retain, [(e, t)], loc, Sil.cf_default) in
Sil.Call([], bi_retain, [(e, t)], loc, CallFlags.default) in
match typ with
| Typ.Tptr (_, Typ.Pk_pointer) when not rhs_owning_method && not is_e1_decl ->
(* for __strong e1 = e2 the semantics is*)

@ -84,7 +84,8 @@ struct
let fname = ModelBuiltins.__set_autorelease_attribute in
let ret_id = Ident.create_fresh Ident.knormal in
let stmt_call =
Sil.Call ([ret_id], Sil.Const (Const.Cfun fname), [(exp, typ)], sil_loc, Sil.cf_default) in
Sil.Call
([ret_id], Sil.Const (Const.Cfun fname), [(exp, typ)], sil_loc, CallFlags.default) in
[stmt_call]
else []
@ -878,7 +879,7 @@ struct
exps = [(cast_exp, function_type)]; }
| None ->
let call_flags =
{ Sil.cf_default with Sil.cf_is_objc_block = is_call_to_block; } in
{ CallFlags.default with CallFlags.cf_is_objc_block = is_call_to_block; } in
create_call_instr trans_state function_type sil_fe act_params sil_loc
call_flags ~is_objc_method:false in
let nname = "Call "^(Sil.exp_to_string sil_fe) in
@ -919,11 +920,11 @@ struct
(* first expr is method address, rest are params including 'this' parameter *)
let actual_params = IList.tl (collect_exprs result_trans_subexprs) in
let call_flags = {
Sil.cf_virtual = is_cpp_call_virtual;
Sil.cf_interface = false;
Sil.cf_noreturn = false;
Sil.cf_is_objc_block = false;
Sil.cf_targets = [];
CallFlags.cf_virtual = is_cpp_call_virtual;
CallFlags.cf_interface = false;
CallFlags.cf_noreturn = false;
CallFlags.cf_is_objc_block = false;
CallFlags.cf_targets = [];
} in
let res_trans_call = create_call_instr trans_state_pri function_type sil_method actual_params
sil_loc call_flags ~is_objc_method:false in
@ -1066,7 +1067,7 @@ struct
let res_trans_block = { empty_res_trans with
instrs = instr_block_param;
} in
let call_flags = { Sil.cf_default with Sil.cf_virtual = is_virtual; } in
let call_flags = { CallFlags.default with CallFlags.cf_virtual = is_virtual; } in
let method_sil = Sil.Const (Const.Cfun callee_name) in
let res_trans_call = create_call_instr trans_state method_type method_sil param_exps
sil_loc call_flags ~is_objc_method:true in
@ -1977,7 +1978,7 @@ struct
let autorelease_pool_vars = CVar_decl.compute_autorelease_pool_vars context stmts in
let stmt_call =
Sil.Call([ret_id], (Sil.Const (Const.Cfun fname)),
autorelease_pool_vars, sil_loc, Sil.cf_default) in
autorelease_pool_vars, sil_loc, CallFlags.default) in
let node_kind = Cfg.Node.Stmt_node ("Release the autorelease pool") in
let call_node = create_node node_kind [stmt_call] sil_loc context in
Cfg.Node.set_succs_exn context.cfg call_node trans_state.succ_nodes [];
@ -2133,7 +2134,8 @@ struct
let result_trans_param = exec_with_self_exception instruction trans_state_param param in
let exp = extract_exp_from_list result_trans_param.exps
"WARNING: There should be one expression to delete. \n" in
let call_instr = Sil.Call ([], Sil.Const (Const.Cfun fname), [exp], sil_loc, Sil.cf_default) in
let call_instr =
Sil.Call ([], Sil.Const (Const.Cfun fname), [exp], sil_loc, CallFlags.default) in
let call_res_trans = { empty_res_trans with instrs = [call_instr] } in
let all_res_trans = if false then
(* FIXME (t10135167): call destructor on deleted pointer if it's not null *)
@ -2193,7 +2195,7 @@ struct
let exp = match res_trans_stmt.exps with | [e] -> e | _ -> assert false in
let args = [exp; (sizeof_expr, Typ.Tvoid)] in
let ret_id = Ident.create_fresh Ident.knormal in
let call = Sil.Call ([ret_id], builtin, args, sil_loc, Sil.cf_default) in
let call = Sil.Call ([ret_id], builtin, args, sil_loc, CallFlags.default) in
let res_ex = Sil.Var ret_id in
let res_trans_dynamic_cast = { empty_res_trans with instrs = [call]; } in
let all_res_trans = [ res_trans_stmt; res_trans_dynamic_cast ] in
@ -2216,7 +2218,7 @@ struct
let params = collect_exprs res_trans_subexpr_list in
let fun_name = Procname.from_string_c_fun CFrontend_config.infer_skip_gcc_ast_stmt in
let sil_fun = Sil.Const (Const.Cfun fun_name) in
let call_instr = Sil.Call ([], sil_fun, params, sil_loc, Sil.cf_default) in
let call_instr = Sil.Call ([], sil_fun, params, sil_loc, CallFlags.default) in
let res_trans_call = { empty_res_trans with
instrs = [call_instr];
exps = []; } in
@ -2249,7 +2251,7 @@ struct
let ret_exp = Sil.Var ret_id in
let field_exp = Sil.Lfield (ret_exp, field_name, typ) in
let args = [type_info_objc; (field_exp, Typ.Tvoid)] @ res_trans_subexpr.exps in
let call_instr = Sil.Call ([ret_id], sil_fun, args, sil_loc, Sil.cf_default) in
let call_instr = Sil.Call ([ret_id], sil_fun, args, sil_loc, CallFlags.default) in
let res_trans_call = { empty_res_trans with
instrs = [call_instr];
exps = [(ret_exp, typ)]; } in
@ -2272,7 +2274,7 @@ struct
let sil_fun = Sil.Const (Const.Cfun fun_name) in
let ret_id = Ident.create_fresh Ident.knormal in
let ret_exp = Sil.Var ret_id in
let call_instr = Sil.Call ([ret_id], sil_fun, params, sil_loc, Sil.cf_default) in
let call_instr = Sil.Call ([ret_id], sil_fun, params, sil_loc, CallFlags.default) in
let res_trans_call = { empty_res_trans with
instrs = [call_instr];
exps = [(ret_exp, typ)]; } in

@ -306,7 +306,8 @@ let create_alloc_instrs context sil_loc function_type fname size_exp_opt procnam
| None -> [] in
let args = exp :: procname_arg in
let ret_id = Ident.create_fresh Ident.knormal in
let stmt_call = Sil.Call([ret_id], Sil.Const (Const.Cfun fname), args, sil_loc, Sil.cf_default) in
let stmt_call =
Sil.Call([ret_id], Sil.Const (Const.Cfun fname), args, sil_loc, CallFlags.default) in
(function_type, stmt_call, Sil.Var ret_id)
let alloc_trans trans_state loc stmt_info function_type is_cf_non_null_alloc procname_opt =
@ -328,7 +329,7 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
create_alloc_instrs trans_state.context loc function_type fname None None in
let init_ret_id = Ident.create_fresh Ident.knormal in
let is_instance = true in
let call_flags = { Sil.cf_default with Sil.cf_virtual = is_instance; } in
let call_flags = { CallFlags.default with CallFlags.cf_virtual = is_instance; } in
let pname = General_utils.mk_procname_from_objc_method cls_name CFrontend_config.init Procname.Instance_objc_method in
CMethod_trans.create_external_procdesc trans_state.context.CContext.cfg pname is_instance None;
let args = [(alloc_ret_exp, alloc_ret_type)] in
@ -371,7 +372,7 @@ let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc =
let pname = ModelBuiltins.__objc_cast in
let args = [(exp, cast_from_typ); (sizeof_exp, Typ.Tint Typ.IULong)] in
let stmt_call =
Sil.Call ([ret_id], Sil.Const (Const.Cfun pname), args, sil_loc, Sil.cf_default) in
Sil.Call ([ret_id], Sil.Const (Const.Cfun pname), args, sil_loc, CallFlags.default) in
(stmt_call, Sil.Var ret_id)
let cast_trans context exps sil_loc callee_pname_opt function_type =
@ -444,7 +445,7 @@ let cast_operation trans_state cast_kind exps cast_typ sil_loc is_objc_bridged =
let trans_assertion_failure sil_loc context =
let assert_fail_builtin = Sil.Const (Const.Cfun ModelBuiltins.__infer_fail) in
let args = [Sil.Const (Const.Cstr Config.default_failure_name), Typ.Tvoid] in
let call_instr = Sil.Call ([], assert_fail_builtin, args, sil_loc, Sil.cf_default) in
let call_instr = Sil.Call ([], assert_fail_builtin, args, sil_loc, CallFlags.default) in
let exit_node = Cfg.Procdesc.get_exit_node (CContext.get_procdesc context)
and failure_node =
Nodes.create_node (Cfg.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in

@ -104,8 +104,8 @@ module ComplexExpressions = struct
pp_to_string (Const.pp pe_text) c
| Sil.Dderef de ->
dexp_to_string de
| Sil.Dfcall (fun_dexp, args, _, { Sil.cf_virtual = isvirtual })
| Sil.Dretcall (fun_dexp, args, _, { Sil.cf_virtual = isvirtual })
| Sil.Dfcall (fun_dexp, args, _, { CallFlags.cf_virtual = isvirtual })
| Sil.Dretcall (fun_dexp, args, _, { CallFlags.cf_virtual = isvirtual })
when functions_idempotent () ->
let pp_arg fmt de = F.fprintf fmt "%s" (dexp_to_string de) in
let pp_args fmt des = (pp_comma_seq) pp_arg fmt des in
@ -773,7 +773,7 @@ let typecheck_instr
let dexp_get = Sil.Dconst (Const.Cfun pname_get) in
let dexp_map = Sil.Dpvar pv_map in
let args = [dexp_map; dexp_key] in
let call_flags = { Sil.cf_default with Sil.cf_virtual = true } in
let call_flags = { CallFlags.default with CallFlags.cf_virtual = true } in
Some (Sil.Dretcall (dexp_get, args, loc, call_flags))
| _ -> None in
begin
@ -801,7 +801,7 @@ let typecheck_instr
EradicateChecks.classify_procedure callee_attributes in
L.stdout " %s unique id: %s@." classification unique_id
end;
if cflags.Sil.cf_virtual && checks.eradicate then
if cflags.CallFlags.cf_virtual && checks.eradicate then
EradicateChecks.check_call_receiver
find_canonical_duplicate
curr_pname

@ -50,7 +50,7 @@ let env_add_instr instr env =
{ env with instrs = instr :: env.instrs; pc = incr_pc env.pc }
(** call flags for an allocation or call to a constructor *)
let cf_alloc = Sil.cf_default
let cf_alloc = CallFlags.default
let fun_exp_from_name proc_name = Sil.Const (Const.Cfun (proc_name))
@ -158,7 +158,7 @@ and inhabit_constructor constr_name (allocated_obj, obj_type) cfg env =
inhabit_args non_receiver_formals cfg env in
let constr_instr =
let fun_exp = fun_exp_from_name constr_name in
Sil.Call ([], fun_exp, (allocated_obj, obj_type) :: args, env.pc, Sil.cf_default) in
Sil.Call ([], fun_exp, (allocated_obj, obj_type) :: args, env.pc, CallFlags.default) in
env_add_instr constr_instr env
with Not_found -> env
@ -168,7 +168,8 @@ let inhabit_call_with_args procname procdesc args env =
if is_void then [] else [Ident.create_fresh Ident.knormal] in
let call_instr =
let fun_exp = fun_exp_from_name procname in
let flags = { Sil.cf_default with Sil.cf_virtual = not (Procname.java_is_static procname); } in
let flags =
{ CallFlags.default with CallFlags.cf_virtual = not (Procname.java_is_static procname); } in
Sil.Call (retval, fun_exp, args, env.pc, flags) in
env_add_instr call_instr env

@ -448,7 +448,7 @@ let rec expression context pc expr =
let args = [(sil_ex, type_of_ex)] in
let ret_id = Ident.create_fresh Ident.knormal in
let call_instr =
Sil.Call ([ret_id], builtin_get_array_length, args, loc, Sil.cf_default) in
Sil.Call ([ret_id], builtin_get_array_length, args, loc, CallFlags.default) in
(instrs @ [deref; call_instr], Sil.Var ret_id, type_of_expr)
| JBir.Conv conv ->
let cast_ex = Sil.Cast (JTransType.cast_type conv, sil_ex) in
@ -468,7 +468,7 @@ let rec expression context pc expr =
| _ -> assert false) in
let args = [(sil_ex, type_of_ex); (sizeof_expr, Typ.Tvoid)] in
let ret_id = Ident.create_fresh Ident.knormal in
let call = Sil.Call([ret_id], builtin, args, loc, Sil.cf_default) in
let call = Sil.Call([ret_id], builtin, args, loc, CallFlags.default) in
let res_ex = Sil.Var ret_id in
(instrs @ [call], res_ex, type_of_expr)
end
@ -559,8 +559,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_
| I_Virtual -> (true, false)
| I_Interface -> (true, true)
| _ -> (false, false) in
let call_flags =
{ Sil.cf_default with Sil.cf_virtual = cf_virtual; Sil.cf_interface = cf_interface; } in
let call_flags = { CallFlags.default with cf_virtual; cf_interface; } in
let init =
match sil_obj_opt with
| None -> [], []
@ -621,7 +620,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_
when Procname.is_constructor callee_procname && JTransType.is_closeable program tenv typ ->
let set_file_attr =
let set_builtin = Sil.Const (Const.Cfun ModelBuiltins.__set_file_attribute) in
Sil.Call ([], set_builtin, [exp], loc, Sil.cf_default) in
Sil.Call ([], set_builtin, [exp], loc, CallFlags.default) in
(* Exceptions thrown in the constructor should prevent adding the resource attribute *)
call_instrs @ [set_file_attr]
@ -630,7 +629,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_
when Procname.java_is_close callee_procname && JTransType.is_closeable program tenv typ ->
let set_mem_attr =
let set_builtin = Sil.Const (Const.Cfun ModelBuiltins.__set_mem_attribute) in
Sil.Call ([], set_builtin, [exp], loc, Sil.cf_default) in
Sil.Call ([], set_builtin, [exp], loc, CallFlags.default) in
(* Exceptions thrown in the close method should not prevent the resource from being *)
(* considered as closed *)
[set_mem_attr] @ call_instrs
@ -763,7 +762,7 @@ let assume_not_null loc sil_expr =
let builtin_infer_assume = Sil.Const (Const.Cfun ModelBuiltins.__infer_assume) in
let not_null_expr =
Sil.BinOp (Binop.Ne, sil_expr, Sil.exp_null) in
let assume_call_flag = { Sil.cf_default with Sil.cf_noreturn = true; } in
let assume_call_flag = { CallFlags.default with CallFlags.cf_noreturn = true; } in
let call_args = [(not_null_expr, Typ.Tint Typ.IBool)] in
Sil.Call ([], builtin_infer_assume, call_args, loc, assume_call_flag)
@ -795,7 +794,7 @@ let rec instruction context pc instr : translation =
let trans_monitor_enter_exit context expr pc loc builtin node_desc =
let instrs, sil_expr, sil_type = expression context pc expr in
let builtin_const = Sil.Const (Const.Cfun builtin) in
let instr = Sil.Call ([], builtin_const, [(sil_expr, sil_type)], loc, Sil.cf_default) in
let instr = Sil.Call ([], builtin_const, [(sil_expr, sil_type)], loc, CallFlags.default) in
let typ_no_ptr = match sil_type with
| Typ.Tptr (typ, _) -> typ
| _ -> sil_type in
@ -903,7 +902,7 @@ let rec instruction context pc instr : translation =
let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in
let args = [(sizeof_exp, class_type)] in
let ret_id = Ident.create_fresh Ident.knormal in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in
let constr_ms = JBasics.make_ms JConfig.constructor_name constr_type_list None in
let constr_procname, call_instrs =
let ret_opt = Some (Sil.Var ret_id, class_type) in
@ -925,7 +924,7 @@ let rec instruction context pc instr : translation =
let (instrs, array_size) = get_array_length context pc expr_list content_type in
let call_args = [(array_size, array_type)] in
let ret_id = Ident.create_fresh Ident.knormal in
let call_instr = Sil.Call([ret_id], builtin_new_array, call_args, loc, Sil.cf_default) in
let call_instr = Sil.Call([ret_id], builtin_new_array, call_args, loc, CallFlags.default) in
let set_instr = Sil.Set (Sil.Lvar array_name, array_type, Sil.Var ret_id, loc) in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node = create_node node_kind (instrs @ [call_instr; set_instr]) in
@ -1017,7 +1016,7 @@ let rec instruction context pc instr : translation =
let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in
let args = [(sizeof_exp, class_type)] in
let ret_id = Ident.create_fresh Ident.knormal in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in
let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
let _, call_instrs =
let ret_opt = Some (Sil.Var ret_id, class_type) in
@ -1070,7 +1069,7 @@ let rec instruction context pc instr : translation =
let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in
let args = [(sizeof_exp, class_type)] in
let ret_id = Ident.create_fresh Ident.knormal in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in
let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
let _, call_instrs =
method_invocation
@ -1092,7 +1091,7 @@ let rec instruction context pc instr : translation =
JTransType.sizeof_of_object_type program tenv object_type Subtype.subtypes_instof in
let check_cast = Sil.Const (Const.Cfun ModelBuiltins.__instanceof) in
let args = [(sil_expr, sil_type); (sizeof_expr, Typ.Tvoid)] in
let call = Sil.Call([ret_id], check_cast, args, loc, Sil.cf_default) in
let call = Sil.Call([ret_id], check_cast, args, loc, CallFlags.default) in
let res_ex = Sil.Var ret_id in
let is_instance_node =
let check_is_false = Sil.BinOp (Binop.Ne, res_ex, Sil.exp_zero) in
@ -1109,7 +1108,7 @@ let rec instruction context pc instr : translation =
let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in
let args = [(sizeof_exp, class_type)] in
let ret_id = Ident.create_fresh Ident.knormal in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in
let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in
let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
let _, call_instrs =
method_invocation context loc pc None cce_cn constr_ms

@ -42,7 +42,8 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table =
let instr_deactivate_exn = Sil.Set (Sil.Lvar ret_var, ret_type, Sil.Var id_deactivate, loc) in
let instr_unwrap_ret_val =
let unwrap_builtin = Sil.Const (Const.Cfun ModelBuiltins.__unwrap_exception) in
Sil.Call([id_exn_val], unwrap_builtin, [(Sil.Var id_ret_val, ret_type)], loc, Sil.cf_default) in
Sil.Call
([id_exn_val], unwrap_builtin, [(Sil.Var id_ret_val, ret_type)], loc, CallFlags.default) in
create_node
loc
Cfg.Node.exn_handler_kind
@ -70,7 +71,7 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table =
let args = [
(Sil.Var id_exn_val, Typ.Tptr(exn_type, Typ.Pk_pointer));
(Sil.Sizeof (exn_type, None, Subtype.exact), Typ.Tvoid)] in
Sil.Call ([id_instanceof], instanceof_builtin, args, loc, Sil.cf_default) in
Sil.Call ([id_instanceof], instanceof_builtin, args, loc, CallFlags.default) in
let if_kind = Sil.Ik_switch in
let instr_prune_true = Sil.Prune (Sil.Var id_instanceof, loc, true, if_kind) in
let instr_prune_false =

@ -187,7 +187,8 @@ let translate_instr_static_field context callee_procdesc fs field_type loc =
let callee_procname = Cfg.Procdesc.get_proc_name callee_procdesc in
let callee_fun = Sil.Const (Const.Cfun callee_procname) in
let field_arg = Sil.Const (Const.Cstr (JBasics.fs_name fs)) in
let call_instr = Sil.Call([ret_id], callee_fun, [field_arg, field_type], loc, Sil.cf_default) in
let call_instr =
Sil.Call ([ret_id], callee_fun, [field_arg, field_type], loc, CallFlags.default) in
Cg.add_edge cg caller_procname callee_procname;
([call_instr], Sil.Var ret_id)

@ -99,7 +99,7 @@ let rec trans_annotated_instructions
[ident_of_variable ret_var],
Sil.Const (Const.Cfun (procname_of_function_variable func_var)),
IList.map (fun (tp, arg) -> (trans_operand arg, trans_typ tp)) typed_args,
location, Sil.cf_default) in
location, CallFlags.default) in
(new_sil_instr :: sil_instrs, locals)
| _ -> raise (Unimplemented "Need to translate instruction to SIL.")
end

@ -92,7 +92,7 @@ module StructuredSil = struct
let make_call ?(procname=dummy_procname) ret_ids args =
let call_exp = Sil.Const (Const.Cfun procname) in
Cmd (Sil.Call (ret_ids, call_exp, args, dummy_loc, Sil.cf_default))
Cmd (Sil.Call (ret_ids, call_exp, args, dummy_loc, CallFlags.default))
let id_assign_id ?(rhs_typ=dummy_typ) lhs rhs =
let lhs_id = ident_of_str lhs in

Loading…
Cancel
Save