Add the lustre-mt tool that process .yml files generated by lv6 -2cmc

bin/lustre-mt/dune

+(executable
+ (public_name lustre-mt)
+ (name main)
+ (libraries yaml yaml.unix)
+)

bin/lustre-mt/main.ml

+(* Time-stamp: <modified the 28/07/2022 (at 10:49) by Erwan Jahier> *)
+
+(* Author: Antony Zahran *)
+
+open Printf
+open Types
+
+let variables = ref [];;
+let channels = ref [];;
+let main = {name = ""; ctx_type = ""; ctx_new = ""; var_in = []; var_out = []; ch_in = []; ch_out = []};;
+let nodes = ref [];;
+let instances = ref [];;
+
+
+(** saves the data from the Yaml parser into references of type Types.t *)
+
+(* converts a `Float list into a int list *)
+let (intlist : Yaml.value list -> int list) =
+  fun l ->
+  let (yv_to_int : Yaml.value -> int) = fun y ->
+    match y with
+    |`Float f -> int_of_float f
+    |_ -> assert false
+  in List.map yv_to_int l
+;;
+
+let (save_variable_attributes : Types.variable -> (string * Yaml.value) -> unit) =
+  fun v (key, value) -> 
+  match key, value with
+  |"id", `Float _f -> ()
+  |"name", `String s -> v.name <- s
+  |"type", `String s -> v.var_type <- s
+  |_ -> assert false
+
+let (save_variables : Yaml.value -> unit) = fun x ->
+  let v = {name = ""; var_type = ""}::[]
+  in
+  match x with
+  |`O l ->
+    List.iter (save_variable_attributes (List.hd v)) l;
+    variables := !variables @ v
+  |_ -> assert false
+
+
+let (save_channels : Yaml.value -> unit) = fun x ->
+  match x with
+  |`Float f -> channels := !channels @ [int_of_float f]
+  |_ -> assert false
+
+
+let (save_main : (string * Yaml.value) -> unit) =
+  fun (key, value) -> 
+  match key, value with
+  |"name", `String s -> main.name <- s
+  |"ctx_type", `String s -> main.ctx_type <- s
+  |"ctx_new",  `String s -> main.ctx_new  <- s
+  |"var_in",   `A l      -> main.var_in  <- List.map (List.nth !variables) (intlist l)
+  |"var_out",  `A l      -> main.var_out <- List.map (List.nth !variables) (intlist l)
+  |"ch_in",    `A l      -> main.ch_in  <- intlist l
+  |"ch_out",   `A l      -> main.ch_out <- intlist l
+  |_ -> assert false
+
+
+let (save_node_attributes : Types.node -> (string * Yaml.value) -> unit) =
+  fun n (key, value) -> 
+  match key, value with
+  |"id", `Float _f -> ()
+  |"file_name", `String s -> n.file_name <- s
+  |"fct_name",  `String s -> n.fct_name <- s
+  |"ctx", `Bool b -> n.ctx <- b
+  |"ctx_tab", `String s -> n.ctx_tab <- s
+  |_ -> assert false
+
+let (save_nodes : Yaml.value -> unit) = fun x ->
+  let n = {file_name = ""; fct_name = ""; ctx = false; ctx_tab = ""}::[] in
+  match x with
+  |`O l ->
+    List.iter (save_node_attributes (List.hd n)) l;
+    nodes := !nodes @ n
+  |_ -> assert false
+
+
+let (save_instance_attributes : Types.instance -> (string * Yaml.value) -> unit) =
+  fun i (key, value) -> 
+  match key, value with
+  |"id",   `Float f -> i.id <- int_of_float f
+  |"node", `Float f -> i.node <- List.nth !nodes (int_of_float f)
+  |"var_in",  `A l -> i.var_in  <- List.map (List.nth !variables) (intlist l)
+  |"var_out", `A l -> i.var_out <- List.map (List.nth !variables) (intlist l)
+  |"ch_in",   `A l -> i.ch_in  <- intlist l
+  |"ch_out",  `A l -> i.ch_out <- intlist l
+  |_ -> assert false
+
+let (save_instances : Yaml.value -> unit) = fun x ->
+  let i = {id = 0; node = List.nth !nodes 0; var_in = []; var_out = []; ch_in = []; ch_out = []}::[]
+  in
+  match x with
+  |`O l ->
+    List.iter (save_instance_attributes (List.hd i)) l;
+    instances := !instances @ i
+  |_ -> assert false
+
+
+let (save_data2 : (string * Yaml.value) -> unit) =
+  fun (key, value) ->
+  match key, value with
+  |"variables", `A l -> List.iter save_variables l
+  |"channels" , `A l -> List.iter save_channels l
+  |"main" , `O l -> List.iter save_main l
+  |"nodes", `A l -> List.iter save_nodes l
+  |"instances", `A l -> List.iter save_instances l
+  |_ -> ()
+
+let (save_data : Yaml.value -> unit) = fun x ->
+  match x with
+  |`O l -> List.iter save_data2 l
+  |_ -> assert false
+
+
+
+let yaml_file = ref ""
+
+
+let main () =
+  if (Array.length Sys.argv) <= 1 then (
+    Arg.usage MainArgs.speclist MainArgs.usage; flush stdout; exit 2
+  ) else (
+    try Arg.parse MainArgs.speclist (fun s -> yaml_file := s) MainArgs.usage
+    with  
+    | Failure(e) -> print_string e; flush stdout; flush stderr; exit 2
+    | e -> print_string (Printexc.to_string e);  flush stdout; exit 2
+  );
+  let yaml = Yaml_unix.of_file_exn Fpath.(v !yaml_file) in
+  save_data yaml;
+
+
+  (* creates the .c file *)
+  let cfile = open_out (main.name ^ "_pthread.c") in
+
+  (* includes *)
+  fprintf cfile "#include <stdio.h>\n";
+  fprintf cfile "#include <stdlib.h>\n";
+  fprintf cfile "#include <string.h>\n";
+  fprintf cfile "#include <stdbool.h>\n";
+  fprintf cfile "#include <pthread.h>\n";
+  fprintf cfile "#include <semaphore.h>\n";
+  fprintf cfile "#include <errno.h>\n";
+  fprintf cfile "#include \"%s.h\"\n" main.name;
+  fprintf cfile "#include \"%s_loop_io.h\"\n" main.name;
+  fprintf cfile "\n";
+
+  (* semaphores macro *)
+  fprintf cfile "/* Initialize the semaphore with the given count.  */\n";
+  fprintf cfile "#define SEM_INIT(sem, v, max_v) sem_init(&(sem), 0, (v))\n";
+  fprintf cfile "/* wait for the semaphore to be active (i.e. equal to 1) and then decrement it by one. */\n";
+  fprintf cfile "#define SEM_WAIT(sem) while (sem_wait(&sem) != 0 && errno == EINTR) continue\n";
+  fprintf cfile "/* make the semaphore active (i.e. equal to 1) */\n";
+  fprintf cfile "#define SEM_SIGNAL(sem) sem_post(&(sem))\n";
+  fprintf cfile "\n";
+
+  (* variables declaration *)
+  fprintf cfile "/* Declare variables */\n";
+  List.iter (fun x -> fprintf cfile "%s %s;\n" x.var_type x.name) !variables;
+  fprintf cfile "\n";
+
+  (* semaphores declaration *)
+  fprintf cfile "/* Declare semaphores */\n";
+  List.iter (fun x -> fprintf cfile "sem_t channel%i;\n" x) !channels;
+  fprintf cfile "\n";
+
+  (* ctx declaration *)
+  fprintf cfile "/* Declare context */\n";
+  fprintf cfile "%s* ctx;\n" main.ctx_type;
+  fprintf cfile "\n";
+
+  (* instance loops *)
+  fprintf cfile "/* Instance loops */\n";
+  let print_instance_loop instance =
+    fprintf cfile "void loop_%s%i() {\n" instance.node.file_name instance.id;
+    fprintf cfile "    while(true) {\n";
+
+    List.iter (fprintf cfile "        SEM_WAIT(channel%i);\n") instance.ch_in;
+    fprintf cfile "        %s(" instance.node.fct_name;
+    fprintf cfile "%s" (List.hd instance.var_in).name;
+    List.iter (fun (x:variable) -> fprintf cfile ", %s" x.name) (List.tl instance.var_in);
+    List.iter (fun (x:variable) -> fprintf cfile ", &%s" x.name) instance.var_out;
+    if instance.node.ctx then fprintf cfile ", &ctx->%s[%i]" instance.node.ctx_tab instance.id;
+    fprintf cfile ");\n";
+    List.iter (fprintf cfile "        SEM_SIGNAL(channel%i);\n") instance.ch_out;
+
+    fprintf cfile "    }\n";
+    fprintf cfile "}\n";
+    fprintf cfile "\n";
+  in
+  List.iter print_instance_loop !instances;
+
+  (* main function *)
+  fprintf cfile "/* Main function */\n";
+  fprintf cfile "void main() {
+  int _s = 0;\n";
+
+  fprintf cfile "    /* Initialize context */\n";
+  fprintf cfile "    ctx = %s(NULL);\n" main.ctx_new;
+  fprintf cfile "\n";
+
+  fprintf cfile "    /* Initialize semaphores */\n";
+  List.iter (fprintf cfile "    SEM_INIT(channel%i, 0, 1);\n") !channels;
+  fprintf cfile "    \n";
+  fprintf cfile "    /* Declare pthreads */\n";
+  List.iter (fun x -> fprintf cfile "    pthread_t pt_%s%i;\n" x.node.file_name x.id) !instances;
+  fprintf cfile "    \n";
+  fprintf cfile "    /* Initialize pthreads */\n";
+  List.iter (fun x -> fprintf cfile "    pthread_create(&pt_%s%i, NULL, loop_%s%i, NULL);\n" x.node.file_name x.id x.node.file_name x.id) !instances;
+  fprintf cfile "    \n";
+
+  (* main loop *)
+  fprintf cfile "print_rif_declaration();\n";
+  output_string cfile "    /* Main loop */
+ while(true) {
+        if (ISATTY) printf(\"#step \\%d \\n\", _s+1);
+        else if(_s) printf(\"\\n\");
+        fflush(stdout);
+        ++_s;\n";
+  fprintf cfile "        get_inputs(ctx";
+  List.iter (fun (x:variable) -> fprintf cfile ", &%s" x.name) main.var_in;
+  fprintf cfile ");\n";
+
+  List.iter (fprintf cfile "        SEM_SIGNAL(channel%i);\n") main.ch_in;
+  List.iter (fprintf cfile "        SEM_WAIT(channel%i);\n") main.ch_out;
+
+  fprintf cfile "        print_outputs(%s" (List.hd main.var_out).name;
+  List.iter (fun (x:variable) -> fprintf cfile ", %s" x.name) (List.tl main.var_out);
+  fprintf cfile ");\n";
+
+  fprintf cfile "    }\n";
+  fprintf cfile "    \n";
+
+  List.iter (fun x -> fprintf cfile "    pthread_join(&pt_%s%i, NULL);\n" x.node.file_name x.id) !instances;
+  fprintf cfile "}\n";
+  fprintf cfile "\n"
+;;
+
+let _ = main ()

bin/lustre-mt/mainArgs.ml

+(* Time-stamp: <modified the 28/07/2022 (at 11:15) by Erwan Jahier> *)
+
+
+let usage = (Sys.argv.(0) ^" [options] f.yml
+
+with -pthread:
+  Generates a f_pthread.c file
+
+  exemple of use:
+    lv6 f.lus -n node -2cmc 
+   "^ Sys.argv.(0) ^"f_node.yml
+   export C_LIBS=\"-lpthread -lm\"; export MAIN_FILE=\"f_node_pthread.c\"; sh node.sh
+
+")
+
+let verbose = ref false
+
+type generation_mode = Pthread
+let generation_mode = ref Pthread
+
+
+(* Cloned from the OCaml stdlib Arg module: I want it on stdout! (scrogneugneu) *)
+let usage_out speclist errmsg =
+  Printf.printf "%s" (Arg.usage_string speclist errmsg)
+
+let rec speclist =
+  [
+
+    "--verbose",Arg.Unit (fun _ -> (verbose := true)),
+    "";
+    "-verbose",Arg.Unit (fun _ -> (verbose := true)),
+    "";
+    "-verb",Arg.Unit (fun _ -> (verbose := true)),
+    "\t\t set on a verbose mode";
+
+    "-pthread",Arg.Unit (fun _ -> (generation_mode := Pthread)),
+    "\t\t use pthread (default)";
+
+    
+    "--help", Arg.Unit (fun _ -> (usage_out speclist usage ; exit 0)),
+    "";
+    "-help", Arg.Unit (fun _ -> (usage_out speclist usage ; exit 0)),
+    "";
+    "-h", Arg.Unit (fun _ -> (usage_out speclist usage ; exit 0)),
+    "\t\t display this help message"
+  ]
+

bin/lustre-mt/types.ml

+(* Time-stamp: <modified the 27/07/2022 (at 15:31) by Erwan Jahier> *)
+
+(** type definition, used to store data *)
+
+type variable = {
+  mutable name: string;
+  mutable var_type: string
+}
+
+type main_node = {
+  mutable name: string;
+  mutable ctx_type: string;
+  mutable ctx_new: string;
+  mutable var_in: variable list;
+  mutable var_out: variable list;
+  mutable ch_in: int list;
+  mutable ch_out: int list
+}
+
+type node = {
+  mutable file_name: string;
+  mutable fct_name: string;
+  mutable ctx: bool;
+  mutable ctx_tab: string
+}
+
+type instance = {
+  mutable id: int;
+  mutable node: node;
+  mutable var_in: variable list;
+  mutable var_out: variable list;
+  mutable ch_in: int list;
+  mutable ch_out: int list
+}

utils/compare_exec_and_2cmc

@@ -52,7 +52,7 @@ fi
 # generated the -2cmc version in $node.exec
 if
     ./lus2lic -dir /tmp/lustre-test-$lustre_file-$node $OPT $lustre_file -n $node  -2cmc ;
-    yaml2pthread /tmp/lustre-test-$lustre_file-$node/${node}_${node}.yml;
+    lustre-mt /tmp/lustre-test-$lustre_file-$node/${node}_${node}.yml;
     cp foo_foo_pthread.c /tmp/lustre-test-$lustre_file-$node ;
     export C_LIBS="-lpthread -lm " ; export MAIN_FILE="foo_foo_pthread.c" ; sh /tmp/lustre-test-$lustre_file-$node/$node.sh
 then