diff --git a/include/arrow.c b/include/arrow.c
index 950b46a6562f080d92023a8b2dab2504b4bb25bf..551cee5d2750c3db774798f5d9db25c21aa7a966 100644
--- a/include/arrow.c
+++ b/include/arrow.c
@@ -2,7 +2,7 @@
#include <assert.h>
#include "arrow.h"
-struct _arrow_mem *arrow_alloc() {
+struct _arrow_mem *_arrow_alloc() {
struct _arrow_mem *_alloc;
_alloc = (struct _arrow_mem *) malloc(sizeof(struct _arrow_mem *));
assert (_alloc);
diff --git a/include/arrow.h b/include/arrow.h
index f2fa3bf7a9f8214bb0a0676399a1b77a815b439c..3157509fc8a409f9fc08f750a0f2cf997e8ec81c 100644
--- a/include/arrow.h
+++ b/include/arrow.h
@@ -4,15 +4,19 @@
struct _arrow_mem {struct _arrow_reg {_Bool _first; } _reg; };
-extern struct _arrow_mem *arrow_alloc ();
+extern struct _arrow_mem *_arrow_alloc ();
-#define _arrow_DECLARE(inst)\
- struct _arrow_mem inst;
+#define _arrow_DECLARE(attr, inst)\
+ attr struct _arrow_mem inst;
#define _arrow_LINK(inst) do {\
;\
} while (0)
+#define _arrow_ALLOC(attr, inst)\
+ _arrow_DECLARE(attr, inst);\
+ _arrow_LINK(inst)
+
#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y))
#define _arrow_reset(self) {(self)->_reg._first = 1;}
diff --git a/src/c_backend.ml b/src/c_backend.ml
index c67382d1ddcb9efb4c1e9a76c16c51164102b635..a0958443e2af8ec87d1d512ed0943984a0542943 100644
--- a/src/c_backend.ml
+++ b/src/c_backend.ml
@@ -36,9 +36,18 @@ let print_version fmt =
Format.fprintf fmt "/* @[<v>C code generated by %s@,SVN version number %s@,Code is %s compliant */@,@]@."
(Filename.basename Sys.executable_name) Version.number (if !Options.ansi then "ANSI C90" else "C99")
+(* Generation of a non-clashing name for the self memory variable (for step and reset functions) *)
let mk_self m =
mk_new_name (m.mstep.step_inputs@m.mstep.step_outputs@m.mstep.step_locals@m.mmemory) "self"
+(* Generation of a non-clashing name for the instance variable of static allocation macro *)
+let mk_instance m =
+ mk_new_name (m.mstep.step_inputs@m.mmemory) "inst"
+
+(* Generation of a non-clashing name for the attribute variable of static allocation macro *)
+let mk_attribute m =
+ mk_new_name (m.mstep.step_inputs@m.mmemory) "attr"
+
let mk_call_var_decl loc id =
{ var_id = id;
var_dec_type = mktyp Location.dummy_loc Tydec_any;
@@ -580,19 +589,24 @@ let print_machine_struct fmt m =
let pp_static_array_instance fmt m (v, m) =
fprintf fmt "%s" (mk_addr_var m v)
*)
-let print_static_declare_instance fmt (i, (m, static)) =
- fprintf fmt "%a(%a%t%s)"
+let print_static_declare_instance attr fmt (i, (m, static)) =
+ fprintf fmt "%a(%s, %a%t%s)"
pp_machine_static_declare_name (node_name m)
+ attr
(Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
(Utils.pp_final_char_if_non_empty ", " static)
i
let print_static_declare_macro fmt m =
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
- fprintf fmt "@[<v 2>#define %a(%a%tinst)\\@,%a inst;\\@,%a%t%a;@,@]"
+ let inst = mk_instance m in
+ let attr = mk_attribute m in
+ fprintf fmt "@[<v 2>#define %a(%s, %a%tinst)\\@,%s %a inst;\\@,%a%t%a;@,@]"
pp_machine_static_declare_name m.mname.node_id
+ attr
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
(Utils.pp_final_char_if_non_empty ", " m.mstatic)
+ attr
pp_machine_memtype_name m.mname.node_id
(Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem
(Utils.pp_final_char_if_non_empty ";\\@," array_mem)
@@ -600,7 +614,7 @@ let print_static_declare_macro fmt m =
(fun fmt (i',m') ->
let path = sprintf "inst ## _%s" i' in
fprintf fmt "%a"
- print_static_declare_instance (path,m')
+ (print_static_declare_instance attr) (path,m')
)) m.minstances
@@ -628,7 +642,7 @@ let print_static_link_macro fmt m =
)) m.minstances
let print_static_alloc_macro fmt m =
- fprintf fmt "@[<v>@[<v 2>#define %a(%a%tinst)\\@,%a(%a%tinst);\\@,%a(inst);@]@,@]@."
+ fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@."
pp_machine_static_alloc_name m.mname.node_id
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
(Utils.pp_final_char_if_non_empty ", " m.mstatic)
@@ -798,7 +812,7 @@ let print_main_fun machines m fmt =
) m.mstep.step_outputs;
fprintf fmt "@ /* Main memory allocation */@ ";
if (!Options.static_mem && !Options.main_node <> "")
- then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname)
+ then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
fprintf fmt "@ /* Initialize the main memory */@ ";
fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
diff --git a/src/corelang.ml b/src/corelang.ml
index c73e93c5e7bd397f06c34f3226a9ceb5e590f1f8..edbbb20526d43df945757d391ee1ce47e9d6655d 100755
--- a/src/corelang.ml
+++ b/src/corelang.ml
@@ -336,6 +336,11 @@ let tag_table =
tag_false, Tydec_bool
]
+(* To guarantee uniqueness of fields in struct types *)
+let field_table =
+ Utils.create_hashtable 20 [
+ ]
+
let get_enum_type_tags cty =
match cty with
| Tydec_bool -> [tag_true; tag_false]
@@ -343,7 +348,14 @@ let get_enum_type_tags cty =
| Tydec_enum tl -> tl
| _ -> assert false)
| _ -> assert false
-
+(*
+let get_struct_type_fields cty =
+ match cty with
+ | Tydec_const _ -> (match Hashtbl.find type_table cty with
+ | Tydec_struct fl -> fl
+ | _ -> assert false)
+ | _ -> assert false
+ *)
let const_of_bool b =
Const_tag (if b then tag_true else tag_false)
diff --git a/src/lustreSpec.ml b/src/lustreSpec.ml
index ef67a0e89b4bd287f89ebca00c464bedbdf75569..8268adb17748a565ca92d5344da2e040df85815f 100644
--- a/src/lustreSpec.ml
+++ b/src/lustreSpec.ml
@@ -33,6 +33,7 @@ and type_dec_desc =
| Tydec_clock of type_dec_desc
| Tydec_const of ident
| Tydec_enum of ident list
+(* | Tydec_struct of (ident * type_dec_desc) list *)
| Tydec_array of Dimension.dim_expr * type_dec_desc
type clock_dec =
diff --git a/src/main_lustre_compiler.ml b/src/main_lustre_compiler.ml
index 1688e98c71df3085a82f87ee6eecfd03d602624e..fbae8294ca28e41c15a5f0658a9930b2e0bccad9 100644
--- a/src/main_lustre_compiler.ml
+++ b/src/main_lustre_compiler.ml
@@ -228,7 +228,16 @@ let rec compile basename extension =
report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?"
(Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
machine_code);
-
+
+ (* Creating destination directory if needed *)
+ if not (Sys.file_exists !Options.dest_dir) then (
+ report ~level:1 (fun fmt -> fprintf fmt ".. creating destination directory@,@?");
+ Unix.mkdir !Options.dest_dir (Unix.stat ".").Unix.st_perm
+ );
+ if (Unix.stat !Options.dest_dir).Unix.st_kind <> Unix.S_DIR then (
+ Format.eprintf "Failure: destination %s is not a directory.@.@." !Options.dest_dir;
+ exit 1
+ );
(* Printing code *)
let basename = Filename.basename basename in
let destname = !Options.dest_dir ^ "/" ^ basename in