ajout de la chaine de compilation avec taches executees sur threads

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";
 
 
 

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 ();
   

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*)