Fix shm pool memory leak: eagerly unmap bigarrays via per-mapping ref counting

clear_mapping destroyed the host pool but never munmap'd the two bigarrays
(client_memory_pool and host_memory_pool). Since bigarrays live outside the
OCaml heap they create no GC pressure and accumulate indefinitely, eventually
OOMing the process.

Each mapping now tracks its own ref_count (incremented when a buffer's lazy
data is forced, decremented on buffer destroy) and a detached flag (set when
the mapping is removed from the pool). When both conditions are met
(detached && ref_count = 0), both bigarrays are immediately unmapped. This
handles both the resize case (old mapping kept alive until last old buffer is
destroyed) and the final pool destruction case (unmapped immediately if no
forced buffers exist).

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

relay.ml

@@ -283,8 +283,23 @@ end = struct
     host_pool : [`V1|`V2] H.Wl_shm_pool.t;
     client_memory_pool : Cstruct.buffer;   (* The client's memory mapped into our address space *)
     host_memory_pool : Cstruct.buffer;     (* The host's memory mapped into our address space *)
+    mutable ref_count : int;               (* Number of forced buffers using this mapping *)
+    mutable detached : bool;               (* True once removed from t.mapping *)
   }
 
+  let unmap_mapping m =
+    Virtio_gpu.Utils.unmap (Bigarray.genarray_of_array1 m.host_memory_pool);
+    Virtio_gpu.Utils.unmap (Bigarray.genarray_of_array1 m.client_memory_pool)
+
+  let maybe_unmap_mapping m =
+    if m.detached && m.ref_count = 0 then
+      unmap_mapping m
+
+  let mapping_dec_ref m =
+    assert (m.ref_count > 0);
+    m.ref_count <- m.ref_count - 1;
+    maybe_unmap_mapping m
+
   type t = {
     host_shm : [`V1|`V2] H.Wl_shm.t;
     virtio_gpu : Virtio_gpu.t;
@@ -329,7 +344,7 @@ end = struct
           )
       in
       let client_memory_pool = Bigarray.array1_of_genarray client_memory_pool in
-      let m = { host_pool; client_memory_pool; host_memory_pool } in
+      let m = { host_pool; client_memory_pool; host_memory_pool; ref_count = 0; detached = false } in
       t.mapping <- Some m;
       m
 
@@ -344,6 +359,8 @@ end = struct
     t.mapping |> Option.iter (fun m ->
         if Proxy.transport_up m.host_pool then
           H.Wl_shm_pool.destroy m.host_pool;
+        m.detached <- true;
+        maybe_unmap_mapping m;
         t.mapping <- None
       )
 
@@ -366,12 +383,15 @@ end = struct
     assert (t.ref_count > 0);   (* The shm_pool proxy must exist to call this. *)
     t.ref_count <- t.ref_count + 1;
     Proxy.on_delete buffer (fun () -> dec_ref t);
+    let mapping_used = ref None in
     let data =
       lazy (
         (* Forced by [map_buffer] when the the buffer is attached to a surface,
            so buffer proxy still exists. *)
         let len = Int32.to_int height * Int32.to_int stride in
         let mapping = get_mapping t in
+        mapping.ref_count <- mapping.ref_count + 1;
+        mapping_used := Some mapping;
         let host_memory = Cstruct.of_bigarray mapping.host_memory_pool ~off:(Int32.to_int offset) ~len in
         let client_memory = Cstruct.of_bigarray mapping.client_memory_pool ~off:(Int32.to_int offset) ~len in
         let host_buffer =
@@ -379,13 +399,14 @@ end = struct
           @@ object
             inherit [_] H.Wl_buffer.v1
             method on_release _ = C.Wl_buffer.release buffer
-          end 
+          end
         in
         { CD.host_memory; client_memory; host_buffer }
       )
     in
     let on_destroy = lazy (
       if Lazy.is_val data then (
+        (match !mapping_used with Some m -> mapping_dec_ref m | None -> ());
         delete_with H.Wl_buffer.destroy (Lazy.force data).host_buffer buffer
       ) else (
         Proxy.delete buffer