diff options
Diffstat (limited to 'sources')
| -rw-r--r-- | sources/thibaut/Makefile | 23 | ||||
| -rw-r--r-- | sources/thibaut/globals.ml | 11 | ||||
| -rw-r--r-- | sources/thibaut/graph.ml | 4 | ||||
| -rw-r--r-- | sources/thibaut/pacemaker.ml | 224 | ||||
| -rw-r--r-- | sources/thibaut/simulator.ml | 61 | ||||
| -rw-r--r-- | sources/thibaut/trace.ml | 6 |
6 files changed, 171 insertions, 158 deletions
diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile index 71c9568..37cc7e5 100644 --- a/sources/thibaut/Makefile +++ b/sources/thibaut/Makefile @@ -7,23 +7,30 @@ SRCS=map2.ml simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattra BUILDDIR=build DEPEND=.depend +.PHONY: gentrace.opt simulator.opt tracestats.opt all clean all: gentrace.opt simulator.opt tracestats.opt $(BUILDDIR): mkdir -p $(BUILDDIR) -tracestats.opt: $(BUILDDIR) tracestats.cmx - $(OCAMLOPT) -o $(BUILDDIR)/tracestats $(OCAMLFLAGS) unix.cmxa str.cmxa compattrace.cmx tracestats.cmx +tracestats.opt: $(BUILDDIR) $(BUILDDIR)/tracestats -gentrace.opt: $(BUILDDIR) gentrace.cmx - $(OCAMLOPT) -o $(BUILDDIR)/gentrace $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx pacemaker.cmx trace.cmx gentrace.cmx +$(BUILDDIR)/tracestats: tracestats.cmx + $(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa str.cmxa compattrace.cmx tracestats.cmx -simulator.opt : $(BUILDDIR) simulator.cmx - $(OCAMLOPT) -o $(BUILDDIR)/simulator $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx +gentrace.opt: $(BUILDDIR) $(BUILDDIR)/gentrace + +$(BUILDDIR)/gentrace: gentrace.cmx + $(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx pacemaker.cmx trace.cmx gentrace.cmx + +simulator.opt : $(BUILDDIR) $(BUILDDIR)/simulator + +$(BUILDDIR)/simulator: simulator.cmx + $(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx clean: - rm -f *.cm? *.cmx? *.o *~ - rm -f .depend + rm -f *.cm? *.cmx? *.o *~ *.annot + rm -f $(DEPEND) depend: $(SRCS) $(OCAMLDEP) $(SRCS) > $(DEPEND) diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml index aa54778..58f2421 100644 --- a/sources/thibaut/globals.ml +++ b/sources/thibaut/globals.ml @@ -94,8 +94,7 @@ type round_data = { duration : int; seed : int; mutable hmap : int HashMap.t; - mutable included : int; - mutable replies : (int * int HashMap.t) list + replies : (int * int HashMap.t) Queue.t } module SlotArray : sig @@ -249,11 +248,15 @@ type peer = { } and slot = peer SlotArray.slot -let disconnect peer = +let disconnect oc round peer = SlotArray.clear peer.slots; peer.con_state <- OFF; - peer.distance <- -1 + peer.distance <- -1; + if (round-peer.connection_time) > 0 then + Printf.fprintf oc "%d %d\n%!" peer.id + (round-peer.connection_time) + let swap a pos1 pos2 = let temp = a.(pos1) in a.(pos1) <- a.(pos2); diff --git a/sources/thibaut/graph.ml b/sources/thibaut/graph.ml index 0c31532..da2652c 100644 --- a/sources/thibaut/graph.ml +++ b/sources/thibaut/graph.ml @@ -15,7 +15,7 @@ let find_peer id peers = (* compute distances from root *) let update_distances peers tracking_array = - let n = Array.length peers in + let n = Array.length peers in let visited = Array.make n false in let queue = Queue.create() in visited.(0) <- true; @@ -50,6 +50,6 @@ let repart round peers = incr old done; result, !old - + diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml index 7534f66..26c30dc 100644 --- a/sources/thibaut/pacemaker.ml +++ b/sources/thibaut/pacemaker.ml @@ -1,142 +1,140 @@ open Globals open SlotArray +exception Found of int HashMap.t + let find_reply hash replies = - let rec aux n replies = match replies with - | [] -> raise Not_found - | h::t -> let (a,b) = h in - if a = hash then n,b - else aux (n+1) t - in - aux 1 replies + try + while not (Queue.is_empty replies) do + let a,b = Queue.pop replies in + if a = hash then + raise (Found b) + done; + raise Not_found + with + Found b -> b let peer_init_round peer round seed duration = - let data = { - phase = SEEDING; - duration = duration; - seed = seed; - hmap = HashMap.add peer.id (Hashtbl.hash seed) HashMap.empty; - included = 0; - replies = [] - } in + let data = { + phase = SEEDING; + duration = duration; + seed = seed; + hmap = HashMap.add peer.id (Hashtbl.hash seed) HashMap.empty; + replies = Queue.create() + } 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 -> incr messages; Queue.push message peer.messages - | _ -> failwith "Big problem" + | Peer peer -> incr messages; Queue.push message peer.messages + | _ -> failwith "Big problem" let server_init_seed peer round duration = - let data = { - phase = SEEDING; - duration = duration; - seed = Random.int (1 lsl 29); - hmap = HashMap.empty; - included = 0; - replies = [] - } in + let data = { + phase = SEEDING; + duration = duration; + seed = Random.int (1 lsl 29); + hmap = HashMap.empty; + replies = Queue.create () + } in peer.rounds_data <- RoundMap.add round data peer.rounds_data; let message = { - sender = peer.id; - round = round; - content = Seed (data.seed, data.duration) + sender = peer.id; + round = round; + content = Seed (data.seed, data.duration) } in - SlotArray.iter (send_message message) peer.slots - + SlotArray.iter (send_message message) peer.slots + let server_init_pulse peer round = - let data = RoundMap.find round peer.rounds_data in + let data = RoundMap.find round peer.rounds_data in data.phase <- IDLE; let message = { - sender = peer.id; - round = round; - content = Pulse (data.seed, [data.hmap]) + sender = peer.id; + round = round; + content = Pulse (data.seed, [data.hmap]) } in - SlotArray.iter (send_message message) peer.slots - + SlotArray.iter (send_message message) peer.slots + let rec verify_branch branch = match branch with - | [] -> true - | [h] -> true - | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t) + | [] -> true + | [h] -> true + | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t) -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 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 - end - | SeedReply(hash) -> - begin try +let process_message oc current_round peer m = + if m.round >= (current_round - 2) then + match m.content with + | Seed(seed,duration) -> + if not (RoundMap.mem m.round peer.rounds_data) then + let message = { + sender = peer.id; + round = m.round; + content = Seed(seed, duration) + } in + peer_init_round peer m.round seed duration; + SlotArray.iter (send_message message) peer.slots + | SeedReply(hash) -> + begin try let data = RoundMap.find m.round peer.rounds_data in - if data.phase = SEEDING then + if data.phase = SEEDING then data.hmap <- HashMap.add m.sender hash data.hmap; - with - Not_found -> () - end - | Pulse(seed, branch) -> - begin try + with + Not_found -> () + end + | Pulse(seed, branch) -> + begin try let data = RoundMap.find m.round peer.rounds_data in - 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 + if data.phase = SEEDING || data.phase = PULSE then + match branch with + | [] -> () + | h::t -> + try + let hash = HashMap.find peer.id h in + let hmap = find_reply hash data.replies in + if verify_branch branch then + let branch2 = hmap::branch in + let message = { + sender = peer.id; + round = m.round; + content = Pulse(seed, branch2) + } in + data.phase <- PULSE; + SlotArray.iter (send_message message) peer.slots; + peer.history <- RoundMap.add m.round + (seed, branch2) peer.history; + Printf.fprintf oc "%d %d %d\n" peer.id + peer.distance current_round + with + | Not_found -> () + with + Not_found -> () + end -let do_peer current_round peer = - Queue.iter (process_message current_round peer) peer.messages; - Queue.clear peer.messages; - try - let aux round data = - if data.phase = SEEDING then begin - let hash = Hashtbl.hash data.hmap in - data.replies <- (hash, data.hmap)::data.replies; - let message = { - sender = peer.id; - round = round; - content = SeedReply(Hashtbl.hash data.hmap) - } in - SlotArray.iter (send_message message) peer.slots; - end - in - 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 current_round peer = - let aux m = match m.content with - | SeedReply _ -> process_message current_round peer m - | _ -> () +let do_peer oc current_round peer = + Queue.iter (process_message oc current_round peer) peer.messages; + Queue.clear peer.messages; + try + let aux round data = + if data.phase = SEEDING then begin + let hash = Hashtbl.hash data.hmap in + Queue.push (hash, data.hmap) data.replies; + let message = { + sender = peer.id; + round = round; + content = SeedReply(Hashtbl.hash data.hmap) + } in + SlotArray.iter (send_message message) peer.slots; + end in + 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 oc current_round peer = + let aux m = match m.content with + | SeedReply _ -> process_message oc current_round peer m + | _ -> () + in Queue.iter aux peer.messages; Queue.clear peer.messages diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml index 5e4dfa8..0536a8c 100644 --- a/sources/thibaut/simulator.ml +++ b/sources/thibaut/simulator.ml @@ -5,8 +5,8 @@ open Graph let degree = ref 10 let tpm = ref 3 -let accuracy = ref 60 -let duration = ref 24 +let accuracy = ref 30 +let duration = ref 12 let seed = ref 0 let tracename = ref "" let datadir = ref "data" @@ -32,7 +32,7 @@ let anon = let usage = "usage: simul [OPTIONS] <tracefile>" let _ = - Printf.printf "Pacemaker simulator\n"; + Printf.printf "Pacemaker simulator\n%!"; if Array.length Sys.argv < 2 then begin Printf.eprintf "Error: Too few arguments\n"; Arg.usage arg_list usage; @@ -49,8 +49,9 @@ let _ = else if not (Sys.is_directory !datadir) then begin Printf.eprintf "%s is not a directory\n" !datadir; exit 1 - end - else if not (Sys.file_exists !outputdir) then + end; + + if not (Sys.file_exists !outputdir) then Unix.mkdir !outputdir 0o755 else if not (Sys.is_directory !outputdir) then begin Printf.eprintf "%s is not a directory\n" !outputdir; @@ -65,32 +66,44 @@ let _ = let ic = open_in !tracename let oc = open_out (Filename.concat !outputdir "rounds.data") +let mesh_oc = open_out (Filename.concat !outputdir "mesh.data") +let sessions_oc = open_out (Filename.concat !outputdir "simul_sessions.data") +let proofs_oc = open_out (Filename.concat !outputdir "proofs.data") + let npeers, days = Trace.read_info ic let peers = Array.init npeers (fun i -> let p = { id = i; - con_state = OFF; + con_state = if i = 0 then ON else 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 + connection_time = 0; } in p ) (* tracking array keeps track of the position of peer i in the peers array *) let tracking_array = Array.init npeers (fun i -> i) -let do_trace_round = Trace.read ic peers +let do_trace_round = Trace.read sessions_oc ic peers let nticks = (days)*24*60*(!tpm) let round = ref 0 let connected = ref 0 let _ = - Printf.fprintf oc "#minute connected messages asks askroots olds\n%!"; + Printf.fprintf oc "#minute connected messages asks askroots\n%!"; + Printf.fprintf mesh_oc "#minute connected old repart\n%!"; + Printf.fprintf sessions_oc "#id duration\n%!"; + Printf.fprintf proofs_oc "#id distance round\n%!"; + for i = 0 to (nticks-1) do + for i = 0 to 2 do + Printf.printf "%c" '\b' + done; + Printf.printf "%02d%%%!" ((i+1)*100/nticks); connected := 1; Pacemaker.messages := 0; if i mod !accuracy = 0 then begin @@ -107,45 +120,37 @@ let _ = let do_server root = Mesh.do_server root; - Pacemaker.do_server !round root + Pacemaker.do_server proofs_oc !round root in let do_peer p = if p.con_state = ON then begin Mesh.do_peer peers.(0) p; - Pacemaker.do_peer !round p; + Pacemaker.do_peer proofs_oc !round p; incr connected end in do_server peers.(0); random_iter do_peer peers tracking_array; - + update_distances peers tracking_array; + if i mod !tpm = 0 then begin - Printf.fprintf oc "%d %d %d %d %d " + Printf.fprintf oc "%d %d %d %d %d\n%!" (i/(!tpm)) !connected !Pacemaker.messages !Mesh.ask !Mesh.askroot; - update_distances peers tracking_array; let rep, old = repart (i/(!tpm)) peers in - Printf.fprintf oc "%d\n%!" old; + Printf.fprintf mesh_oc "%d %d %d " (i/(!tpm)) !connected old; for i = 0 to Array.length rep - 1 do - Printf.printf "%d, " rep.(i) + Printf.fprintf mesh_oc "%d " rep.(i) done; - print_newline (); - (*for i = 0 to (npeers-1) do - let p = peers.(i) in - if p.con_state = ON then begin - Printf.printf "%d: %d | " p.id p.distance; - SlotArray.iter (fun (SlotArray.Peer p) -> - Printf.printf "%d, " p.id ) p.slots; - print_newline () - end - done;*) - + Printf.fprintf mesh_oc "\n%!"; + Mesh.ask := 0; Mesh.askroot := 0; end - done + done; + print_newline (); diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml index a340edc..018831f 100644 --- a/sources/thibaut/trace.ml +++ b/sources/thibaut/trace.ml @@ -55,11 +55,11 @@ let read_info ic = in npeers, ndays -let read ic peers = +let read oc 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 + | Peer (i, avail, state) -> () (*peers.(i).con_state <- state*) | _ -> failwith "Not enough peers" done; @@ -74,7 +74,7 @@ let read ic peers = peers.(i).connection_time <- round; next round | Off i -> - disconnect peers.(i); + disconnect oc round peers.(i); next round | _ -> () |