Upgrade boxroot, prepare OCaml 5 support

.github/workflows/build.yml

@@ -12,7 +12,7 @@ jobs:
     strategy:
       matrix:
         os: [macos-latest, ubuntu-latest]
-        ocaml-version: ["4.14.1"]
+        ocaml-version: ["5.1.1", "4.14.1"]
     steps:
       - uses: actions/checkout@v3
       - name: OCaml/Opam cache
@@ -30,7 +30,7 @@ jobs:
       - name: Add Opam switch to PATH
         run: opam var bin >> $GITHUB_PATH
       - name: Setup Rust
-        uses: actions-rs/toolchain@v1
+        uses: dtolnay/rust-toolchain@v1
         with:
           toolchain: stable
       - name: Setttings for cargo in OSX

Cargo.toml

@@ -13,14 +13,14 @@ exclude = [
 ]
 
 [package.metadata.docs.rs]
-features = [ "without-ocamlopt" ]
+features = [ "without-ocamlopt", "caml-state" ]
 
 [dependencies]
 ocaml-sys = "0.23"
-ocaml-boxroot-sys = "0.2"
+ocaml-boxroot-sys = { git = "https://gitlab.com/ocaml-rust/ocaml-boxroot.git", rev="652d92b1" }
 static_assertions = "1.1.0"
 
 [features]
-without-ocamlopt = ["ocaml-sys/without-ocamlopt", "ocaml-boxroot-sys/without-ocamlopt"]
+without-ocamlopt = ["ocaml-sys/without-ocamlopt"]
 caml-state = ["ocaml-sys/caml-state"]
 no-caml-startup = []

build.rs

