Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (8 KB)

1
open Format 
2
open LustreSpec
3
open Corelang
4
open Machine_code
5
open C_backend_common
6

    
7
(********************************************************************************************)
8
(*                         Header Printing functions                                        *)
9
(********************************************************************************************)
10
let print_machine_decl_prefix = ref (fun fmt x -> ())
11

    
12

    
13
let print_import_standard fmt =
14
  fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
15

    
16
    
17
let pp_registers_struct fmt m =
18
  if m.mmemory <> []
19
  then
20
    fprintf fmt "@[%a {@[%a; @]}@] _reg; "
21
      pp_machine_regtype_name m.mname.node_id
22
      (Utils.fprintf_list ~sep:"; " pp_c_decl_struct_var) m.mmemory
23
  else
24
    ()
25

    
26
let print_machine_struct fmt m =
27
  if fst (get_stateless_status m) then
28
    begin
29
    end
30
  else
31
    begin
32
      (* Define struct *)
33
      fprintf fmt "@[%a {@[%a%a%t@]};@]@."
34
	pp_machine_memtype_name m.mname.node_id
35
	pp_registers_struct m
36
	(Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances
37
	(Utils.pp_final_char_if_non_empty "; " m.minstances)
38
    end
39

    
40
let print_static_declare_instance attr fmt (i, (m, static)) =
41
  fprintf fmt "%a(%s, %a%t%s)"
42
    pp_machine_static_declare_name (node_name m)
43
    attr
44
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
45
    (Utils.pp_final_char_if_non_empty ", " static)
46
    i
47

    
48
let print_static_declare_macro fmt m =
49
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
50
  let inst = mk_instance m in
51
  let attr = mk_attribute m in
52
  fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%s %a %s;\\@,%a%t%a;@,@]"
53
    pp_machine_static_declare_name m.mname.node_id
54
    attr
55
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
56
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
57
    inst
58
    attr
59
    pp_machine_memtype_name m.mname.node_id
60
    inst
