Skip to content
Snippets Groups Projects
Commit 44fa68e2 authored by erwan's avatar erwan
Browse files

Update: continue to refactor files and functions for SasaRun implementation

parent cd7bcd23
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
.merlin
+ 4
− 2
View file @ 44fa68e2
S bin
S src
S lib/sasacore
S lib/algo
B /home/jahier/.opam/4.07.0/lib/ocaml
B /home/jahier/.opam/4.07.0/lib/ocamlgraph
B _build/default/bin/.sasa.eobjs
B _build/default/src/.sasaMain.eobjs
B _build/default/lib/algo/.algo.objs
B _build/default/lib/sasacore/.sascore.objs
Makefile.version
+ 2
− 1
View file @ 44fa68e2
......@@ -13,4 +13,5 @@ lib/sasacore/sasaVersion.ml:
echo "(* generated by ../Makefile.version *)" > lib/sasacore/sasaVersion.ml ; \
echo "let str=\"$(VERSION)\"" >> lib/sasacore/sasaVersion.ml ; \
echo "let sha=\"$(SHA)\"" >> lib/sasacore/sasaVersion.ml ; \
echo "let branch=\"$(BRANCH)\"" >> lib/sasacore/sasaVersion.ml
echo "let branch=\"$(BRANCH)\"" >> lib/sasacore/sasaVersion.ml ; \
echo "let maintainer = \"erwan.jahier@univ-grenoble-alpes.fr\"" >> lib/sasacore/sasaVersion.ml ;
lib/sasacore/sasArg.ml
+ 37
− 38
View file @ 44fa68e2
(* Time-stamp: <modified the 14/03/2019 (at 17:31) by Erwan Jahier> *)
(* Time-stamp: <modified the 15/03/2019 (at 22:37) by Erwan> *)
type t = {
......@@ -19,10 +19,10 @@ type t = {
mutable _margin : int;
}
let usage_msg = ("usage: " ^Sys.argv.(0) ^ " [<option>]* <topology>.dot
let usage_msg tool = ("usage: " ^ tool ^ " [<option>]* <topology>.dot
use -h to see the available options.
" )
let print_usage () = Printf.printf "%s\n" usage_msg; flush stdout
let print_usage tool = Printf.printf "%s\n" (usage_msg tool); flush stdout
let (make_args : unit -> t) =
......@@ -36,16 +36,15 @@ let (make_args : unit -> t) =
seed = (Random.self_init (); Random.int 1073741823);
ifi = false;
gen_lutin = false;
_args = [];
_args = [];
_user_man = [];
_hidden_man = [];
_others = [];
_margin =12;
}
let (args : t) = make_args ()
let pspec os (c, ml) = (
let pspec args os (c, ml) = (
let (m1, oth) = match ml with
| h::t -> (h,t)
| _ -> ("",[])
......@@ -62,13 +61,13 @@ let pspec os (c, ml) = (
Printf.fprintf os "\n" ;
)
let options oc = (
let options args oc = (
let l = List.rev args._user_man in
List.iter (pspec oc) l
List.iter (pspec args oc) l
)
let more_options oc = (
let more_options args oc = (
let l = List.rev (args._hidden_man) in
List.iter (pspec oc) l
List.iter (pspec args oc) l
)
let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec ->
string list -> unit) =
......@@ -83,67 +82,66 @@ let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec ->
let myexit i = exit i
(*** User Options Tab **)
let (mkoptab : t -> unit) =
fun opt ->
let _nl = "\n"^(String.make args._margin ' ') in
let (mkoptab : string array -> t -> unit) =
fun argv args ->
(
mkopt opt ["--synchronous-demon";"-sd"]
mkopt args ["--synchronous-demon";"-sd"]
(Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
["Use a Synchronous deamon"];
mkopt opt ["--central-demon";"-cd"]
mkopt args ["--central-demon";"-cd"]
(Arg.Unit(fun () -> args.demon <- Demon.Central))
["Use a Central deamon (which selects exactly one action)"];
mkopt opt ["--locally-central-demon";"-lcd"]
mkopt args ["--locally-central-demon";"-lcd"]
(Arg.Unit(fun () -> args.demon <- Demon.LocallyCentral))
["Use a Locally Central deamon (which never activates two neighbors";
"actions in the same step)"];
mkopt opt ["--distributed-demon";"-dd"]
mkopt args ["--distributed-demon";"-dd"]
(Arg.Unit(fun () -> args.demon <- Demon.Distributed))
["Use a Distributed deamon (which select at least one action)"];
mkopt opt ["--custom-demon";"-custd"]
mkopt args ["--custom-demon";"-custd"]
(Arg.Unit(fun () -> args.demon <- Demon.Custom;args.rif <- true))
["Use a Custom deamon (forces --rif)"];
mkopt opt ["--rif";"-rif"]
mkopt args ["--rif";"-rif"]
(Arg.Unit(fun () -> args.rif <- true))
["Follows RIF conventions"];
mkopt opt ["--seed";"-seed"]
mkopt args ["--seed";"-seed"]
(Arg.Int(fun i -> args.seed <- i))
["Set the pseudo-random generator seed of build-in demons"];
mkopt opt ~hide:true ["--gen-lutin-demon";"-gld"]
mkopt args ~hide:true ["--gen-lutin-demon";"-gld"]
(Arg.Unit(fun () -> args.gen_lutin <- true))
["Generate Lutin demons and exit"];
mkopt opt ~hide:true ["--ignore-first-inputs"; "-ifi"]
mkopt args ~hide:true ["--ignore-first-inputs"; "-ifi"]
(Arg.Unit(fun () -> args.ifi <- true))
["Ignore first inputs (necessary to use luciole via lurette/rdbg/luciole-rif)"];
mkopt opt ["--length";"-l"] ~arg:" <int>"
mkopt args ["--length";"-l"] ~arg:" <int>"
(Arg.Int (fun i -> args.length <- i))
["Maximum number of steps to be done (" ^ (string_of_int args.length) ^ " by default).\n"];
mkopt opt ~hide:true ["--version";"-version";"-v"]
mkopt args ~hide:true ["--version";"-version";"-v"]
(Arg.Unit (fun _ ->
(print_string (SasaVersion.str^"-"^SasaVersion.sha^"\n");flush stdout;exit 0)))
["Display the sasa version and exit."];
mkopt opt ~hide:true ["--ocaml-version"]
mkopt args ~hide:true ["--ocaml-version"]
(Arg.Unit (fun _ -> (print_string (Sys.ocaml_version^"\n"); flush stdout; exit 0)))
["Display the version ocaml version sasa was compiled with and exit."];
mkopt opt ["--verbose";"-vl"] ~arg:" <int>"
mkopt args ["--verbose";"-vl"] ~arg:" <int>"
(Arg.Int (fun i -> args.verbose <- i)) ["Set the verbose level"];
mkopt opt ["--help";"-help"; "-h"]
(Arg.Unit (fun _ -> print_usage();options stdout; exit 0))
mkopt args ["--help";"-help"; "-h"]
(Arg.Unit (fun _ -> print_usage (argv.(0)); options args stdout; exit 0))
["Display main options"];
mkopt opt ["--more";"-m"] (Arg.Unit (fun () -> more_options stdout; exit 0))
mkopt args ["--more";"-m"] (Arg.Unit (fun () -> more_options args stdout; exit 0))
["Display more options"]
)
......@@ -174,8 +172,9 @@ let unexpected s = (
let parse argv = (
let save_current = !current in
try (
mkoptab args;
Arg.parse_argv ~current:current argv args._args (add_other args) usage_msg;
let args = make_args () in
mkoptab argv args;
Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg argv.(0));
(List.iter
(fun f ->
if (String.sub f 0 1 = "-") then
......@@ -189,17 +188,17 @@ let parse argv = (
args.topo <- (match args._others with
[] ->
Printf.fprintf stderr "*** The topology file is missing in '%s'\n%s\n"
(Sys.argv.(0)) usage_msg;
(argv.(0)) (usage_msg argv.(0));
exit 2;
| x::_ -> x
)
);
args
)
with
(* only 1rst line is interesting ! *)
| Arg.Bad msg ->
Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (Sys.argv.(0))
(first_line msg) usage_msg; exit 2;
Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0))
(first_line msg) (usage_msg argv.(0)); exit 2;
| Arg.Help msg ->
Printf.fprintf stdout "%s\n%s\n" msg usage_msg;
options stdout; exit 0
Printf.fprintf stdout "%s\n%s\n" msg (usage_msg argv.(0));
exit 0
)
lib/sasacore/sasArg.mli 0 → 100644
+ 25
− 0
View file @ 44fa68e2
(* Time-stamp: <modified the 15/03/2019 (at 22:37) by Erwan> *)
type t = {
mutable topo: string;
mutable length: int;
mutable verbose: int;
mutable demon: Demon.t;
mutable rif: bool;
mutable seed: int;
mutable ifi: bool;
mutable gen_lutin: bool;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
mutable _hidden_man: (string * string list) list;
mutable _others : string list;
mutable _margin : int;
}
val usage_msg : string -> string
val parse : string array -> t
src/sasa.ml → lib/sasacore/sasa.ml
+ 61
− 66
View file @ 44fa68e2
(* Time-stamp: <modified the 15/03/2019 (at 17:28) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/03/2019 (at 11:50) by Erwan Jahier> *)
(* XXX Je pourrais utiliser Lwt pour rendre step non-bloquant, ce qui
permettrait d'accelerer la simu sur les machines qui ont plusieurs
......@@ -62,13 +62,11 @@ let (to_algo_neighbor: Env.t -> Topology.neighbor -> Algo.neighbor) =
n_vars = n.Topology.n_vars
}
exception Silent of int
let (print_step : int -> int -> Env.t -> Process.t list -> string -> string -> unit) =
fun n i e pl activate_val enable_val ->
if SasArg.args.rif then (
if SasArg.args.demon = Demon.Custom then (
let (print_step : int -> int -> SasArg.t -> Env.t -> Process.t list -> string ->
string -> unit) =
fun n i args e pl activate_val enable_val ->
if args.rif then (
if args.demon = Demon.Custom then (
(* in custom mode, to be able to talk with lurette, this should not be
printed on stdout
*)
......@@ -86,12 +84,14 @@ let (print_step : int -> int -> Env.t -> Process.t list -> string -> string -> u
(string_of_int (n-i+1)) (StringOf.env e pl) activate_val;
flush stderr
)
let rec (simu: int -> int -> Process.t list -> string ->
(Process.t * Topology.neighbor list) list -> Env.t -> unit) =
fun n i pl activate_val pl_n e ->
exception Silent of int
let (simustep: int -> int -> SasArg.t -> Process.t list -> string ->
(Process.t * Topology.neighbor list) list -> Env.t -> Env.t * string) =
fun n i args pl activate_val pl_n e ->
let custom = args.demon = Demon.Custom in
(* 1: Get enable processes *)
let all = List.fold_left
(fun acc (p,nl) ->
let nl4algo = List.map (to_algo_neighbor e) nl in
......@@ -117,15 +117,14 @@ let rec (simu: int -> int -> Process.t list -> string ->
(List.flatten enab_ll))
in
if (List.flatten all = []) then (
print_step n i e pl activate_val enable_val;
print_step n i args e pl activate_val enable_val;
raise (Silent (n-i+1))
);
print_step n i e pl activate_val enable_val;
print_step n i args e pl activate_val enable_val;
let next_activate_val, pnal =
Demon.f (SasArg.args.verbose > 1) args.demon pl all enab_ll
Demon.f (args.verbose > 1) args.demon pl all enab_ll
in
(* Do the steps *)
(* 2: Do the steps *)
let lenv_list =
List.map (fun (p,nl,a) ->
let nl4algo = List.map (to_algo_neighbor e) nl in
......@@ -133,33 +132,35 @@ let rec (simu: int -> int -> Process.t list -> string ->
p, p.step nl4algo lenv a)
pnal
in
(* update the env *)
(* 3: update the env *)
let ne = List.fold_left update_env e lenv_list in
ne, next_activate_val
if i > 0 then simu n (i-1) pl next_activate_val pl_n ne else (
if SasArg.args.rif then (
print_string "q\n"; flush stdout
))
let () =
( try SasArg.parse Sys.argv;
with
Failure(e) ->
output_string stdout e;
flush stdout ;
exit 2
| e ->
output_string stdout (Printexc.to_string e);
flush stdout;
exit 2
);
let dot_file = SasArg.args.topo in
let nl = Topology.read dot_file in
let nstrl = List.map (fun n -> n.Topology.id) nl in
let nstr = String.concat "," nstrl in
try
Algo.verbose_level := SasArg.args.verbose;
Random.init SasArg.args.seed;
type t = SasArg.t * Process.t list * (Process.t * Topology.neighbor list) list * Env.t
let (make : string array -> t) =
fun argv ->
let args =
try SasArg.parse argv;
with
Failure(e) ->
output_string stdout e;
flush stdout ;
exit 2
| e ->
output_string stdout (Printexc.to_string e);
flush stdout;
exit 2
in
try
let dot_file = args.topo in
let nl = Topology.read dot_file in
let nstrl = List.map (fun n -> n.Topology.id) nl in
let nstr = String.concat "," nstrl in
Algo.verbose_level := args.verbose;
Random.init args.seed;
if !Algo.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;
let e = Env.init () in
let pl = List.map (Process.make (args.demon=Custom)) nl in
......@@ -168,23 +169,22 @@ let () =
let e = update_env_with_init e pl algo_neighors in
let pl_n = List.combine pl neighors in
if !Algo.verbose_level > 0 then List.iter dump_process pl_n;
if SasArg.args.gen_lutin then (
let fn = (Filename.remove_extension SasArg.args.topo) ^ ".lut" in
if args.gen_lutin then (
let fn = (Filename.remove_extension args.topo) ^ ".lut" in
if Sys.file_exists fn then (
Printf.eprintf "%s already exists.\n" fn; flush stderr
) else
let oc = open_out fn in
Printf.fprintf oc "%s" (GenLutin.f pl);
flush oc;
close_out oc;
exit 0);
let n = SasArg.args.length in
if SasArg.args.rif then (
Printf.fprintf oc "%s" (GenLutin.f pl);
flush oc;
close_out oc;
exit 0);
if args.rif then (
Printf.printf "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
if SasArg.args.demon <> Demon.Custom then
Printf.printf "#seed %i\n" SasArg.args.seed;
if args.demon <> Demon.Custom then
Printf.printf "#seed %i\n" args.seed;
Printf.printf "#inputs %s\n"
(if SasArg.args.demon = Demon.Custom then (
(if args.demon = Demon.Custom then (
let f p = List.map
(fun a -> "\""^p.pid ^(if a="" then "" else "_")^a^ "\":bool")
p.actions
......@@ -194,26 +194,21 @@ let () =
Printf.printf "#outputs %s\n" (StringOf.env_rif_decl pl);
flush stdout
) else (
if SasArg.args.demon <> Demon.Custom then (
Printf.printf "The pseudo-random engine is used with seed %i\n" SasArg.args.seed;
if args.demon <> Demon.Custom then (
Printf.printf "The pseudo-random engine is used with seed %i\n" args.seed;
flush stdout
);
);
if SasArg.args.ifi then (
if args.ifi then (
List.iter
(fun p -> List.iter
(fun a -> ignore (RifRead.bool (args.verbose > 1) p a)) p.actions)
pl;
Printf.eprintf "Ignoring the first vectors of sasa inputs\n"; flush stderr;
);
simu n n pl "" pl_n e
with
| Dynlink.Error e -> Printf.printf "Error: %s\n" (Dynlink.error_message e)
| Failure msg -> Printf.printf "Error: %s\n" msg
| Silent i ->
let str = if SasArg.args.rif then "#" else "" in
Printf.printf "%sThis algo is silent after %i steps\n" str i ;
flush stdout;
if SasArg.args.rif && args.demon = Custom then (
print_string "q\n"; flush stdout
)
args, pl, pl_n, e
with
| Dynlink.Error e ->
Printf.printf "Error: %s\n" (Dynlink.error_message e); flush stdout;
exit 2
lib/sasalib/dune
+ 2
− 2
View file @ 44fa68e2
;; Time-stamp: <modified the 15/03/2019 (at 16:03) by Erwan Jahier>
;; Time-stamp: <modified the 17/03/2019 (at 11:34) by Erwan Jahier>
(library
(name sasalib)
(public_name sasalib)
(libraries dynlink ocamlgraph rdbg-plugin algo sasacore)
(libraries dynlink ocamlgraph rdbg-plugin algo sasacore lutils)
(synopsis "The Sasa rdbg plugin")
)
......
src/dune
+ 3
− 3
View file @ 44fa68e2
;; Time-stamp: <modified the 15/03/2019 (at 16:04) by Erwan Jahier>
;; Time-stamp: <modified the 15/03/2019 (at 23:07) by Erwan>
(executable
(name sasa)
(name sasaMain)
(libraries dynlink ocamlgraph lutils sasacore algo)
)
......@@ -13,7 +13,7 @@
(install
(section bin)
(files (sasa.exe as sasa))
(files (sasaMain.exe as sasa))
; (files sasaRun.cmxa)
)
src/sasaMain.ml 0 → 100644
+ 27
− 0
View file @ 44fa68e2
open Sasacore
open Sasa
let rec (simuloop: int -> int -> SasArg.t -> Process.t list -> string ->
(Process.t * Topology.neighbor list) list -> Env.t -> unit) =
fun n i args pl activate_val pl_n e ->
let ne, next_activate_val = simustep n i args pl activate_val pl_n e in
if i > 0 then simuloop n (i-1) args pl next_activate_val pl_n ne else (
if args.rif then (
print_string "q\n"; flush stdout
))
let () =
let args, pl, pl_n, e = Sasa.make Sys.argv in
try
let n = args.length in
simuloop n n args pl "" pl_n e
with
| Failure msg -> Printf.printf "Error: %s\n" msg
| Silent i ->
let str = if args.rif then "#" else "" in
Printf.printf "%sThis algo is silent after %i steps\n" str i ;
flush stdout;
if args.rif && args.demon = Custom then (
print_string "q\n"; flush stdout
)
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment