Beginning of the protocol simulator.

git-svn-id: https://scm.gforge.inria.fr/svn/pacemaker@13 30fcff6e-8de6-41c7-acce-77ff6d1dd07b

1 files changed, 143 insertions, 0 deletions

diff --git a/sources/thibaut/simul.ml b/sources/thibaut/simul.ml
new file mode 100644
index 0000000..8781a67
--- /dev/null
+++ b/sources/thibaut/simul.ml
@@ -0,0 +1,143 @@
+type phase = SEEDING | IDLE
+type state = ON | OFF
+type peer_id = int
+
+module PeerId = struct
+    type t = peer_id
+    let compare = Pervasives.compare
+end
+
+module Int = struct
+    type t = int
+    let compare = Pervasives.compare
+end
+
+module HashMap = Map.Make(PeerId)
+
+module IntMap = Map.Make(Int)
+
+type message_content = 
+    | Seed of int * int (* seed, duration *)
+    | SeedReply of int (* hash *)
+    | Pulse of int * int HashMap.t list (* seed, branch *)
+
+type message = {
+    sender : peer_id;
+    round : int;
+    content : message_content
+} 
+
+type round_data = {
+    mutable phase : phase;
+    duration : int;
+    seed : int;
+    mutable hmap : int HashMap.t;
+    mutable included : int;
+    mutable replies : (int * int HashMap.t) list
+}
+
+type peer = {
+    id : peer_id;
+    mutable con_state : state;
+    neighbours : peer_id array;
+    mutable rounds_data : round_data IntMap.t;
+    messages : message Queue.t
+}
+
+let peers = Array.init 1000 (fun i -> {
+    id = i;
+    con_state = OFF;
+    neighbours = Array.make 10 0;
+    rounds_data = IntMap.empty;
+    messages = Queue.create()
+})
+
+let find_reply hash replies = 
+    let rec aux n replies = match replies with
+        | [] -> raise Not_found
+        | h::t -> let (a,b) = h in
+            if a = hash then n,b
+            else aux (n+1) t
+    in
+    aux 1 replies      
+
+let peer_init_round peer round seed duration = 
+    let data = { 
+        phase = SEEDING;
+        duration = duration;
+        seed = seed;
+        hmap = HashMap.add peer.id (Hashtbl.hash seed) HashMap.empty;
+        included = 0;
+        replies = []
+    } in
+    peer.rounds_data <- IntMap.add round data peer.rounds_data
+
+let send_message message receiver_id =
+    Queue.push message peers.(receiver_id).messages 
+    
+let rec verify_branch branch = match branch with
+    | [] -> true
+    | [h] -> true 
+    | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t)
+
+let do_peer peer = 
+    let process_message m = match m.content with
+        | Seed(seed,duration) -> 
+            begin
+                if not (IntMap.mem m.round peer.rounds_data) then begin
+                    peer_init_round peer m.round seed duration;
+                    let message = {
+                        sender = peer.id;
+                        round = m.round;
+                        content = Seed(seed, duration)
+                    } in
+                    Array.iter (send_message message) peer.neighbours
+                end
+            end
+        | SeedReply(hash) ->
+            begin
+                try
+                    let data = IntMap.find m.round peer.rounds_data in
+                    if data.phase = SEEDING then begin
+                        data.hmap <- HashMap.add m.sender hash data.hmap;
+                        peer.rounds_data <- IntMap.add m.round data peer.rounds_data
+                    end
+                with
+                    Not_found -> ()
+            end
+        | Pulse(seed, branch) ->
+            begin
+                try
+                    let data = IntMap.find m.round peer.rounds_data in
+                    match branch with
+                        | [] -> ()
+                        | h::t -> 
+                            try
+                                let hash = HashMap.find peer.id h in
+                                let n,hmap = find_reply hash data.replies in
+                                if data.included > n && verify_branch branch then
+                                    let branch2 = hmap::branch in
+                                    begin
+                                        data.included <- n;
+                                        data.phase <- IDLE;
+                                        peer.rounds_data <- IntMap.add m.round data peer.rounds_data;
+                                        let message = {
+                                            sender = peer.id;
+                                            round = m.round;
+                                            content = Pulse(seed, branch2)
+                                        } in
+                                        Array.iter (send_message message) peer.neighbours
+                                    end
+                            with
+                                | Not_found -> ()
+                with
+                    Not_found -> ()
+            end
+                    
+                    
+    in
+    Queue.iter process_message peer.messages;
+    Queue.clear;
+                        
+            
+