Refactor mesh consctruction.

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

4 files changed, 107 insertions, 103 deletions

diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index f025108..1faf227 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -32,6 +32,7 @@ module RoundMap : sig
 	val truncate : int -> 'a t -> 'a t
 	
 end = struct
+
 	type 'a t = (int* 'a) list
 	
 	let add round data map = (round,data)::map
@@ -75,6 +76,20 @@ end = struct
 		
 end
 
+let random_iter f a = 
+	let rec aux n = match n with
+		| 1 -> ()
+		| n -> let pos = 1+ Random.int (n-1) in
+			let b = a.(pos) in
+			a.(pos) <- a.(n-1);
+			a.(n-1) <- b;
+			f a.(n-1);
+			aux (n-1)
+	in
+	f a.(0);
+	aux (Array.length a)
+	 
+
 type message_content = 
     | Seed of int * int (* seed, duration *)
     | SeedReply of int (* hash *)
@@ -96,110 +111,91 @@ type round_data = {
 }
 
 module SlotArray : sig
-    
-    type 'a t
 
-    val length : 'a t -> int
-    val make : int -> 'a -> 'a t
-    val full : 'a t -> bool
-    val add : 'a t -> 'a -> unit
-    val remove : 'a t -> int -> 'a -> unit
-    val random_peer : 'a t -> 'a
-    val clear : 'a t -> 'a -> unit
-    val map : ('a -> 'a) -> 'a t -> unit
-    val mapi : (int -> 'a -> 'a option) -> 'a t -> unit
-    val iter : ('a -> unit) -> 'a t -> unit
-    val iteri : (int -> 'a -> unit) -> 'a t -> unit
-    val mem : ('a -> bool) -> 'a t -> bool
-      
+	type 'a slot = Peer of 'a | Ask of 'a | AskRoot
+	type 'a t
+	val make : int -> 'a t
+	val full : 'a t -> bool
+	val accept : 'a slot -> 'a t -> unit
+	val clear : 'a t -> unit
+		
 end = struct
+	
+	type 'a slot = Peer of 'a | Ask of 'a | AskRoot
+	
+	type 'a t = {
+	    mutable npeers : int;
+	    mutable nasks : int; 
+	    mutable peers: ('a slot) list;
+	    capacity: int;
+	    mutable asks: ('a slot) list
+	}
+	
+	let full sa = ( sa.npeers = sa.capacity )
+	
+	let iter_asks f sa = 
+		let rec aux result peers asks = match asks with
+			| [] -> sa.asks <- result; sa.peers <- peers
+			| a::b ->
+				if full sa then begin
+					sa.asks <- (List.rev_append result asks);
+					sa.peers <- peers
+				end
+				else begin match f a with
+					| Peer p as e -> sa.npeers <- sa.npeers + 1;
+									  sa.nasks <- sa.nasks - 1;
+								  	  aux result (e::peers) b
+			  		| Ask p as e -> aux (e::result) peers b
+			  		| AskRoot -> sa.nasks <- sa.nasks - 1; aux result peers b
+		  		end
+	  	in
+	  	aux [] sa.peers sa.asks
+	  	
+	let check_peers f sa =
+		let rec aux result peers = match peers with
+			| [] -> sa.peers <- result
+			| a::b -> if f a then aux (a::result) b
+					  else begin
+	      		  		  sa.npeers <- (sa.npeers - 1);
+	      		  		  aux result b
+      		  		  end
+		in
+		aux [] sa.peers
+										
+	let clear sa = 
+		sa.peers <- [];
+		sa.npeers <- 0
+			
+	let make capacity = {
+	    peers = [];
+	    asks = [];
+	    nasks = 0;
+	    npeers = 0;
+	    capacity = capacity
+	}
 
-    type 'a t = {
-        mutable length : int; 
-        array : 'a array;
-        capacity : int
-    }
-      
-    let full t = (t.length = t.capacity)
-    
-    let clear t newelem = 
-        for i = 0 to t.capacity-1 do
-            t.array.(i) <- newelem
-        done;
-        t.length <- 0
-    
-    let make n elem = {
-        length = 0;
-        array = Array.make n elem;
-        capacity = n
-    }
-      
-    let add t p = 
-        let length = t.length in
-        t.array.(length) <- p;
-        t.length <- length + 1
-
-    let remove t pos newelem =
-        let tab = t.array in
-        let length = (t.length-1) in
-        tab.(pos) <- tab.(length);
-        tab.(length) <- newelem;
-        t.length <- length
-    
-    let length t = t.length
-    
-    let map f t =
-        for i = 0 to t.capacity-1 do
-            t.array.(i) <- f(t.array.(i))
-        done
-
-    let mapi f t =
-        for i = 0 to t.capacity-1 do
-            match f i t.array.(i) with
-                | None -> ()
-                | Some x -> t.array.(i) <- x
-        done
-        
-    let iter f t =
-        for i = 0 to t.capacity-1 do
-            f(t.array.(i))
-        done
-
-    let iteri f t =
-        for i = 0 to t.capacity-1 do
-            f i (t.array.(i))
-        done
-        
-    let mem pred sa = 
-        let found = ref false in
-        let i = ref 0 in
-        while not !found && !i < (sa.capacity-1) do
-            if pred sa.array.(!i) then begin
-                found := true;
-                incr i
-            end
-            else begin
-                incr i
-            end
-        done;
-        !found
-    
-    let random_peer t =
-        let n = Random.int t.length in
-        t.array.(n)     
-end
+	let length sa = sa.npeers
+	
+	let test f sa = 
+		let rec aux l = match l with
+			| [] -> false
+			| a::b -> (f a)||(aux b)
+		in
+		aux sa.peers
+		
+	let accept p sa = if not (full sa) then begin
+		sa.npeers <- sa.npeers + 1;
+		sa.peers <- (p::sa.peers)
+	end
+		       
+end 
 
 type peer = {
     id : peer_id;
     mutable con_state : state;
-    slots : slot SlotArray.t;
+    slots : peer SlotArray.t;
     mutable rounds_data : round_data RoundMap.t;
     messages : message Queue.t;
     mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *)
 }
-
-and slot = 
-    | Empty 
-    | Peer of peer
-    | AskRoot
-    | AskPeer of peer
+and slot = peer SlotArray.slot
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index ebec0b0..554a851 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -11,12 +11,17 @@ let print_slotarray t =
 	
 let ask = ref 0
 let askroot = ref 0
+
+let ask_root root p
 (* peer is asking to p *)
 let ask_peer peer p = 
 	incr ask;
 	if p.id = 0 then
 		incr askroot;
 		
+	if not SlotArray.full p.slots then
+		
+		
 	if p.id = peer.id then
 		AskRoot
     else if p.con_state <> ON then
@@ -32,12 +37,14 @@ let ask_peer peer p =
             SlotArray.add p.slots (Peer peer);
             Peer p
         end
-        else match SlotArray.random_peer p.slots with
+        else match SlotArray.random_elem p.slots with
             | Peer x -> AskPeer x
             | _ -> failwith "Something is very wrong.\n"
     end
 
 let do_peer root peer =
+
+	let aux i slot = 
     let aux i slot = match slot with
         | Empty -> if peer.id = 0 then None else Some AskRoot
         | AskRoot -> 
diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml
index e5b54c4..d37ef12 100644
--- a/sources/thibaut/pacemaker.ml
+++ b/sources/thibaut/pacemaker.ml
@@ -1,4 +1,5 @@
 open Globals
+open SlotArray
 
 let find_reply hash replies = 
     let rec aux n replies = match replies with
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 41baad7..3d135a3 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -4,8 +4,8 @@ open Mesh
 
 let degree = ref 10
 let tpm = ref 3
-let accuracy = ref 30
-let duration = ref 9
+let accuracy = ref 60
+let duration = ref 24
 let seed = ref 0
 let filename = ref ""
 
@@ -59,18 +59,18 @@ let _ =
     for i = 0 to (nticks-1) do
     	connected := 0;
 	    Pacemaker.messages := 0;
-        if i mod !accuracy = 0 then begin
+	    if i mod !accuracy = 0 then begin
             incr round;
             server_init_seed peers.(0) !round !duration
         end;
         
         if i mod !accuracy = !duration then
             server_init_pulse peers.(0) !round;
-            
+        
         if i mod !tpm = 0 then begin
             do_trace_round (i/(!tpm));
         end;
-            
+        
         do_server !round peers.(0);
         
         let do_peer p = 
@@ -80,7 +80,7 @@ let _ =
               	incr connected
             end
         in
-        Array.iter do_peer peers;
+        random_iter do_peer peers;
         
         if i mod !tpm = 0 then begin
         	Printf.printf "Minute %d, " (i/(!tpm));