fix with actual TLS release

This commit is contained in:
Simon Cruanes 2024-08-26 11:20:27 -04:00
parent 265d4f73dd
commit 444f8a3acc
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 17 additions and 6 deletions

View file

@ -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

View file

@ -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
)