Merge pull request mirage#504 from hannesm/no-mirage-profile

remove mirage-profile dependency

src/icmp/dune

@@ -3,7 +3,7 @@
  (public_name tcpip.icmpv4)
  (instrumentation
   (backend bisect_ppx))
- (libraries logs tcpip mirage-profile ipaddr tcpip.checksum)
+ (libraries logs tcpip ipaddr tcpip.checksum)
  (preprocess
   (pps ppx_cstruct))
  (wrapped false))

src/icmp/icmpv4.ml

@@ -42,7 +42,6 @@ module Make (IP : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) = struct
 
   let input t ~src ~dst:_ buf =
     let open Icmpv4_packet in
-    MProf.Trace.label "icmp_input";
     match Unmarshal.of_cstruct buf with
     | Error s ->
       Log.info (fun f ->

src/tcp/dune

@@ -3,7 +3,7 @@
  (public_name tcpip.tcp)
  (instrumentation
   (backend bisect_ppx))
- (libraries logs ipaddr cstruct lwt-dllist mirage-profile tcpip.checksum
+ (libraries logs ipaddr cstruct lwt-dllist tcpip.checksum
    tcpip duration randomconv fmt mirage-time mirage-clock mirage-random
    mirage-flow metrics)
  (preprocess

src/tcp/flow.ml

@@ -342,18 +342,18 @@ struct
         ~tx_isn
     in
     (* When we transmit an ACK for a received segment, rx_ack is written to *)
-    let rx_ack = MProf.Trace.named_mvar_empty "rx_ack" in
+    let rx_ack = Lwt_mvar.create_empty () in
     (* When we receive an ACK for a transmitted segment, tx_ack is written to *)
-    let tx_ack = MProf.Trace.named_mvar_empty "tx_ack" in
+    let tx_ack = Lwt_mvar.create_empty () in
     (* When new data is received, rx_data is written to *)
-    let rx_data = MProf.Trace.named_mvar_empty "rx_data" in
+    let rx_data = Lwt_mvar.create_empty () in
     (* Write to this mvar to transmit an empty ACK to the remote side *)
-    let send_ack = MProf.Trace.named_mvar_empty "send_ack" in
+    let send_ack = Lwt_mvar.create_empty () in
     (* The user application receive buffer and close notification *)
     let rx_buf_size = Window.rx_wnd wnd in
     let urx = User_buffer.Rx.create ~max_size:rx_buf_size ~wnd in
     (* The window handling thread *)
-    let tx_wnd_update = MProf.Trace.named_mvar_empty "tx_wnd_update" in
+    let tx_wnd_update = Lwt_mvar.create_empty () in
     (* Set up transmit and receive queues *)
     let on_close () = clearpcb t id tx_isn in
     let state =
@@ -696,7 +696,7 @@ struct
       Options.MSS (Ip.mtu t.ip ~dst - Tcp_wire.sizeof_tcp) :: Options.Window_size_shift rx_wnd_scaleoffer :: []
     in
     let window = 5840 in
-    let th, wakener = MProf.Trace.named_task "TCP connect" in
+    let th, wakener = Lwt.wait () in
     if Hashtbl.mem t.connects id then (
       Log.debug (fun f ->
           f "duplicate attempt to make a connection: [%a]. \

src/tcp/stats.ml

@@ -38,17 +38,11 @@ module Gc = struct
 
 end
 
-type counter = MProf.Counter.t
-
-let value = MProf.Counter.value
-
-let pp_counter fmt t = Format.fprintf fmt "%d" (value t)
-
 type t = {
-  tcp_listens : counter;
-  tcp_channels: counter;
-  tcp_connects: counter;
-  tcp_timers  : counter;
+  mutable tcp_listens : int;
+  mutable tcp_channels: int;
+  mutable tcp_connects: int;
+  mutable tcp_timers  : int;
   mutable total_established : int;
   mutable total_passive_connections : int;
   mutable total_active_connections : int;
@@ -60,34 +54,30 @@ let metrics =
   let doc = "TCP metrics" in
   let data t =
     Data.v
-      [ int "syn-rcvd state" (MProf.Counter.value t.tcp_listens)
-      ; int "established state" (MProf.Counter.value t.tcp_channels)
-      ; int "client connections" (MProf.Counter.value t.tcp_connects)
-      ; int "timers" (MProf.Counter.value t.tcp_timers)
+      [ int "syn-rcvd state" t.tcp_listens
+      ; int "established state" t.tcp_channels
+      ; int "client connections" t.tcp_connects
+      ; int "timers" t.tcp_timers
       ; int "total timers" t.total_timers
       ; int "total established" t.total_established
       ; int "total syn-rcvd" t.total_passive_connections
       ; int "total client" t.total_active_connections ]
   in
   Src.v ~doc ~tags:Metrics.Tags.[] ~data "tcp"
 
-let pp fmt t = Format.fprintf fmt "[%a|%a|%a|%a%a]"
-    pp_counter t.tcp_timers
-    pp_counter t.tcp_listens
-    pp_counter t.tcp_channels
-    pp_counter t.tcp_connects
+let pp fmt t = Format.fprintf fmt "[%d|%d|%d|%d%a]"
+    t.tcp_timers
+    t.tcp_listens
+    t.tcp_channels
+    t.tcp_connects
     Gc.pp ()
 
-let incr r = MProf.Counter.increase r 1
-let decr r = MProf.Counter.increase r (-1)
-
 let singleton =
-  let make name = MProf.Counter.create ~name () in
   {
-    tcp_listens = make "Tcp.listens";
-    tcp_channels = make "Tcp.channels";
-    tcp_connects = make "Tcp.connects";
-    tcp_timers = make "Tcp.timers";
+    tcp_listens = 0;
+    tcp_channels = 0;
+    tcp_connects = 0;
+    tcp_timers = 0;
     total_timers = 0;
     total_established = 0;
     total_passive_connections = 0;
@@ -98,26 +88,34 @@ let metrics () =
   Metrics.add metrics (fun x -> x) (fun d -> d singleton)
 
 let incr_listen () =
-  incr singleton.tcp_listens;
+  singleton.tcp_listens <- succ singleton.tcp_listens;
   singleton.total_passive_connections <- succ singleton.total_passive_connections;
   metrics ()
-let decr_listen () = decr singleton.tcp_listens; metrics ()
+let decr_listen () =
+  singleton.tcp_listens <- pred singleton.tcp_listens;
+  metrics ()
 
 let incr_channel () =
-  incr singleton.tcp_channels;
+  singleton.tcp_channels <- succ singleton.tcp_channels;
   singleton.total_established <- succ singleton.total_established;
   metrics ()
-let decr_channel () = decr singleton.tcp_channels; metrics ()
+let decr_channel () =
+  singleton.tcp_channels <- pred singleton.tcp_channels;
+  metrics ()
 
 let incr_connect () =
-  incr singleton.tcp_connects;
+  singleton.tcp_connects <- succ singleton.tcp_connects;
   singleton.total_active_connections <- succ singleton.total_active_connections;
   metrics ()
-let decr_connect () = decr singleton.tcp_connects; metrics ()
+let decr_connect () =
+  singleton.tcp_connects <- pred singleton.tcp_connects;
+  metrics ()
 
 let incr_timer () =
-  incr singleton.tcp_timers;
+  singleton.tcp_timers <- succ singleton.tcp_timers;
   singleton.total_timers <- succ singleton.total_timers;
   metrics ()
-let decr_timer () = decr singleton.tcp_timers; metrics ()
+let decr_timer () =
+  singleton.tcp_timers <- pred singleton.tcp_timers;
+  metrics ()
 

src/tcp/stats.mli

@@ -16,17 +16,11 @@
 
 (** TCP Statistics *)
 
-type counter
-(** The type for counters. *)
-
-val value: counter -> int
-(** The counter value. [value t] is [{!incr} t] - [{!decrs} t].*)
-
 type t = {
-  tcp_listens : counter;
-  tcp_channels: counter;
-  tcp_connects: counter;
-  tcp_timers  : counter;
+  mutable tcp_listens : int;
+  mutable tcp_channels: int;
+  mutable tcp_connects: int;
+  mutable tcp_timers  : int;
   mutable total_established : int;
   mutable total_passive_connections : int;
   mutable total_active_connections : int;

src/tcp/user_buffer.ml

@@ -61,7 +61,7 @@ module Rx = struct
 
   let add_r t s =
     if t.cur_size > t.max_size then
-      let th,u = MProf.Trace.named_task "User_buffer.add_r" in
+      let th,u = Lwt.wait () in
       let node = Lwt_dllist.add_r u t.writers in
       Lwt.on_cancel th (fun _ -> Lwt_dllist.remove node);
       (* Update size before blocking, which may push cur_size above max_size *)
@@ -80,7 +80,7 @@ module Rx = struct
 
   let take_l t =
     if Lwt_dllist.is_empty t.q then begin
-      let th,u = MProf.Trace.named_task "User_buffer.take_l" in
+      let th,u = Lwt.wait () in
       let node = Lwt_dllist.add_r u t.readers in
       Lwt.on_cancel th (fun _ -> Lwt_dllist.remove node);
       th
@@ -154,7 +154,7 @@ module Tx(Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) = struct
       Lwt.return_unit
     end
     else begin
-      let th,u = MProf.Trace.named_task "User_buffer.wait_for" in
+      let th,u = Lwt.wait () in
       let node = Lwt_dllist.add_r u t.writers in
       Lwt.on_cancel th (fun _ -> Lwt_dllist.remove node);
       th >>= fun () ->
@@ -169,7 +169,7 @@ module Tx(Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) = struct
       Lwt.return_unit
     end
     else begin
-      let th,u = MProf.Trace.named_task "User_buffer.wait_for_flushed" in
+      let th,u = Lwt.wait () in
       let node = Lwt_dllist.add_r u t.writers in
       Lwt.on_cancel th (fun _ -> Lwt_dllist.remove node);
       th >>= fun () ->

src/tcp/window.ml

@@ -56,8 +56,6 @@ type t = {
   mutable backoff_count: int;
 }
 
-let count_ackd_segs = MProf.Counter.make ~name:"tcp-ackd-segs"
-
 (* To string for debugging *)
 let pp fmt t =
   Format.fprintf fmt
@@ -133,7 +131,6 @@ let ack_win t = t.ack_win
 
 let set_ack_serviced t v = t.ack_serviced <- v
 let set_ack_seq_win t s w =
-  MProf.Counter.increase count_ackd_segs (Sequence.(sub s t.ack_seq |> to_int));
   t.ack_seq <- s;
   t.ack_win <- w
 

src/tcp/wire.ml

@@ -18,8 +18,6 @@ open Lwt.Infix
 let src = Logs.Src.create "tcp.wire" ~doc:"Mirage TCP Wire module"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-let count_tcp_to_ip = MProf.Counter.make ~name:"tcp-to-ip"
-
 module Make (Ip : Tcpip.Ip.S) = struct
 
   type error = Tcpip.Ip.error
@@ -71,8 +69,6 @@ module Make (Ip : Tcpip.Ip.S) = struct
              frame and drop the payload.. oops *)
       | Ok l ->
         Cstruct.blit payload 0 buf l (Cstruct.length payload) ;
-        MProf.Counter.increase count_tcp_to_ip
-          (Cstruct.length payload + if syn then 1 else 0) ;
         tcp_size
     in
     Ip.write ip ~fragment:false ~src dst `TCP ~size:tcp_size fill_buffer [] >|= function

tcpip.opam

@@ -37,7 +37,6 @@ depends: [
   "ipaddr" {>= "5.0.0"}
   "macaddr" {>="4.0.0"}
   "macaddr-cstruct"
-  "mirage-profile" {>= "0.5"}
   "fmt" {>= "0.8.7"}
   "lwt" {>= "4.0.0"}
   "lwt-dllist"

test/dune

@@ -1,6 +1,6 @@
 (test
  (name test)
- (libraries alcotest mirage-random-test lwt.unix logs logs.fmt mirage-profile
+ (libraries alcotest mirage-random-test lwt.unix logs logs.fmt
    mirage-flow mirage-vnetif mirage-clock-unix pcap-format duration
    mirage-random arp arp.mirage ethernet tcpip.ipv4 tcpip.tcp tcpip.udp
    tcpip.stack-direct tcpip.icmpv4 tcpip.udpv4v6-socket tcpip.tcpv4v6-socket