Fix some bigs. Simulator is now working. Left to do:

* remove some load on the server for mesh construction
* test several policies for mesh constructions, connection scheme...


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

7 files changed, 160 insertions, 60 deletions

diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 076f662..5b0561b 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -26,7 +26,7 @@ clean:
 	rm .depend
 
 depend: $(SRCS)
-	$(OCAMLDEP) $(OCAMLFLAGS) $(SRCS) > $(DEPEND)
+	$(OCAMLDEP) $(SRCS) > $(DEPEND)
 
 .SUFFIXES: .mli .ml .cmo .cmi .cmx
 
diff --git a/sources/thibaut/gentrace.ml b/sources/thibaut/gentrace.ml
index a69936c..4d45d3f 100644
--- a/sources/thibaut/gentrace.ml
+++ b/sources/thibaut/gentrace.ml
@@ -43,7 +43,7 @@ let peers = Array.init !npeers (fun i ->
     let init = Random.float 1. in
     let state = if init < avail then ON else OFF in
     let session_length = 10 + Random.int 90 in
-    let mu = 1./. (float_of_int session_length) in
+    let mu = if i = 0 then 0. else 1./. (float_of_int session_length) in
     let lambda = mu*.(1.-.avail)/.avail in
     output oc (Trace.Peer (i, avail, state));
     {
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index a2b22a8..f025108 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -9,7 +9,7 @@ let state_of_string s = match s with
     | "Off" -> OFF
     | _ -> failwith (Printf.sprintf "Wrong state:%s" s)
     
-type phase = SEEDING | IDLE
+type phase = SEEDING | IDLE | PULSE
 type peer_id = int
 
 module PeerId = struct
@@ -17,14 +17,63 @@ module PeerId = struct
     let compare = Pervasives.compare
 end
 
-module Int = struct
-    type t = int
-    let compare a b =  - (Pervasives.compare a b)
-end
-
 module HashMap = Map2.Make(PeerId)
 
-module RoundMap = Map2.Make(Int)
+module RoundMap : sig
+	type 'a t
+	
+	val empty : 'a t
+	val add : int -> 'a -> 'a t -> 'a t
+	val mem : int -> 'a t -> bool
+	val find : int -> 'a t -> 'a
+	val iter : (int -> 'a -> unit) -> 'a t -> unit
+	val iter_limit : (int -> 'a -> unit) -> int -> 'a t -> unit
+	val last_round : 'a t -> int
+	val truncate : int -> 'a t -> 'a t
+	
+end = struct
+	type 'a t = (int* 'a) list
+	
+	let add round data map = (round,data)::map
+	
+	let last_round map = match map with
+		| [] -> 0
+		| (a,b)::c -> a
+	
+	let empty = []
+	
+	let rec mem round map = match map with
+		| [] -> false
+		| (a,b)::c ->
+			if a = round then true
+			else if a < round then false
+			else mem round c
+		
+	let rec find round map = match map with
+		| [] -> raise Not_found
+		| (a,b)::c ->
+			if a = round then b
+			else if a < round then raise Not_found
+			else find round c
+			
+	let rec iter f map = match map with
+		| [] -> ()
+		| (a,b)::c -> f a b; iter f c
+		
+	let rec iter_limit f limit map = match map with
+		| [] -> ()
+		| (a,b)::c ->
+			if a >= limit then begin
+				f a b;
+				iter_limit f limit c
+			end
+			
+	let rec truncate limit map = match map with
+		| [] -> []
+		| (a,b)::c -> if a < limit then [] else (a,b)::(truncate limit c) 
+		
+		
+end
 
 type message_content = 
     | Seed of int * int (* seed, duration *)
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index aba1c5e..ebec0b0 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -1,9 +1,25 @@
 open Globals
 
+let print_slotarray t =
+	let aux elem = begin match elem with
+		| Peer p -> print_int p.id
+		| AskRoot -> print_string "Askroot"
+		| AskPeer p -> Printf.printf "Ask %d" p.id
+		| Empty -> print_string "Empty"
+	end; print_char ',' in
+	SlotArray.iter aux t
+	
+let ask = ref 0
+let askroot = ref 0
 (* peer is asking to p *)
 let ask_peer peer p = 
-    Printf.printf "%d asking %d\n" peer.id p.id;
-    if p.con_state <> ON then
+	incr ask;
+	if p.id = 0 then
+		incr askroot;
+		
+	if p.id = peer.id then
+		AskRoot
+    else if p.con_state <> ON then
         AskRoot
     else begin
         let pred elem = match elem with
@@ -21,11 +37,22 @@ let ask_peer peer p =
             | _ -> failwith "Something is very wrong.\n"
     end
 
-let do_peer peers peer =
+let do_peer root peer =
     let aux i slot = match slot with
-        | Empty -> Some AskRoot
+        | Empty -> if peer.id = 0 then None else Some AskRoot
         | AskRoot -> 
-            begin match ask_peer peer peers.(0) with
+            begin match ask_peer peer root with
+                | Peer p ->
+                    if p.con_state = ON then begin
+                        SlotArray.add peer.slots (Peer p);
+                        None
+                    end
+                    else
+                        Some AskRoot
+                | x -> Some x
+            end
+        | AskPeer p ->
+        	 begin match ask_peer peer p with
                 | Peer p ->
                     if p.con_state = ON then begin
                         SlotArray.add peer.slots (Peer p);
@@ -35,9 +62,8 @@ let do_peer peers peer =
                         Some AskRoot
                 | x -> Some x
             end
-        | AskPeer p -> Some (ask_peer peer p)
         | Peer p -> 
-            if p.con_state <> ON then None
+            if p.con_state = ON then None
             else begin
                 SlotArray.remove peer.slots i Empty;
                 None
diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml
index f4d2f0e..e5b54c4 100644
--- a/sources/thibaut/pacemaker.ml
+++ b/sources/thibaut/pacemaker.ml
@@ -20,8 +20,10 @@ let peer_init_round peer round seed duration =
     } in
     peer.rounds_data <- RoundMap.add round data peer.rounds_data
 
+let messages = ref 0
+
 let send_message message receiver = match receiver with
-    | Peer peer -> Printf.printf "message sent !\n"; Queue.push message peer.messages
+    | Peer peer -> incr messages; Queue.push message peer.messages
     | _ -> ()
 
 let server_init_seed peer round duration = 
@@ -56,16 +58,21 @@ let rec verify_branch branch = match branch with
     | [h] -> true 
     | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t)
     
-let process_message peer m = match m.content with
+let process_message current_round peer m =
+	if m.round < (current_round - 2) then
+		()
+	else
+	match m.content with
     | Seed(seed,duration) -> 
-        if not (RoundMap.mem m.round peer.rounds_data) then
+        if not (RoundMap.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
-        SlotArray.iter (send_message message) peer.slots
+		    let message = {
+		        sender = peer.id;
+		        round = m.round;
+		        content = Seed(seed, duration)
+		    } in
+		    SlotArray.iter (send_message message) peer.slots
+	    end
     | SeedReply(hash) ->
         begin try
             let data = RoundMap.find m.round peer.rounds_data in
@@ -77,34 +84,35 @@ let process_message peer m = match m.content with
     | Pulse(seed, branch) ->
         begin try
             let data = RoundMap.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 begin
-                        let branch2 = hmap::branch in
-                        data.included <- n;
-                        data.phase <- IDLE;
-                        let message = {
-                            sender = peer.id;
-                            round = m.round;
-                            content = Pulse(seed, branch2)
-                        } in
-                        SlotArray.iter (send_message message) peer.slots;
-                        peer.history <- RoundMap.add m.round 
-                                                      (seed, branch2)
-                                                      peer.history
-                    end
-                    with
-                        | Not_found -> ()
+            if data.phase = SEEDING || data.phase = IDLE then
+		        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 begin
+		                    let branch2 = hmap::branch in
+		                    data.included <- n;
+		                    data.phase <- PULSE;
+		                    let message = {
+		                        sender = peer.id;
+		                        round = m.round;
+		                        content = Pulse(seed, branch2)
+		                    } in
+		                    SlotArray.iter (send_message message) peer.slots;
+		                    peer.history <- RoundMap.add m.round 
+		                                                  (seed, branch2)
+		                                                  peer.history
+		                end
+		                with
+		                    | Not_found -> ()
         with
             Not_found -> ()
         end
 
-let do_peer peer =
-    Queue.iter (process_message peer) peer.messages;
+let do_peer current_round peer =
+    Queue.iter (process_message current_round peer) peer.messages;
     Queue.clear peer.messages;
     try
         let aux round data = 
@@ -117,16 +125,16 @@ let do_peer peer =
                     content = SeedReply(Hashtbl.hash data.hmap)
                 } in
                 SlotArray.iter (send_message message) peer.slots;
-            end else
-                failwith "not seeding"
+            end
         in
-        RoundMap.iter aux peer.rounds_data
+        RoundMap.iter_limit aux (current_round - 2) peer.rounds_data;
+        peer.rounds_data <- RoundMap.truncate (current_round - 2) peer.rounds_data
     with
         Failure _ -> ()
         
-let do_server peer = 
+let do_server current_round peer = 
     let aux m = match m.content with
-        | SeedReply _ ->  process_message peer m
+        | SeedReply _ ->  process_message current_round peer m
         | _ -> ()
     in
     Queue.iter aux peer.messages;
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 14edf4f..41baad7 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -53,9 +53,12 @@ let do_trace_round = Trace.read ic peers
 
 let nticks = (days)*24*60*(!tpm)
 let round = ref 0
+let connected = ref 0
 
 let _ = 
     for i = 0 to (nticks-1) do
+    	connected := 0;
+	    Pacemaker.messages := 0;
         if i mod !accuracy = 0 then begin
             incr round;
             server_init_seed peers.(0) !round !duration
@@ -64,18 +67,32 @@ let _ =
         if i mod !accuracy = !duration then
             server_init_pulse peers.(0) !round;
             
-        if i mod !tpm = 0 then 
+        if i mod !tpm = 0 then begin
             do_trace_round (i/(!tpm));
+        end;
             
-        do_server peers.(0);
+        do_server !round peers.(0);
         
         let do_peer p = 
             if p.con_state = ON then begin
-                Pacemaker.do_peer p;
-                Mesh.do_peer peers p
+                Pacemaker.do_peer !round p;
+              	Mesh.do_peer peers.(0) p;
+              	incr connected
             end
         in
-        Array.iter do_peer peers
+        Array.iter do_peer peers;
+        
+        if i mod !tpm = 0 then begin
+        	Printf.printf "Minute %d, " (i/(!tpm));
+		    Printf.printf "Connected: %d, " !connected;
+		    Printf.printf "Messages: %d, " !Pacemaker.messages;
+		    Printf.printf "Asks: %d, " !Mesh.ask;
+		    Printf.printf "Askroots: %d" !Mesh.askroot;
+		    print_newline ();
+		    
+		    Mesh.ask := 0;
+		    Mesh.askroot := 0;
+	    end
     done
     
  
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index 3276653..e284846 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -55,7 +55,7 @@ let read_info ic =
         | _ -> failwith "Bad trace"
     in
     npeers, ndays
-    
+
 let read ic peers = 
     let npeers = Array.length peers in
 	for i = 0 to (npeers-1) do