diff options
Diffstat (limited to 'sources')
| -rw-r--r-- | sources/thibaut/globals.ml | 27 | ||||
| -rw-r--r-- | sources/thibaut/mesh.ml | 54 | ||||
| -rw-r--r-- | sources/thibaut/trace.ml | 3 |
3 files changed, 62 insertions, 22 deletions
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml index d71ff34..a2b22a8 100644 --- a/sources/thibaut/globals.ml +++ b/sources/thibaut/globals.ml @@ -54,11 +54,13 @@ module SlotArray : sig val make : int -> 'a -> 'a t val full : 'a t -> bool val add : 'a t -> 'a -> unit - val remove : 'a t -> int -> unit + val remove : 'a t -> int -> 'a -> unit val random_peer : 'a t -> 'a - val clear : 'a t -> unit + val clear : 'a t -> 'a -> unit val map : ('a -> 'a) -> 'a t -> unit + val mapi : (int -> 'a -> 'a option) -> 'a t -> unit val iter : ('a -> unit) -> 'a t -> unit + val iteri : (int -> 'a -> unit) -> 'a t -> unit val mem : ('a -> bool) -> 'a t -> bool end = struct @@ -71,7 +73,11 @@ end = struct let full t = (t.length = t.capacity) - let clear t = t.length <- 0 + let clear t newelem = + for i = 0 to t.capacity-1 do + t.array.(i) <- newelem + done; + t.length <- 0 let make n elem = { length = 0; @@ -84,10 +90,11 @@ end = struct t.array.(length) <- p; t.length <- length + 1 - let remove t pos = + let remove t pos newelem = let tab = t.array in let length = (t.length-1) in tab.(pos) <- tab.(length); + tab.(length) <- newelem; t.length <- length let length t = t.length @@ -96,11 +103,23 @@ end = struct for i = 0 to t.capacity-1 do t.array.(i) <- f(t.array.(i)) done + + let mapi f t = + for i = 0 to t.capacity-1 do + match f i t.array.(i) with + | None -> () + | Some x -> t.array.(i) <- x + done let iter f t = for i = 0 to t.capacity-1 do f(t.array.(i)) done + + let iteri f t = + for i = 0 to t.capacity-1 do + f i (t.array.(i)) + done let mem pred sa = let found = ref false in diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml index a73a3bc..aba1c5e 100644 --- a/sources/thibaut/mesh.ml +++ b/sources/thibaut/mesh.ml @@ -2,25 +2,45 @@ 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 + Printf.printf "%d asking %d\n" peer.id p.id; + if p.con_state <> ON then AskRoot - else if not (SlotArray.full p.slots) then begin - SlotArray.add p.slots (Peer peer); - Peer p + else begin + 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" 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 + | Empty -> Some AskRoot + | AskRoot -> + begin match ask_peer peer peers.(0) with + | Peer p -> + if p.con_state = ON then begin + SlotArray.add peer.slots (Peer p); + None + end + else + Some AskRoot + | x -> Some x + end + | AskPeer p -> Some (ask_peer peer p) + | Peer p -> + if p.con_state <> ON then None + else begin + SlotArray.remove peer.slots i Empty; + None + end in - SlotArray.map aux peer.slots + SlotArray.mapi aux peer.slots diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml index 8d539ad..3276653 100644 --- a/sources/thibaut/trace.ml +++ b/sources/thibaut/trace.ml @@ -70,7 +70,8 @@ let read ic peers = match !event with | Round n -> if n = round then next round | On i -> peers.(i).con_state <- ON; next round - | Off i -> peers.(i).con_state <- OFF; next round + | Off i -> SlotArray.clear peers.(i).slots Empty; + peers.(i).con_state <- OFF; next round | _ -> () and next round = get_event(); read_round round in |