Mesh construction.

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

7 files changed, 192 insertions, 80 deletions

diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 152966d..076f662 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -3,28 +3,30 @@ OCAMLOPT=ocamlopt.opt
 OCAMLDEP=ocamldep.opt
 INCLUDES=
 OCAMLFLAGS=$(INCLUDES)
-SRCS=map2.ml simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattrace.ml tracestats.ml
+SRCS=map2.ml simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattrace.ml tracestats.ml mesh.ml
 BUILDDIR=build
+DEPEND=.depend
 
 all: gentrace.opt simulator.opt tracestats.opt
 
-builddir:
+$(BUILDDIR):
 	mkdir -p $(BUILDDIR)
 	
-tracestats.opt: builddir tracestats.cmx
+tracestats.opt: depend $(BUILDDIR) tracestats.cmx
 	$(OCAMLOPT) -o $(BUILDDIR)/tracestats $(OCAMLFLAGS) str.cmxa compattrace.cmx tracestats.cmx
 	
-gentrace.opt: builddir gentrace.cmx
+gentrace.opt: depend $(BUILDDIR) gentrace.cmx
 	$(OCAMLOPT) -o $(BUILDDIR)/gentrace $(OCAMLFLAGS) map2.cmx str.cmxa globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
 
-simulator.opt : builddir simulator.cmx
-	$(OCAMLOPT) -o $(BUILDDIR)/simulator $(OCAMLFLAGS) map2.cmx str.cmxa globals.cmx pacemaker.cmx trace.cmx simulator.cmx
+simulator.opt : depend $(BUILDDIR) simulator.cmx
+	$(OCAMLOPT) -o $(BUILDDIR)/simulator $(OCAMLFLAGS) map2.cmx str.cmxa globals.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx
 
 clean:
 	rm -f *.cm? *.cmx? *.o *~
+	rm .depend
 
 depend: $(SRCS)
-	$(OCAMLDEP) $(OCAMLFLAGS) $(SRCS) > .depend
+	$(OCAMLDEP) $(OCAMLFLAGS) $(SRCS) > $(DEPEND)
 
 .SUFFIXES: .mli .ml .cmo .cmi .cmx
 
@@ -35,4 +37,4 @@ depend: $(SRCS)
 %.cmx : %.ml
 	$(OCAMLOPT) -c $(OCAMLFLAGS) $<
 
--include .depend
+-include $(DEPEND)
diff --git a/sources/thibaut/gentrace.ml b/sources/thibaut/gentrace.ml
index ad4734a..a69936c 100644
--- a/sources/thibaut/gentrace.ml
+++ b/sources/thibaut/gentrace.ml
@@ -45,10 +45,10 @@ let peers = Array.init !npeers (fun i ->
     let session_length = 10 + Random.int 90 in
     let mu = 1./. (float_of_int session_length) in
     let lambda = mu*.(1.-.avail)/.avail in
-    output oc (Peer (i, avail, state));
+    output oc (Trace.Peer (i, avail, state));
     {
         id = i;
-        state = state;
+        Trace.state = state;
         avail = avail;
         lambda = lambda;
         mu = mu
@@ -61,12 +61,12 @@ let _ =
         output oc (Round i);
         let aux p = 
             let r = Random.float 1. in
-            if p.state = OFF && r < p.lambda then begin
-                p.state <- ON;
-                output oc (On p.id)
+            if p.Trace.state = OFF && r < p.lambda then begin
+                p.Trace.state <- ON;
+                output oc (On p.Trace.id)
             end else if p.state = ON && r < p.mu then begin
-                p.state <- OFF;
-                output oc (Off p.id)
+                p.Trace.state <- OFF;
+                output oc (Off p.Trace.id)
             end
         in
         Array.iter aux peers   
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index 90a5a48..d71ff34 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -8,3 +8,130 @@ let state_of_string s = match s with
     | "On" -> ON
     | "Off" -> OFF
     | _ -> failwith (Printf.sprintf "Wrong state:%s" s)
+    
+type phase = SEEDING | IDLE
+type peer_id = int
+
+module PeerId = struct
+    type t = peer_id
+    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)
+
+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
+}
+
+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 -> unit
+    val random_peer : 'a t -> 'a
+    val clear : 'a t -> unit
+    val map : ('a -> 'a) -> 'a t -> unit
+    val iter : ('a -> unit) -> 'a t -> unit
+    val mem : ('a -> bool) -> 'a t -> bool
+      
+end = struct
+
+    type 'a t = {
+        mutable length : int; 
+        array : 'a array;
+        capacity : int
+    }
+      
+    let full t = (t.length = t.capacity)
+    
+    let clear t = 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 =
+        let tab = t.array in
+        let length = (t.length-1) in
+        tab.(pos) <- tab.(length);
+        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 iter f t =
+        for i = 0 to t.capacity-1 do
+            f(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
+
+type peer = {
+    id : peer_id;
+    mutable con_state : state;
+    slots : slot 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
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
new file mode 100644
index 0000000..a73a3bc
--- /dev/null
+++ b/sources/thibaut/mesh.ml
@@ -0,0 +1,26 @@
+open Globals
+
+(* peer is asking to p *)
+let ask_peer peer p = 
+    let pred elem = match elem with
+        | Peer x -> x.id = peer.id
+        | _ -> false
+    in
+    if SlotArray.mem pred p.slots then
+        AskRoot
+    else if not (SlotArray.full p.slots) then begin
+        SlotArray.add p.slots (Peer peer);
+        Peer p
+    end
+    else match SlotArray.random_peer p.slots with
+        | Peer x -> AskPeer x
+        | _ -> failwith "Something is very wrong.\n"
+    
+let do_peer peers peer =
+    let aux i slot = match slot with
+        | Empty -> AskRoot
+        | AskRoot -> ask_peer peer peers.(0)
+        | AskPeer p -> ask_peer peer p
+        | Peer p -> if p.con_state <> ON then Peer p else AskRoot
+    in
+    SlotArray.map aux peer.slots
diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml
index 2b85e79..f4d2f0e 100644
--- a/sources/thibaut/pacemaker.ml
+++ b/sources/thibaut/pacemaker.ml
@@ -1,53 +1,5 @@
 open Globals
 
-type phase = SEEDING | IDLE
-type peer_id = int
-
-module PeerId = struct
-    type t = peer_id
-    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)
-
-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 : node array;
-    mutable rounds_data : round_data RoundMap.t;
-    messages : message Queue.t;
-    mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *)
-} and
-
-node = None | Some of peer
-
 let find_reply hash replies = 
     let rec aux n replies = match replies with
         | [] -> raise Not_found
