Use typrex for pacemaker code.HEADmaster

11 files changed, 94 insertions, 65 deletions

diff --git a/sources/thibaut/.typerex b/sources/thibaut/.typerex
new file mode 100644
index 0000000..f055bbc
--- /dev/null
+++ b/sources/thibaut/.typerex
@@ -0,0 +1,2 @@
+.
+-chord.ml
diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 2f6d482..2b9a3e7 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -1,8 +1,8 @@
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
+OCAMLC=ocp-ocamlc
+OCAMLOPT=ocp-ocamlopt
 OCAMLDEP=ocamldep
 INCLUDES=
-OCAMLFLAGS=$(INCLUDES) -annot
+OCAMLFLAGS=$(INCLUDES)
 SRCS=simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattrace.ml tracestats.ml mesh.ml graph.ml client.ml clientGlobals.ml clientMessages.ml clientArg.ml clientSlots.ml clientSlots.mli
 BUILDDIR=build
 DEPEND=.depend
diff --git a/sources/thibaut/chord.ml b/sources/thibaut/chord.ml
index cb3ad2a..c5a14ee 100644
--- a/sources/thibaut/chord.ml
+++ b/sources/thibaut/chord.ml
@@ -1,27 +1,26 @@
 open Globals
 open SlotArray
 
-
 let do_peer root peer =
 
   let aux = function 
     | Ask p -> ask_peer peer p 
     | _ -> failwith "Big problem"
   in
-    
-    SlotArray.filter_peers is_active peer.slots;
-    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 > 2 then 
-      let (a,b) = ask_root root peer in
-        if a then begin
-          SlotArray.accept (Peer root) peer.slots;
-          SlotArray.append_asks b peer.slots
-        end
-        else
-          SlotArray.append_asks b peer.slots
-            
+  
+  SlotArray.filter_peers is_active peer.slots;
+  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 > 2 then 
+    let (a,b) = ask_root root peer in
+    if a then begin
+      SlotArray.accept (Peer root) peer.slots;
+      SlotArray.append_asks b peer.slots
+    end
+    else
+      SlotArray.append_asks b peer.slots
+        
 let do_server root = 
   SlotArray.filter_peers is_active root.slots
   
