Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
(* Time-stamp: <modified the 21/02/2019 (at 11:30) 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
coeurs
step : action -> (string -> value) Lwt.t ;
*)
open Algo
let (to_process: Env.t -> Topology.node -> Env.t * Process.t) =
fun e n ->
let p = Process.make n in
let e = List.fold_left
(fun e (n,_t) -> Env.set e p.pid n (p.init n))
e
p.variables
in
e, p
let (to_process_list : Env.t -> Topology.node list -> Env.t * Process.t list) =
fun e nl ->
List.fold_left
(fun (e,pl) n -> let e,p= to_process e n in e,p::pl)
(e,[]) nl
(* Should be called after [to_process] has been called on all
Topology.nodes, which is ensured by the [process_are_created] ref
*)
let process_are_created = ref false
let (get_neighors: Process.t -> Topology.neighbor list) =
fun p ->
assert (!process_are_created);
let id = p.Process.pid in
let idl = try Hashtbl.find Topology.node_succ id with Not_found -> [] in
List.map
(fun id ->
let node =
try Hashtbl.find Topology.node_info id with Not_found -> assert false
in
let algo_id = Filename.chop_suffix node.file ".cmxs" in
{
Topology.n_id = node.id;
Topology.n_vars = Algo.get_vars algo_id;
}
)
idl
let (dump_process: Process.t * Topology.neighbor list -> unit) =
fun (p,nl) ->
let pvars = StringOf.algo_vars p.variables in
let neighbors = List.map StringOf.topology_neighbor nl in
Printf.printf "process %s\n\tvars:%s\n\tneighors: \n\t\t%s\n" p.pid pvars
(String.concat "\n\t\t" neighbors)
let (update_env: Env.t -> Process.t * Algo.local_env -> Env.t) =
fun e (p, lenv) ->
List.fold_left
(fun e (n,_) -> Env.set e p.pid n (lenv n))
e
p.variables
open Process
let (to_algo_neighbor: Env.t -> Topology.neighbor -> Algo.neighbor) =
fun e n ->
{
lenv= Env.get e n.Topology.n_id;
n_vars = n.Topology.n_vars
}
let rec (simu: int -> int -> Process.t list ->
(Process.t * Topology.neighbor list) list -> Env.t -> unit) =
fun n i pl pl_n e ->
let all = List.fold_left
(fun acc (p,nl) ->
let nl4algo = List.map (to_algo_neighbor e) nl in
let lenv = Env.get e p.pid in
let al = p.enable nl4algo lenv in
let al = List.map (fun a -> p,nl,a) al in
if al <> [] then al::acc else acc)
[] pl_n
in
assert (all <> []);
let al = Demon.f Demon.Random all in
(* Do the steps *)
let lenv_list =
List.map (fun (p,nl,a) ->
let nl4algo = List.map (to_algo_neighbor e) nl in
let lenv = Env.get e p.pid in
p, p.step nl4algo lenv a)
al
in
(* update the env *)
let ne = List.fold_left update_env e lenv_list in
let al_str =
String.concat "," (List.map (fun (p,_,_a) -> Printf.sprintf "%s" p.pid) al)
in
Printf.eprintf "step %s: %s (%s)\n" (string_of_int (n-i)) (StringOf.env e pl) al_str;
match all with
| [_] -> ()
| [] -> assert false
| _ -> if i > 0 then simu n (i-1) pl pl_n ne else ()
let () =
let dot_file = Sys.argv.(1) 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 :=1;
Random.self_init();
Printf.printf "nodes: %s\nedges:\n" nstr;
let e = Env.init () in
let e, pl = to_process_list e nl in
process_are_created := true;
let neighors = List.map get_neighors pl in
let pl_n = List.combine pl neighors in
List.iter dump_process pl_n;
let n = (int_of_string Sys.argv.(2)) in
simu n n pl pl_n e
with Dynlink.Error e -> Printf.printf "E: %s\n"(Dynlink.error_message e)