Project

General

Profile

Revision 3b2bd83d src/backends/C/c_backend_header.ml

View differences:

src/backends/C/c_backend_header.ml
34 34
struct
35 35

  
36 36
let print_import_standard fmt =
37
  fprintf fmt "#include \"%s/arrow.h\"@.@." Version.include_path
37
  begin
38
    if !Options.mpfr then
39
      begin
40
	fprintf fmt "#include <mpfr.h>@."
41
      end;
42
    fprintf fmt "#include \"%s/arrow.h\"@.@." Version.include_path
43
  end
38 44

  
39 45
let rec print_static_val pp_var fmt v =
40
  match v with
46
  match v.value_desc with
41 47
  | Cst c         -> pp_c_const fmt c
42 48
  | LocalVar v    -> pp_var fmt v
43 49
  | Fun (n, vl)   -> Basic_library.pp_c n (print_static_val pp_var) fmt vl
......
145 151
    inst
146 152

  
147 153
let print_machine_decl fmt m =
148
  Mod.print_machine_decl_prefix fmt m;
149
  if fst (get_stateless_status m) then
150
    begin
151
      fprintf fmt "extern %a;@.@."
152
	print_stateless_prototype
153
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
154
    end
155
  else
156
    begin
157
      (* Static allocation *)
158
      if !Options.static_mem
159
      then
160
	begin
161
	  let inst = mk_instance m in
162
	  let attr = mk_attribute m in
163
	  fprintf fmt "%a@.%a@.%a@."
164
	    print_static_declare_macro (m, attr, inst)
165
	    print_static_link_macro (m, attr, inst)
166
	    print_static_alloc_macro (m, attr, inst)
167
	end
168
      else
169
	begin 
170
        (* Dynamic allocation *)
171
	  fprintf fmt "extern %a;@.@."
172
	    print_alloc_prototype (m.mname.node_id, m.mstatic)
173
	end;
174
      let self = mk_self m in
175
      fprintf fmt "extern %a;@.@."
176
	(print_reset_prototype self) (m.mname.node_id, m.mstatic);
154
  begin
155
    Mod.print_machine_decl_prefix fmt m;
156
    if fst (get_stateless_status m) then
157
      begin
158
	fprintf fmt "extern %a;@.@."
159
	  print_stateless_prototype
160
	  (m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
161
      end
162
    else
163
      begin
164
        (* Static allocation *)
165
	if !Options.static_mem
166
	then
167
	  begin
168
	    let inst = mk_instance m in
169
	    let attr = mk_attribute m in
170
	    fprintf fmt "%a@.%a@.%a@."
171
	      print_static_declare_macro (m, attr, inst)
172
	      print_static_link_macro (m, attr, inst)
173
	      print_static_alloc_macro (m, attr, inst)
174
	  end
175
	else
176
	  begin 
177
            (* Dynamic allocation *)
178
	    fprintf fmt "extern %a;@.@."
179
	      print_alloc_prototype (m.mname.node_id, m.mstatic)
180
	  end;
181
	let self = mk_self m in
182
	fprintf fmt "extern %a;@.@."
183
	  (print_reset_prototype self) (m.mname.node_id, m.mstatic);
177 184

  
178
      fprintf fmt "extern %a;@.@."
179
	(print_step_prototype self)
180
	(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
181
    end
185
	fprintf fmt "extern %a;@.@."
186
	  (print_step_prototype self)
187
	  (m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs);
188
	
189
	if !Options.mpfr then
190
	  begin
191
	    fprintf fmt "extern %a;@.@."
192
	      (print_init_prototype self) (m.mname.node_id, m.mstatic);
193

  
194
	    fprintf fmt "extern %a;@.@."
195
	      (print_clear_prototype self) (m.mname.node_id, m.mstatic);
196
	  end
197
      end
198
  end
182 199

  
183 200
let print_machine_alloc_decl fmt m =
184 201
  Mod.print_machine_decl_prefix fmt m;
......
215 232
	  print_stateless_C_prototype
216 233
	  (inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs)
217 234
      end
218
    else (
219
      raise (Invalid_argument ("A node with declared prototype C cannot be stateful, it has to be a function")))
235
    else (Format.eprintf "internal error: print_machine_decl_from_header"; assert false)
220 236
  else
221 237
    if inode.nodei_stateless then
222 238
    begin
......
233 249
	let self = mk_new_name used "self" in
234 250
	fprintf fmt "extern %a;@.@."
235 251
	  (print_reset_prototype self) (inode.nodei_id, static_inputs);
236
	
252

  
253
	fprintf fmt "extern %a;@.@."
254
	  (print_init_prototype self) (inode.nodei_id, static_inputs);
255

  
256
	fprintf fmt "extern %a;@.@."
257
	  (print_clear_prototype self) (inode.nodei_id, static_inputs);
258

  
237 259
	fprintf fmt "extern %a;@.@."
238 260
	  (print_step_prototype self)
239 261
	  (inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs)
240 262
      end
241 263

  
242 264
let print_const_decl fmt cdecl =
243
  fprintf fmt "extern %a;@." 
244
    (pp_c_type cdecl.const_id) cdecl.const_type
265
  if !Options.mpfr &&  Types.is_real_type (Types.array_base_type cdecl.const_type)
266
  then
267
    fprintf fmt "extern %a;@." 
268
      (pp_c_type cdecl.const_id) (Types.dynamic_type cdecl.const_type) 
269
  else
270
    fprintf fmt "extern %a;@." 
271
      (pp_c_type cdecl.const_id) cdecl.const_type
245 272

  
246 273
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) =
247 274
  fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc
......
249 276
  match tdecl with
250 277
  | Tydec_any           -> assert false
251 278
  | Tydec_int           -> fprintf fmt "int %s" var
279
  | Tydec_real when !Options.mpfr
280
                        -> fprintf fmt "%s %s" Mpfr.mpfr_t var
252 281
  | Tydec_real          -> fprintf fmt "double %s" var
253
  | Tydec_float         -> fprintf fmt "float %s" var
282
  (* | Tydec_float         -> fprintf fmt "float %s" var *)
254 283
  | Tydec_bool          -> fprintf fmt "_Bool %s" var
255 284
  | Tydec_clock ty      -> pp_c_type_decl filename cpt var fmt ty
256 285
  | Tydec_const c       -> fprintf fmt "%s %s" c var
......
290 319
(********************************************************************************************)
291 320
let print_header header_fmt basename prog machines dependencies =
292 321
  (* Include once: start *)
293
  let baseNAME = String.uppercase basename in
294
  let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in
322
  let baseNAME = file_to_module_name basename in
295 323
  begin
296
    (* Print the svn version number and the supported C standard (C90 or C99) *)
324
    (* Print the version number and the supported C standard (C90 or C99) *)
297 325
    print_version header_fmt;
298 326
    fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
299 327
    pp_print_newline header_fmt ();
......
302 330
    print_import_standard header_fmt;
303 331
    pp_print_newline header_fmt ();
304 332
    (* imports dependencies *)
305
    fprintf header_fmt "/* Import Dependencies */@.";
333
    fprintf header_fmt "/* Import dependencies */@.";
306 334
    fprintf header_fmt "@[<v>";
307 335
    List.iter (print_import_prototype header_fmt) dependencies;
308 336
    fprintf header_fmt "@]@.";
......
314 342
    fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
315 343
    List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) (get_consts prog);
316 344
    pp_print_newline header_fmt ();
345
    if !Options.mpfr then
346
      begin
347
	fprintf header_fmt "/* Global initialization declaration */@.";
348
	fprintf header_fmt "extern %a;@.@."
349
	  print_global_init_prototype baseNAME;
350
	
351
	fprintf header_fmt "/* Global clear declaration */@.";
352
	fprintf header_fmt "extern %a;@.@."
353
	  print_global_clear_prototype baseNAME;
354
      end;
317 355
    (* Print the struct declarations of all machines. *)
318
    fprintf header_fmt "/* Struct declarations */@.";
356
    fprintf header_fmt "/* Structs declarations */@.";
319 357
    List.iter (print_machine_struct header_fmt) machines;
320 358
    pp_print_newline header_fmt ();
321 359
    (* Print the prototypes of all machines *)
......
329 367

  
330 368
let print_alloc_header header_fmt basename prog machines dependencies =
331 369
  (* Include once: start *)
332
  let baseNAME = String.uppercase basename in
333
  let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in
370
  let baseNAME = file_to_module_name basename in
334 371
  begin
335 372
    (* Print the svn version number and the supported C standard (C90 or C99) *)
336 373
    print_version header_fmt;
......
362 399
   header. *)
363 400
let print_header_from_header header_fmt basename header =
364 401
  (* Include once: start *)
365
  let baseNAME = String.uppercase basename in
366
  let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in
402
  let baseNAME = file_to_module_name basename in
367 403
  let types = get_typedefs header in
368 404
  let consts = get_consts header in
369 405
  let nodes = get_imported_nodes header in
370 406
  let dependencies = get_dependencies header in
371 407
  begin
372
    (* Print the svn version number and the supported C standard (C90 or C99) *)
408
    (* Print the version number and the supported C standard (C90 or C99) *)
373 409
    print_version header_fmt;
374 410
    fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
375 411
    pp_print_newline header_fmt ();
......
395 431
    fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
396 432
    List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) consts;
397 433
    pp_print_newline header_fmt ();
434
    if !Options.mpfr then
435
      begin
436
	fprintf header_fmt "/* Global initialization declaration */@.";
437
	fprintf header_fmt "extern %a;@.@."
438
	  print_global_init_prototype baseNAME;
439
	
440
	fprintf header_fmt "/* Global clear declaration */@.";
441
	fprintf header_fmt "extern %a;@.@."
442
	  print_global_clear_prototype baseNAME;
443
      end;
398 444
    (* Print the struct declarations of all machines. *)
399
    fprintf header_fmt "/* Struct declarations */@.";
445
    fprintf header_fmt "/* Structs declarations */@.";
400 446
    List.iter (fun node -> print_machine_struct_from_header header_fmt (imported_node_of_top node)) nodes;
401 447
    pp_print_newline header_fmt ();
402 448
    (* Print the prototypes of all machines *)

Also available in: Unified diff