61
    (Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem
62
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
63
    (Utils.fprintf_list ~sep:";\\@,"
64
       (fun fmt (i',m') ->
65
	 let path = sprintf "inst ## _%s" i' in
66
	 fprintf fmt "%a"
67
	   (print_static_declare_instance attr) (path,m')
68
       )) m.minstances
69

    
70
      
71
let print_static_link_instance fmt (i, (m, _)) =
72
 fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i
73

    
74
(* Allocation of a node struct:
75
   - if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct)
76
*)
77
let print_static_link_macro fmt m =
78
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
79
  fprintf fmt "@[<v>@[<v 2>#define %a(inst) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
80
    pp_machine_static_link_name m.mname.node_id
81
    (Utils.fprintf_list ~sep:";\\@,"
82
       (fun fmt v ->
83
	 fprintf fmt "inst._reg.%s = (%a*) &%s"
84
	   v.var_id
85
           (fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v
86
	   v.var_id
87
       )) array_mem
88
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
89
    (Utils.fprintf_list ~sep:";\\@,"
90
       (fun fmt (i',m') ->
91
	 let path = sprintf "inst ## _%s" i' in
92
	 fprintf fmt "%a;\\@,inst.%s = &%s"
93
	   print_static_link_instance (path,m')
94
	   i'
95
	   path
96
       )) m.minstances
97
      
98
let print_static_alloc_macro fmt m =
99
  fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@."
100
    pp_machine_static_alloc_name m.mname.node_id
101
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
102
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
103
    pp_machine_static_declare_name m.mname.node_id
104
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
105
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
106
    pp_machine_static_link_name m.mname.node_id
107

    
108
 
109
let print_machine_decl fmt m =
110
  !print_machine_decl_prefix fmt m;
111
  if fst (get_stateless_status m) then
112
    begin
113
      fprintf fmt "extern %a;@.@."
114
	print_stateless_prototype
115
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
116
    end
117
  else
118
    begin
119
      (* Static allocation *)
120
      if !Options.static_mem
121
      then (
122
	fprintf fmt "%a@.%a@.%a@."
123
	  print_static_declare_macro m
124
	  print_static_link_macro m
125
	  print_static_alloc_macro m
126
      )
127
      else ( 
128
        (* Dynamic allocation *)
129
	fprintf fmt "extern %a;@.@."
130
	  print_alloc_prototype (m.mname.node_id, m.mstatic)
131
      );
132
      let self = mk_self m in
133
      fprintf fmt "extern %a;@.@."
134
	(print_reset_prototype self) (m.mname.node_id, m.mstatic);
135

    
136
      fprintf fmt "extern %a;@.@."
137
	(print_step_prototype self)
138
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
139
    end
140

    
141
let print_const_decl fmt cdecl =
142
  fprintf fmt "extern %a;@." 
143
    (pp_c_type cdecl.const_id) cdecl.const_type
144

    
145
(********************************************************************************************)
146
(*                      Struct/TypeDef Printing functions                                   *)
147
(********************************************************************************************)
148

    
149

    
150
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) =
151
  fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc
152
and pp_c_type_decl filename cpt var fmt tdecl =
153
  match tdecl with
154
  | Tydec_any           -> assert false
155
  | Tydec_int           -> fprintf fmt "int %s" var
156
  | Tydec_real          -> fprintf fmt "double %s" var
157
  | Tydec_float         -> fprintf fmt "float %s" var
158
  | Tydec_bool          -> fprintf fmt "_Bool %s" var
159
  | Tydec_clock ty      -> pp_c_type_decl filename cpt var fmt ty
160
  | Tydec_const c       -> fprintf fmt "%s %s" c var
161
  | Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d
162
  | Tydec_enum tl ->
163
    begin
164
      incr cpt;
165
      fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
166
    end
167
  | Tydec_struct fl ->
168
    begin
169
      incr cpt;
170
      fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var
171
    end
172

    
173
let print_type_definitions fmt filename =
174
  let cpt_type = ref 0 in
175
  Hashtbl.iter (fun typ def ->
176
    match typ with
177
    | Tydec_const var ->
178
      fprintf fmt "typedef %a;@.@."
179
	(pp_c_type_decl filename cpt_type var) def
180
    | _        -> ()) type_table
181

    
182
(********************************************************************************************)
183
(*                         MAIN Header Printing functions                                   *)
184
(********************************************************************************************)
185

    
186
let print_header header_fmt basename prog machines =
187
  (* Include once: start *)
188
  let baseNAME = String.uppercase basename in
189
  let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in
190
  (* Print the svn version number and the supported C standard (C90 or C99) *)
191
  print_version header_fmt;
192
  fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
193
  pp_print_newline header_fmt ();
194
  fprintf header_fmt "/* Imports standard library */@.";
195
  (* imports standard library definitions (arrow) *)
196
  print_import_standard header_fmt;
197
  pp_print_newline header_fmt ();
198
  fprintf header_fmt "/* Types definitions */@.";
199
  (* Print the type definitions from the type table *)
200
  print_type_definitions header_fmt basename;
201
  pp_print_newline header_fmt ();
202
  (* Print the global constant declarations. *)
203
  fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
204
  List.iter (fun c -> print_const_decl header_fmt c) (get_consts prog);
205
  pp_print_newline header_fmt ();
206
  (* Print the struct declarations of all machines. *)
207
  fprintf header_fmt "/* Struct declarations */@.";
208
  List.iter (print_machine_struct header_fmt) machines;
209
  pp_print_newline header_fmt ();
210
  (* Print the prototypes of all machines *)
211
  fprintf header_fmt "/* Nodes declarations */@.";
212
  List.iter (print_machine_decl header_fmt) machines;
213
  pp_print_newline header_fmt ();
214
  (* Include once: end *)
215
  fprintf header_fmt "#endif@.";
216
  pp_print_newline header_fmt ()
217

    
218
(* Local Variables: *)
219
(* compile-command:"make -C ../../.." *)
220
(* End: *)