diff --git a/src/backends/C/c_backend_common.ml b/src/backends/C/c_backend_common.ml index 02f1f0ada558ed732841768c01d8f3a2f780fc66..2e84a72e3aa700238f7712715c06048a04dacc09 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 7fd49d414614f67357718a380cf9323d21e922cc..1d01bc7c49d8c706a774b1d89a3e5491b1649d0e 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 fda050a671df8c8889ffad45f39c4ca4533e3453..5f76b708014df549927f3e11cb4787616a1ca8f0 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 76bd72d3a7c38c5ddef83b9c61a3c62d816d376b..1e43edd5d2517c7c7553564a98b790323c9e2c18 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