2016-01-07 06:24:35 -05:00
|
|
|
(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
|
|
|
|
See the README file for details. *)
|
|
|
|
|
|
|
|
let src = Logs.Src.create "frameQ" ~doc:"Interface output queue"
|
|
|
|
module Log = (val Logs.src_log src : Logs.LOG)
|
|
|
|
|
|
|
|
type t = {
|
|
|
|
name : string;
|
|
|
|
mutable items : int;
|
|
|
|
}
|
|
|
|
|
|
|
|
let create name = { name; items = 0 }
|
2017-04-29 06:42:31 -04:00
|
|
|
|
|
|
|
(* Note: the queue is only used if we already filled the transmit buffer. *)
|
|
|
|
let max_qlen = 10
|
|
|
|
|
2016-01-07 06:24:35 -05:00
|
|
|
let send q fn =
|
2017-04-29 06:42:31 -04:00
|
|
|
if q.items = max_qlen then (
|
2019-03-17 18:42:05 -04:00
|
|
|
Log.warn (fun f -> f "Maximum queue length exceeded for %s: dropping frame" q.name);
|
2017-04-29 06:42:31 -04:00
|
|
|
Lwt.return_unit
|
|
|
|
) else (
|
|
|
|
let sent = fn () in
|
|
|
|
if Lwt.state sent = Lwt.Sleep then (
|
|
|
|
q.items <- q.items + 1;
|
|
|
|
Log.info (fun f -> f "Queue length for %s: incr to %d" q.name q.items);
|
|
|
|
Lwt.on_termination sent (fun () ->
|
|
|
|
q.items <- q.items - 1;
|
|
|
|
Log.info (fun f -> f "Queue length for %s: decr to %d" q.name q.items);
|
|
|
|
)
|
|
|
|
);
|
|
|
|
sent
|
|
|
|
)
|