From e016192b834206af64b71882c3461a68d33ae4c5 Mon Sep 17 00:00:00 2001 From: Gabriel de Perthuis Date: Tue, 22 Dec 2020 13:40:23 +0100 Subject: [PATCH 1/2] Expose Gc.compact for use in tests --- testing/rust-caller/ocaml/callable.ml | 3 ++- testing/rust-caller/src/lib.rs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/testing/rust-caller/ocaml/callable.ml b/testing/rust-caller/ocaml/callable.ml index 59fcb15..4523741 100644 --- a/testing/rust-caller/ocaml/callable.ml +++ b/testing/rust-caller/ocaml/callable.ml @@ -86,4 +86,5 @@ let () = Callback.register "stringify_polymorphic_variant" stringify_polymorphic_variant; Callback.register "raises_message_exception" raises_message_exception; Callback.register "raises_nonmessage_exception" raises_nonmessage_exception; - Callback.register "raises_nonblock_exception" raises_nonblock_exception; \ No newline at end of file + Callback.register "raises_nonblock_exception" raises_nonblock_exception; + Callback.register "gc_compact" Gc.compact; \ No newline at end of file diff --git a/testing/rust-caller/src/lib.rs b/testing/rust-caller/src/lib.rs index f8b0081..575636e 100644 --- a/testing/rust-caller/src/lib.rs +++ b/testing/rust-caller/src/lib.rs @@ -70,6 +70,7 @@ mod ocaml { pub fn raises_message_exception(message: String); pub fn raises_nonmessage_exception(unit: ()); pub fn raises_nonblock_exception(unit: ()); + pub fn gc_compact(unit: ()); } } @@ -141,7 +142,6 @@ pub fn allocate_alot(cr: &mut OCamlRuntime) -> bool { let _x: OCaml = vec.to_ocaml(cr); let _y: OCaml = vec.to_ocaml(cr); let _z: OCaml = vec.to_ocaml(cr); - () } true } From 2496f089b7a6a83f343d332600e710c2a4da5178 Mon Sep 17 00:00:00 2001 From: Gabriel de Perthuis Date: Wed, 14 Apr 2021 17:55:21 +0200 Subject: [PATCH 2/2] Add global and generational roots --- src/lib.rs | 2 +- src/memory.rs | 105 ++++++++++++++++++++++++++++++++- src/value.rs | 15 +++++ testing/rust-caller/build.rs | 8 ++- testing/rust-caller/src/lib.rs | 34 +++++++++++ 5 files changed, 161 insertions(+), 3 deletions(-) diff --git a/src/lib.rs b/src/lib.rs index 1ddd874..d5c07be 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -300,7 +300,7 @@ pub use crate::boxroot::BoxRoot; pub use crate::closure::{OCamlFn1, OCamlFn2, OCamlFn3, OCamlFn4, OCamlFn5}; pub use crate::conv::{FromOCaml, ToOCaml}; pub use crate::error::OCamlException; -pub use crate::memory::OCamlRef; +pub use crate::memory::{OCamlGenerationalRoot, OCamlGlobalRoot, OCamlRef}; pub use crate::mlvalues::{ OCamlBytes, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, RawOCaml, }; diff --git a/src/memory.rs b/src/memory.rs index 13f5254..7ab4eaf 100644 --- a/src/memory.rs +++ b/src/memory.rs @@ -7,12 +7,115 @@ use crate::{ runtime::OCamlRuntime, value::OCaml, }; -use core::{cell::UnsafeCell, marker::PhantomData}; +use core::{ + cell::{Cell, UnsafeCell}, + marker::PhantomData, + pin::Pin, +}; pub use ocaml_sys::{caml_alloc, store_field}; use ocaml_sys::{ caml_alloc_string, caml_alloc_tuple, caml_copy_double, caml_copy_int32, caml_copy_int64, string_val, }; +/// A global root for keeping OCaml values alive and tracked +/// +/// This allows keeping a value around when exiting the stack frame. +/// +/// See [`OCaml::register_global_root`]. +pub struct OCamlGlobalRoot { + pub(crate) cell: Pin>>, + _marker: PhantomData>, +} + +impl std::fmt::Debug for OCamlGlobalRoot { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "OCamlGlobalRoot({:#x})", self.cell.get()) + } +} + +impl OCamlGlobalRoot { + // NOTE: we require initialisation here, unlike OCamlRoot which delays it + // This is because we register with the GC in the constructor, + // for easy pairing with Drop, and registering without initializing + // would break OCaml runtime invariants. + // Always registering with UNIT (like for GCFrame initialisation) + // would also work, but for OCamlGenerationalRoot that would + // make things slower (updating requires notifying the GC), + // and it's better if the API is the same for both kinds of global roots. + pub(crate) fn new(val: OCaml) -> Self { + let r = Self { + cell: Box::pin(Cell::new(val.raw)), + _marker: PhantomData, + }; + unsafe { ocaml_sys::caml_register_global_root(r.cell.as_ptr()) }; + r + } + + /// Access the rooted value + pub fn get_ref(&self) -> OCamlRef { + unsafe { OCamlCell::create_ref(self.cell.as_ptr()) } + } + + /// Replace the rooted value + pub fn set(&self, val: OCaml) { + self.cell.replace(val.raw); + } +} + +impl Drop for OCamlGlobalRoot { + fn drop(&mut self) { + unsafe { ocaml_sys::caml_remove_global_root(self.cell.as_ptr()) }; + } +} + +/// A global, GC-friendly root for keeping OCaml values alive and tracked +/// +/// This allows keeping a value around when exiting the stack frame. +/// +/// Unlike with [`OCamlGlobalRoot`], the GC doesn't have to walk +/// referenced values on every minor collection. This makes collection +/// faster, except if the value is short-lived and frequently updated. +/// +/// See [`OCaml::register_generational_root`]. +pub struct OCamlGenerationalRoot { + pub(crate) cell: Pin>>, + _marker: PhantomData>, +} + +impl std::fmt::Debug for OCamlGenerationalRoot { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "OCamlGenerationalRoot({:#x})", self.cell.get()) + } +} + +impl OCamlGenerationalRoot { + pub(crate) fn new(val: OCaml) -> Self { + let r = Self { + cell: Box::pin(Cell::new(val.raw)), + _marker: PhantomData, + }; + unsafe { ocaml_sys::caml_register_generational_global_root(r.cell.as_ptr()) }; + r + } + + /// Access the rooted value + pub fn get_ref(&self) -> OCamlRef { + unsafe { OCamlCell::create_ref(self.cell.as_ptr()) } + } + + /// Replace the rooted value + pub fn set(&self, val: OCaml) { + unsafe { ocaml_sys::caml_modify_generational_global_root(self.cell.as_ptr(), val.raw) }; + debug_assert_eq!(self.cell.get(), val.raw); + } +} + +impl Drop for OCamlGenerationalRoot { + fn drop(&mut self) { + unsafe { ocaml_sys::caml_remove_generational_global_root(self.cell.as_ptr()) }; + } +} + pub struct OCamlCell { cell: UnsafeCell, _marker: PhantomData, diff --git a/src/value.rs b/src/value.rs index c084473..8ed894f 100644 --- a/src/value.rs +++ b/src/value.rs @@ -1,6 +1,7 @@ // Copyright (c) SimpleStaking and Tezedge Contributors // SPDX-License-Identifier: MIT +use crate::memory::{OCamlGenerationalRoot, OCamlGlobalRoot}; use crate::{ boxroot::BoxRoot, error::OCamlFixnumConversionError, memory::OCamlCell, mlvalues::*, FromOCaml, OCamlRef, OCamlRuntime, @@ -113,6 +114,20 @@ impl<'a, T> OCaml<'a, T> { { RustT::from_ocaml(*self) } + + /// Register a global root with the OCaml runtime + /// + /// If the value is seldom modified ([`OCamlGlobalRoot::set`] isn't + /// frequently used), [`OCaml::register_generational_root`] can be + /// faster. + pub fn register_global_root(self) -> OCamlGlobalRoot { + OCamlGlobalRoot::new(self) + } + + /// Register a GC-friendly global root with the OCaml runtime + pub fn register_generational_root(self) -> OCamlGenerationalRoot { + OCamlGenerationalRoot::new(self) + } } impl OCaml<'static, ()> { diff --git a/testing/rust-caller/build.rs b/testing/rust-caller/build.rs index a09a569..4450e14 100644 --- a/testing/rust-caller/build.rs +++ b/testing/rust-caller/build.rs @@ -8,7 +8,13 @@ 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") diff --git a/testing/rust-caller/src/lib.rs b/testing/rust-caller/src/lib.rs index 575636e..d118186 100644 --- a/testing/rust-caller/src/lib.rs +++ b/testing/rust-caller/src/lib.rs @@ -3,6 +3,8 @@ extern crate ocaml_interop; +#[cfg(test)] +use ocaml_interop::OCamlInt64; use ocaml_interop::{OCaml, OCamlBytes, OCamlRuntime, ToOCaml}; mod ocaml { @@ -330,3 +332,35 @@ fn test_exception_handling_nonblock_exception() { "OCaml exception, message: None" ); } + +#[test] +#[serial] +fn test_global_roots() { + OCamlRuntime::init_persistent(); + let mut cr = unsafe { OCamlRuntime::recover_handle() }; + let crr = &mut cr; + + let i64: OCaml = 5.to_ocaml(crr); + let root = i64.register_global_root(); + ocaml::gc_compact(crr, &OCaml::unit()); + root.set(6.to_ocaml(crr)); + ocaml::gc_compact(crr, &OCaml::unit()); + let i64_bis: i64 = crr.get(root.get_ref()).to_rust(); + assert_eq!(i64_bis, 6); +} + +#[test] +#[serial] +fn test_generational_roots() { + OCamlRuntime::init_persistent(); + let mut cr = unsafe { OCamlRuntime::recover_handle() }; + let crr = &mut cr; + + let i64: OCaml = 5.to_ocaml(crr); + let root = i64.register_generational_root(); + ocaml::gc_compact(crr, &OCaml::unit()); + root.set(6.to_ocaml(crr)); + ocaml::gc_compact(crr, &OCaml::unit()); + let i64_bis: i64 = crr.get(root.get_ref()).to_rust(); + assert_eq!(i64_bis, 6); +}