diff --git a/sources/thibaut/clientGlobals.ml b/sources/thibaut/clientGlobals.ml
index 8349203..5dd4c05 100644
--- a/sources/thibaut/clientGlobals.ml
+++ b/sources/thibaut/clientGlobals.ml
@@ -115,6 +115,7 @@ let protlog_ic = ref (open_out_gen [Open_append; Open_creat] 0o644
 let id_ic = safe_open open_in !id_file
 let my_id = Scanf.fscanf id_ic "%d" (fun x -> x)
 let conf_ic = safe_open open_in !config_file
+
 let root_name, root_port = Scanf.fscanf conf_ic "%s\n%d" (fun a b -> a,b)
 let root_addr_list = (gethostbyname root_name).h_addr_list
 let root_addr = root_addr_list.(0)
diff --git a/sources/thibaut/clientSlots.mli b/sources/thibaut/clientSlots.mli
index 32e1909..6f1f7b3 100644
--- a/sources/thibaut/clientSlots.mli
+++ b/sources/thibaut/clientSlots.mli
@@ -21,3 +21,4 @@ val iter_remove : (neighbour -> bool) -> t -> unit
 val remove_id : user_id -> t -> unit
 val to_list_avoid : user_id -> t -> sockaddr list
 val iter : (slot -> unit) -> t -> unit
+
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index 5015f96..9977eb0 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -97,7 +97,9 @@ type round_data = {
   replies : (int * int HashMap.t) Queue.t
 }
 
-module SlotArray : sig
+    
+
+module SlutArray : sig
   exception SlotArray of string
   type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
   type 'a t
@@ -233,13 +235,12 @@ end = struct
 	  | _ -> raise (SlotArray "trying to append non peer")
     in
       aux 0
-
 end 
 
 type peer = {
   id : peer_id;
   mutable con_state : state;
-  slots : peer SlotArray.t;
+  slots : peer SlutArray.t;
   mutable rounds_data : round_data RoundMap.t;
   messages : message Queue.t;
   mutable history : (int * (int HashMap.t list)) RoundMap.t; (* seed, branch *)
@@ -247,15 +248,15 @@ type peer = {
   mutable connection_time : int;
   mutable nproofs : int;
   mutable real_avail : int;
-  mutable proofs : int
+  mutable proofs : int;
 }
-and slot = peer SlotArray.slot
+and slot = peer SlutArray.slot
 
 let swap a pos1 pos2 =
   let temp = a.(pos1) in
     a.(pos1) <- a.(pos2);
     a.(pos2) <- temp
-    
+
 let swap_track tracking_array real_array pos1 pos2 =
   let id1 = real_array.(pos1).id in
   let id2 = real_array.(pos2).id in
@@ -271,3 +272,24 @@ let random_iter f a tracking =
 	aux (n-1)
   in
     aux (Array.length a)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/sources/thibaut/graph.ml b/sources/thibaut/graph.ml
index da2652c..4640028 100644
--- a/sources/thibaut/graph.ml
+++ b/sources/thibaut/graph.ml
@@ -25,15 +25,15 @@ let update_distances peers tracking_array =
       let id = Queue.pop queue in
       let peer = peers.(tracking_array.(id)) in
       let aux pe = match pe with
-        | SlotArray.Peer p -> 
+        | SlutArray.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") 
+        | _ -> raise (SlutArray.SlotArray "non peer in slots") 
       in
-        SlotArray.iter aux peer.slots
+        SlutArray.iter aux peer.slots
     done
 
 let repart round peers =
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index b94a6ac..cc826b3 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -1,5 +1,6 @@
 open Globals
-open SlotArray
+open SlutArray
+open RoundMap
 let ask = ref 0
 let askroot = ref 0
 
@@ -8,42 +9,41 @@ let equal a b = match a, b with
   | _ -> failwith "Trying to compare non peers"
       
 (* p is asking n slots to root *)
-let ask_root root p =
+let ask_ruut root p =
   incr askroot;
-  if SlotArray.test (equal (Peer p)) root.slots then
-    false, SlotArray.ask_list root.slots
-  else if not (SlotArray.full root.slots) then begin
-    SlotArray.accept (Peer p) root.slots;
-    true, SlotArray.ask_list root.slots
+  if SlutArray.test (equal (Peer p)) root.slots then
+    false, SlutArray.ask_list root.slots
+  else if not (SlutArray.full root.slots) then begin
+    SlutArray.accept (Peer p) root.slots;
+    true, SlutArray.ask_list root.slots
   end 
   else
-    false, SlotArray.ask_list root.slots
+    false, SlutArray.ask_list root.slots
 
 (* peer is asking to p *)
 let ask_peer peer p = 
   incr ask;
-  
+ 
   if p.id = peer.id then
     AskRoot
   else if p.con_state <> ON then
     AskRoot
-  else if SlotArray.test (equal (Peer peer)) p.slots then
-    match SlotArray.random_peer_avoid (equal (Peer peer)) p.slots with
+  else if SlutArray.test (equal (Peer peer)) p.slots then
+    match SlutArray.random_peer_avoid (equal (Peer peer)) p.slots with
       | Peer x -> Ask x
       | AskRoot -> AskRoot
       | _ -> failwith "Random peer is failing"
-  else if not (SlotArray.full p.slots) then begin
-    SlotArray.accept (Peer peer) p.slots;
+  else if not (SlutArray.full p.slots) then begin
+    SlutArray.accept (Peer peer) p.slots;
     Peer p
   end
-  else match SlotArray.random_peer p.slots with
+  else match SlutArray.random_peer p.slots with
     | Peer x -> Ask x
     | _ -> failwith "Random peer is failing"
 
 let is_active = function
   | Peer p -> p.con_state = ON
   | _ -> failwith "Big problem"
-    
 
 let do_peer root peer =
 
@@ -51,20 +51,24 @@ let do_peer root peer =
     | Ask p -> ask_peer peer p 
     | _ -> failwith "Big problem"
   in
-    
-    SlotArray.filter_peers is_active peer.slots;
-    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 > 2 then 
-      let (a,b) = ask_root root peer in
-        if a then begin
-          SlotArray.accept (Peer root) peer.slots;
-          SlotArray.append_asks b peer.slots
-        end
-        else
-          SlotArray.append_asks b peer.slots
-            
+
+  SlutArray.filter_peers is_active peer.slots;
+  SlutArray.iter_asks aux peer.slots;
+  let free_slots = SlutArray.capacity peer.slots - SlutArray.length peer.slots
+    - SlutArray.asks peer.slots in
+  if free_slots > 2 then 
+    let (a,b) = ask_ruut root peer in
+    if a then begin
+      SlutArray.accept (Peer root) peer.slots;
+      SlutArray.append_asks b peer.slots
+    end
+    else
+      SlutArray.append_asks b peer.slots
+        
 let do_server root = 
-  SlotArray.filter_peers is_active root.slots
+  SlutArray.filter_peers is_active root.slots
   
+
+
+
+
diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml
index 12d3597..61f45a6 100644
--- a/sources/thibaut/pacemaker.ml
+++ b/sources/thibaut/pacemaker.ml
@@ -1,5 +1,5 @@
 open Globals
-open SlotArray
+open SlutArray
 
 exception Found of int HashMap.t
 
@@ -44,7 +44,7 @@ let server_init_seed peer round duration =
       round = round;
       content = Seed (data.seed, data.duration)
     } in
-      SlotArray.iter (send_message message) peer.slots
+      SlutArray.iter (send_message message) peer.slots
 	
 let server_init_pulse peer round = 
   let data = RoundMap.find round peer.rounds_data in
@@ -54,7 +54,7 @@ let server_init_pulse peer round =
       round = round;
       content = Pulse (data.seed, [data.hmap])
     } in
