Trigger a minor GC when custom blocks accumulate in minor heap (#1476)

When a custom block is allocated with caml_alloc_custom, one specifies
a ratio (mem/max) which is used to increase the pressure on the major
GC.  But before this commit, there is no logic to put some pressure on
the minor GC.  Consequently, a trivial loop that allocates rather
large bigarrays and throw them away immediately will trigger out-of-memory
on systems with constrained memory, and in particular on 32-bit systems.

Before OCaml 4.03, custom objects with finalizers (which include bigarrays)
were never allocated in the minor heap, thus reducing the risk of hitting
the problem.

This commit replicates the logic used to trigger the major GC: when
the sum of ratios corresponding to custom blocks allocated in the
minor heap reaches 1, a minor collection is forced.

Changes

@@ -191,6 +191,11 @@ Working version
   raise exceptions.
   (David Allsopp)
 
+- MPR#7100, GPR#1476: trigger a minor GC when custom blocks accumulate
+  in minor heap
+  (Alain Frisch, report by talex, review by Damien Doligez, Leo White,
+  Gabriel Scherer)
+
 - GPR#1431: remove ocamlrun dependencies on curses/terminfo/termcap C library
   (Xavier Leroy, review by Daniel Bünzli)
 

byterun/caml/minor_gc.h

@@ -26,6 +26,7 @@ CAMLextern value *caml_young_ptr, *caml_young_limit;
 CAMLextern value *caml_young_trigger;
 extern asize_t caml_minor_heap_wsz;
 extern int caml_in_minor_collection;
+extern double caml_extra_heap_resources_minor;
 
 #define CAML_TABLE_STRUCT(t) { \
   t *base;                     \

byterun/custom.c

@@ -22,6 +22,7 @@
 #include "caml/fail.h"
 #include "caml/memory.h"
 #include "caml/mlvalues.h"
+#include "caml/signals.h"
 
 /* [size] is a number of bytes */
 CAMLexport value caml_alloc_custom(struct custom_operations * ops,
@@ -39,6 +40,16 @@ CAMLexport value caml_alloc_custom(struct custom_operations * ops,
     if (ops->finalize != NULL || mem != 0) {
       /* Remember that the block needs processing after minor GC. */
       add_to_custom_table (&caml_custom_table, result, mem, max);
+      /* Keep track of extra resources held by custom block in
+         minor heap. */
+      if (mem != 0) {
+        if (max == 0) max = 1;
+        caml_extra_heap_resources_minor += (double) mem / (double) max;
+        if (caml_extra_heap_resources_minor > 1.0) {
+          caml_request_minor_gc ();
+          caml_gc_dispatch ();
+        }
+      }
     }
   } else {
     result = caml_alloc_shr(wosize, Custom_tag);

byterun/minor_gc.c

@@ -77,6 +77,8 @@ CAMLexport struct caml_custom_table
 
 int caml_in_minor_collection = 0;
 
+double caml_extra_heap_resources_minor = 0;
+
 /* [sz] and [rsv] are numbers of entries */
 static void alloc_generic_table (struct generic_table *tbl, asize_t sz,
                                  asize_t rsv, asize_t element_size)
@@ -394,6 +396,7 @@ void caml_empty_minor_heap (void)
     clear_table ((struct generic_table *) &caml_ref_table);
     clear_table ((struct generic_table *) &caml_ephe_ref_table);
     clear_table ((struct generic_table *) &caml_custom_table);
+    caml_extra_heap_resources_minor = 0;
     caml_gc_message (0x02, ">");
     caml_in_minor_collection = 0;
     caml_final_empty_young ();