@@ -4,10 +4,7 @@
 const OCAML_INTEROP_NO_CAML_STARTUP: &str = "OCAML_INTEROP_NO_CAML_STARTUP";
 
 fn main() {
-    println!(
-        "cargo:rerun-if-env-changed={}",
-        OCAML_INTEROP_NO_CAML_STARTUP
-    );
+    println!("cargo:rerun-if-env-changed={OCAML_INTEROP_NO_CAML_STARTUP}",);
     if std::env::var(OCAML_INTEROP_NO_CAML_STARTUP).is_ok() {
         println!("cargo:rustc-cfg=feature=\"no-caml-startup\"");
     }

src/boxroot.rs

@@ -1,11 +1,11 @@
 // Copyright (c) Viable Systems and TezEdge Contributors
 // SPDX-License-Identifier: MIT
 
-use std::{marker::PhantomData, ops::Deref, sync::Once};
+use std::{marker::PhantomData, ops::Deref};
 
 use ocaml_boxroot_sys::{
-    boxroot_create, boxroot_delete, boxroot_get, boxroot_get_ref, boxroot_modify, boxroot_setup,
-    BoxRoot as PrimitiveBoxRoot,
+    boxroot_create, boxroot_delete, boxroot_get, boxroot_get_ref, boxroot_modify, boxroot_status,
+    BoxRoot as PrimitiveBoxRoot, Status,
 };
 
 use crate::{memory::OCamlCell, OCaml, OCamlRef, OCamlRuntime};
@@ -19,15 +19,21 @@ pub struct BoxRoot<T: 'static> {
 impl<T> BoxRoot<T> {
     /// Creates a new root from an [`OCaml`]`<T>` value.
     pub fn new(val: OCaml<T>) -> BoxRoot<T> {
-        static INIT: Once = Once::new();
-
-        INIT.call_once(|| unsafe {
-            boxroot_setup();
-        });
-
-        BoxRoot {
-            boxroot: unsafe { boxroot_create(val.raw) },
-            _marker: PhantomData,
+        if let Some(boxroot) = unsafe { boxroot_create(val.raw) } {
+            BoxRoot {
+                boxroot,
+                _marker: PhantomData,
+            }
+        } else {
+            let status = unsafe { boxroot_status() };
+            let reason = match status {
+                Status::NotSetup => "NotSetup",
+                Status::Running => "Running",
+                Status::ToreDown => "ToreDown",
+                Status::Invalid => "Invalid",
+                _ => "Unknown",
+            };
+            panic!("Failed to allocate boxroot, boxroot_status() -> {}", reason,)
         }
     }
 
@@ -39,7 +45,17 @@ impl<T> BoxRoot<T> {
     /// Roots the OCaml value `val`, returning an [`OCamlRef`]`<T>`.
     pub fn keep<'tmp>(&'tmp mut self, val: OCaml<T>) -> OCamlRef<'tmp, T> {
         unsafe {
-            boxroot_modify(&mut self.boxroot, val.raw);
+            if !boxroot_modify(&mut self.boxroot, val.raw) {
+                let status = boxroot_status();
+                let reason = match status {
+                    Status::NotSetup => "NotSetup",
+                    Status::Running => "Running",
+                    Status::ToreDown => "ToreDown",
+                    Status::Invalid => "Invalid",
+                    _ => "Unknown",
+                };
+                panic!("Failed to modify boxroot, boxroot_status() -> {}", reason,)
+            }
             &*(boxroot_get_ref(self.boxroot) as *const OCamlCell<T>)
         }
     }

src/compile_ok_tests.rs

@@ -29,7 +29,7 @@ mod test_immediate_ocamlrefs {
 
     #[test]
     fn test_immediate_ocamlrefs() {
-        let cr = unsafe { OCamlRuntime::recover_handle() };
+        let cr = unsafe { OCamlRuntime::recover_handle_mut() };
         assert!(test_immediate_ocamlref(cr));
     }
 }

src/conv/to_ocaml.rs

@@ -217,7 +217,7 @@ where
     A: ToOCaml<OCamlA>,
 {
     fn to_ocaml<'a>(&self, cr: &'a mut OCamlRuntime) -> OCaml<'a, OCamlList<OCamlA>> {
-        let mut result = BoxRoot::new(OCaml::nil());
+        let mut result = BoxRoot::new(OCaml::nil(cr));
         for elt in self.iter().rev() {
             let ov = elt.to_boxroot(cr);
             let cons = alloc_cons(cr, &ov, &result);

src/error.rs

@@ -15,13 +15,11 @@ impl fmt::Display for OCamlFixnumConversionError {
         match self {
             OCamlFixnumConversionError::InputTooBig(n) => write!(
                 f,
-                "Input value doesn't fit in OCaml fixnum n={} > MAX_FIXNUM={}",
-                n, MAX_FIXNUM
+                "Input value doesn't fit in OCaml fixnum n={n} > MAX_FIXNUM={MAX_FIXNUM}",
             ),
             OCamlFixnumConversionError::InputTooSmall(n) => write!(
                 f,
-                "Input value doesn't fit in OCaml fixnum n={} < MIN_FIXNUM={}",
-                n, MIN_FIXNUM
+                "Input value doesn't fit in OCaml fixnum n={n} < MIN_FIXNUM={MIN_FIXNUM}",
             ),
         }
     }

src/lib.rs

@@ -303,7 +303,7 @@ pub use crate::mlvalues::{
     bigarray, DynBox, OCamlBytes, OCamlException, OCamlFloat, OCamlFloatArray, OCamlInt,
     OCamlInt32, OCamlInt64, OCamlList, OCamlUniformArray, RawOCaml,
 };
-pub use crate::runtime::OCamlRuntime;
+pub use crate::runtime::{OCamlRuntime, OCamlDomainLock};
 pub use crate::value::OCaml;
 
 #[doc(hidden)]
@@ -312,7 +312,7 @@ pub mod internal {
     pub use crate::memory::{alloc_tuple, caml_alloc, store_field};
     pub use crate::mlvalues::tag;
     pub use crate::mlvalues::UNIT;
-    pub use ocaml_boxroot_sys::{boxroot_setup, boxroot_teardown};
+    pub use ocaml_boxroot_sys::boxroot_teardown;
     pub use ocaml_sys::caml_hash_variant;
 
     // To bypass ocaml_sys::int_val unsafe declaration

src/macros.rs

@@ -1577,7 +1577,7 @@ macro_rules! expand_exported_function {
     } => {
         #[no_mangle]
         pub extern "C" fn $name( $($arg: $typ),* ) -> $crate::expand_exported_function_return!($($rtyp)*) {
-            let $cr = unsafe { &mut $crate::OCamlRuntime::recover_handle() };
+            let $cr = unsafe { &mut $crate::OCamlRuntime::recover_handle_mut() };
             $crate::expand_rooted_args_init!($cr, $($original_args)*);
             $crate::expand_exported_function_body!(
                 @body $body

src/runtime.rs

@@ -1,8 +1,11 @@
 // Copyright (c) Viable Systems and TezEdge Contributors
 // SPDX-License-Identifier: MIT
 
-use ocaml_boxroot_sys::{boxroot_setup, boxroot_teardown};
-use std::marker::PhantomData;
+use ocaml_boxroot_sys::boxroot_teardown;
+use std::{
+    marker::PhantomData,
+    ops::{Deref, DerefMut},
+};
 
 use crate::{memory::OCamlRef, value::OCaml};
 
@@ -38,28 +41,26 @@
                 let c_args = [arg0, core::ptr::null()];
                 unsafe {
                     ocaml_sys::caml_startup(c_args.as_ptr());
+                    ocaml_boxroot_sys::boxroot_setup_systhreads();
                 }
             })
         }
         #[cfg(feature = "no-caml-startup")]
         panic!("Rust code that is called from an OCaml program should not try to initialize the runtime.");
     }
 
-    /// Recover the runtime handle.
-    ///
-    /// This method is used internally, do not use directly in code, only when writing tests.
-    ///
-    /// # Safety
-    ///
-    /// This function is unsafe because the OCaml runtime handle should be obtained once
-    /// upon initialization of the OCaml runtime and then passed around. This method exists
-    /// only to ease the authoring of tests.
+    #[doc(hidden)]
     #[inline(always)]
-    pub unsafe fn recover_handle() -> &'static mut Self {
+    pub unsafe fn recover_handle_mut() -> &'static mut Self {
         static mut RUNTIME: OCamlRuntime = OCamlRuntime { _private: () };
         &mut RUNTIME
     }
 
+    #[inline(always)]
+    unsafe fn recover_handle() -> &'static Self {
+        Self::recover_handle_mut()
+    }
+
     /// Release the OCaml runtime lock, call `f`, and re-acquire the OCaml runtime lock.
     pub fn releasing_runtime<T, F>(&mut self, f: F) -> T
     where
@@ -75,6 +76,10 @@
             raw: unsafe { reference.get_raw() },
         }
     }
