Support DLA on Windows

Author: patricoferris

dune-project

@@ -61,6 +61,7 @@
  (depends
   (eio (= :version))
   (cstruct-unix (= dev))
+  (kcas (and (>= 0.3.0) :with-test))
   (alcotest (and (>= 1.4.0) :with-test))))
 (package
  (name eio_main)

eio_windows.opam

@@ -12,6 +12,7 @@ depends: [
   "dune" {>= "3.7"}
   "eio" {= version}
   "cstruct-unix" {= "dev"}
+  "kcas" {>= "0.3.0" & with-test}
   "alcotest" {>= "1.4.0" & with-test}
   "odoc" {with-doc}
 ]

lib_eio_windows/sched.ml

@@ -355,8 +355,12 @@ let run ~extra_effects t main x =
   let result = ref None in
   let `Exit_scheduler =
     let new_fiber = Fiber_context.make_root () in
-    fork ~new_fiber (fun () ->
-        result := Some (with_op t main x);
+    Domain_local_await.using
+      ~prepare_for_await:Eio.Private.Dla.prepare_for_await
+      ~while_running:(fun () ->
+        fork ~new_fiber (fun () ->
+          result := Some (with_op t main x);
+        )
       )
   in
   match !result with

lib_eio_windows/test/dune

@@ -8,6 +8,6 @@ let () = Jbuild_plugin.V1.send @@ if not win32 then "" else {|
   (name test)
   (package eio_windows)
   (enabled_if (= %{os_type} "Win32"))
-  (libraries alcotest eio.mock eio_windows))
+  (libraries alcotest kcas eio.mock eio_windows))
 
 |}

lib_eio_windows/test/test.ml

@@ -26,10 +26,34 @@ module Random = struct
   ]
 end
 
+module Dla = struct
+
+  let test_dla () =
+    let open Kcas in
+    let x = Loc.make 0 in
+    let y = Loc.make 0 in
+    let foreign_domain = Domain.spawn @@ fun () ->
+      let x = Loc.get_as (fun x -> Retry.unless (x <> 0); x) x in
+      Loc.set y 22;
+      x
+    in
+    Loc.set x 20;
+    let y' = Loc.get_as (fun y -> Retry.unless (y <> 0); y) y in
+    Alcotest.(check int) "correct y" y' 22;
+    let ans = y' + Domain.join foreign_domain in
+    Alcotest.(check int) "answer" ans 42
+
+  let tests = [
+    "dla", `Quick, test_dla
+  ]
+end
+
+
 let () =
   Eio_windows.run @@ fun env ->
   Alcotest.run "eio_windows" [
     "net", Test_net.tests env;
     "timeout", Timeout.tests env;
-    "random", Random.tests env
+    "random", Random.tests env;
+    "dla", Dla.tests
   ]