diff --git a/src/icmp/dune b/src/icmp/dune index 7883cf4b..96ef347c 100644 --- a/src/icmp/dune +++ b/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)) diff --git a/src/icmp/icmpv4.ml b/src/icmp/icmpv4.ml index 7ff0c765..44e88dfb 100644 --- a/src/icmp/icmpv4.ml +++ b/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 -> diff --git a/src/tcp/dune b/src/tcp/dune index 084749bf..4ebec055 100644 --- a/src/tcp/dune +++ b/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 diff --git a/src/tcp/flow.ml b/src/tcp/flow.ml index 24b2f596..e644ab1c 100644 --- a/src/tcp/flow.ml +++ b/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]. \ diff --git a/src/tcp/stats.ml b/src/tcp/stats.ml index 5563f870..79ba89e2 100644 --- a/src/tcp/stats.ml +++ b/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,10 +54,10 @@ 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 @@ -71,23 +65,19 @@ let metrics = 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 () diff --git a/src/tcp/stats.mli b/src/tcp/stats.mli index c9ab29a3..25d824a2 100644 --- a/src/tcp/stats.mli +++ b/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; diff --git a/src/tcp/user_buffer.ml b/src/tcp/user_buffer.ml index 4ef00221..cc95d25c 100644 --- a/src/tcp/user_buffer.ml +++ b/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 () -> diff --git a/src/tcp/window.ml b/src/tcp/window.ml index 7b7ca3cb..c11154d0 100644 --- a/src/tcp/window.ml +++ b/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 diff --git a/src/tcp/wire.ml b/src/tcp/wire.ml index f50805cc..cc46e7b5 100644 --- a/src/tcp/wire.ml +++ b/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 diff --git a/tcpip.opam b/tcpip.opam index d6a9f521..b2683c98 100644 --- a/tcpip.opam +++ b/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" diff --git a/test/dune b/test/dune index b6d15a43..4315ca3e 100644 --- a/test/dune +++ b/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