ocaml_interop/
memory.rs

1// Copyright (c) Viable Systems and TezEdge Contributors
2// SPDX-License-Identifier: MIT
3
4use crate::{
5    conv::FromOCaml,
6    mlvalues::{
7        bigarray::{Array1, BigarrayElt},
8        tag, DynBox, OCamlBytes, OCamlFloat, OCamlInt32, OCamlInt64, OCamlList, RawOCaml,
9    },
10    runtime::OCamlRuntime,
11    value::OCaml,
12};
13use core::{any::Any, cell::UnsafeCell, marker::PhantomData, mem, pin::Pin, ptr};
14pub use ocaml_sys::{caml_alloc, store_field};
15use ocaml_sys::{
16    caml_alloc_string, caml_alloc_tuple, caml_copy_double, caml_copy_int32, caml_copy_int64,
17    custom_operations, string_val, Size,
18};
19
20pub struct OCamlCell<T> {
21    cell: UnsafeCell<RawOCaml>,
22    _marker: PhantomData<T>,
23}
24
25static_assertions::assert_eq_size!(OCamlCell<bool>, OCaml<'static, bool>, RawOCaml);
26
27/// An `OCamlRef<T>` is a reference to a location containing a [`OCaml`]`<T>` value.
28///
29/// Usually obtained as the result of rooting an OCaml value.
30pub type OCamlRef<'a, T> = &'a OCamlCell<T>;
31
32impl<T> OCamlCell<T> {
33    #[doc(hidden)]
34    pub unsafe fn create_ref<'a>(val: *const RawOCaml) -> OCamlRef<'a, T> {
35        &*(val as *const OCamlCell<T>)
36    }
37
38    /// Converts this value into a Rust value.
39    pub fn to_rust<RustT>(&self, cr: &OCamlRuntime) -> RustT
40    where
41        RustT: FromOCaml<T>,
42    {
43        RustT::from_ocaml(cr.get(self))
44    }
45
46    /// Borrows the raw value contained in this root.
47    ///
48    /// # Safety
49    ///
50    /// The [`RawOCaml`] value obtained may become invalid after the OCaml GC runs.
51    pub unsafe fn get_raw(&self) -> RawOCaml {
52        *self.cell.get()
53    }
54}
55
56pub fn alloc_bytes<'a>(cr: &'a mut OCamlRuntime, s: &[u8]) -> OCaml<'a, OCamlBytes> {
57    unsafe {
58        let len = s.len();
59        let value = caml_alloc_string(len);
60        let ptr = string_val(value);
61        core::ptr::copy_nonoverlapping(s.as_ptr(), ptr, len);
62        OCaml::new(cr, value)
63    }
64}
65
66pub fn alloc_string<'a>(cr: &'a mut OCamlRuntime, s: &str) -> OCaml<'a, String> {
67    unsafe {
68        let len = s.len();
69        let value = caml_alloc_string(len);
70        let ptr = string_val(value);
71        core::ptr::copy_nonoverlapping(s.as_ptr(), ptr, len);
72        OCaml::new(cr, value)
73    }
74}
75
76pub fn alloc_int32(cr: &mut OCamlRuntime, i: i32) -> OCaml<OCamlInt32> {
77    unsafe { OCaml::new(cr, caml_copy_int32(i)) }
78}
79
80pub fn alloc_int64(cr: &mut OCamlRuntime, i: i64) -> OCaml<OCamlInt64> {
81    unsafe { OCaml::new(cr, caml_copy_int64(i)) }
82}
83
84pub fn alloc_double(cr: &mut OCamlRuntime, d: f64) -> OCaml<OCamlFloat> {
85    unsafe { OCaml::new(cr, caml_copy_double(d)) }
86}
87
88// TODO: it is possible to directly alter the fields memory upon first allocation of
89// small values (like tuples and conses are) without going through `caml_modify` to get
90// a little bit of extra performance.
91
92pub fn alloc_some<'a, A>(cr: &'a mut OCamlRuntime, value: OCamlRef<'_, A>) -> OCaml<'a, Option<A>> {
93    unsafe {
94        let ocaml_some = caml_alloc(1, tag::SOME);
95        store_field(ocaml_some, 0, value.get_raw());
96        OCaml::new(cr, ocaml_some)
97    }
98}
99
100pub fn alloc_ok<'a, A, Err>(
101    cr: &'a mut OCamlRuntime,
102    value: OCamlRef<'_, A>,
103) -> OCaml<'a, Result<A, Err>> {
104    unsafe {
105        let ocaml_ok = caml_alloc(1, tag::TAG_OK);
106        store_field(ocaml_ok, 0, value.get_raw());
107        OCaml::new(cr, ocaml_ok)
108    }
109}
110
111pub fn alloc_error<'a, A, Err>(
112    cr: &'a mut OCamlRuntime,
113    err: OCamlRef<'_, Err>,
114) -> OCaml<'a, Result<A, Err>> {
115    unsafe {
116        let ocaml_err = caml_alloc(1, tag::TAG_ERROR);
117        store_field(ocaml_err, 0, err.get_raw());
118        OCaml::new(cr, ocaml_err)
119    }
120}
121
122#[doc(hidden)]
123pub unsafe fn alloc_tuple<T>(cr: &mut OCamlRuntime, size: usize) -> OCaml<T> {
124    let ocaml_tuple = caml_alloc_tuple(size);
125    OCaml::new(cr, ocaml_tuple)
126}
127
128/// List constructor
129///
130/// Build a new list from a head and a tail list.
131pub fn alloc_cons<'a, 'b, A>(
132    cr: &'a mut OCamlRuntime,
133    head: OCamlRef<'b, A>,
134    tail: OCamlRef<'b, OCamlList<A>>,
135) -> OCaml<'a, OCamlList<A>> {
136    unsafe {
137        let ocaml_cons = caml_alloc(2, tag::CONS);
138        store_field(ocaml_cons, 0, head.get_raw());
139        store_field(ocaml_cons, 1, tail.get_raw());
140        OCaml::new(cr, ocaml_cons)
141    }
142}
143
144#[inline]
145pub unsafe fn store_raw_field_at<A>(
146    cr: &mut OCamlRuntime,
147    block: OCamlRef<A>,
148    offset: Size,
149    raw_value: RawOCaml,
150) {
151    store_field(cr.get(block).get_raw(), offset, raw_value);
152}
153
154const BOX_OPS_DYN_DROP: custom_operations = custom_operations {
155    identifier: c"_rust_box_dyn_drop".as_ptr() as *const ocaml_sys::Char,
156    finalize: Some(drop_box_dyn),
157    compare: None,
158    hash: None,
159    serialize: None,
160    deserialize: None,
161    compare_ext: None,
162    fixed_length: ptr::null(),
163};
164
165extern "C" fn drop_box_dyn(oval: RawOCaml) {
166    unsafe {
167        let box_ptr = ocaml_sys::field(oval, 1) as *mut Pin<Box<dyn Any>>;
168        ptr::drop_in_place(box_ptr);
169    }
170}
171
172// Notes by @g2p:
173//
174// Implementation notes: is it possible to reduce indirection?
175// Could we also skip the finalizer?
176//
177// While putting T immediately inside the custom block as field(1)
178// is tempting, GC would misalign it (UB) when moving.  Put a pointer to T instead.
179// That optimisation would only work when alignment is the same as OCaml,
180// meaning size_of<uintnat>.  It would also need to use different types.
181//
182// Use Any for now.  This allows safe downcasting when converting back to Rust.
183//
184// mem::needs_drop can be used to detect drop glue.
185// This could be used to skip the finalizer, but only when there's no box.
186// Using a lighter finalizer won't work either, the GlobalAllocator trait needs
187// to know the layout before freeing the referenced block.
188// malloc won't use that info, but other allocators would.
189//
190// Also: caml_register_custom_operations is only useful for Marshall serialization,
191// skip it
192
193/// Allocate a `DynBox` for a value of type `A`.
194pub fn alloc_box<A: 'static>(cr: &mut OCamlRuntime, data: A) -> OCaml<DynBox<A>> {
195    let oval;
196    // A fatter Box, points to data then to vtable
197    type B = Pin<Box<dyn Any>>;
198    unsafe {
199        oval = ocaml_sys::caml_alloc_custom(&BOX_OPS_DYN_DROP, mem::size_of::<B>(), 0, 1);
200        let box_ptr = ocaml_sys::field(oval, 1) as *mut B;
201        std::ptr::write(box_ptr, Box::pin(data));
202    }
203    unsafe { OCaml::new(cr, oval) }
204}
205
206/// Create a new OCaml `Bigarray.Array1` with the given type and size
207///
208/// Memory belongs to the OCaml GC,
209/// including the data, which is in the malloc heap but will be freed on
210/// collection through a custom block
211pub fn alloc_bigarray1<'a, A: BigarrayElt>(
212    cr: &'a mut OCamlRuntime,
213    data: &[A],
214) -> OCaml<'a, Array1<A>> {
215    let len = data.len();
216    let ocaml_ba;
217    unsafe {
218        // num_dims == 1
219        // data == NULL, OCaml will allocate with malloc (outside the GC)
220        // and add the CAML_BA_MANAGED flag
221        // OCaml custom block contains a bigarray struct after the header,
222        // that points to the data array
223        ocaml_ba = ocaml_sys::bigarray::caml_ba_alloc_dims(A::KIND, 1, core::ptr::null_mut(), len);
224        let ba_meta_ptr = ocaml_sys::field(ocaml_ba, 1) as *const ocaml_sys::bigarray::Bigarray;
225        core::ptr::copy_nonoverlapping(data.as_ptr(), (*ba_meta_ptr).data as *mut A, len);
226    }
227    unsafe { OCaml::new(cr, ocaml_ba) }
228}
ocaml_interop/memory.rs

ocaml_interop/
memory.rs
