diff --git a/src/plugins/builtin/Makefile.in b/src/plugins/builtin/Makefile.in
index a7203c74139e8cc3bf2241b5ffff499a2846923e..702ddb08ba8a3e8e3f600c81ecec9af5adc6572d 100644
--- a/src/plugins/builtin/Makefile.in
+++ b/src/plugins/builtin/Makefile.in
@@ -37,7 +37,7 @@ PLUGIN_DIR ?= .
PLUGIN_ENABLE := @ENABLE_BUILTIN@
PLUGIN_NAME := Builtin
PLUGIN_CMI :=
-PLUGIN_CMO := options transform basic_blocks memcpy memcmp memmove register
+PLUGIN_CMO := basic_blocks options transform memcpy memcmp memmove register
PLUGIN_DISTRIBUTED := $(PLUGIN_ENABLE)
PLUGIN_DISTRIB_EXTERNAL:= Makefile.in configure.ac configure
#PLUGIN_NO_DEFAULT_TEST := no
diff --git a/src/plugins/builtin/basic_blocks.ml b/src/plugins/builtin/basic_blocks.ml
index 65ae46edd4efc55867a8a0299d1e4ebb84ec16dd..d962ae3b70ee16d26eb4f4a97abc3fc3c279c303 100644
--- a/src/plugins/builtin/basic_blocks.ml
+++ b/src/plugins/builtin/basic_blocks.ml
@@ -33,20 +33,14 @@ let size_t () =
let prepare_definition name fun_type =
let vi = Cil.makeGlobalVar ~referenced:true name fun_type in
+ vi.vdefined <- true ;
let fd = Cil.emptyFunctionFromVI vi in
Cil.setFormalsDecl vi fun_type ;
fd.sformals <- Cil.getFormalsDecl vi ;
fd
-let set_function_body fd body =
- fd.sbody <- body ;
- fd.svar.vdefined <- true ;
- File.must_recompute_cfg fd
-
-let call_function lval name args =
- let open Globals.Functions in
+let call_function lval vi args =
let loc = Cil_datatype.Location.unknown in
- let vi = get_vi (find_by_name name) in
let _, typs, _, _ = Cil.splitFunctionTypeVI vi in
let typs = Cil.argsToList typs in
let gen_arg exp (_, typ, _) =
diff --git a/src/plugins/builtin/basic_blocks.mli b/src/plugins/builtin/basic_blocks.mli
index 642e8c1b69f3f346b7cec0efcb70e2558ed24384..13a746b45716b5124399265e496f2a8dbce5dfcd 100644
--- a/src/plugins/builtin/basic_blocks.mli
+++ b/src/plugins/builtin/basic_blocks.mli
@@ -28,8 +28,7 @@ val const_of: typ -> typ
val size_t: unit -> typ
val prepare_definition: string -> typ -> fundec
-val set_function_body: fundec -> block -> unit
-val call_function: lval option -> string -> exp list -> instr
+val call_function: lval option -> varinfo -> exp list -> instr
val string_of_typ: typ -> string
diff --git a/src/plugins/builtin/memcmp.ml b/src/plugins/builtin/memcmp.ml
index 17ac40ba510f07d4fa00b89c1e5bbd08414545f0..a5b8bea26479d901ef87f27a1da06dfc8a2194f7 100644
--- a/src/plugins/builtin/memcmp.ml
+++ b/src/plugins/builtin/memcmp.ml
@@ -79,22 +79,13 @@ let generate_function_type t =
] in
TFun(Cil.intType, Some params, false, [])
-let generate_body fd =
- let loc = Cil_datatype.Location.unknown in
- let rv = Cil.makeLocalVar fd "__retres" Cil.intType in
- let args = List.map Cil.evar fd.sformals in
- let call = Instr(call_function (Some (Var rv, NoOffset)) function_name args) in
- let ret = Return (Some (Cil.evar rv), loc) in
- let block = Cil.mkBlock (List.map Cil.mkStmt [ call ; ret]) in
- block.blocals <- [ rv ] ;
- block
-
-let generate_function t =
+let generate_prototype t =
+ let fun_type = generate_function_type t in
let name = function_name ^ "_" ^ (string_of_typ t) in
- let fun_t = generate_function_type t in
- let fd = prepare_definition name fun_t in
- set_function_body fd (generate_body fd) ;
- fd
+ name, fun_type
+
+let args_for_original _t fd =
+ List.map Cil.evar fd.sformals
let type_from_arg x =
let x = Cil.stripCasts x in
@@ -131,6 +122,7 @@ let () = Transform.register (module struct
let well_typed_call = well_typed_call
let key_from_call = key_from_call
let retype_args = retype_args
- let generate_function = generate_function
+ let generate_prototype = generate_prototype
let generate_spec = generate_spec
+ let args_for_original = args_for_original
end)
\ No newline at end of file
diff --git a/src/plugins/builtin/memcpy.ml b/src/plugins/builtin/memcpy.ml
index 7140704da341031a336a20c6b326f4a324177658..717c7009ae1390c71b69016b9a20b9883d6ae5d2 100644
--- a/src/plugins/builtin/memcpy.ml
+++ b/src/plugins/builtin/memcpy.ml
@@ -83,22 +83,13 @@ let generate_function_type t =
] in
TFun(dt, Some params, false, [])
-let generate_body t fd =
- let loc = Cil_datatype.Location.unknown in
- let rv = Cil.makeLocalVar fd "__retres" (TPtr(t, [])) in
- let args = List.map Cil.evar fd.sformals in
- let call = Instr(call_function (Some (Var rv, NoOffset)) function_name args) in
- let ret = Return (Some (Cil.evar rv), loc) in
- let block = Cil.mkBlock (List.map Cil.mkStmt [ call ; ret]) in
- block.blocals <- [ rv ] ;
- block
-
-let generate_function t =
+let generate_prototype t =
+ let fun_type = generate_function_type t in
let name = function_name ^ "_" ^ (string_of_typ t) in
- let fun_t = generate_function_type t in
- let fd = prepare_definition name fun_t in
- set_function_body fd (generate_body t fd) ;
- fd
+ name, fun_type
+
+let args_for_original _t fd =
+ List.map Cil.evar fd.sformals
let type_from_arg x =
let x = Cil.stripCasts x in
@@ -135,6 +126,7 @@ let () = Transform.register (module struct
let well_typed_call = well_typed_call
let key_from_call = key_from_call
let retype_args = retype_args
- let generate_function = generate_function
+ let generate_prototype = generate_prototype
let generate_spec = generate_spec
+ let args_for_original = args_for_original
end)
\ No newline at end of file
diff --git a/src/plugins/builtin/memmove.ml b/src/plugins/builtin/memmove.ml
index ec50e9b6253d2dabc1d5d58d4b8498f8c7fba809..e5b7b6f7ff2640fae0e98409d3d207d0d14aed89 100644
--- a/src/plugins/builtin/memmove.ml
+++ b/src/plugins/builtin/memmove.ml
@@ -78,22 +78,13 @@ let generate_function_type t =
] in
TFun(dt, Some params, false, [])
-let generate_body t fd =
- let loc = Cil_datatype.Location.unknown in
- let rv = Cil.makeLocalVar fd "__retres" (TPtr(t, [])) in
- let args = List.map Cil.evar fd.sformals in
- let call = Instr(call_function (Some (Var rv, NoOffset)) function_name args) in
- let ret = Return (Some (Cil.evar rv), loc) in
- let block = Cil.mkBlock (List.map Cil.mkStmt [ call ; ret]) in
- block.blocals <- [ rv ] ;
- block
-
-let generate_function t =
+let generate_prototype t =
+ let fun_type = generate_function_type t in
let name = function_name ^ "_" ^ (string_of_typ t) in
- let fun_t = generate_function_type t in
- let fd = prepare_definition name fun_t in
- set_function_body fd (generate_body t fd) ;
- fd
+ name, fun_type
+
+let args_for_original _t fd =
+ List.map Cil.evar fd.sformals
let type_from_arg x =
let x = Cil.stripCasts x in
@@ -130,6 +121,7 @@ let () = Transform.register (module struct
let well_typed_call = well_typed_call
let key_from_call = key_from_call
let retype_args = retype_args
- let generate_function = generate_function
+ let generate_prototype = generate_prototype
let generate_spec = generate_spec
+ let args_for_original = args_for_original
end)
\ No newline at end of file
diff --git a/src/plugins/builtin/transform.ml b/src/plugins/builtin/transform.ml
index 0e1db9267c764c612550f574dc8b6614e9991e1c..a14e9360266f1d0be691214b54d4eac01a1e6acc 100644
--- a/src/plugins/builtin/transform.ml
+++ b/src/plugins/builtin/transform.ml
@@ -21,6 +21,7 @@
(**************************************************************************)
open Cil_types
+open Basic_blocks
module type Builtin = sig
module Hashtbl: Datatype.Hashtbl
@@ -30,8 +31,9 @@ module type Builtin = sig
val well_typed_call: exp list -> bool
val key_from_call: exp list -> override_key
val retype_args: override_key -> exp list -> exp list
- val generate_function: override_key -> fundec
+ val generate_prototype: override_key -> (string * typ)
val generate_spec: override_key -> fundec -> location -> funspec
+ val args_for_original: override_key -> fundec -> exp list
end
module type Internal_builtin = sig
@@ -52,13 +54,34 @@ module Make_internal_builtin (B: Builtin) = struct
let name = "Builtins." ^ B.function_name
end)
+ let create_and_add key =
+ let (name, typ) = B.generate_prototype key in
+ let fd = Basic_blocks.prepare_definition name typ in
+ let loc = Cil_datatype.Location.unknown in
+ let open Globals.Functions in
+ let open Extlib in
+ let ret_var = match Cil.getReturnType fd.svar.vtype with
+ | t when Cil.isVoidType t -> None
+ | t -> Some (Cil.makeLocalVar fd "__retres" t)
+ in
+ let call =
+ let orig = get_vi (find_by_name function_name) in
+ let args = B.args_for_original key fd in
+ Instr(call_function (opt_map Cil.var ret_var) orig args)
+ in
+ let ret = Return ( (opt_map Cil.evar ret_var), loc) in
+ fd.sbody <-
+ { (Cil.mkBlock (List.map Cil.mkStmt [ call ; ret ]))
+ with blocals = list_of_opt ret_var } ;
+ File.must_recompute_cfg fd ;
+ Cache.add key fd
+
let get_override key =
try
Cache.find key
with Not_found ->
- let fct = B.generate_function key in
- Cache.add key fct ;
- fct
+ create_and_add key ;
+ Cache.find key
let get_globals location =
let finalize key fd =
@@ -135,12 +158,12 @@ class visitor = object(_)
method! vinst = function
| Call(_) | Local_init(_, ConsInit(_, _, Plain_func), _) ->
let change = function
- | [ Call(r, ({ enode = Lval((Var fct), NoOffset) } as e), args, loc) ] ->
- let fct, args = replace_call (fct, args) in
- [ Call(r, { e with enode = Lval((Var fct), NoOffset) }, args, loc) ]
- | [ Local_init(r, ConsInit(fct, args, Plain_func), loc) ] ->
- let fct, args = replace_call (fct, args) in
- [ Local_init(r, ConsInit(fct, args, Plain_func), loc) ]
+ | [ Call(r, ({ enode = Lval((Var f), NoOffset) } as e), args, loc) ] ->
+ let f, args = replace_call (f, args) in
+ [ Call(r, { e with enode = Lval((Var f), NoOffset) }, args, loc) ]
+ | [ Local_init(r, ConsInit(f, args, Plain_func), loc) ] ->
+ let f, args = replace_call (f, args) in
+ [ Local_init(r, ConsInit(f, args, Plain_func), loc) ]
| _ -> assert false
in
Cil.DoChildrenPost change
diff --git a/src/plugins/builtin/transform.mli b/src/plugins/builtin/transform.mli
index 9d081643eeb1c66c45beb900ff0a0f6e17d9e4ea..e5876ab7a520906e99bce092e1fbfa0cc1d0e5e6 100644
--- a/src/plugins/builtin/transform.mli
+++ b/src/plugins/builtin/transform.mli
@@ -30,8 +30,9 @@ module type Builtin = sig
val well_typed_call: exp list -> bool
val key_from_call: exp list -> override_key
val retype_args: override_key -> exp list -> exp list
- val generate_function: override_key -> fundec
+ val generate_prototype: override_key -> (string * typ)
val generate_spec: override_key -> fundec -> location -> funspec
+ val args_for_original: override_key -> fundec -> exp list
end
val register: (module Builtin) -> unit