remove memory management code not needed anymore

client_net.ml

@@ -29,7 +29,6 @@ let writev eth dst proto fillfn =
 class client_iface eth ~domid ~gateway_ip ~client_ip client_mac : client_link =
   let log_header = Fmt.str "dom%d:%a" domid Ipaddr.V4.pp client_ip in
   object
-    val queue = FrameQ.create (Ipaddr.V4.to_string client_ip)
     val mutable rules = []
     method get_rules = rules
     method set_rules new_db = rules <- Dao.read_rules new_db client_ip
@@ -38,9 +37,7 @@ class client_iface eth ~domid ~gateway_ip ~client_ip client_mac : client_link =
     method my_ip = gateway_ip
     method other_ip = client_ip
     method writev proto fillfn =
-      FrameQ.send queue (fun () ->
-          writev eth client_mac proto fillfn
-        )
+        writev eth client_mac proto fillfn
     method log_header = log_header
   end
 

firewall.ml

@@ -83,16 +83,8 @@ let apply_rules t (rules : ('a, 'b) Packet.t -> Packet.action Lwt.t) ~dst (annot
       Log.debug (fun f -> f "Dropped packet (%s) %a" reason Nat_packet.pp packet);
       Lwt.return_unit
 
-let handle_low_memory t =
-  match Memory_pressure.status () with
-  | `Memory_critical -> (* TODO: should happen before copying and async *)
-      Log.warn (fun f -> f "Memory low - dropping packet and resetting NAT table");
-      My_nat.reset t.Router.nat t.Router.ports >|= fun () ->
-      `Memory_critical
-  | `Ok -> Lwt.return `Ok
-
 let ipv4_from_client resolver dns_servers t ~src packet =
-  handle_low_memory t >>= function
+  match Memory_pressure.status () with
   | `Memory_critical -> Lwt.return_unit
   | `Ok ->
   (* Check for existing NAT entry for this packet *)
@@ -107,7 +99,7 @@ let ipv4_from_client resolver dns_servers t ~src packet =
   | Some firewall_packet -> apply_rules t (Rules.from_client resolver dns_servers) ~dst firewall_packet
 
 let ipv4_from_netvm t packet =
-  handle_low_memory t >>= function
+  match Memory_pressure.status () with
   | `Memory_critical -> Lwt.return_unit
   | `Ok ->
   let `IPv4 (ip, _transport) = packet in

frameQ.ml

@@ -1,32 +0,0 @@
-(* 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 }
-
-(* Note: the queue is only used if we already filled the transmit buffer. *)
-let max_qlen = 10
-
-let send q fn =
-  if q.items = max_qlen then (
-    Log.warn (fun f -> f "Maximum queue length exceeded for %s: dropping frame" q.name);
-    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
-  )

frameQ.mli

@@ -1,15 +0,0 @@
-(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
-   See the README file for details. *)
-
-(** Keep track of the queue length for output buffers. *)
-
-type t
-
-val create : string -> t
-(** [create name] is a new empty queue. [name] is used in log messages. *)
-
-val send : t -> (unit -> unit Lwt.t) -> unit Lwt.t
-(** [send t fn] checks that the queue isn't overloaded and calls [fn ()] if it's OK.
-    The item is considered to be queued until the result of [fn] has resolved.
-    In the case of mirage-net-xen's [writev], this happens when the frame has been
-    added to the ring (not when it is consumed), which is fine for us. *)

memory_pressure.ml

@@ -54,7 +54,6 @@ let print_mem_usage =
 let init () =
   Gc.full_major ();
   let stats = Xen_os.Memory.quick_stat () in
-  print_mem_usage ;
   report_mem_usage stats
 
 let status () =

uplink.ml

@@ -25,15 +25,12 @@ module Make (R:Mirage_random.S) (Clock : Mirage_clock.MCLOCK) (Time : Mirage_tim
   }
 
 class netvm_iface eth mac ~my_ip ~other_ip : interface = object
-  val queue = FrameQ.create (Ipaddr.V4.to_string other_ip)
   method my_mac = Eth.mac eth
   method my_ip = my_ip
   method other_ip = other_ip
   method writev ethertype fillfn =
-    FrameQ.send queue (fun () ->
-      mac >>= fun dst ->
-      Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error
-    )
+    mac >>= fun dst ->
+    Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error
 end
 
   let send_dns_client_query t ~src_port ~dst ~dst_port buf =