Merge pull request #11673 from stedolan/free-old-frame-tables

Octachron · web-flow · commit b06f2d1ac516 · 2022-11-08T14:00:08.000+01:00
Ensure that old frame descriptor tables are freed
diff --git a/runtime/frame_descriptors.c b/runtime/frame_descriptors.c
@@ -22,6 +22,7 @@
 #include "caml/frame_descriptors.h"
 #include "caml/major_gc.h" /* for caml_major_cycles_completed */
 #include "caml/memory.h"
+#include "caml/shared_heap.h"
 #include <stddef.h>
 
 /* Defined in code generated by ocamlopt */
@@ -172,6 +173,15 @@ void caml_register_frametable(intnat *table)
   ft->prev = old;
   atomic_store_rel(&current_frametable, (uintnat)ft);
 
+  /* Ensure that we GC often enough to prevent more than 1/4 of
+     heap memory being stale frame tables */
+  caml_adjust_gc_speed(
+     /* Size of the table just allocated */
+     (sizeof(*ft) + sizeof(ft->table.descriptors[0]) * (ft->table.mask + 1)),
+     /* 1/4 of the heap size */
+     caml_heap_size(Caml_state->shared_heap) / 4
+  );
+
   caml_plat_unlock(&descr_mutex);
 }
 
@@ -182,11 +192,16 @@ caml_frame_descrs caml_get_frame_descrs(void)
   CAMLassert(ft);
   if (atomic_load_acq(&ft->free_prev_after_cycle) < caml_major_cycles_completed)
   {
-    /* it's now safe to free the old table */
+    /* it's now safe to free the old table(s) */
     caml_plat_lock(&descr_mutex);
     if (ft->prev != NULL) {
-      caml_stat_free(ft->prev->table.descriptors);
-      caml_stat_free(ft->prev);
+      struct frametable_version *p = ft->prev;
+      while (p != NULL) {
+        struct frametable_version *next = p->prev;
+        caml_stat_free(p->table.descriptors);
+        caml_stat_free(p);
+        p = next;
+      }
       ft->prev = NULL;
       atomic_store_rel(&ft->free_prev_after_cycle, No_need_to_free);
     }
