on_first_conflict_pause: unit -> unit;
(* If config is set to use individual instead of aggregate conflict-rate-limiting,
- we use this instead of the queues. *)
- mutable n_paused: int;
+ we use these counts instead of the queues. The second one includes the first. *)
+ mutable n_paused: int; (* Number of domains with zero or negative credit *)
+ mutable n_penalised: int; (* Number of domains with less than maximum credit *)
}
let init eventchn on_first_conflict_pause = {
doms_with_conflict_penalty = Queue.create ();
on_first_conflict_pause = on_first_conflict_pause;
n_paused = 0;
+ n_penalised = 0;
}
let del doms id = Hashtbl.remove doms.table id
let exist doms id = Hashtbl.mem doms.table id
let number doms = Hashtbl.length doms.table
let iter doms fct = Hashtbl.iter (fun _ b -> fct b) doms.table
+let rec is_empty_queue q =
+ Queue.is_empty q ||
+ if !(Queue.peek q) = None
+ then (
+ ignore (Queue.pop q);
+ is_empty_queue q
+ ) else false
+
+let all_at_max_credit doms =
+ if !Define.conflict_rate_limit_is_aggregate
+ then
+ (* Check both becuase if burst limit is 1.0 then a domain can go straight
+ * from max-credit to paused without getting into the penalty queue. *)
+ is_empty_queue doms.doms_with_conflict_penalty
+ && is_empty_queue doms.doms_conflict_paused
+ else doms.n_penalised = 0
+
(* Functions to handle queues of domains given that the domain might be deleted while in a queue. *)
let push dom queue =
Queue.push (ref (Some dom)) queue
let before = dom.Domain.conflict_credit in
let after = max (-1.0) (before -. 1.0) in
dom.Domain.conflict_credit <- after;
+ let newly_penalised =
+ before >= !Define.conflict_burst_limit
+ && after < !Define.conflict_burst_limit in
+ let newly_paused = before > 0.0 && after <= 0.0 in
if !Define.conflict_rate_limit_is_aggregate then (
- if before >= !Define.conflict_burst_limit
- && after < !Define.conflict_burst_limit
+ if newly_penalised
&& after > 0.0
then (
push dom doms.doms_with_conflict_penalty
- ) else if before > 0.0 && after <= 0.0
+ ) else if newly_paused
then (
let first_pause = Queue.is_empty doms.doms_conflict_paused in
push dom doms.doms_conflict_paused;
) else (
(* The queues are correct already: no further action needed. *)
)
- ) else if before > 0.0 && after <= 0.0 then (
- doms.n_paused <- doms.n_paused + 1;
- if doms.n_paused = 1 then doms.on_first_conflict_pause ()
+ ) else (
+ if newly_penalised then doms.n_penalised <- doms.n_penalised + 1;
+ if newly_paused then (
+ doms.n_paused <- doms.n_paused + 1;
+ if doms.n_paused = 1 then doms.on_first_conflict_pause ()
+ )
)
(* Give one point of credit to one domain, and update the queues appropriately. *)
let before = dom.Domain.conflict_credit in
let after = min (before +. 1.0) !Define.conflict_burst_limit in
dom.Domain.conflict_credit <- after;
+
if before <= 0.0 && after > 0.0
- then doms.n_paused <- doms.n_paused - 1
+ then doms.n_paused <- doms.n_paused - 1;
+
+ if before < !Define.conflict_burst_limit
+ && after >= !Define.conflict_burst_limit
+ then doms.n_penalised <- doms.n_penalised - 1
in
- (* Scope for optimisation (probably tiny): avoid iteration if all domains are at max credit *)
- iter doms inc
+ if doms.n_penalised > 0 then iter doms inc
)