From 4da7799c4bf47070d4ea5acc5619365e01b5d0a7 Mon Sep 17 00:00:00 2001
From: Leandre Lacourt <lacourtl@santel.imag.fr>
Date: Mon, 1 Jul 2024 15:38:57 +0200
Subject: [PATCH] ajout de la chaine de compilation avec taches executees sur
threads
---
bin/lustre-mt/main.ml | 26 ++++++++-
lib/soc2yaml.ml | 73 +++++++++++++++++++------
lib/socNameC.ml | 124 ++++++++++++++++++++++++++----------------
3 files changed, 154 insertions(+), 69 deletions(-)
diff --git a/bin/lustre-mt/main.ml b/bin/lustre-mt/main.ml
index 5dc0d8f..cca0ff9 100644
--- a/bin/lustre-mt/main.ml
+++ b/bin/lustre-mt/main.ml
@@ -8,6 +8,7 @@ open Parser
let yaml_file = ref ""
+(*penser à rajouter de quoi écrire le .h*)
(* let print_var_outputs name var =
* fprintf cfile "void %s_TASK_getout_%s(%s_TASK_type tD, %s* p%s) {\n" name var.name name var.var_type var.name;
@@ -28,8 +29,8 @@ let main () =
Parser.get_data yaml;
- (* creates the .c file *)
- let cfile = open_out (!Parser.name ^ "_thread.c") in
+ (* creates the files *)
+ let cfile = open_out ("para.c") in
(* includes *)
fprintf cfile "#include <stdio.h>\n";
@@ -144,7 +145,26 @@ let main () =
in
List.iter print_task_outputs !tasks;
-
+ let hfile = open_out ("para.h") in
+ fprintf hfile "#ifndef _PARA_H\n#define _PARA_H\n\n";
+
+ let print_h_tasks task =
+ fprintf hfile "typedef void* %s_TASK_type;\n" task.name;
+ fprintf hfile "extern %s_TASK_type %s_TASK_init();\n" task.name task.name;
+ fprintf hfile "extern void %s_TASK_reset(%s_TASK_type tD);\n" task.name task.name;
+ fprintf hfile "extern void %s_TASK_START(%s_TASK_type tD);\n" task.name task.name;
+ fprintf hfile "extern void %s_TASK_JOIN(%s_TASK_type tD);\n" task.name task.name;
+ let (print_h_task_inputs : Types.variable -> unit) = fun var ->
+ fprintf hfile "extern void %s_TASK_setin_%s(%s_TASK_type tD, %s %s);\n" task.name var.name task.name var.var_type var.name
+ in
+ List.iter print_h_task_inputs task.var_in;
+ let (print_h_task_outputs : Types.variable -> unit) = fun var ->
+ fprintf hfile "extern void %s_TASK_getout_%s(%s_TASK_type td, %s* %s);\n" task.name var.name task.name var.var_type var.name
+ in
+ List.iter print_h_task_outputs task.var_out
+ in
+ List.iter print_h_tasks !tasks;
+ fprintf hfile "#endif";
diff --git a/lib/soc2yaml.ml b/lib/soc2yaml.ml
index fff324d..899473e 100644
--- a/lib/soc2yaml.ml
+++ b/lib/soc2yaml.ml
@@ -2,30 +2,52 @@
(* Author: Antony Zahran *)
+
+(*
+
+
+quoi faire : écrire le yaml avec le bon format et les bonnes valeurs
+
+
+*)
open Printf
(*open Soc2cIdent*)
open SocNameC
let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
- let main_soc = SocUtils.find (Lxm.dummy "dfsdf") sk stbl in (*recup tous les autres soc : cf socnamec*)
+ let main_soc = SocUtils.find (Lxm.dummy "dfsdf") sk stbl in
(*let nodes = SocNameC.get_nodes main_soc in*)
- (*let socs = SocNameC.get_all_soc main_soc stbl in*)
- let variables = (SocNameC.get_inputs main_soc) @ (SocNameC.get_variables main_soc) @ (SocNameC.get_outputs main_soc) in
+ let socs = (SocNameC.get_all_soc main_soc stbl) @ [main_soc] in
+ (*let variables = (SocNameC.get_inputs main_soc) @ (SocNameC.get_variables main_soc) @ (SocNameC.get_outputs main_soc) in*)
(*let instances = SocNameC.get_instances main_soc in*)
- let tasks = SocNameC.get_tasks main_soc in
+ let tasks = (List.map (SocNameC.get_tasks stbl main_soc) socs |> List.flatten) in
let yaml_file = open_out (basename ^ ".yml") in
- (*let (socs2yaml : task_type -> unit) = fun soc ->
- match soc.key with
- | (k, _, _) -> let s = k ^ " \naeaea\n" in
- fprintf yaml_file "%s" s
- |_ -> let s = "XXXXX" in fprintf yaml_file
+ (*let (socyaml : Soc.t -> unit) = fun soc ->
+ let (x, _, _) = soc.key in
+ let s = x ^ " \naeaea\n" in
+ fprintf yaml_file "%s" s
in
- List.iter socs2yaml socs;*)
-
+ List.iter socyaml socs;*)
+
+
+
+ (*let taskvar2yaml : Soc.var -> unit = fun var ->
+ let (id, type) = var in
+ let s = id ^ "\naeaea\n" in
+ fprintf yaml_file "%s" s
+ in
+ let taskiter : task_type -> unit = fun task ->
+ List.iter taskvar2yaml task.var_in;
+ List.iter taskvar2yaml task.var_out
+ in
+ List.iter taskiter tasks;*)
+
+
+ (* vieille version
let (var2yaml : int -> string) = fun i ->
let choose_var : int -> variable_type -> bool = fun i var -> i = var.id in
let findvar : unit -> variable_type = fun () -> List.find (choose_var i) variables in
@@ -34,15 +56,30 @@ let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
^ "\n type: " ^ var.var_type
^ "\n" in
s
+ in*)
+
+ (*changer ça pour utiliser les listes de var des tâches*)
+ let (var2yaml : Soc.var -> string) = fun var ->
+ let (name, var_type) = var in
+ let var_type_str = match var_type with
+ | Bool -> "_boolean"
+ | Int -> "_integer"
+ | Real -> "_real"
+ | String -> "_char*"
+ | _ -> ""
+ in
+ let s = " - name: _" ^ name
+ ^ "\n type: " ^ var_type_str
+ ^ "\n" in
+ s
in
- (*PS : ident = la liste des ids des variables qui vont être utilisées*)
- (*Attention : 1 tâche pour le start, 1 pour le join donc rassembler les 2 tâches*)
let (tasks2yaml : task_type -> unit) = fun task ->
+ let name = String.concat "_" (Str.split (Str.regexp "::") task.name) in
let s_vi = String.concat "" (List.map var2yaml task.var_in) in
let s_vo = String.concat "" (List.map var2yaml task.var_out) in
let s = " - task: "
- ^ "\n name: " ^ task.name
+ ^ "\n name: " ^ name
^ "\n var_in:\n" ^ s_vi
^ " var_out:\n" ^ s_vo
in
@@ -55,7 +92,6 @@ let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
in
fprintf yaml_file "tasks:\n";
- (* penser a fusionner les start et join d'une tache + toujours supprimer les duplicatas APRES AVOIR FUSIONNE (sinon risque de perdre join du start)*)
let n = ref [] in
let rec (remove_duplicate_task : task_type list -> task_type list) = fun task_list ->
match task_list with
@@ -66,7 +102,8 @@ let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
else remove_duplicate_task p
in
- let n = ref [] in
+ (*devient inutile : besoin juste du nom, on y associe juste le profil*)
+ (*let n = ref [] in
let rec (fuse_start_join_task : task_type list -> task_type list) = fun task_list ->
match task_list with
|[] -> []
@@ -83,10 +120,10 @@ let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
n := full_task::!n;
full_task::(fuse_start_join_task p) (*Comment actualiser n pour dire qu'on a trouvé ? penser à find_index f list, mais attention ça renvoie un type option*)
else fuse_start_join_task p (*la tâche est déjà complète c'est juste une autre avec le même noeud on en a pas besoin*)
- in
+ in*)
- List.iter tasks2yaml (remove_duplicate_task (List.rev (fuse_start_join_task tasks)));
+ List.iter tasks2yaml (remove_duplicate_task tasks);
main2yaml ();
diff --git a/lib/socNameC.ml b/lib/socNameC.ml
index 8298239..4d06de5 100644
--- a/lib/socNameC.ml
+++ b/lib/socNameC.ml
@@ -24,8 +24,8 @@ type instance_type = {
type task_type = {
name: string;
- var_in: int list;
- var_out: int list
+ var_in: Soc.var list;
+ var_out: Soc.var list
}
let get_filename : Soc.t -> string = fun soc ->
@@ -97,7 +97,7 @@ let get_gaol soc =
let gaol step_impl =
match step_impl with
| Gaol (_,gaol) -> gaol
- | Predef -> assert false
+ | Predef -> [] (*assert false*)
| Iterator _ -> assert false
| Boolred _ -> assert false
| Condact _ -> assert false
@@ -143,13 +143,13 @@ 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
+
+ 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 get_instances : Soc.t -> instance_type list = fun soc ->
let gaol = get_gaol soc in
let ltbl = Hashtbl.create 2 in
let node_cpt_ref = ref (-1) in
@@ -165,7 +165,7 @@ let get_instances : Soc.t -> instance_type list = fun soc ->
let inst_cpt = inst_cpt+1 in
Hashtbl.add ltbl k (node_cpt, inst_cpt);
node_cpt, inst_cpt
- in
+ in
{
id = i+1;
node = node_cpt;
@@ -177,29 +177,80 @@ let get_instances : Soc.t -> instance_type list = fun soc ->
let res = List.mapi gao_to_instance_type gaol in
(* List.iter print_instance_type res; *)
res
-
-let get_tasks : Soc.t -> task_type list = fun soc ->
- let gaol = get_gaol soc in
- let all_vars = (get_inputs_assoc soc) @ (get_outputs_assoc soc) @ (get_variables_assoc soc) in
- let (gao_to_tasks: gao -> task_type option) = fun gao ->
- match gao with
- | Call(_,Assign,_,_) -> assert false
- | Call(args_out, Method(_, _, task), args_in, _)
- | Call(args_out, Procedure (_, _, task) , args_in, _) ->
- begin
- match task with
+
+ let get_all_soc : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl -> (*bon j'ai bien tout mais mon remove duplicata marche pas*)
+ 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
+ | Call(_, Method((_, sk), _, _), _, _)
+ | Call(_, Procedure(sk, _, _), _, _) ->
+ let new_soc = (SocUtils.find (Lxm.dummy "aeaea") sk stbl) in
+ let new_gaol = get_gaol new_soc in
+ if ((List.length new_gaol) = 0) then []
+ else
+ [new_soc] @ (List.flatten (List.map find_soc new_gaol))
+ | Call(_, _, _, _) -> []
+ in
+ let socs = List.map find_soc gaol in
+ 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
+ (String.equal hid sid) || (String.equal hid "Lustre::pre")
+ in
+ let n = ref [] in
+ let rec (remove_duplicate : Soc.t list -> Soc.t list) = fun socl ->
+ match socl with
+ | [] -> []
+ | h::p -> if Bool.not (List.exists (compare_socs h) !n) then
+ (n := h::!n;
+ h::(remove_duplicate p))
+ else
+ remove_duplicate p
+ 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 get_tasks : Soc.tbl -> Soc.t -> Soc.t -> task_type list = fun stbl main_soc soc ->
+ let gaol = get_gaol soc in
+ (*let all_vars = (get_inputs_assoc soc) @ (get_outputs_assoc soc) @ (get_variables_assoc soc) in*)
+ let (gao_to_tasks: gao -> task_type option) = fun gao ->
+ match gao with
+ | Call(_,Assign,_,_) -> assert false
+ | Call(_, Method(_, _, task), _, _)
+ | Call(_, Procedure (_, _, task) , _, _) ->
+ begin
+ match task with
| None -> let t : task_type option = None in t
| Some (_, (n, _, _)) ->
- let x = Str.split (Str.regexp "::") n in
+ (*let x = Str.split (Str.regexp "::") n in*)
+ let name_task = (*List.nth x ((List.length x)-1)*) n in
+ let socs = (get_all_soc main_soc stbl) @ [main_soc] in
+ let (var_ins, var_outs) = get_task_profile name_task socs in
let t =
{
- name = List.nth x ((List.length x)-1);
- var_in = List.map (var_expr_to_index all_vars) args_in;
- var_out = List.map (var_expr_to_index all_vars) args_out
+ name = name_task;
+ var_in = var_ins; (*List.map (var_expr_to_index all_vars) args_in;*)
+ var_out = var_outs (*List.map (var_expr_to_index all_vars) args_out*)
} in
Some t
end
- | Case(_, _,_) -> assert false
+ | Case(_, _,_) -> assert false
in
let (to_list : task_type option -> task_type list) = fun a ->
match a with
@@ -209,27 +260,4 @@ let get_tasks : Soc.t -> task_type list = fun soc ->
let res = List.concat (List.map to_list (List.map gao_to_tasks gaol)) in
res
-(*faire ça : récup les socs de tous les noeuds
-let get_all_soc : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl ->
- let gaol = get_gaol soc in
- let rec find_soc gao = fun gao ->
- match gao with
- | Case(_, [(_, gaoll)], _) -> List.map find_soc gaoll
- | Call(_, Method((_, sk), _, _), _, _)
- | Call(_, Procedure(sk, _, _), _, _) ->
- (SocUtils.find (Lxm.dummy "aeaea") sk stbl)
- in
- let socs = List.map find_soc gaol in
- let n = ref [] in
- let rec (remove_duplicate : Soc.t list -> Soc.t list) = fun socl ->
- match socl with
- | [] -> []
- | h::p -> if Bool.not (List.exists n h) then
- (n := soc::!n;
- h::(remove_duplicate p))
- else
- remove_duplicate p
- in
- let x = List.map remove_duplicate socs in (*supprimer les duplicatas*)
- x*)
--
GitLab