lustrec / src / backends / C / c_backend_main.ml @ 5fccce23
History | View | Annotate | Download (7.33 KB)
1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|
2 | (* *) |
||
3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||
4 | (* Copyright 2012 - -- ONERA - CNRS - INPT *) |
||
5 | (* *) |
||
6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||
7 | (* under the terms of the GNU Lesser General Public License *) |
||
8 | (* version 2.1. *) |
||
9 | (* *) |
||
10 | (********************************************************************) |
||
11 | |||
12 | 8446bf03 | ploc | open Lustre_types |
13 | open Machine_code_types |
||
14 | 13eb21df | ploc | open Corelang |
15 | 2863281f | ploc | open Machine_code_common |
16 | 13eb21df | ploc | open Format |
17 | open C_backend_common |
||
18 | 6fa45cb6 | ploc | open Utils |
19 | 13eb21df | ploc | |
20 | d4107cf2 | ploc | module type MODIFIERS_MAINSRC = |
21 | sig |
||
22 | end |
||
23 | |||
24 | module EmptyMod = |
||
25 | struct |
||
26 | end |
||
27 | |||
28 | module Main = functor (Mod: MODIFIERS_MAINSRC) -> |
||
29 | struct |
||
30 | |||
31 | 13eb21df | ploc | (********************************************************************************************) |
32 | (* Main related functions *) |
||
33 | (********************************************************************************************) |
||
34 | |||
35 | |||
36 | 04a63d25 | xthirioux | let print_put_outputs fmt m = |
37 | 6fa45cb6 | ploc | let po fmt (id, o', o) = |
38 | 7ab1c5bd | ploc | let suff = string_of_int id in |
39 | print_put_var fmt suff o'.var_id o.var_type o.var_id |
||
40 | 13eb21df | ploc | in |
41 | 66359a5e | ploc | List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs |
42 | 6fa45cb6 | ploc | |
43 | let print_main_inout_declaration basename fmt m = |
||
44 | let mname = m.mname.node_id in |
||
45 | f76eae4f | ploc | (* TODO: find a proper way to shorthen long names. This causes segfault in the binary when trying to fprintf in them *) |
46 | let mname = if String.length mname > 50 then string_of_int (Hashtbl.hash mname) else mname in |
||
47 | 6fa45cb6 | ploc | fprintf fmt "/* Declaration of inputs/outputs variables */@ "; |
48 | List.iteri |
||
49 | (fun idx v -> |
||
50 | fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type; |
||
51 | fprintf fmt "FILE *f_in%i;@ " (idx+1); (* we start from 1: in1, in2, ... *) |
||
52 | fprintf fmt "f_in%i = fopen(\"%s_%s_simu.in%i\", \"w\");@ " (idx+1) basename mname (idx+1); |
||
53 | ) m.mstep.step_inputs; |
||
54 | List.iteri |
||
55 | (fun idx v -> |
||
56 | fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type; |
||
57 | fprintf fmt "FILE *f_out%i;@ " (idx+1); (* we start from 1: in1, in2, ... *) |
||
58 | fprintf fmt "f_out%i = fopen(\"%s_%s_simu.out%i\", \"w\");@ " (idx+1) basename mname (idx+1); |
||
59 | ) m.mstep.step_outputs |
||
60 | 04a63d25 | xthirioux | |
61 | |||
62 | 6fa45cb6 | ploc | |
63 | 04a63d25 | xthirioux | let print_main_memory_allocation mname main_mem fmt m = |
64 | if not (fst (get_stateless_status m)) then |
||
65 | begin |
||
66 | fprintf fmt "@ /* Main memory allocation */@ "; |
||
67 | if (!Options.static_mem && !Options.main_node <> "") |
||
68 | then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname) |
||
69 | else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); |
||
70 | fprintf fmt "@ /* Initialize the main memory */@ "; |
||
71 | fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; |
||
72 | end |
||
73 | |||
74 | let print_global_initialize fmt basename = |
||
75 | let mNAME = file_to_module_name basename in |
||
76 | fprintf fmt "@ /* Initialize global constants */@ %a();@ " |
||
77 | pp_global_init_name mNAME |
||
78 | |||
79 | let print_global_clear fmt basename = |
||
80 | let mNAME = file_to_module_name basename in |
||
81 | fprintf fmt "@ /* Clear global constants */@ %a();@ " |
||
82 | pp_global_clear_name mNAME |
||
83 | |||
84 | let print_main_initialize mname main_mem fmt m = |
||
85 | if not (fst (get_stateless_status m)) |
||
86 | then |
||
87 | fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
||
88 | (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
||
89 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
90 | (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
||
91 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
92 | pp_machine_init_name mname |
||
93 | main_mem |
||
94 | else |
||
95 | fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ " |
||
96 | (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
||
97 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
98 | (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
||
99 | |||
100 | let print_main_clear mname main_mem fmt m = |
||
101 | if not (fst (get_stateless_status m)) |
||
102 | then |
||
103 | fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
||
104 | (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
||
105 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
106 | (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
||
107 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
108 | pp_machine_clear_name mname |
||
109 | main_mem |
||
110 | else |
||
111 | fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ " |
||
112 | (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
||
113 | (Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
||
114 | (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
||
115 | |||
116 | let print_main_loop mname main_mem fmt m = |
||
117 | let input_values = |
||
118 | c35de73b | ploc | List.map (fun v -> mk_val (Var v) v.var_type) |
119 | 04a63d25 | xthirioux | m.mstep.step_inputs in |
120 | begin |
||
121 | fprintf fmt "@ ISATTY = isatty(0);@ "; |
||
122 | fprintf fmt "@ /* Infinite loop */@ "; |
||
123 | fprintf fmt "@[<v 2>while(1){@ "; |
||
124 | fprintf fmt "fflush(stdout);@ "; |
||
125 | 6fa45cb6 | ploc | List.iteri (fun idx _ -> fprintf fmt "fflush(f_in%i);@ " (idx+1)) m.mstep.step_inputs; |
126 | List.iteri (fun idx _ -> fprintf fmt "fflush(f_out%i);@ " (idx+1)) m.mstep.step_outputs; |
||
127 | 04a63d25 | xthirioux | fprintf fmt "%a@ %t%a" |
128 | print_get_inputs m |
||
129 | (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs) |
||
130 | print_put_outputs m |
||
131 | end |
||
132 | 13eb21df | ploc | |
133 | 04a63d25 | xthirioux | let print_main_code fmt basename m = |
134 | 13eb21df | ploc | let mname = m.mname.node_id in |
135 | let main_mem = |
||
136 | if (!Options.static_mem && !Options.main_node <> "") |
||
137 | then "&main_mem" |
||
138 | else "main_mem" in |
||
139 | fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; |
||
140 | 6fa45cb6 | ploc | print_main_inout_declaration basename fmt m; |
141 | 7ab1c5bd | ploc | Plugins.c_backend_main_loop_body_prefix basename mname fmt (); |
142 | 04a63d25 | xthirioux | print_main_memory_allocation mname main_mem fmt m; |
143 | if !Options.mpfr then |
||
144 | begin |
||
145 | print_global_initialize fmt basename; |
||
146 | print_main_initialize mname main_mem fmt m; |
||
147 | end; |
||
148 | print_main_loop mname main_mem fmt m; |
||
149 | f6acf47b | ploc | |
150 | Plugins.c_backend_main_loop_body_suffix fmt (); |
||
151 | 04a63d25 | xthirioux | fprintf fmt "@]@ }@ @ "; |
152 | if !Options.mpfr then |
||
153 | begin |
||
154 | print_main_clear mname main_mem fmt m; |
||
155 | print_global_clear fmt basename; |
||
156 | end; |
||
157 | fprintf fmt "@ return 1;"; |
||
158 | 13eb21df | ploc | fprintf fmt "@]@ }@." |
159 | |||
160 | let print_main_header fmt = |
||
161 | 52c5ba00 | David Doose | fprintf fmt (if !Options.cpp then "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.hpp\"@." else "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@.") |
162 | 1bff14ac | ploc | (Options_management.core_dependency "io_frontend") |
163 | 13eb21df | ploc | |
164 | 58a463e7 | ploc | let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) = |
165 | d4107cf2 | ploc | print_main_header main_fmt; |
166 | ef34b4ae | xthirioux | fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@."; |
167 | 5fccce23 | ploc | print_import_alloc_prototype main_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ; |
168 | ef34b4ae | xthirioux | pp_print_newline main_fmt (); |
169 | |||
170 | d4107cf2 | ploc | (* Print the svn version number and the supported C standard (C90 or C99) *) |
171 | print_version main_fmt; |
||
172 | 04a63d25 | xthirioux | print_main_code main_fmt basename main_machine |
173 | d4107cf2 | ploc | end |
174 | 13eb21df | ploc | |
175 | (* Local Variables: *) |
||
176 | cd670fe1 | ploc | (* compile-command:"make -C ../../.." *) |
177 | 13eb21df | ploc | (* End: *) |