From 7ab1c5bdb6f9ce764af46088e7e1b13415d77cf5 Mon Sep 17 00:00:00 2001
From: ploc <ploc@garoche.net>
Date: Thu, 22 Jun 2017 08:21:02 -0700
Subject: [PATCH] - Added a precision parameter for io_frontend "real" types -
New fonction in plugins: main_loop_body_prefix
---
src/backends/C/c_backend_common.ml | 11 +++++++++++
src/backends/C/c_backend_main.ml | 9 +++------
src/pluginType.ml | 2 ++
src/plugins.ml | 5 +++++
4 files changed, 21 insertions(+), 6 deletions(-)
diff --git a/src/backends/C/c_backend_common.ml b/src/backends/C/c_backend_common.ml
index 02f1f0ad..2e84a72e 100644
--- a/src/backends/C/c_backend_common.ml
+++ b/src/backends/C/c_backend_common.ml
@@ -647,6 +647,17 @@ let pp_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list
aux [] fmt (List.hd inputs).value_type
end
+
+(*** Common functions for main ***)
+
+let print_put_var fmt file_suffix name var_type var_id =
+ match (Types.unclock_type var_type).Types.tdesc with
+ | Types.Tint -> fprintf fmt "_put_int(f_out%s, \"%s\", %s)" file_suffix name var_id
+ | Types.Tbool -> fprintf fmt "_put_bool(f_out%s, \"%s\", %s)" file_suffix name var_id
+ | Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(f_out%s, \"%s\", mpfr_get_d(%s, %s), %i)" file_suffix name var_id (Mpfr.mpfr_rnd ()) !Options.print_prec_double
+ | Types.Treal -> fprintf fmt "_put_double(f_out%s, \"%s\", %s, %i)" file_suffix name var_id !Options.print_prec_double
+ | _ -> Format.eprintf "Impossible to print the _put_xx for type %a@.@?" Types.print_ty var_type; assert false
+
(* Local Variables: *)
(* compile-command:"make -C ../../.." *)
(* End: *)
diff --git a/src/backends/C/c_backend_main.ml b/src/backends/C/c_backend_main.ml
index 7fd49d41..1d01bc7c 100644
--- a/src/backends/C/c_backend_main.ml
+++ b/src/backends/C/c_backend_main.ml
@@ -53,12 +53,8 @@ let print_get_inputs fmt m =
let print_put_outputs fmt m =
let po fmt (id, o', o) =
- match (Types.unclock_type o.var_type).Types.tdesc with
- | Types.Tint -> fprintf fmt "_put_int(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
- | Types.Tbool -> fprintf fmt "_put_bool(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
- | Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(f_out%i, \"%s\", mpfr_get_d(%s, %s))" id o'.var_id o.var_id (Mpfr.mpfr_rnd ())
- | Types.Treal -> fprintf fmt "_put_double(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
- | _ -> assert false
+ let suff = string_of_int id in
+ print_put_var fmt suff o'.var_id o.var_type o.var_id
in
Utils.List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs
@@ -158,6 +154,7 @@ let print_main_code fmt basename m =
else "main_mem" in
fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
print_main_inout_declaration basename fmt m;
+ Plugins.c_backend_main_loop_body_prefix basename mname fmt ();
print_main_memory_allocation mname main_mem fmt m;
if !Options.mpfr then
begin
diff --git a/src/pluginType.ml b/src/pluginType.ml
index fda050a6..5f76b708 100644
--- a/src/pluginType.ml
+++ b/src/pluginType.ml
@@ -6,6 +6,7 @@ sig
val check_force_stateful : unit -> bool
val refine_machine_code: LustreSpec.top_decl list ->
Machine_code.machine_t list -> Machine_code.machine_t list
+ val c_backend_main_loop_body_prefix : string -> string -> Format.formatter -> unit -> unit
val c_backend_main_loop_body_suffix : Format.formatter -> unit -> unit
end
@@ -13,5 +14,6 @@ module Default =
struct
let check_force_stateful () = false
let refine_machine_code prog machines = machines
+ let c_backend_main_loop_body_prefix basename mname fmt () = ()
let c_backend_main_loop_body_suffix fmt () = ()
end
diff --git a/src/plugins.ml b/src/plugins.ml
index 76bd72d3..1e43edd5 100644
--- a/src/plugins.ml
+++ b/src/plugins.ml
@@ -25,6 +25,11 @@ let refine_machine_code prog machine_code =
) machine_code plugins
+let c_backend_main_loop_body_prefix basename mname fmt () =
+ List.iter (fun (m: (module PluginType.PluginType)) ->
+ let module M = (val m : PluginType.PluginType) in
+ M.c_backend_main_loop_body_prefix basename mname fmt ()) plugins
+
let c_backend_main_loop_body_suffix fmt () =
List.iter (fun (m: (module PluginType.PluginType)) ->
let module M = (val m : PluginType.PluginType) in
--
GitLab