+
+    pub fn acquire_lock() -> OCamlDomainLock {
+        OCamlDomainLock::new()
+    }
 }
 
 impl Drop for OCamlRuntime {
@@ -108,11 +113,64 @@
     }
 }
 
+pub struct OCamlDomainLock {
+    _private: (),
+}
+
+extern "C" {
+    pub fn caml_c_thread_register() -> isize;
+    pub fn caml_c_thread_unregister() -> isize;
+}
+
+impl OCamlDomainLock {
+    #[inline(always)]
+    fn new() -> Self {
+        unsafe {
+            caml_c_thread_register();
+            ocaml_sys::caml_leave_blocking_section();
+        };
+        Self { _private: () }
+    }
+
+    #[inline(always)]
+    fn recover_handle<'a>(&self) -> &'a OCamlRuntime {
+        unsafe { OCamlRuntime::recover_handle() }
+    }
+
+    #[inline(always)]
+    fn recover_handle_mut<'a>(&self) -> &'a mut OCamlRuntime {
+        unsafe { OCamlRuntime::recover_handle_mut() }
+    }
+}
+
+impl Drop for OCamlDomainLock {
+    fn drop(&mut self) {
+        unsafe {
+            ocaml_sys::caml_enter_blocking_section();
+            // FIXME: breaks with OCaml 5
+            // caml_c_thread_unregister();
+        };
+    }
+}
+
+impl Deref for OCamlDomainLock {
+    type Target = OCamlRuntime;
+
+    fn deref(&self) -> &OCamlRuntime {
+        self.recover_handle()
+    }
+}
+
+impl DerefMut for OCamlDomainLock {
+    fn deref_mut(&mut self) -> &mut OCamlRuntime {
+        self.recover_handle_mut()
+    }
+}
+
 // For initializing from an OCaml-driven program
 
 #[no_mangle]
 extern "C" fn ocaml_interop_setup(_unit: crate::RawOCaml) -> crate::RawOCaml {
-    unsafe { boxroot_setup() };
     ocaml_sys::UNIT
 }
 

src/value.rs

@@ -374,7 +374,7 @@ impl<'a, A, Err> OCaml<'a, Result<A, Err>> {
 
 impl<'a, A> OCaml<'a, OCamlList<A>> {
     /// Returns an OCaml nil (empty list) value.
-    pub fn nil() -> Self {
+    pub fn nil(_: &'a mut OCamlRuntime) -> Self {
         OCaml {
             _marker: PhantomData,
             raw: EMPTY_LIST,

testing/rust-caller/Cargo.toml

@@ -4,8 +4,9 @@ version = "0.1.0"
 authors = ["Bruno Deferrari <[email protected]>"]
 edition = "2018"
 
-[dependencies.ocaml-interop]
-path = "../.."
+[dependencies]
+ocaml-interop = { path = "../.." }
+ocaml-sys = "*"
 
 [dev-dependencies]
-serial_test = "*"
+once_cell = "*"

testing/rust-caller/build.rs

@@ -8,29 +8,29 @@ fn main() {
     let ocaml_callable_dir = "./ocaml";
     let dune_dir = "../../_build/default/testing/rust-caller/ocaml";
     Command::new("opam")
-        .args(&["exec", "--", "dune", "build", &format!("{}/callable.exe.o", ocaml_callable_dir)])
+        .args(["exec", "--", "dune", "build", &format!("{}/callable.exe.o", ocaml_callable_dir)])
         .status()
         .expect("Dune failed");
     Command::new("rm")
-        .args(&["-f", &format!("{}/libcallable.a", out_dir)])
+        .args(["-f", &format!("{}/libcallable.a", out_dir)])
         .status()
         .expect("rm failed");
     Command::new("rm")
-        .args(&["-f", &format!("{}/libcallable.o", out_dir)])
+        .args(["-f", &format!("{}/libcallable.o", out_dir)])
         .status()
         .expect("rm failed");
     Command::new("cp")
-        .args(&[
+        .args([
             &format!("{}/callable.exe.o", dune_dir),
-            &format!("{}/libcallable.o", out_dir),
+            &format!("{}/callable.o", out_dir),
         ])
         .status()
         .expect("File copy failed.");
     Command::new("ar")
-        .args(&[
+        .args([
             "qs",
             &format!("{}/libcallable.a", out_dir),
-            &format!("{}/libcallable.o", out_dir),
+            &format!("{}/callable.o", out_dir),
         ])
         .status()
         .expect("ar failed");

testing/rust-caller/ocaml/dune

@@ -1,3 +1,5 @@
 (executables
  (names callable)
+ (libraries threads)
+ (flags (:standard -noautolink -cclib -lunix -cclib -lthreadsnat))
  (modes object))