Revision 3b2bd83d
Added by Teme Kahsai about 8 years ago
src/backends/C/c_backend_main.ml | ||
---|---|---|
30 | 30 |
(* Main related functions *) |
31 | 31 |
(********************************************************************************************) |
32 | 32 |
|
33 |
let print_get_input fmt v = |
|
34 |
match (Types.repr v.var_type).Types.tdesc with |
|
35 |
| Types.Tint -> fprintf fmt "_get_int(\"%s\")" v.var_id |
|
36 |
| Types.Tbool -> fprintf fmt "_get_bool(\"%s\")" v.var_id |
|
37 |
| Types.Treal -> fprintf fmt "_get_double(\"%s\")" v.var_id |
|
38 |
| _ -> assert false |
|
33 |
let print_get_inputs fmt m = |
|
34 |
let pi fmt (v', v) = |
|
35 |
match (Types.unclock_type v.var_type).Types.tdesc with |
|
36 |
| Types.Tint -> fprintf fmt "%s = _get_int(\"%s\")" v.var_id v'.var_id |
|
37 |
| Types.Tbool -> fprintf fmt "%s = _get_bool(\"%s\")" v.var_id v'.var_id |
|
38 |
| Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(\"%s\"), %i)" v.var_id v'.var_id (Mpfr.mpfr_prec ()) |
|
39 |
| Types.Treal -> fprintf fmt "%s = _get_double(\"%s\")" v.var_id v'.var_id |
|
40 |
| _ -> |
|
41 |
begin |
|
42 |
Global.main_node := !Options.main_node; |
|
43 |
Format.eprintf "Code generation error: %a%a@." |
|
44 |
pp_error Main_wrong_kind |
|
45 |
Location.pp_loc v'.var_loc; |
|
46 |
raise (Error (v'.var_loc, Main_wrong_kind)) |
|
47 |
end |
|
48 |
in |
|
49 |
List.iter2 (fun v' v -> fprintf fmt "@ %a;" pi (v', v)) m.mname.node_inputs m.mstep.step_inputs |
|
39 | 50 |
|
40 |
let print_put_outputs fmt ol = |
|
41 |
let po fmt o = |
|
42 |
match (Types.repr o.var_type).Types.tdesc with |
|
43 |
| Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id |
|
44 |
| Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id |
|
45 |
| Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id |
|
51 |
let print_put_outputs fmt m = |
|
52 |
let po fmt (o', o) = |
|
53 |
match (Types.unclock_type o.var_type).Types.tdesc with |
|
54 |
| Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o'.var_id o.var_id |
|
55 |
| Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o'.var_id o.var_id |
|
56 |
| Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(\"%s\", mpfr_get_d(%s, %s))" o'.var_id o.var_id (Mpfr.mpfr_rnd ()) |
|
57 |
| Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o'.var_id o.var_id |
|
46 | 58 |
| _ -> assert false |
47 | 59 |
in |
48 |
List.iter (fprintf fmt "@ %a;" po) ol |
|
60 |
List.iter2 (fun v' v -> fprintf fmt "@ %a;" po (v', v)) m.mname.node_outputs m.mstep.step_outputs |
|
61 |
|
|
62 |
let print_main_inout_declaration fmt m = |
|
63 |
begin |
|
64 |
fprintf fmt "/* Declaration of inputs/outputs variables */@ "; |
|
65 |
List.iter |
|
66 |
(fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type |
|
67 |
) m.mstep.step_inputs; |
|
68 |
List.iter |
|
69 |
(fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type |
|
70 |
) m.mstep.step_outputs |
|
71 |
end |
|
72 |
|
|
73 |
let print_main_memory_allocation mname main_mem fmt m = |
|
74 |
if not (fst (get_stateless_status m)) then |
|
75 |
begin |
|
76 |
fprintf fmt "@ /* Main memory allocation */@ "; |
|
77 |
if (!Options.static_mem && !Options.main_node <> "") |
|
78 |
then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname) |
|
79 |
else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); |
|
80 |
fprintf fmt "@ /* Initialize the main memory */@ "; |
|
81 |
fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; |
|
82 |
end |
|
83 |
|
|
84 |
let print_global_initialize fmt basename = |
|
85 |
let mNAME = file_to_module_name basename in |
|
86 |
fprintf fmt "@ /* Initialize global constants */@ %a();@ " |
|
87 |
pp_global_init_name mNAME |
|
88 |
|
|
89 |
let print_global_clear fmt basename = |
|
90 |
let mNAME = file_to_module_name basename in |
|
91 |
fprintf fmt "@ /* Clear global constants */@ %a();@ " |
|
92 |
pp_global_clear_name mNAME |
|
93 |
|
|
94 |
let print_main_initialize mname main_mem fmt m = |
|
95 |
if not (fst (get_stateless_status m)) |
|
96 |
then |
|
97 |
fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
|
98 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
|
99 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
100 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
|
101 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
102 |
pp_machine_init_name mname |
|
103 |
main_mem |
|
104 |
else |
|
105 |
fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ " |
|
106 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
|
107 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
108 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
|
109 |
|
|
110 |
let print_main_clear mname main_mem fmt m = |
|
111 |
if not (fst (get_stateless_status m)) |
|
112 |
then |
|
113 |
fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
|
114 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
|
115 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
116 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
|
117 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
118 |
pp_machine_clear_name mname |
|
119 |
main_mem |
|
120 |
else |
|
121 |
fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ " |
|
122 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
|
123 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
|
124 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
|
125 |
|
|
126 |
let print_main_loop mname main_mem fmt m = |
|
127 |
let input_values = |
|
128 |
List.map (fun v -> mk_val (LocalVar v) v.var_type) |
|
129 |
m.mstep.step_inputs in |
|
130 |
begin |
|
131 |
fprintf fmt "@ ISATTY = isatty(0);@ "; |
|
132 |
fprintf fmt "@ /* Infinite loop */@ "; |
|
133 |
fprintf fmt "@[<v 2>while(1){@ "; |
|
134 |
fprintf fmt "fflush(stdout);@ "; |
|
135 |
fprintf fmt "%a@ %t%a" |
|
136 |
print_get_inputs m |
|
137 |
(fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs) |
|
138 |
print_put_outputs m |
|
139 |
end |
|
49 | 140 |
|
50 |
let print_main_fun machines m fmt =
|
|
141 |
let print_main_code fmt basename m =
|
|
51 | 142 |
let mname = m.mname.node_id in |
52 | 143 |
let main_mem = |
53 | 144 |
if (!Options.static_mem && !Options.main_node <> "") |
54 | 145 |
then "&main_mem" |
55 | 146 |
else "main_mem" in |
56 | 147 |
fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; |
57 |
fprintf fmt "/* Declaration of inputs/outputs variables */@ "; |
|
58 |
List.iter |
|
59 |
(fun v -> fprintf fmt "%a = %a;@ " (pp_c_type v.var_id) v.var_type pp_c_initialize v.var_type |
|
60 |
) m.mstep.step_inputs; |
|
61 |
List.iter |
|
62 |
(fun v -> fprintf fmt "%a = %a;@ " (pp_c_type v.var_id) v.var_type pp_c_initialize v.var_type |
|
63 |
) m.mstep.step_outputs; |
|
64 |
fprintf fmt "@ /* Main memory allocation */@ "; |
|
65 |
if (!Options.static_mem && !Options.main_node <> "") |
|
66 |
then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname) |
|
67 |
else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); |
|
68 |
fprintf fmt "@ /* Initialize the main memory */@ "; |
|
69 |
fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; |
|
70 |
fprintf fmt "@ ISATTY = isatty(0);@ "; |
|
71 |
fprintf fmt "@ /* Infinite loop */@ "; |
|
72 |
fprintf fmt "@[<v 2>while(1){@ "; |
|
73 |
fprintf fmt "fflush(stdout);@ "; |
|
74 |
List.iter |
|
75 |
(fun v -> fprintf fmt "%s = %a;@ " |
|
76 |
v.var_id |
|
77 |
print_get_input v |
|
78 |
) m.mstep.step_inputs; |
|
79 |
(match m.mstep.step_outputs with |
|
80 |
(* | [] -> ( *) |
|
81 |
(* fprintf fmt "%a(%a%t%s);@ " *) |
|
82 |
(* pp_machine_step_name mname *) |
|
83 |
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *) |
|
84 |
(* (pp_final_char_if_non_empty ", " m.mstep.step_inputs) *) |
|
85 |
(* main_mem *) |
|
86 |
(* ) *) |
|
87 |
(* | [o] -> ( *) |
|
88 |
(* fprintf fmt "%s = %a(%a%t%a, %s);%a" *) |
|
89 |
(* o.var_id *) |
|
90 |
(* pp_machine_step_name mname *) |
|
91 |
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *) |
|
92 |
(* (pp_final_char_if_non_empty ", " m.mstep.step_inputs) *) |
|
93 |
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *) |
|
94 |
(* main_mem *) |
|
95 |
(* print_put_outputs [o]) *) |
|
96 |
| _ -> ( |
|
97 |
fprintf fmt "%a(%a%t%a, %s);%a" |
|
98 |
pp_machine_step_name mname |
|
99 |
(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs |
|
100 |
(Utils.pp_final_char_if_non_empty ", " m.mstep.step_inputs) |
|
101 |
(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs |
|
102 |
main_mem |
|
103 |
print_put_outputs m.mstep.step_outputs) |
|
104 |
); |
|
105 |
fprintf fmt "@]@ }@ "; |
|
106 |
fprintf fmt "return 1;"; |
|
148 |
print_main_inout_declaration fmt m; |
|
149 |
print_main_memory_allocation mname main_mem fmt m; |
|
150 |
if !Options.mpfr then |
|
151 |
begin |
|
152 |
print_global_initialize fmt basename; |
|
153 |
print_main_initialize mname main_mem fmt m; |
|
154 |
end; |
|
155 |
print_main_loop mname main_mem fmt m; |
|
156 |
if Scopes.Plugin.is_active () then |
|
157 |
begin |
|
158 |
fprintf fmt "@ %t" Scopes.Plugin.pp |
|
159 |
end; |
|
160 |
fprintf fmt "@]@ }@ @ "; |
|
161 |
if !Options.mpfr then |
|
162 |
begin |
|
163 |
print_main_clear mname main_mem fmt m; |
|
164 |
print_global_clear fmt basename; |
|
165 |
end; |
|
166 |
fprintf fmt "@ return 1;"; |
|
107 | 167 |
fprintf fmt "@]@ }@." |
108 | 168 |
|
109 | 169 |
let print_main_header fmt = |
... | ... | |
118 | 178 |
|
119 | 179 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
120 | 180 |
print_version main_fmt; |
121 |
print_main_fun machines main_machine main_fmt
|
|
181 |
print_main_code main_fmt basename main_machine
|
|
122 | 182 |
end |
123 | 183 |
|
124 | 184 |
(* Local Variables: *) |
Also available in: Unified diff
updating to onera version 30f766a:2016-12-04