-      SlotArray.iter (send_message message) peer.slots
+      SlutArray.iter (send_message message) peer.slots
 
 exception Found
 
@@ -83,7 +83,7 @@ let process_message oc current_round peer m =
 	      content = Seed(seed, duration)
 	    } in            
 	      peer_init_round peer m.round seed duration;
-	      SlotArray.iter (send_message message) peer.slots
+	      SlutArray.iter (send_message message) peer.slots
       | SeedReply(hash) ->
           begin try
             let data = RoundMap.find m.round peer.rounds_data in
@@ -115,7 +115,7 @@ let process_message oc current_round peer m =
 				  peer.id current_round;
 				peer.nproofs <- peer.nproofs + 1
 			      end;
-		              SlotArray.iter (send_message message) peer.slots;
+		              SlutArray.iter (send_message message) peer.slots;
 		              (*peer.history <- RoundMap.add m.round 
 				(seed, branch2) peer.history;*)
 		      with
@@ -137,7 +137,7 @@ let do_peer oc current_round peer =
             round = round;
             content = SeedReply(hash)
           } in
-            SlotArray.iter (send_message message) peer.slots;
+            SlutArray.iter (send_message message) peer.slots;
       end
     in
       RoundMap.iter_limit aux (current_round - 2) peer.rounds_data;
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index e69ffca..6f31b46 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -79,7 +79,7 @@ let peers = Array.init npeers
      let p = {
        id = i;
        con_state = if i = 0 then ON else OFF;
-       slots = SlotArray.make (if i> 0 then !degree else 2*(!degree));
+       slots = SlutArray.make (if i> 0 then !degree else 2*(!degree));
        rounds_data = RoundMap.empty;
        messages = Queue.create();
        history = RoundMap.empty;
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index e7a6e06..e05e15c 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -57,7 +57,7 @@ let read_info ic =
     npeers, ndays
 
 let disconnect oc round peer =
-  SlotArray.clear peer.Globals.slots;
+  SlutArray.clear peer.Globals.slots;
   let duration = round - peer.connection_time in
   if duration > 0 then
     Printf.fprintf oc "%d %d %d\n" peer.Globals.id duration peer.nproofs;