Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit 744b4d5b authored by François Bobot's avatar François Bobot
Browse files

hashweak : delayed the removing during hashweak garbage collection

parent f35238e8
......@@ -17,6 +17,39 @@
(* *)
module ProdConsume :
type 'a t
val create : unit -> 'a t
val add : 'a -> 'a t -> unit
val iter_remove : ('a -> unit) -> 'a t -> unit
= struct
(* One thing can produce, one thing can consume concurrently *)
type 'a cell =
| Empty
| Cons of 'a * 'a list
and 'a list = 'a cell ref
let rec iter f = function
| Empty -> ()
| Cons (x,l) -> f x; iter f !l
(* a reference on a mutable singly linked list *)
type 'a t = 'a list ref
let create () = ref (ref (Empty))
let add x t = t := ref (Cons(x,!t))
let iter_remove f t =
if !(!t) = Empty then () else
let r = !t in (* atomic one cell of the list *)
let l = !r in (* the content of the cell *)
r := Empty; (* Work even if there are some production,
just not anymore the head *)
iter f l
module type S = sig
type key
......@@ -124,19 +157,34 @@ module Make (S : Weakey) = struct
let tbl_final t = iterk (fun k -> Hashtbl.remove (tag_map k) t.tbl_tag) t
(** All the hashweak that can be collected. When a hashweak is
garbage collected we need to remove its tag from the key
hashtable. Since finalisation can be triggered at anytime even
when the key hashtable are in an inconsistent state, we need to
delay the actual removing until it can be done safely.
t_collected contains the delayed hashweak *)
let t_collected = ProdConsume.create ()
(** Do really the removing *)
let collect () = ProdConsume.iter_remove tbl_final t_collected
let create = let c = ref (-1) in fun n ->
let t = {
tbl_set = H.create n;
tbl_tag = (incr c; !c) }
Gc.finalise tbl_final t;
Gc.finalise (fun t -> ProdConsume.add t t_collected) t;
let clear t = tbl_final t; H.clear t.tbl_set
let find x y = collect (); find x y
let set x y z = collect (); set x y z
let clear t = collect (); tbl_final t; H.clear t.tbl_set
let length t = H.count t.tbl_set
let copy t =
collect ();
let t' = create (length t) in
iter (set t') t;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment