diff --git a/lib/lic2soc.ml b/lib/lic2soc.ml
index f8ce99b1d565f5fc187951768834020010ade083..a53b148894d04e418b691493ddbb05760dee8df1 100644
--- a/lib/lic2soc.ml
+++ b/lib/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 09/07/2024 (at 10:12) by Erwan Jahier> *)
+(** Time-stamp: <modified the 09/07/2024 (at 11:38) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -780,15 +780,17 @@ and (actions_of_expression : Lxm.t -> Soc.tbl -> ctx -> Lic.clock -> Soc.var_exp
(*********************************************************************************)
-let (is_a_task : Lxm.t -> bool) =
- fun lxm ->
+let (is_a_task : bool -> Lxm.t -> bool) =
+ fun toplevel_node lxm ->
let rec f pl =
match pl with
| [] -> false
| Pragma("MT",_)::_ -> true
| Pragma(_,_)::pl -> f pl
in
- if Lv6MainArgs.global_opt.Lv6MainArgs.multi_task then
+ if Lv6MainArgs.global_opt.Lv6MainArgs.multi_task_top then
+ toplevel_node
+ else if Lv6MainArgs.global_opt.Lv6MainArgs.multi_task then
f (Lxm.pragma lxm)
else
false
@@ -798,18 +800,16 @@ let (is_a_task : Lxm.t -> bool) =
Generated dependencies are merged by the caller.
*)
-let (actions_of_equation: Lxm.t -> Soc.tbl -> ctx -> Lic.eq_info ->
+let (actions_of_equation: bool -> Lxm.t -> Soc.tbl -> ctx -> Lic.eq_info ->
ctx * action list * Soc.instance list * Soc.task list * ActionsDeps.t) =
- fun lxm soc_tbl ctx (left_part, right_part) ->
+ fun toplevel_node lxm soc_tbl ctx (left_part, right_part) ->
let clk = clock_of_expr right_part in
let left_loc = List.map (filter_of_left_part ctx.prg) left_part in
let left_loc = List.flatten left_loc in
- let is_task = is_a_task lxm in
+ let is_task = is_a_task toplevel_node lxm in
let ctx, actions, _, instances, tasks, deps =
actions_of_expression lxm soc_tbl ctx clk left_loc is_task right_part
- (* XXX c'est ici qu'on coupe l'action en 2 *)
in
- (* let tasks = if not is_task then tasks else xxx:: tasks in *)
ctx, actions, instances, tasks, deps
(*********************************************************************************)
@@ -819,8 +819,8 @@ let profile_info = Lv6Verbose.profile_info
let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
fun prog mnk ->
- let rec (process_node : Lic.node_key -> Soc.tbl -> Soc.key * Soc.tbl) =
- fun nk soc_tbl ->
+ let rec (process_node : bool -> Lic.node_key -> Soc.tbl -> Soc.key * Soc.tbl) =
+ fun main_node nk soc_tbl ->
profile_info ("Lic2soc.process_node "^(Lic.string_of_node_key nk)^"\n");
let node =
match LicPrg.find_node prog nk with
@@ -845,7 +845,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
(match LicPrg.find_node prog nk with
| None -> assert false
| Some node_def ->
- (match soc_of_node prog node_def soc_tbl with
+ (match soc_of_node main_node prog node_def soc_tbl with
| Some(_,soc,soc_tbl) -> SocUtils.add sk soc soc_tbl
| None ->
print_string ("Undefined soc : " ^ (string_of_node_key nk) ^ "\n");
@@ -860,8 +860,8 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
ZZZ ca part facilement en vrille ici si une erreur
a été faite en amont...
*)
- let soc_tbl = snd (process_node nk2 soc_tbl) in
- snd (process_node nk soc_tbl)
+ let soc_tbl = snd (process_node false nk2 soc_tbl) in
+ snd (process_node main_node nk soc_tbl)
| Undef_soc (sk,lxm,pos_op, types, fby_init_opt) -> (
let soc =
@@ -875,7 +875,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
assert false
);
let soc_tbl = SocUtils.add soc.key soc soc_tbl in
- snd (process_node nk soc_tbl)
+ snd (process_node main_node nk soc_tbl)
)
| Polymorphic ->
let msg = (Lxm.details node.lxm) ^
@@ -888,7 +888,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
sk, soc_tbl
and make_condact_soc node condact_node soc_key soc_tbl ctx lxm vel =
- let nsk, soc_tbl = process_node condact_node soc_tbl in
+ let nsk, soc_tbl = process_node false condact_node soc_tbl in
let nsoc = SocUtils.find lxm nsk soc_tbl in
let nsoc_step = match nsoc.step with [s] -> s
| _ -> assert false (* hmm. Iterating on a pre will not work. XXX fixme ! *)
@@ -899,7 +899,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
| ctx,None -> ctx,[]
in
let soc_key =
- let x,y,_=soc_key in
+ let x,y,_ = soc_key in
x,y, Soc.MemInit(Soc.Const("_true", Data.Bool)) (* the first step flag *)
in
let soc = {
@@ -925,24 +925,26 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
soc_tbl, soc
(* Produit des soc de noeuds. *)
- and (soc_of_node: LicPrg.t -> Lic.node_exp -> Soc.tbl ->
+ and (soc_of_node: bool -> LicPrg.t -> Lic.node_exp -> Soc.tbl ->
(ctx * Soc.t * Soc.tbl) option) =
- fun licprg node soc_tbl ->
+ fun main_node licprg node soc_tbl ->
+
profile_info ("Lic2soc.soc_of_node "^
(Lic.string_of_node_key node.node_key_eff)^"\n");
+
let io_list = node.Lic.inlist_eff @ node.Lic.outlist_eff in
let io_type = List.map (fun vi -> lic_to_data_type vi.var_type_eff) io_list in
let soc_key = make_soc_key_of_node_key node.Lic.node_key_eff None io_type in
let lxm = node.Lic.lxm in
let ctx = create_context licprg in
- let (soc_of_body: Lic.node_body -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
- fun b soc_tbl ->
+ let (soc_of_body: bool -> Lic.node_body -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
+ fun main_node b soc_tbl ->
profile_info " Lic2soc.soc_of_node: computing actions...\n";
let ctx, actions, instances, tasks, deps =
(* on itere sur la liste des équations *)
List.fold_left
(fun (c, a, i, t, d) eq ->
- let nc, na, ni, nt, nd = actions_of_equation eq.src soc_tbl c eq.it in
+ let nc, na, ni, nt, nd = actions_of_equation main_node eq.src soc_tbl c eq.it in
nc, List.rev_append na a,
List.rev_append ni i,
List.rev_append nt t,
@@ -1010,7 +1012,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.clock_profile = [];
Soc.instances = instances ;
Soc.tasks = tasks;
- Soc.step = [step1;step2 ] ;
+ Soc.step = [step1;step2] ;
Soc.memory = Soc.No_mem;
Soc.precedences = [ "step", ["step0"]] ;
Soc.assertions =
@@ -1030,9 +1032,9 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.clock_profile = [];
Soc.instances = instances ;
Soc.tasks = tasks;
- Soc.step = [step (* XXX c'est ici qu'on doire generer 2 step en mode multi-task *)] ;
+ Soc.step = [step] ;
Soc.memory = Soc.No_mem;
- Soc.precedences = [ (*["step1", ["step2"]] *)];
+ Soc.precedences = [];
Soc.assertions =
if Lv6MainArgs.global_opt.Lv6MainArgs.gen_autotest then
[] (* In this mode no code is generated and the var creation
@@ -1052,7 +1054,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
| ("map"|"red"|"fill"|"fillred"|"fold"),[
ConstStaticArgLic(_,Int_const_eff(c)); TypeStaticArgLic(_);
NodeStaticArgLic(_,iter_node)] -> ( (*red, fill, fillred, map *)
- let nsk, soc_tbl = process_node iter_node soc_tbl in
+ let nsk, soc_tbl = process_node main_node iter_node soc_tbl in
let nsoc = SocUtils.find lxm nsk soc_tbl in
let nsoc_step = match nsoc.step with
[s] -> s
@@ -1160,9 +1162,9 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
in
match node.Lic.def_eff with
| AbstractLic None -> assert false (* None if extern in the provide part *)
- | AbstractLic (Some node_exp) -> soc_of_node licprg node_exp soc_tbl
- | MetaOpLic -> soc_of_metaop node.Lic.node_key_eff soc_tbl
- | BodyLic b -> soc_of_body b soc_tbl
+ | AbstractLic (Some node_exp) -> soc_of_node main_node licprg node_exp soc_tbl
+ | MetaOpLic -> soc_of_metaop node.Lic.node_key_eff soc_tbl
+ | BodyLic b -> soc_of_body main_node b soc_tbl
| ExternLic -> soc_of_extern node soc_tbl
in
- process_node mnk SocMap.empty
+ process_node true mnk SocMap.empty
diff --git a/lib/lv6MainArgs.ml b/lib/lv6MainArgs.ml
index 2407fd601c407df0a2389f32e04fa8a13181bce0..9b84c549deef9e0a0c8ccc1b9f4ebaf3814bd154 100644
--- a/lib/lv6MainArgs.ml
+++ b/lib/lv6MainArgs.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 18/06/2024 (at 16:19) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/07/2024 (at 11:41) by Erwan Jahier> *)
(*
Le manager d'argument adapté de celui de lutin, plus joli
N.B. solution un peu batarde : les options sont stockées, comme avant, dans Global,
@@ -76,6 +76,7 @@ type global_opt = {
mutable soc2c_global_ctx : bool;
mutable soc2c_dro : bool;
mutable multi_task : bool;
+ mutable multi_task_top : bool;
mutable gen_wcet : bool;
mutable io_transmit_mode : io_transmit_mode;
mutable schedul_mode : schedul_mode;
@@ -109,6 +110,7 @@ let (global_opt:global_opt) =
soc2c_global_ctx = false;
soc2c_dro = false;
multi_task = false;
+ multi_task_top = false;
gen_wcet = false;
io_transmit_mode = Args;
schedul_mode = Simple;
@@ -563,8 +565,18 @@ let mkoptab (opt:t) : unit = (
["-2cmc";"--2c-multi-core";"-2cmt";"--2c-multi-task"]
(Arg.Unit (fun () ->
set_c_options opt;
+ global_opt.io_transmit_mode <- Ctx;
global_opt.multi_task <- true;))
- ["Generate a yaml file required for multi-core code generation"]
+ ["Set on the multi-task code generation mode (nodes with the %MT:t% pragma are tasks)"]
+ ;
+ mkopt opt ~doc_level:Dev
+ ["-2cmct";"--2c-multi-task-top"]
+ (Arg.Unit (fun () ->
+ set_c_options opt;
+ global_opt.io_transmit_mode <- Ctx;
+ global_opt.multi_task <- true;
+ global_opt.multi_task_top <- true;))
+ ["All node calls in the main node are put in a task"]
;
mkopt opt ~doc_level:Advanced
diff --git a/lib/lv6MainArgs.mli b/lib/lv6MainArgs.mli
index 4d050e8bc045d9c6eb1f2197ed586770e58fa114..09c9692fea0ea1cb50cbd34830d862cc34baebec 100644
--- a/lib/lv6MainArgs.mli
+++ b/lib/lv6MainArgs.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 18/06/2024 (at 16:19) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/07/2024 (at 10:30) by Erwan Jahier> *)
type enum_mode =
AsInt (* translate enums into int (for rif-friendlyness *)
@@ -79,6 +79,7 @@ type global_opt = {
mutable soc2c_global_ctx : bool;
mutable soc2c_dro : bool;
mutable multi_task : bool;
+ mutable multi_task_top : bool;
mutable gen_wcet : bool;
mutable io_transmit_mode : io_transmit_mode;
mutable schedul_mode : schedul_mode;
diff --git a/lib/soc2c.ml b/lib/soc2c.ml
index 6f97c2e254b349ec077e93e3123967337802e8f4..718dc435e1f10dd7b2e22c6d20b698e1bf7533ed 100644
--- a/lib/soc2c.ml
+++ b/lib/soc2c.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/06/2024 (at 09:26) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/07/2024 (at 10:40) by Erwan Jahier> *)
(* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
diff --git a/lib/socNameC.ml b/lib/socNameC.ml
index 2ada82e50cea2417e6961ab9ba4b7a2b4274bb86..fe9a7b9cbb5e3fe1f6acfac23176dcaaf864e8d5 100644
--- a/lib/socNameC.ml
+++ b/lib/socNameC.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 19/06/2024 (at 17:50) by Erwan Jahier> *)
+(** Time-stamp: <modified the 09/07/2024 (at 10:17) by Erwan Jahier> *)
@@ -144,12 +144,12 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
| Index _ -> assert false
| Slice _ -> assert false
-
+
let print_instance_type i =
Printf.printf "{id=%d ; node=%d ; var_in=[%s] ; var_out=[%s] }\n" i.id i.node
(String.concat "," (List.map string_of_int i.var_in))
(String.concat "," (List.map string_of_int i.var_out))
-
+
let get_instances : Soc.t -> instance_type list = fun soc ->
let gaol = get_gaol soc in
let ltbl = Hashtbl.create 2 in
@@ -178,9 +178,9 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
let res = List.mapi gao_to_instance_type gaol in
(* List.iter print_instance_type res; *)
res
-
+
(*let get_literally_all_socs : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl ->
- let gaol = get_gaol soc in
+ let gaol = get_gaol soc in
let rec find_soc = function
| Case(_, id_gaol_l, _) -> id_gaol_l |> List.map (fun (_, gaol2) -> List.map find_soc gaol2) |>
List.flatten |> List.flatten
@@ -198,7 +198,7 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
x*)
let get_all_soc : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl ->
- let gaol = get_gaol soc in
+ let gaol = get_gaol soc in
let rec find_soc = function
| Case(_, id_gaol_l, _) -> id_gaol_l |> List.map (fun (_, gaol2) -> List.map find_soc gaol2) |>
List.flatten |> List.flatten
@@ -212,13 +212,13 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
| Call(_, _, _, _) -> []
in
let socs = List.map find_soc gaol in
- let (compare_socs : Soc.t -> Soc.t -> bool) = fun h soc ->
+ let (compare_socs : Soc.t -> Soc.t -> bool) = fun h soc ->
let hid = match h.key with
| (id, _, _) -> id
in
let sid = match soc.key with
| (id, _, _) -> id
- in
+ in
(String.equal hid sid) || (String.equal hid "Lustre::pre")
in
let n = ref [] in
@@ -233,32 +233,25 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
in
let x = (socs |> List.flatten |> remove_duplicate) in (*supprimer les duplicatas*)
x
-
+
let compare_name : string -> Soc.t -> bool = fun name soc ->
let (x, _, _) = soc.key in
(*let split_soc_name = Str.split (Str.regexp "::") x in
let soc_name = List.nth split_soc_name ((List.length split_soc_name)-1) in*)
String.equal x name
-
+
let get_task_profile : string -> Soc.t list -> Soc.var list * Soc.var list = fun name socs ->
let soc = List.find (compare_name name) socs in
let (var_in, var_out):Soc.var list * Soc.var list = soc.profile in
(var_in, var_out)
-
- (*let memory_soc : Soc.t -> unit = fun soc ->
- let (x, _, _) = soc.key in
- match soc.memory with
- | No_mem -> Printf.printf "aeaeaea %s\n" x
- | Mem _ -> Printf.printf "A clamitous disaster indeed %s\n" x (*uniquement dans les lustre pre : trouver si un lustre pre quelque part dans le soc pour dire mem = true*)
- | Mem_hidden -> Printf.printf "It's wizard time %s\n" x (*idée : ne pas explorer les méthodes/procédures, juste regarder le nom pour trouver un pre ?*)
-*)
+
let find_memory_soc : Soc.t -> bool = fun soc ->
let gaol = get_gaol soc in
let gao_has_memory = fun gao ->
match gao with
| Call(_,Assign,_,_) -> assert false
| Call(_, Method((_, sk), _, _), _, _)
- | Call(_, Procedure (sk, _, _), _, _) ->
+ | Call(_, Procedure (sk, _, _), _, _) ->
let (name, _, _) = sk in
(String.equal "Lustre::pre" name) || (String.equal "Lustre::arrow" name)
| Case(_, _, _) -> assert false
@@ -269,7 +262,7 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
let soc = List.find (compare_name name) socs in
let has_mem = find_memory_soc soc in
has_mem
-
+
let get_tasks : Soc.tbl -> Soc.t -> Soc.t -> task_type list = fun stbl main_soc soc ->
let gaol = get_gaol soc in
(*let socs_all = (get_literally_all_socs main_soc stbl) @ [main_soc] in*)
@@ -278,7 +271,7 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
match gao with
| Call(_,Assign,_,_) -> assert false
| Call(_, Method(_, _, task), _, _)
- | Call(_, Procedure (_, _, task), _, _) ->
+ | Call(_, Procedure (_, _, task), _, _) ->
begin
match task with
| None -> let t : task_type option = None in t
@@ -306,5 +299,3 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
in
let res = List.concat (List.map to_list (List.map gao_to_tasks gaol)) in
res
-
-