@@ -69,8 +21,8 @@ let peer_init_round peer round seed duration =
     peer.rounds_data <- RoundMap.add round data peer.rounds_data
 
 let send_message message receiver = match receiver with
-    | None -> ()
-    | Some peer -> Queue.push message peer.messages
+    | Peer peer -> Printf.printf "message sent !\n"; Queue.push message peer.messages
+    | _ -> ()
 
 let server_init_seed peer round duration = 
     let data = {
@@ -87,7 +39,7 @@ let server_init_seed peer round duration =
         round = round;
         content = Seed (data.seed, data.duration)
     } in
-    Array.iter (send_message message) peer.neighbours
+    SlotArray.iter (send_message message) peer.slots
     
 let server_init_pulse peer round = 
     let data = RoundMap.find round peer.rounds_data in
@@ -97,7 +49,7 @@ let server_init_pulse peer round =
         round = round;
         content = Pulse (data.seed, [data.hmap])
     } in
-    Array.iter (send_message message) peer.neighbours
+    SlotArray.iter (send_message message) peer.slots
     
 let rec verify_branch branch = match branch with
     | [] -> true
@@ -113,7 +65,7 @@ let process_message peer m = match m.content with
             round = m.round;
             content = Seed(seed, duration)
         } in
-        Array.iter (send_message message) peer.neighbours
+        SlotArray.iter (send_message message) peer.slots
     | SeedReply(hash) ->
         begin try
             let data = RoundMap.find m.round peer.rounds_data in
@@ -140,7 +92,7 @@ let process_message peer m = match m.content with
                             round = m.round;
                             content = Pulse(seed, branch2)
                         } in
-                        Array.iter (send_message message) peer.neighbours;
+                        SlotArray.iter (send_message message) peer.slots;
                         peer.history <- RoundMap.add m.round 
                                                       (seed, branch2)
                                                       peer.history
@@ -164,7 +116,7 @@ let do_peer peer =
                     round = round;
                     content = SeedReply(Hashtbl.hash data.hmap)
                 } in
-                Array.iter (send_message message) peer.neighbours;
+                SlotArray.iter (send_message message) peer.slots;
             end else
                 failwith "not seeding"
         in
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 32855d8..14edf4f 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -1,5 +1,6 @@
 open Pacemaker
 open Globals
+open Mesh
 
 let degree = ref 10
 let tpm = ref 3
@@ -42,13 +43,13 @@ let npeers, days = Trace.read_info ic
 let peers = Array.init npeers (fun i -> {
     id = i;
     con_state = OFF;
-    neighbours = Array.make !degree None;
+    slots = SlotArray.make !degree Empty;
     rounds_data = RoundMap.empty;
     messages = Queue.create();
     history = RoundMap.empty
 })
 
-let read_round = Trace.read ic peers npeers
+let do_trace_round = Trace.read ic peers
 
 let nticks = (days)*24*60*(!tpm)
 let round = ref 0
@@ -63,15 +64,18 @@ let _ =
         if i mod !accuracy = !duration then
             server_init_pulse peers.(0) !round;
             
-        if i mod !tpm = 0 then
-            read_round (i/(!tpm));
+        if i mod !tpm = 0 then 
+            do_trace_round (i/(!tpm));
             
         do_server peers.(0);
-        for i = 1 to (npeers-1) do
-            let peer = peers.(i) in
-            if peer.con_state = ON then
-                do_peer peer
-        done
+        
+        let do_peer p = 
+            if p.con_state = ON then begin
+                Pacemaker.do_peer p;
+                Mesh.do_peer peers p
+            end
+        in
+        Array.iter do_peer peers
     done
     
  
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index d47e576..8d539ad 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -56,7 +56,8 @@ let read_info ic =
     in
     npeers, ndays
     
-let read ic peers npeers = 
+let read ic peers = 
+    let npeers = Array.length peers in
 	for i = 0 to (npeers-1) do
         match input ic with
             | Peer (i, avail, state) -> peers.(i).con_state <- state