support for domain-local-await when installed

This commit is contained in:
Simon Cruanes 2023-06-19 17:27:48 -04:00
parent 27ec0f85e6
commit a266a42628
6 changed files with 32 additions and 1 deletions

View file

@ -26,6 +26,8 @@
(and (and
(>= 1.9.0) (>= 1.9.0)
:with-test))) :with-test)))
(depopts
(domain-local-await (>= 0.2)))
(tags (tags
(thread pool domain))) (thread pool domain)))

View file

@ -17,6 +17,9 @@ depends: [
"odoc" {with-doc} "odoc" {with-doc}
"mdx" {>= "1.9.0" & with-test} "mdx" {>= "1.9.0" & with-test}
] ]
depopts: [
"domain-local-await" {>= "0.2"}
]
build: [ build: [
["dune" "subst"] {dev} ["dune" "subst"] {dev}
[ [

View file

@ -1,6 +1,7 @@
type domain = Domain_.t type domain = Domain_.t
let work_ _i q : unit = let work_ _i q : unit =
Dla_.setup_domain ();
while true do while true do
let f = Bb_queue.pop q in let f = Bb_queue.pop q in
try f () with _ -> () try f () with _ -> ()

13
src/dla_.dummy.ml Normal file
View file

@ -0,0 +1,13 @@
(** Interface to Domain-local-await.
This is used to handle the presence or absence of DLA. *)
type t = {
release: unit -> unit;
await: unit -> unit;
}
let using : prepare_for_await:(unit -> t) -> while_running:(unit -> 'a) -> 'a =
fun ~prepare_for_await:_ ~while_running -> while_running ()
let setup_domain () = ()

9
src/dla_.real.ml Normal file
View file

@ -0,0 +1,9 @@
type t = Domain_local_await.t = {
release: unit -> unit;
await: unit -> unit;
}
let using : prepare_for_await:(unit -> t) -> while_running:(unit -> 'a) -> 'a =
Domain_local_await.using
let setup_domain () = Domain_local_await.per_thread (module Thread)

View file

@ -2,7 +2,10 @@
(public_name moonpool) (public_name moonpool)
(name moonpool) (name moonpool)
(private_modules d_pool_) (private_modules d_pool_)
(libraries threads either)) (libraries threads either
(select dla_.ml from
(domain-local-await -> dla_.real.ml)
( -> dla_.dummy.ml))))
(rule (rule
(targets atomic_.ml) (targets atomic_.ml)