From e9b965a2d29c49b0493809aec851792f54d42a3c Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Mon, 21 Dec 2020 15:36:25 +0100
Subject: [PATCH] record memory metrics as well

---
 monitoring-experiments.opam   |  4 ++--
 src/monitoring_experiments.ml | 14 ++++++++++++++
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/monitoring-experiments.opam b/monitoring-experiments.opam
index 23e0975..af52d22 100644
--- a/monitoring-experiments.opam
+++ b/monitoring-experiments.opam
@@ -17,9 +17,9 @@ depends: [
   "mirage-clock" {>= "3.0.0"}
   "mirage-time" {>= "2.0.0"}
   "mirage-stack" {>= "2.2.0"}
-  "tcpip" {>= "5.0.99"}
+  "tcpip" {>= "6.0.99"}
   "mirage-net-solo5" {>= "0.6.2"}
-  "mirage-solo5" {>= "0.6.3"}
+  "mirage-solo5" {>= "0.6.4"}
   "ocaml-freestanding" {>= "0.4.5"}
   "bheap"
 ]
diff --git a/src/monitoring_experiments.ml b/src/monitoring_experiments.ml
index 6f2eabf..e782f09 100644
--- a/src/monitoring_experiments.ml
+++ b/src/monitoring_experiments.ml
@@ -29,6 +29,19 @@ let counter_metrics ~f name =
 
 let vmname = Metrics.field ~doc:"name of the virtual machine" "vm" Metrics.String
 
+let memory_metrics ~tags =
+  let open Metrics in
+  let doc = "Memory counters" in
+  let data () =
+    let stat = OS.Memory.quick_stat () in
+    Data.v
+      [ uint "memory heap words" stat.heap_words
+      ; uint "memory live words" stat.live_words
+      ; uint "memory stack words" stat.stack_words
+      ; uint "memory free words" stat.free_words ]
+  in
+  Src.v ~doc ~tags ~data "memory"
+
 module Make (T : Mirage_time.S) (S : Mirage_stack.V4V6) = struct
 
   let timer conn get host stack dst =
@@ -79,6 +92,7 @@ module Make (T : Mirage_time.S) (S : Mirage_stack.V4V6) = struct
     Metrics.enable_all ();
     Metrics_lwt.init_periodic (fun () -> T.sleep_ns (Duration.of_sec interval));
     Metrics_lwt.periodically (OS.MM.malloc_metrics ~tags:Metrics.Tags.[]);
+    Metrics_lwt.periodically (memory_metrics ~tags:Metrics.Tags.[]);
     let host = match hostname with None -> [] | Some host -> [vmname host] in
     Lwt.async (timer_loop get_cache host interval stack (dst, port))
 end