Reduce root spamming

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

5 files changed, 32 insertions, 28 deletions

diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 98b17e8..6f1c6dc 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -12,18 +12,18 @@ all: gentrace.opt simulator.opt tracestats.opt
 $(BUILDDIR):
 	mkdir -p $(BUILDDIR)
 	
-tracestats.opt: depend $(BUILDDIR) tracestats.cmx
+tracestats.opt: $(BUILDDIR) tracestats.cmx
 	$(OCAMLOPT) -o $(BUILDDIR)/tracestats $(OCAMLFLAGS) str.cmxa compattrace.cmx tracestats.cmx
 	
-gentrace.opt: depend $(BUILDDIR) gentrace.cmx
-	$(OCAMLOPT) -o $(BUILDDIR)/gentrace $(OCAMLFLAGS) map2.cmx str.cmxa globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
+gentrace.opt: $(BUILDDIR) gentrace.cmx
+	$(OCAMLOPT) -o $(BUILDDIR)/gentrace $(OCAMLFLAGS) str.cmxa map2.cmx globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
 
-simulator.opt : depend $(BUILDDIR) simulator.cmx
-	$(OCAMLOPT) -o $(BUILDDIR)/simulator $(OCAMLFLAGS) map2.cmx str.cmxa globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx
+simulator.opt : $(BUILDDIR) simulator.cmx
+	$(OCAMLOPT) -o $(BUILDDIR)/simulator $(OCAMLFLAGS) str.cmxa map2.cmx globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx
 
 clean:
 	rm -f *.cm? *.cmx? *.o *~
-	rm .depend
+	rm -f .depend
 
 depend: $(SRCS)
 	$(OCAMLDEP) $(SRCS) > $(DEPEND)
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index 41c8b0c..19a8844 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -97,7 +97,7 @@ type round_data = {
 }
 
 module SlotArray : sig
-
+    exception SlotArray of string
 	type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
 	type 'a t
 	val make : int -> 'a t
@@ -117,7 +117,7 @@ module SlotArray : sig
 	val append_asks : ('a slot array) -> 'a t -> unit
 		
 end = struct
-	
+	exception SlotArray of string
 	type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
 	
 	type 'a t = {
@@ -161,7 +161,7 @@ end = struct
 	                | Ask _ as e -> sa.asks.(n) <- e; aux (n+1)
 	                | AskRoot -> remove_ask n sa; aux n
 	                | Peer _ as e -> add_peer e sa; remove_ask n sa; aux n
-	                | _ -> failwith "Big problem"
+	                | _ -> raise (SlotArray "iter_asks")
                 end
         in
         aux 0
@@ -236,7 +236,7 @@ end = struct
                 match list.(n) with
                     | Peer p -> add_ask (Ask p) sa; aux (n+1)
                     | Empty -> ()
-	                | _ -> failwith "Big problem"
+	                | _ -> raise (SlotArray "trying to append non peer")
         in
         aux 0
 
diff --git a/sources/thibaut/graph.ml b/sources/thibaut/graph.ml
index d3cbdfe..5fba67a 100644
--- a/sources/thibaut/graph.ml
+++ b/sources/thibaut/graph.ml
@@ -24,14 +24,16 @@ let update_distances peers tracking_array =
     while not (Queue.is_empty queue) do
         let id = Queue.pop queue in
         let peer = peers.(tracking_array.(id)) in
-        let aux p =
-            if not visited.(p.id) then begin
-                visited.(p.id) <- true;
-                p.distance <- peer.distance + 1;
-                Queue.push p.id queue
-            end
+        let aux pe = match pe with
+            | SlotArray.Peer p -> 
+                if not visited.(p.id) then begin
+                    visited.(p.id) <- true;
+                    p.distance <- peer.distance + 1;
+                    Queue.push p.id queue
+                end
+            | _ -> raise (SlotArray.SlotArray "non peer in slots") 
         in
-        SlotArray.iter (fun (SlotArray.Peer p) -> aux p) peer.slots
+        SlotArray.iter aux peer.slots
     done
 
 let repart round peers =
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index 4060b91..7c27ee9 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -58,7 +58,7 @@ let do_peer root peer =
     SlotArray.iter_asks aux peer.slots;
     let free_slots = SlotArray.capacity peer.slots - SlotArray.length peer.slots
                      - SlotArray.asks peer.slots in
-    if free_slots > 0 then 
+    if free_slots > 2 then 
         let (a,b) = ask_root root peer in
         if a then begin
             SlotArray.accept (Peer root) peer.slots;
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 5a08784..4af40cf 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -41,16 +41,18 @@ let ic = open_in !filename
 
 let npeers, days = Trace.read_info ic
 
-let peers = Array.init npeers (fun i -> {
-    id = i;
-    con_state = OFF;
-    slots = SlotArray.make !degree;
-    rounds_data = RoundMap.empty;
-    messages = Queue.create();
-    history = RoundMap.empty;
-    distance = -1;
-    connection_time = 0;
-})
+let peers = Array.init npeers (fun i ->
+    let p = {
+        id = i;
+        con_state = OFF;
+        slots = SlotArray.make (if i> 0 then !degree else 2*(!degree));
+        rounds_data = RoundMap.empty;
+        messages = Queue.create();
+        history = RoundMap.empty;
+        distance = -1;
+        connection_time = 0
+    } in
+    p)
 
 let tracking_array = Array.init npeers (fun i -> i)