diff --git a/src/kernel_services/plugin_entry_points/db.ml b/src/kernel_services/plugin_entry_points/db.ml
index 6d7e0a97be49d98241f37be69baf4bc27c6355c0..699745967d929230091a915a67daa2544e1a648b 100644
--- a/src/kernel_services/plugin_entry_points/db.ml
+++ b/src/kernel_services/plugin_entry_points/db.ml
@@ -618,7 +618,7 @@ module Value = struct
(** Type for a Value builtin function *)
- type builtin_type = typ * typ list
+ type builtin_type = unit -> typ * typ list
type builtin =
state ->
(Cil_types.exp * Cvalue.V.t * Cvalue.V_Offsetmap.t) list ->
diff --git a/src/kernel_services/plugin_entry_points/db.mli b/src/kernel_services/plugin_entry_points/db.mli
index df8e76225528cc8d6f61c8f76e41f1a2012d10d3..b37707a8ae7b1d07f2a3d5ee08266868707eb9c0 100644
--- a/src/kernel_services/plugin_entry_points/db.mli
+++ b/src/kernel_services/plugin_entry_points/db.mli
@@ -179,7 +179,7 @@ module Value : sig
(* Type of a C function interpreted by a builtin:
return type and list of argument types. *)
- type builtin_type = typ * typ list
+ type builtin_type = unit -> typ * typ list
(** Type for an Eva builtin function *)
type builtin =
diff --git a/src/plugins/value/domains/cvalue/builtins.ml b/src/plugins/value/domains/cvalue/builtins.ml
index 55f7f29e6d3546c8ff5f8b4c5ea1083aef6ebf19..2465cf2763583f4fb4225f8507e0273d07e61ee8 100644
--- a/src/plugins/value/domains/cvalue/builtins.ml
+++ b/src/plugins/value/domains/cvalue/builtins.ml
@@ -30,8 +30,13 @@ exception Invalid_nb_of_args of int
if -val-builtins-auto is set. *)
type use_builtin = Always | OnAuto
+(* Table of all registered builtins; filled by [register_builtin] calls. *)
let table = Hashtbl.create 17
+(* Table binding each kernel function to their builtin for a given analysis.
+ Filled at the beginning of each analysis by [prepare_builtins]. *)
+let builtins_table = Hashtbl.create 17
+
let register_builtin name ?replace ?typ f =
Hashtbl.replace table name (f, typ, None, Always);
match replace with
@@ -100,7 +105,7 @@ let mem_builtin name =
let () = Db.Value.mem_builtin := mem_builtin
-(* Returns the builtin with its specification, used to evaluate preconditions
+(* Returns the specification of a builtin, used to evaluate preconditions
and to transfer the states of other domains. *)
let find_builtin_specification kf =
let spec = Annotations.funspec kf in
@@ -113,7 +118,8 @@ let find_builtin_specification kf =
for a given builtin, which therefore cannot be applied. *)
let inconsistent_builtin_typ kf = function
| None -> false (* No expected type provided with the builtin, no check. *)
- | Some (expected_result, expected_args) ->
+ | Some typ ->
+ let expected_result, expected_args = typ () in
match Kernel_function.get_type kf with
| TFun (result, args, _, _) ->
let args = Cil.argsToList args in
@@ -122,66 +128,62 @@ let inconsistent_builtin_typ kf = function
|| List.exists2 (fun (_, t, _) u -> Cil.need_cast t u) args expected_args
| _ -> assert false
-let find_builtin_override kf =
- let name =
- try Value_parameters.BuiltinsOverrides.find kf
- with Not_found -> Kernel_function.get_name kf
+(* Warns if the builtin [bname] overrides the function definition [kf]. *)
+let warn_builtin_override kf source bname =
+ let internal =
+ (* TODO: treat this 'internal' *)
+ let file = source.Filepath.pos_path in
+ Filepath.is_relative ~base_name:Config.datadir (file :> string)
in
- try
- let f, typ, _, u = Hashtbl.find table name in
- if (u = Always || Value_parameters.BuiltinsAuto.get ())
- && not (inconsistent_builtin_typ kf typ)
- then Extlib.opt_map (fun s -> name, f, s) (find_builtin_specification kf)
- else None
- with Not_found -> None
+ if Kernel_function.is_definition kf && not internal
+ then
+ let fname = Kernel_function.get_name kf in
+ Value_parameters.warning ~source ~once:true
+ ~wkey:Value_parameters.wkey_builtins_override
+ "function %s: definition will be overridden by %s"
+ fname (if fname = bname then "its builtin" else "builtin " ^ bname)
-let warn_builtin_override bname kf expected_typ =
+let prepare_builtin kf builtin_name builtin expected_typ =
let source = fst (Kernel_function.get_location kf) in
if inconsistent_builtin_typ kf expected_typ
then
Value_parameters.warning ~source ~once:true
~wkey:Value_parameters.wkey_builtins_override
"The builtin %s will not be used for function %a of incompatible type."
- bname Kernel_function.pretty kf
+ builtin_name Kernel_function.pretty kf
else
- if find_builtin_specification kf = None
- then
- Value_parameters.warning ~source ~once:true
- ~wkey:Value_parameters.wkey_builtins_missing_spec
- "The builtin for function %a will not be used, as its frama-c libc \
- specification is not available."
- Kernel_function.pretty kf
- else
- let internal =
- let pos = fst (Kernel_function.get_location kf) in
- (*TODO: treat this 'internal'*)
- let file = pos.Filepath.pos_path in
- Filepath.is_relative ~base_name:Config.datadir (file :> string)
- in
- if Kernel_function.is_definition kf && not internal
- then
- let fname = Kernel_function.get_name kf in
+ match find_builtin_specification kf with
+ | None ->
Value_parameters.warning ~source ~once:true
- ~wkey:Value_parameters.wkey_builtins_override
- "function %s: definition will be overridden by %s"
- fname (if fname = bname then "its builtin" else "builtin " ^ bname)
+ ~wkey:Value_parameters.wkey_builtins_missing_spec
+ "The builtin for function %a will not be used, as its frama-c libc \
+ specification is not available."
+ Kernel_function.pretty kf
+ | Some spec ->
+ warn_builtin_override kf source builtin_name;
+ Hashtbl.replace builtins_table kf (builtin_name, builtin, spec)
-let warn_definitions_overridden_by_builtins () =
- Value_parameters.BuiltinsOverrides.iter
- (fun (kf, name) ->
- let name = Extlib.the name in
- let (_, typ, _ , _) = Hashtbl.find table name in
- warn_builtin_override name kf typ);
+let prepare_builtins () =
+ Hashtbl.clear builtins_table;
let autobuiltins = Value_parameters.BuiltinsAuto.get () in
+ (* Links kernel functions to the registered builtins. *)
Hashtbl.iter
- (fun name (_, typ, _, u) ->
+ (fun name (f, typ, _bname, u) ->
if autobuiltins || u = Always
then
try
let kf = Globals.Functions.find_by_name name in
- warn_builtin_override name kf typ
+ prepare_builtin kf name f typ
with Not_found -> ())
- table
+ table;
+ (* Overrides builtins attribution according to the -eva-builtin option. *)
+ Value_parameters.BuiltinsOverrides.iter
+ (fun (kf, name) ->
+ let builtin_name = Extlib.the name in
+ let f, typ, _, _ = Hashtbl.find table builtin_name in
+ prepare_builtin kf builtin_name f typ)
+
+let find_builtin_override = Hashtbl.find_opt builtins_table
(* -------------------------------------------------------------------------- *)
(* --- Returning a clobbered set --- *)
diff --git a/src/plugins/value/domains/cvalue/builtins.mli b/src/plugins/value/domains/cvalue/builtins.mli
index ebf302fd0d534aa60c398de0623406087182a8e4..561a04c266d21313b6ade99a9ae6586585cab429 100644
--- a/src/plugins/value/domains/cvalue/builtins.mli
+++ b/src/plugins/value/domains/cvalue/builtins.mli
@@ -35,17 +35,17 @@ val register_builtin:
string -> ?replace:string ->
?typ:Db.Value.builtin_type -> Db.Value.builtin -> unit
+(** Prepares the builtins to be used for an analysis. Must be called at the
+ beginning of each Eva analysis. Warns about builtins of incompatible types,
+ builtins without an available specification and builtins overriding function
+ definitions. *)
+val prepare_builtins: unit -> unit
+
(** [clobbered_set_from_ret state ret] can be used for functions that return
a pointer to where they have written some data. It returns all the bases
of [ret] whose contents may contain local variables. *)
val clobbered_set_from_ret: Cvalue.Model.t -> Cvalue.V.t -> Base.SetLattice.t
-(** Emits warnings for each function definition that will be overridden by an
- Eva built-in.
- Does not include definitions in the Frama-C stdlib.
- @since Phosphorus-20170501-beta1 *)
-val warn_definitions_overridden_by_builtins: unit -> unit
-
type builtin
type call = (Precise_locs.precise_location, Cvalue.V.t) Eval.call
type result = Cvalue.Model.t * Locals_scoping.clobbered_set
diff --git a/src/plugins/value/domains/cvalue/builtins_float.ml b/src/plugins/value/domains/cvalue/builtins_float.ml
index e636114ac354bbbc3cb8a27ab973fb38ecf73049..3c28988d37d153cd207c925d78de5a611e203c4b 100644
--- a/src/plugins/value/domains/cvalue/builtins_float.ml
+++ b/src/plugins/value/domains/cvalue/builtins_float.ml
@@ -71,7 +71,7 @@ let arity2 fk caml_fun state actuals =
let register_arity2 c_name fk f =
let name = "Frama_C_" ^ c_name in
let t = Cil_types.TFloat (fk, []) in
- let typ = t, [t; t] in
+ let typ () = t, [t; t] in
Builtins.register_builtin name ~replace:c_name ~typ (arity2 fk f)
let () =
@@ -114,7 +114,7 @@ let arity1 name fk caml_fun state actuals =
let register_arity1 c_name fk f =
let name = "Frama_C_" ^ c_name in
let t = Cil_types.TFloat (fk, []) in
- let typ = t, [t] in
+ let typ () = t, [t] in
Builtins.register_builtin name ~replace:c_name ~typ (arity1 name fk f)
let () =
diff --git a/src/plugins/value/engine/compute_functions.ml b/src/plugins/value/engine/compute_functions.ml
index 21a9876322a1e7dfe27fdc0a8c9d0dc8803ce778..d5dabe47293e52f7b3a3cc6a99e7efec0b6474dd 100644
--- a/src/plugins/value/engine/compute_functions.ml
+++ b/src/plugins/value/engine/compute_functions.ml
@@ -76,8 +76,7 @@ let pre_analysis () =
Split_return.pretty_strategies ();
generate_specs ();
Widen.precompute_widen_hints ();
- if Value_parameters.WarnBuiltinOverride.get () then
- Builtins.warn_definitions_overridden_by_builtins ();
+ Builtins.prepare_builtins ();
Value_perf.reset ();
(* We may be resuming Value from a previously crashed analysis. Clear
degeneration states *)