Stub implementation of new custom memory API (#3437)

runtime/bigarray.c

@@ -251,7 +251,7 @@ caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
   uses_resources =
     ((flags & CAML_BA_MANAGED_MASK) == CAML_BA_MANAGED)
     && !(flags & CAML_BA_SUBARRAY);
-  res = caml_alloc_custom_mem(&caml_ba_ops, asize, uses_resources ? size : 0);
+  res = caml_alloc_custom_dep(&caml_ba_ops, asize, uses_resources ? size : 0);
   b = Caml_ba_array_val(res);
   b->data = data;
   b->num_dims = num_dims;
@@ -291,9 +291,11 @@ CAMLexport void caml_ba_finalize(value v)
   case CAML_BA_MANAGED:
     if (b->proxy == NULL) {
       free(b->data);
+      caml_free_dependent_memory(v, caml_ba_byte_size(b));
     } else {
       if (caml_atomic_refcount_decr(&b->proxy->refcount) == 1) {
         free(b->proxy->data);
+        caml_free_dependent_memory(v, b->proxy->size);
         free(b->proxy);
       }
     }
@@ -620,6 +622,7 @@ CAMLexport uintnat caml_ba_deserialize(void * dst)
     caml_deserialize_error("input_value: size overflow for bigarray");
   /* Allocate room for data */
   b->data = malloc(size);
+  caml_alloc_dependent_memory(Custom_val_data (dst), size);
   if (b->data == NULL)
     caml_deserialize_error("input_value: out of memory for bigarray");
   /* Read data */
@@ -1138,8 +1141,7 @@ static void caml_ba_update_proxy(struct caml_ba_array * b1,
     caml_atomic_refcount_init(&proxy->refcount, 2);
     /* initial refcount: 2 = original array + sub array */
     proxy->data = b1->data;
-    proxy->size =
-      b1->flags & CAML_BA_MAPPED_FILE ? caml_ba_byte_size(b1) : 0;
+    proxy->size = caml_ba_byte_size(b1);
     b1->proxy = proxy;
     b2->proxy = proxy;
   }

runtime/caml/custom.h

@@ -74,6 +74,17 @@ CAMLextern value caml_alloc_custom_mem(const struct custom_operations * ops,
                                        uintnat size, /*size in bytes*/
                                        mlsize_t mem  /*memory consumed*/);
 
+  /* [caml_alloc_custom_dep] allocates a custom block with dependent memory
+   (memory outside the heap that will be reclaimed when the block is
+   finalized). If [mem] is greater than [custom_minor_max_size] (see gc.mli)
+   the block is allocated directly in the major heap.
+   The program must call [caml_free_dependent_memory] when the memory is
+   reclaimed.
+  */
+CAMLextern value caml_alloc_custom_dep(const struct custom_operations * ops,
+                                       uintnat size, /*size in bytes*/
+                                       mlsize_t mem  /*dep memory in bytes*/);
+
 CAMLextern void
           caml_register_custom_operations(const struct custom_operations * ops);
 

runtime/caml/memory.h

@@ -41,8 +41,8 @@ CAMLextern value caml_alloc_local_reserved(mlsize_t, tag_t, reserved_t);
 
 CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
 CAMLextern void caml_adjust_minor_gc_speed (mlsize_t, mlsize_t);
-CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz);
-CAMLextern void caml_free_dependent_memory (mlsize_t bsz);
+CAMLextern void caml_alloc_dependent_memory (value v, mlsize_t bsz);
+CAMLextern void caml_free_dependent_memory (value v, mlsize_t bsz);
 CAMLextern void caml_modify (volatile value *, value);
 CAMLextern void caml_modify_local (value obj, intnat i, value val);
 CAMLextern void caml_initialize (volatile value *, value);

runtime/caml/mlvalues.h

@@ -527,6 +527,7 @@ CAMLextern int caml_is_double_array (value);   /* 0 is false, 1 is true */
    See [custom.h] for operations on method suites. */
 #define Custom_tag 255
 #define Data_custom_val(v) ((void *) (Op_val(v) + 1))
+#define Custom_val_data(d) (Val_op((value *)d - 1))
 struct custom_operations;       /* defined in [custom.h] */
 
 /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */

runtime/custom.c

@@ -157,6 +157,14 @@ CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops,
   return v;
 }
 
