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

put back changes removed in sha: 1cb82084 and... 

put back changes removed in sha: 1cb82084 and sha:76c21c6e
parent f00ae41d
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/sasaMain.ml
+ 78
− 38
View file @ ff45e5e4
open Sasacore
let (print_step : int -> int -> string -> string -> SasArg.t -> 'v Env.t ->
'v Process.t list -> string -> bool list list -> unit) =
fun n i legitimate pot args e pl activate_val enab_ll ->
let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> string -> SasArg.t ->
'v Env.t -> 'v Process.t list -> string -> bool list list -> unit) =
fun log st n i legitimate pot args e pl activate_val enab_ll ->
let enable_val =
String.concat " " (List.map (fun b -> if b then "t" else "f")
(List.flatten enab_ll))
in
if st.sasarg.init_search_max_trials <> None then (
(* Printf.fprintf log "\n#step %s\n%!" (string_of_int (n-i)); *)
(* Printf.fprintf log "%s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val legitimate pot; *)
) else
if args.no_data_file then (
Printf.printf "\n#step %s\n%!" (string_of_int (n-i))
) else (
......@@ -22,7 +26,8 @@ let (print_step : int -> int -> string -> string -> SasArg.t -> 'v Env.t ->
) else (
(* rif mode, internal daemons *)
if args.rif then
Printf.printf " %s %s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val activate_val legitimate pot
Printf.printf " %s %s %s %s %s\n%!"
(StringOf.env_rif e pl) enable_val activate_val legitimate pot
else (
Printf.printf "\n#step %s\n" (string_of_int (n-i));
Printf.printf "%s%s %s %s %s %s\n%!"
......@@ -89,11 +94,11 @@ let (compute_potentiel: 'v SimuState.t -> string) =
string_of_float p
let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
fun n i activate_val st ->
let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
fun log n i activate_val st ->
(* 1: Get enable processes *)
let verb = !Register.verbose_level > 0 in
if verb then Printf.eprintf "==> SasaSimuState.simustep :1: Get enable processes\n%!";
if verb then Printf.fprintf log "==> SasaSimuState.simustep :1: Get enable processes\n%!";
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
let pot = compute_potentiel st in
let pl = st.network in
......@@ -105,15 +110,15 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
then (
match Register.get_fault () with
| None ->
print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
incr rounds;
raise (Silent (n-i))
| Some ff ->
print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
let str = if st.sasarg.rif then "#" else "" in
Printf.eprintf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
Printf.eprintf "%s==> Inject a fault\n%!" str;
Printf.fprintf log "%s==> Inject a fault\n%!" str;
let st = inject_fault ff st in
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
......@@ -121,15 +126,15 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
else if leg then (
match Register.get_fault () with
| None ->
print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
raise (Legitimate (n-i))
| Some ff ->
print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
let str = if st.sasarg.rif then "#" else "#" in
Printf.eprintf
Printf.fprintf log
"\n%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n"
str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
Printf.eprintf "%s==> Inject a fault\n%!" str;
Printf.fprintf log "%s==> Inject a fault\n%!" str;
let st = inject_fault ff st in
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
......@@ -139,9 +144,9 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
in
let leg_str = if leg then "t" else "f" in
if st.sasarg.daemon = DaemonType.Custom then
print_step n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
print_step log st n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
(* 2: read the actions *)
if verb then Printf.eprintf "==> SasaSimuState.simustep : 2: read the actions\n%!";
if verb then Printf.fprintf log "==> SasaSimuState.simustep : 2: read the actions\n%!";
let get_action_value = RifRead.bool (st.sasarg.verbose > 1) in
let next_activate_val, pnal = Daemon.f st.sasarg.dummy_input
(st.sasarg.verbose >= 1) st.sasarg.daemon st.network SimuState.neigbors_of_pid
......@@ -151,44 +156,79 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
update_round next_activate_val enab_ll;
let next_activate_val = bool_ll_to_string next_activate_val in
(* 3: Do the steps *)
if verb then Printf.eprintf "==> SasaSimuState.simustep : 3: Do the steps\n%!";
if verb then Printf.fprintf log "==> SasaSimuState.simustep : 3: Do the steps\n%!";
if st.sasarg.daemon <> DaemonType.Custom then
print_step n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
print_step log st n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
let st = Sasacore.Step.f pnal st in
st, next_activate_val
let rec (simuloop: int -> int -> string -> 'v SimuState.t -> unit) =
fun n i activate_val st ->
if !Register.verbose_level > 0 then Printf.eprintf "==> SasaSimuState.simuloop %d/%d \n%!" i n;
let st, next_activate_val = simustep n i activate_val st in
if i > 0 then simuloop n (i-1) next_activate_val st else (
print_string "#q\n"; flush_all ()
)
let () =
let st = Sasacore.SimuState.make true Sys.argv in
try
let n = st.sasarg.length in
simuloop n n "" st
let rec (simuloop: out_channel -> int -> int -> string -> 'v SimuState.t -> int) =
fun log n i activate_val st ->
let rec loop i activate_val st =
if !Register.verbose_level > 0 then
Printf.fprintf log "==> SasaSimuState.simuloop %d/%d \n%!" i n;
let st, next_activate_val = simustep log n i activate_val st in
if i > 0 then loop (i-1) next_activate_val st else (
print_string "#q\n"; flush_all ()
)
in
try (loop i activate_val st); n
with
| Silent i ->
let str = if st.sasarg.rif then "#" else "" in
Printf.printf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
print_string "\nq\n#quit\n%!";
flush_all()
flush_all();
i
| Legitimate i ->
let str = if st.sasarg.rif then "#" else "" in
Printf.printf
Printf.fprintf log
"\n%s%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n%!"
(if st.sasarg.rif then "#" else "#")
str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
print_string "\n#quit\n";
flush_all()
Printf.fprintf log "\n#quit\n";
flush_all();
i
let () =
let st = Sasacore.SimuState.make true Sys.argv in
let log = open_out (st.sasarg.topo ^ ".log") in
let newdot_fn = (Filename.chop_extension st.sasarg.topo) ^ "_wi.dot" in
let newdot = open_out newdot_fn in
let n = st.sasarg.length in
try
match st.sasarg.init_search_max_trials with
| None ->
ignore (simuloop stdout n n "" st)
| Some maxt ->
let i = ref 1 in
let run s =
moves := 0;
rounds := 0;
round_mask := [];
Printf.fprintf log "-------------------------- New simu (%d) \n%!" !i;
let s = SimuState.update_config s.config s in
let res = simuloop log n n "" s in
Printf.fprintf log "initial conf=(%s)\n%!" (StringOf.env_rif s.config s.network);
incr i;
res
in
let st = (WorstInit.fchc log run st maxt) in
Printf.printf " (%s)\n%!" (StringOf.env_rif st.config st.network);
Printf.fprintf newdot "%s\n" (SimuState.to_dot st);
Printf.printf "%s and %s have been generated\n" (st.sasarg.topo ^ ".log") newdot_fn;
flush_all();
close_out newdot;
close_out log
with
| e ->
Printf.printf "%s%s\n%!" (if st.sasarg.rif then "#" else "") (Printexc.to_string e);
print_string "\nq\n#quit\n%!";
flush_all();
exit 2
test/dijkstra-ring/config.ml
+ 20
− 7
View file @ ff45e5e4
......@@ -10,22 +10,25 @@ open State
* 2 2 2 3 0 1 3 -> convex
* 2 4 5 3 0 1 3 -> convex
* 2 2 2 3 0 2 3 -> not convex
*)
*)
module IntSet = Set.Make(Int)
let compute_Z root root_st (get: Algo.pid -> State.t * (State.t Algo.neighbor * Algo.pid) list) =
let v = root_st.v in
let used = Array.make (card () + 1) false in
let used = ref IntSet.empty in
let rec convex pid encountered res =
(* Printf.eprintf (if encountered then "<" else "|"); *)
(* Printf.eprintf (if res then ">" else "|"); *)
let next_st, next =
match get pid with
(_, [s,n]) -> state s, n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
(_, [s,n]) -> state s, n | _ ->
failwith "Can't compute the cost of a topology that is not a directed ring"
in
if next = root then res
else
let next_v = next_st.v in
(* Printf.eprintf "%s %d" next next_v; *)
used.(next_v) <- true;
used := IntSet.add next_v !used;
convex next (encountered || next_v = v) (res && (not encountered || next_v = v))
in
if convex root false true
......@@ -33,7 +36,7 @@ let compute_Z root root_st (get: Algo.pid -> State.t * (State.t Algo.neighbor *
else
let rec get_min_free cur_val dist =
if cur_val = v then assert false;
if not used.(cur_val) then dist
if not (IntSet.mem cur_val !used) then dist
else
get_min_free ((cur_val + 1) mod (card () + 1)) (dist + 1)
in
......@@ -48,14 +51,16 @@ let compute_sd (root: pid) (get: Algo.pid -> State.t * (State.t Algo.neighbor *
else
let st, ((n_state, neighbor): 's * pid) =
match get pid with
(st, [n]) -> st, n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
(st, [n]) -> st, n | _ ->
failwith "Can't compute the cost of a topology that is not a directed ring"
in
let total = if (P.enable_f st [n_state]) <> [] then total + rang else total in
compute neighbor total (rang+1)
in
let succ: pid =
match get root with
(_, [_, n]) -> n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
(_, [_, n]) -> n | _ ->
failwith "Can't compute the cost of a topology that is not a directed ring"
in
compute succ 0 1
;;
......@@ -101,3 +106,11 @@ let (legitimate: pid list -> (pid -> t * (t neighbor * pid) list) -> bool) =
token_nb = 1
let legitimate = Some legitimate
let s2n s = [I s.v]
let n2s nl s =
match nl with
| [I i] -> { s with v = i }
| _ -> assert false
let for_init_search = Some (s2n, n2s)
test/dijkstra-ring/ring.dot
+ 7
− 7
View file @ ff45e5e4
digraph ring7 {
graph [k=3]
root [algo="root.ml" init="{root=1;v=1}" ]
p2 [algo="p.ml" init="{root=0;v=3}" ]
p3 [algo="p.ml" init="{root=0;v=3}" ]
p4 [algo="p.ml" init="{root=0;v=2}" ]
p5 [algo="p.ml" init="{root=0;v=2}" ]
p6 [algo="p.ml" init="{root=0;v=1}" ]
p7 [algo="p.ml" init="{root=0;v=1}" ]
root [algo="root.ml" init="{root=1;v=0}" ]
p2 [algo="p.ml" init="{root=0;v=0}" ]
p3 [algo="p.ml" init="{root=0;v=0}" ]
p4 [algo="p.ml" init="{root=0;v=0}" ]
p5 [algo="p.ml" init="{root=0;v=0}" ]
p6 [algo="p.ml" init="{root=0;v=0}" ]
p7 [algo="p.ml" init="{root=0;v=0}" ]
p8 [algo="p.ml" init="{root=0;v=0}" ]
root -> p2 -> p3 -> p4 -> p5 -> p6 -> p7 -> p8 -> root
......
test/dijkstra-ring/state.ml
+ 17
− 2
View file @ ff45e5e4
......@@ -2,8 +2,23 @@
type t = { root: bool ; v : int } (* semi-anonymous network: we know who is the root! *)
let to_string s = Printf.sprintf "c=%i" s.v
let first = ref true
let (of_string: (string -> t) option) =
Some (fun s ->
Scanf.sscanf s "{root=%d;v=%d}" (fun i1 i2 -> { root = i1<>0; v = i2 } ))
Some (fun s ->
try (* if the root node is not explicitly set in the dot file, we
consider the first one to be the root *)
Scanf.sscanf s "{root=%d;v=%d}" (fun i1 i2 -> { root = i1<>0; v = i2 } )
with
_ ->
try
let res = Scanf.sscanf s "c=%d" (fun i -> { root = !first; v = i } ) in
first := false;
res
with
_ ->
Printf.printf "state.m: Unable to parse the initial state in the .dot: '%s'\n%!" s;
assert false
)
let copy x = x
let actions = ["T"]
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