Project

General

Profile

Revision fa090c4e

View differences:

include/arrow.c
2 2
#include <assert.h>
3 3
#include "arrow.h"
4 4

  
5
struct _arrow_mem *arrow_alloc() {
5
struct _arrow_mem *_arrow_alloc() {
6 6
  struct _arrow_mem *_alloc;
7 7
  _alloc = (struct _arrow_mem *) malloc(sizeof(struct _arrow_mem *));
8 8
  assert (_alloc);
include/arrow.h
4 4

  
5 5
struct _arrow_mem {struct _arrow_reg {_Bool _first; } _reg; };
6 6

  
7
extern struct _arrow_mem *arrow_alloc ();
7
extern struct _arrow_mem *_arrow_alloc ();
8 8

  
9
#define _arrow_DECLARE(inst)\
10
  struct _arrow_mem inst;
9
#define _arrow_DECLARE(attr, inst)\
10
  attr struct _arrow_mem inst;
11 11
  
12 12
#define _arrow_LINK(inst) do {\
13 13
  ;\
14 14
} while (0)
15 15

  
16
#define _arrow_ALLOC(attr, inst)\
17
  _arrow_DECLARE(attr, inst);\
18
  _arrow_LINK(inst)
19

  
16 20
#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y))
17 21

  
18 22
#define _arrow_reset(self) {(self)->_reg._first = 1;}
src/c_backend.ml
36 36
  Format.fprintf fmt "/* @[<v>C code generated by %s@,SVN version number %s@,Code is %s compliant */@,@]@."
37 37
    (Filename.basename Sys.executable_name) Version.number (if !Options.ansi then "ANSI C90" else "C99")
38 38

  
39
(* Generation of a non-clashing name for the self memory variable (for step and reset functions) *)
39 40
let mk_self m =
40 41
  mk_new_name (m.mstep.step_inputs@m.mstep.step_outputs@m.mstep.step_locals@m.mmemory) "self"
41 42

  
43
(* Generation of a non-clashing name for the instance variable of static allocation macro *)
44
let mk_instance m =
45
  mk_new_name (m.mstep.step_inputs@m.mmemory) "inst"
46

  
47
(* Generation of a non-clashing name for the attribute variable of static allocation macro *)
48
let mk_attribute m =
49
  mk_new_name (m.mstep.step_inputs@m.mmemory) "attr"
50

  
42 51
let mk_call_var_decl loc id =
43 52
  { var_id = id;
44 53
    var_dec_type = mktyp Location.dummy_loc Tydec_any;
......
580 589
let pp_static_array_instance fmt m (v, m) =
581 590
 fprintf fmt "%s" (mk_addr_var m v)
582 591
*)
583
let print_static_declare_instance fmt (i, (m, static)) =
584
  fprintf fmt "%a(%a%t%s)"
592
let print_static_declare_instance attr fmt (i, (m, static)) =
593
  fprintf fmt "%a(%s, %a%t%s)"
585 594
    pp_machine_static_declare_name (node_name m)
595
    attr
586 596
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
587 597
    (Utils.pp_final_char_if_non_empty ", " static)
588 598
    i
589 599

  
590 600
let print_static_declare_macro fmt m =
591 601
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
592
  fprintf fmt "@[<v 2>#define %a(%a%tinst)\\@,%a inst;\\@,%a%t%a;@,@]"
602
  let inst = mk_instance m in
603
  let attr = mk_attribute m in
604
  fprintf fmt "@[<v 2>#define %a(%s, %a%tinst)\\@,%s %a inst;\\@,%a%t%a;@,@]"
593 605
    pp_machine_static_declare_name m.mname.node_id
606
    attr
594 607
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
595 608
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
609
    attr
596 610
    pp_machine_memtype_name m.mname.node_id
597 611
    (Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem
598 612
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
......
600 614
       (fun fmt (i',m') ->
601 615
	 let path = sprintf "inst ## _%s" i' in
602 616
	 fprintf fmt "%a"
603
	   print_static_declare_instance (path,m')
617
	   (print_static_declare_instance attr) (path,m')
604 618
       )) m.minstances
605 619

  
606 620
      
......
628 642
       )) m.minstances
629 643
      
630 644
let print_static_alloc_macro fmt m =
631
  fprintf fmt "@[<v>@[<v 2>#define %a(%a%tinst)\\@,%a(%a%tinst);\\@,%a(inst);@]@,@]@."
645
  fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@."
632 646
    pp_machine_static_alloc_name m.mname.node_id
633 647
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
634 648
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
......
798 812
    ) m.mstep.step_outputs;
799 813
  fprintf fmt "@ /* Main memory allocation */@ ";
800 814
  if (!Options.static_mem && !Options.main_node <> "")
801
  then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname)
815
  then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
802 816
  else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
803 817
  fprintf fmt "@ /* Initialize the main memory */@ ";
804 818
  fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
src/corelang.ml
336 336
   tag_false, Tydec_bool
337 337
  ]
338 338

  
339
(* To guarantee uniqueness of fields in struct types *)
340
let field_table =
341
  Utils.create_hashtable 20 [
342
  ]
343

  
339 344
let get_enum_type_tags cty =
340 345
 match cty with
341 346
 | Tydec_bool    -> [tag_true; tag_false]
......
343 348
                     | Tydec_enum tl -> tl
344 349
                     | _             -> assert false)
345 350
 | _            -> assert false
346

  
351
(*
352
let get_struct_type_fields cty =
353
 match cty with
354
 | Tydec_const _ -> (match Hashtbl.find type_table cty with
355
                     | Tydec_struct fl -> fl
356
                     | _               -> assert false)
357
 | _            -> assert false
358
 *)
347 359
let const_of_bool b =
348 360
 Const_tag (if b then tag_true else tag_false)
349 361

  
src/lustreSpec.ml
33 33
  | Tydec_clock of type_dec_desc
34 34
  | Tydec_const of ident
35 35
  | Tydec_enum of ident list
36
(*  | Tydec_struct of (ident * type_dec_desc) list *)
36 37
  | Tydec_array of Dimension.dim_expr * type_dec_desc
37 38

  
38 39
type clock_dec =
src/main_lustre_compiler.ml
228 228
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?"
229 229
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
230 230
    machine_code);
231

  
231
  
232
  (* Creating destination directory if needed *)
233
  if not (Sys.file_exists !Options.dest_dir) then (
234
    report ~level:1 (fun fmt -> fprintf fmt ".. creating destination directory@,@?");
235
    Unix.mkdir !Options.dest_dir (Unix.stat ".").Unix.st_perm
236
  );
237
  if (Unix.stat !Options.dest_dir).Unix.st_kind <> Unix.S_DIR then (
238
    Format.eprintf "Failure: destination %s is not a directory.@.@." !Options.dest_dir;
239
    exit 1
240
  );
232 241
  (* Printing code *)
233 242
  let basename    =  Filename.basename basename in
234 243
  let destname = !Options.dest_dir ^ "/" ^ basename in

Also available in: Unified diff