+CAMLexport value caml_alloc_custom_dep(const struct custom_operations * ops,
+                                       uintnat size, mlsize_t mem)
+{
+  /* For now, alias caml_alloc_custom_mem, but this implementation
+     is to be replaced */
+  return caml_alloc_custom_mem(ops, size, mem);
+}
+
 struct custom_operations_list {
   const struct custom_operations * ops;
   struct custom_operations_list * next;

runtime/memory.c

@@ -236,19 +236,14 @@ CAMLexport CAMLweakdef void caml_modify (volatile value *fp, value val)
    free it.  In both cases, you pass as argument the size (in bytes)
    of the block being allocated or freed.
 */
-CAMLexport void caml_alloc_dependent_memory (mlsize_t nbytes)
+CAMLexport void caml_alloc_dependent_memory (value v, mlsize_t nbytes)
 {
-  Caml_state->dependent_size += nbytes / sizeof (value);
-  Caml_state->dependent_allocated += nbytes / sizeof (value);
+  /* No-op for now */
 }
 
-CAMLexport void caml_free_dependent_memory (mlsize_t nbytes)
+CAMLexport void caml_free_dependent_memory (value v, mlsize_t nbytes)
 {
-  if (Caml_state->dependent_size < nbytes / sizeof (value)){
-    Caml_state->dependent_size = 0;
-  }else{
-    Caml_state->dependent_size -= nbytes / sizeof (value);
-  }
+  /* No-op for now */
 }
 
 /* Use this function to tell the major GC to speed up when you use

runtime4/caml/custom.h

@@ -72,6 +72,17 @@ CAMLextern value caml_alloc_custom_mem(struct custom_operations * ops,
                                        uintnat size, /*size in bytes*/
                                        mlsize_t mem  /*memory consumed*/);
 
+  /* [caml_alloc_custom_dep] allocates a custom block with dependent memory
+   (memory outside the heap that will be reclaimed when the block is
+   finalized). If [mem] is greater than [custom_minor_max_size] (see gc.mli)
+   the block is allocated directly in the major heap.
+   The program must call [caml_free_dependent_memory] when the memory is
+   reclaimed.
+  */
+CAMLextern value caml_alloc_custom_dep(struct custom_operations * ops,
+                                       uintnat size, /*size in bytes*/
+                                       mlsize_t mem  /*dep memory in bytes*/);
+
 CAMLextern void caml_register_custom_operations(struct custom_operations * ops);
 
 /* Global variable moved to Caml_state in 4.10 */

runtime4/caml/memory.h

@@ -58,8 +58,8 @@ CAMLextern value caml_alloc_local(mlsize_t, tag_t);
 CAMLextern value caml_alloc_local_reserved(mlsize_t, tag_t, reserved_t);
 
 CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
-CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz);
-CAMLextern void caml_free_dependent_memory (mlsize_t bsz);
+CAMLextern void caml_alloc_dependent_memory (value v, mlsize_t bsz);
+CAMLextern void caml_free_dependent_memory (value v, mlsize_t bsz);
 CAMLextern void caml_modify (value *, value);
 CAMLextern void caml_modify_local (value obj, intnat i, value val);
 CAMLextern void caml_initialize (value *, value);

runtime4/custom.c

@@ -127,6 +127,12 @@ CAMLexport value caml_alloc_custom_mem(struct custom_operations * ops,
   return v;
 }
 
+CAMLexport value caml_alloc_custom_dep(struct custom_operations * ops,
+                                       uintnat size, mlsize_t mem)
+{
+  return caml_alloc_custom_mem(ops, size, mem);
+}
+
 struct custom_operations_list {
   struct custom_operations * ops;
   struct custom_operations_list * next;

runtime4/memory.c

@@ -587,19 +587,14 @@ CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
    free it.  In both cases, you pass as argument the size (in bytes)
    of the block being allocated or freed.
 */
-CAMLexport void caml_alloc_dependent_memory (mlsize_t nbytes)
+CAMLexport void caml_alloc_dependent_memory (value v, mlsize_t nbytes)
 {
-  caml_dependent_size += nbytes / sizeof (value);
-  caml_dependent_allocated += nbytes / sizeof (value);
+  /* No-op for now */
 }
 
-CAMLexport void caml_free_dependent_memory (mlsize_t nbytes)
+CAMLexport void caml_free_dependent_memory (value v, mlsize_t nbytes)
 {
-  if (caml_dependent_size < nbytes / sizeof (value)){
-    caml_dependent_size = 0;
-  }else{
-    caml_dependent_size -= nbytes / sizeof (value);
-  }
+  /* No-op for now */
 }
 
 /* Use this function to tell the major GC to speed up when you use