mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-06 03:05:30 -05:00
fix with actual TLS release
This commit is contained in:
parent
265d4f73dd
commit
444f8a3acc
2 changed files with 17 additions and 6 deletions
|
|
@ -4,10 +4,12 @@ type 'a t
|
|||
(** A TLS slot for values of type ['a]. This allows the storage of a
|
||||
single value of type ['a] per thread. *)
|
||||
|
||||
exception Not_set
|
||||
|
||||
val create : unit -> 'a t
|
||||
|
||||
val get : 'a t -> 'a
|
||||
(** @raise Failure if not present *)
|
||||
val get_exn : 'a t -> 'a
|
||||
(** @raise Not_set if not present *)
|
||||
|
||||
val get_opt : 'a t -> 'a option
|
||||
val set : 'a t -> 'a -> unit
|
||||
|
|
|
|||
|
|
@ -62,15 +62,14 @@ let[@inline] get_raw index : Obj.t =
|
|||
else
|
||||
sentinel_value_for_uninit_tls
|
||||
|
||||
let[@inline never] tls_error () =
|
||||
failwith "Thread_local_storage.get: TLS entry not initialised"
|
||||
exception Not_set
|
||||
|
||||
let[@inline] get slot =
|
||||
let[@inline] get_exn slot =
|
||||
let v = get_raw slot in
|
||||
if v != sentinel_value_for_uninit_tls then
|
||||
Obj.obj v
|
||||
else
|
||||
tls_error ()
|
||||
raise_notrace Not_set
|
||||
|
||||
let[@inline] get_opt slot =
|
||||
let v = get_raw slot in
|
||||
|
|
@ -109,3 +108,13 @@ let get_tls_with_capacity index : Obj.t array =
|
|||
let[@inline] set slot value : unit =
|
||||
let tls = get_tls_with_capacity slot in
|
||||
Array.unsafe_set tls slot (Obj.repr (Sys.opaque_identity value))
|
||||
|
||||
let[@inline] get_default ~default slot =
|
||||
let v = get_raw slot in
|
||||
if v != sentinel_value_for_uninit_tls then
|
||||
Obj.obj v
|
||||
else (
|
||||
let v = default () in
|
||||
set slot v;
|
||||
v
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue