Merge pull request #17514 from MinaProtocol/lyh/revamp-reuse-lmdb-keys

LMDB Cache: partially reuse GCed IDs so to save cycles on cleaning LMDB V2

Author: glyh

src/lib/disk_cache/lmdb/disk_cache.ml

@@ -20,39 +20,61 @@ module Make (Data : Binable.S) = struct
     { env : Rw.t
     ; db : Rw.holder
     ; counter : int ref
-    ; garbage : int Hash_set.t
-          (** A list of ids that are no longer reachable from OCaml's side *)
+    ; reusable_keys : int Queue.t
+          (** A list of ids that are no longer reachable from OCaml runtime, but
+              haven't been cleared inside the LMDB disk cache *)
+    ; queue_guard : Error_checking_mutex.t
     }
 
-  (** How big can the above hashset be before we do a cleanup *)
-  let garbage_size_limit = 512
+  (** How big can the queue [reusable_keys] be before we do a cleanup *)
+  let reuse_size_limit = 512
 
   let initialize path ~logger =
     Async.Deferred.Result.map (Disk_cache_utils.initialize_dir path ~logger)
       ~f:(fun path ->
         let env, db = Rw.create path in
-        { env; db; counter = ref 0; garbage = Hash_set.create (module Int) } )
+        { env
+        ; db
+        ; counter = ref 0
+        ; reusable_keys = Queue.create ()
+        ; queue_guard = Error_checking_mutex.create ()
+        } )
 
   type id = { idx : int }
 
   let get ({ env; db; _ } : t) ({ idx } : id) : Data.t =
     Rw.get ~env db idx |> Option.value_exn
 
-  let put ({ env; db; counter; garbage } : t) (x : Data.t) : id =
-    (* TODO: we may reuse IDs by pulling them from the `garbage` hash set *)
-    let idx = !counter in
-    incr counter ;
+  let put ({ env; db; counter; reusable_keys; queue_guard } : t) (x : Data.t) :
+      id =
+    let idx =
+      match
+        Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
+            Queue.dequeue reusable_keys )
+      with
+      | None ->
+          (* We don't have reusable keys, assign a new one nobody ever used *)
+          incr counter ; !counter - 1
+      | Some reused_key ->
+          (* Any key inside [reusable_keys] is marked as garbage by GC, so we're
+             free to use them *)
+          reused_key
+    in
     let res = { idx } in
     (* When this reference is GC'd, delete the file. *)
     Gc.Expert.add_finalizer_last_exn res (fun () ->
         (* The actual deletion is delayed, as GC maybe triggered in LMDB's
            critical section. LMDB critical section then will be re-entered if
            it's invoked directly in a GC hook.
            This causes mutex double-acquiring and node freezes. *)
-        Hash_set.add garbage idx ) ;
-    if Hash_set.length garbage >= garbage_size_limit then (
-      Hash_set.iter garbage ~f:(fun to_remove -> Rw.remove ~env db to_remove) ;
-      Hash_set.clear garbage ) ;
+        Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
+            Queue.enqueue reusable_keys idx ) ) ;
+
+    Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
+        if Queue.length reusable_keys >= reuse_size_limit then (
+          Queue.iter reusable_keys ~f:(fun to_remove ->
+              Rw.remove ~env db to_remove ) ;
+          Queue.clear reusable_keys ) ) ;
     Rw.set ~env db idx x ;
     res