Project

General

Profile

Download (8.17 KB) Statistics
| Branch: | Tag: | Revision:
1
(********************************************************************)
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
open LustreSpec
13
open Corelang
14
open Machine_code
15
open Format
16
open C_backend_common
17
open Utils
18

    
19
module type MODIFIERS_MAINSRC =
20
sig
21
end
22

    
23
module EmptyMod =
24
struct
25
end
26

    
27
module Main = functor (Mod: MODIFIERS_MAINSRC) -> 
28
struct
29

    
30
(********************************************************************************************)
31
(*                         Main related functions                                           *)
32
(********************************************************************************************)
33

    
34
let print_get_inputs fmt m =
35
  let pi fmt (id, v', v) =
36
  match (Types.unclock_type v.var_type).Types.tdesc with
37
    | Types.Tint -> fprintf fmt "%s = _get_int(f_in%i, \"%s\")" v.var_id id v'.var_id
38
    | Types.Tbool -> fprintf fmt "%s = _get_bool(f_in%i, \"%s\")" v.var_id id v'.var_id
39
    | Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(f_in%i, \"%s\"), %i)" v.var_id id v'.var_id (Mpfr.mpfr_prec ())
40
    | Types.Treal -> fprintf fmt "%s = _get_double(f_in%i, \"%s\")" v.var_id id v'.var_id
41
    | _ ->
42
      begin
43
	Global.main_node := !Options.main_node;
44
	Format.eprintf "Code generation error: %a%a@."
45
	  pp_error Main_wrong_kind
46
	  Location.pp_loc v'.var_loc;
47
	raise (Error (v'.var_loc, Main_wrong_kind))
48
      end
49
  in
50
  List.iteri2 (fun idx v' v ->
51
    fprintf fmt "@ %a;" pi ((idx+1), v', v);
52
  ) m.mname.node_inputs m.mstep.step_inputs
53

    
54
let print_put_outputs fmt m = 
55
  let po fmt (id, o', o) =
56
    match (Types.unclock_type o.var_type).Types.tdesc with
57
    | Types.Tint -> fprintf fmt "_put_int(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
58
    | Types.Tbool -> fprintf fmt "_put_bool(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
59
    | 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 ())
60
    | Types.Treal -> fprintf fmt "_put_double(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
61
    | _ -> assert false
62
  in
63
  Utils.List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs
64

    
65
let print_main_inout_declaration basename fmt m =
66
  let mname = m.mname.node_id in
67
  fprintf fmt "/* Declaration of inputs/outputs variables */@ ";
68
  List.iteri 
69
    (fun idx v ->
70
      fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
71
      fprintf fmt "FILE *f_in%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
72
      fprintf fmt "f_in%i = fopen(\"%s_%s_simu.in%i\", \"w\");@ " (idx+1) basename mname (idx+1);
73
    ) m.mstep.step_inputs;
74
  List.iteri 
75
    (fun idx v ->
76
      fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
77
      fprintf fmt "FILE *f_out%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
78
      fprintf fmt "f_out%i = fopen(\"%s_%s_simu.out%i\", \"w\");@ " (idx+1) basename mname (idx+1);
79
    ) m.mstep.step_outputs
80

    
81

    
82
  
83
let print_main_memory_allocation mname main_mem fmt m =
84
  if not (fst (get_stateless_status m)) then
85
  begin  
86
    fprintf fmt "@ /* Main memory allocation */@ ";
87
    if (!Options.static_mem && !Options.main_node <> "")
88
    then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
89
    else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
90
    fprintf fmt "@ /* Initialize the main memory */@ ";
91
    fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
92
  end
93

    
94
let print_global_initialize fmt basename =
95
  let mNAME = file_to_module_name basename in
96
  fprintf fmt "@ /* Initialize global constants */@ %a();@ "
97
    pp_global_init_name mNAME
98

    
99
let print_global_clear fmt basename =
100
  let mNAME = file_to_module_name basename in
101
  fprintf fmt "@ /* Clear global constants */@ %a();@ "
102
    pp_global_clear_name mNAME
103

    
104
let print_main_initialize mname main_mem fmt m =
105
  if not (fst (get_stateless_status m))
106
  then
107
    fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
108
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
109
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
110
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
111
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
112
      pp_machine_init_name mname
113
      main_mem
114
  else
115
    fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ "
116
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
117
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
118
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
119

    
120
let print_main_clear mname main_mem fmt m =
121
  if not (fst (get_stateless_status m))
122
  then
123
    fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
124
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
125
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
126
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
127
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
128
      pp_machine_clear_name mname
129
      main_mem
130
  else
131
    fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ "
132
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
133
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
134
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
135

    
136
let print_main_loop mname main_mem fmt m =
137
  let input_values =
138
    List.map (fun v -> mk_val (LocalVar v) v.var_type)
139
      m.mstep.step_inputs in
140
  begin
141
    fprintf fmt "@ ISATTY = isatty(0);@ ";
142
    fprintf fmt "@ /* Infinite loop */@ ";
143
    fprintf fmt "@[<v 2>while(1){@ ";
144
    fprintf fmt  "fflush(stdout);@ ";
145
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_in%i);@ " (idx+1)) m.mstep.step_inputs;
146
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_out%i);@ " (idx+1)) m.mstep.step_outputs;
147
    fprintf fmt "%a@ %t%a"
148
      print_get_inputs m
149
      (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
150
      print_put_outputs m
151
  end
152

    
153
let print_main_code fmt basename m =
154
  let mname = m.mname.node_id in
155
  let main_mem =
156
    if (!Options.static_mem && !Options.main_node <> "")
157
    then "&main_mem"
158
    else "main_mem" in
159
  fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
160
  print_main_inout_declaration basename fmt m;
161
  print_main_memory_allocation mname main_mem fmt m;
162
  if !Options.mpfr then
163
    begin
164
      print_global_initialize fmt basename;
165
      print_main_initialize mname main_mem fmt m;
166
    end;
167
  print_main_loop mname main_mem fmt m;
168
  if Scopes.Plugin.is_active () then
169
    begin
170
      fprintf fmt "@ %t" Scopes.Plugin.pp 
171
    end;    
172
  fprintf fmt "@]@ }@ @ ";
173
  if !Options.mpfr then
174
    begin
175
      print_main_clear mname main_mem fmt m;
176
      print_global_clear fmt basename;
177
    end;
178
  fprintf fmt "@ return 1;";
179
  fprintf fmt "@]@ }@."       
180

    
181
let print_main_header fmt =
182
  fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@."
183
    !Options.include_dir
184

    
185
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
186
  print_main_header main_fmt;
187
  fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
188
  print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
189
  pp_print_newline main_fmt ();
190

    
191
  (* Print the svn version number and the supported C standard (C90 or C99) *)
192
  print_version main_fmt;
193
  print_main_code main_fmt basename main_machine
194
end  
195

    
196
(* Local Variables: *)
197
(* compile-command:"make -C ../../.." *)
198
(* End: *)
(4-4/7)