summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--sources/thibaut/Makefile18
-rw-r--r--sources/thibaut/gentrace.ml14
-rw-r--r--sources/thibaut/globals.ml127
-rw-r--r--sources/thibaut/mesh.ml26
-rw-r--r--sources/thibaut/pacemaker.ml62
-rw-r--r--sources/thibaut/simulator.ml22
-rw-r--r--sources/thibaut/trace.ml3
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
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2025-12-21 18:13:51 +0000