Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_header.ml @ b38ffff3

History | View | Annotate | Download (8.9 KB)

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 Format 
13
open LustreSpec
14
open Corelang
15
open Machine_code
16
open C_backend_common
17

    
18
(********************************************************************************************)
19
(*                         Header Printing functions                                        *)
20
(********************************************************************************************)
21

    
22

    
23
module type MODIFIERS_HDR =
24
sig
25
  val print_machine_decl_prefix: Format.formatter -> Machine_code.machine_t -> unit
26
end
27

    
28
module EmptyMod =
29
struct
30
  let print_machine_decl_prefix = fun fmt x -> ()
31
end
32

    
33
module Main = functor (Mod: MODIFIERS_HDR) -> 
34
struct
35

    
36
let print_import_standard fmt =
37
  fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
38

    
39
    
40
let pp_registers_struct fmt m =
41
  if m.mmemory <> []
42
  then
43
    fprintf fmt "@[%a {@[%a; @]}@] _reg; "
44
      pp_machine_regtype_name m.mname.node_id
45
      (Utils.fprintf_list ~sep:"; " pp_c_decl_struct_var) m.mmemory
46
  else
47
    ()
48

    
49
let print_machine_struct fmt m =
50
  if fst (get_stateless_status m) then
51
    begin
52
    end
53
  else
54
    begin
55
      (* Define struct *)
56
      fprintf fmt "@[%a {@[%a%a%t@]};@]@."
57
	pp_machine_memtype_name m.mname.node_id
58
	pp_registers_struct m
59
	(Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances
60
	(Utils.pp_final_char_if_non_empty "; " m.minstances)
61
    end
62

    
63
let print_static_declare_instance attr fmt (i, (m, static)) =
64
  fprintf fmt "%a(%s, %a%t%s)"
65
    pp_machine_static_declare_name (node_name m)
66
    attr
67
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
68
    (Utils.pp_final_char_if_non_empty ", " static)
69
    i
70

    
71
let print_static_declare_macro fmt m =
72
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
73
  let inst = mk_instance m in
74
  let attr = mk_attribute m in
75
  fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%s %a %s;\\@,%a%t%a;@,@]"
76
    pp_machine_static_declare_name m.mname.node_id
77
    attr
78
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
79
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
80
    inst
81
    attr
82
    pp_machine_memtype_name m.mname.node_id
83
    inst
