Revision fa090c4e
Added by Xavier Thirioux over 10 years ago
| 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
corrected bug in arrow macros names, added storage attribute for static alloc macros, option -d now creates the destination directory if needed, with current dir as file permissions
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@181 041b043f-8d7c-46b2-b46e-ef0dd855326e