From fa090c4e4815af9ff29643e595c192b880786d2a Mon Sep 17 00:00:00 2001
From: xthirioux <xthirioux@041b043f-8d7c-46b2-b46e-ef0dd855326e>
Date: Thu, 6 Mar 2014 14:39:27 +0000
Subject: [PATCH] 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
---
include/arrow.c | 2 +-
include/arrow.h | 10 +++++++---
src/c_backend.ml | 26 ++++++++++++++++++++------
src/corelang.ml | 14 +++++++++++++-
src/lustreSpec.ml | 1 +
src/main_lustre_compiler.ml | 11 ++++++++++-
6 files changed, 52 insertions(+), 12 deletions(-)
diff --git a/include/arrow.c b/include/arrow.c
index 950b46a6..551cee5d 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 f2fa3bf7..3157509f 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 c67382d1..a0958443 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 c73e93c5..edbbb205 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 ef67a0e8..8268adb1 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 1688e98c..fbae8294 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
--
GitLab