84
    (Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem
85
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
86
    (Utils.fprintf_list ~sep:";\\@,"
87
       (fun fmt (i',m') ->
88
	 let path = sprintf "inst ## _%s" i' in
89
	 fprintf fmt "%a"
90
	   (print_static_declare_instance attr) (path,m')
91
       )) m.minstances
92

    
93
      
94
let print_static_link_instance fmt (i, (m, _)) =
95
 fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i
96

    
97
(* Allocation of a node struct:
98
   - if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct)
99
*)
100
let print_static_link_macro fmt m =
101
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
102
  fprintf fmt "@[<v>@[<v 2>#define %a(inst) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
103
    pp_machine_static_link_name m.mname.node_id
104
    (Utils.fprintf_list ~sep:";\\@,"
105
       (fun fmt v ->
106
	 fprintf fmt "inst._reg.%s = (%a*) &%s"
107
	   v.var_id
108
           (fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v
109
	   v.var_id
110
       )) array_mem
111
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
112
    (Utils.fprintf_list ~sep:";\\@,"
113
       (fun fmt (i',m') ->
114
	 let path = sprintf "inst ## _%s" i' in
115
	 fprintf fmt "%a;\\@,inst.%s = &%s"
116
	   print_static_link_instance (path,m')
117
	   i'
118
	   path
119
       )) m.minstances
120
      
121
let print_static_alloc_macro fmt m =
122
  fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@."
123
    pp_machine_static_alloc_name m.mname.node_id
124
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
125
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
126
    pp_machine_static_declare_name m.mname.node_id
127
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
128
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
129
    pp_machine_static_link_name m.mname.node_id
130

    
131
 
132
let print_machine_decl fmt m =
133
  Mod.print_machine_decl_prefix fmt m;
134
  if fst (get_stateless_status m) then
135
    begin
136
      fprintf fmt "extern %a;@.@."
137
	print_stateless_prototype
138
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
139
    end
140
  else
141
    begin
142
      (* Static allocation *)
143
      if !Options.static_mem
144
      then (
145
	fprintf fmt "%a@.%a@.%a@."
146
	  print_static_declare_macro m
147
	  print_static_link_macro m
148
	  print_static_alloc_macro m
149
      )
150
      else ( 
151
        (* Dynamic allocation *)
152
	fprintf fmt "extern %a;@.@."
153
	  print_alloc_prototype (m.mname.node_id, m.mstatic)
154
      );
155
      let self = mk_self m in
156
      fprintf fmt "extern %a;@.@."
157
	(print_reset_prototype self) (m.mname.node_id, m.mstatic);
158

    
159
      fprintf fmt "extern %a;@.@."
160
	(print_step_prototype self)
161
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
162
    end
163

    
164
let print_const_decl fmt cdecl =
165
  fprintf fmt "extern %a;@." 
166
    (pp_c_type cdecl.const_id) cdecl.const_type
167

    
168
(********************************************************************************************)
169
(*                      Struct/TypeDef Printing functions                                   *)
170
(********************************************************************************************)
171

    
172

    
173
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) =
174
  fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc
175
and pp_c_type_decl filename cpt var fmt tdecl =
176
  match tdecl with
177
  | Tydec_any           -> assert false
178
  | Tydec_int           -> fprintf fmt "int %s" var
179
  | Tydec_real          -> fprintf fmt "double %s" var
180
  | Tydec_float         -> fprintf fmt "float %s" var
181
  | Tydec_bool          -> fprintf fmt "_Bool %s" var
182
  | Tydec_clock ty      -> pp_c_type_decl filename cpt var fmt ty
183
  | Tydec_const c       -> fprintf fmt "%s %s" c var
184
  | Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d
185
  | Tydec_enum tl ->
186
    begin
187
      incr cpt;
188
      fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
189
    end
190
  | Tydec_struct fl ->
191
    begin
192
      incr cpt;
193
      fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var
194
    end
195

    
196
let print_type_definitions fmt filename =
197
  let cpt_type = ref 0 in
198
  Hashtbl.iter (fun typ def ->
199
    match typ with
200
    | Tydec_const var ->
201
      fprintf fmt "typedef %a;@.@."
202
	(pp_c_type_decl filename cpt_type var) def
203
    | _        -> ()) type_table
204

    
205
(********************************************************************************************)
206
(*                         MAIN Header Printing functions                                   *)
207
(********************************************************************************************)
208
let print_header header_fmt basename prog machines =
209
  (* Include once: start *)
210
  let baseNAME = String.uppercase basename in
211
  let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in
212
  (* Print the svn version number and the supported C standard (C90 or C99) *)
213
  print_version header_fmt;
214
  fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
215
  pp_print_newline header_fmt ();
216
  fprintf header_fmt "/* Imports standard library */@.";
217
  (* imports standard library definitions (arrow) *)
218
  print_import_standard header_fmt;
219
  pp_print_newline header_fmt ();
220
  fprintf header_fmt "/* Types definitions */@.";
221
  (* Print the type definitions from the type table *)
222
  print_type_definitions header_fmt basename;
223
  pp_print_newline header_fmt ();
224
  (* Print the global constant declarations. *)
225
  fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
226
  List.iter (fun c -> print_const_decl header_fmt c) (get_consts prog);
227
  pp_print_newline header_fmt ();
228
  (* Print the struct declarations of all machines. *)
229
  fprintf header_fmt "/* Struct declarations */@.";
230
  List.iter (print_machine_struct header_fmt) machines;
231
  pp_print_newline header_fmt ();
232
  (* Print the prototypes of all machines *)
233
  fprintf header_fmt "/* Nodes declarations */@.";
234
  List.iter (print_machine_decl header_fmt) machines;
235
  pp_print_newline header_fmt ();
236
  (* Include once: end *)
237
  fprintf header_fmt "#endif@.";
238
  pp_print_newline header_fmt ()
239
end
240

    
241
(* Local Variables: *)
242
(* compile-command:"make -C ../../.." *)
243
(* End: *)