Merge pull request #10213 from damiendoligez/fix-best-fit

Fix an oversight in #10188

Changes

@@ -61,8 +61,8 @@ Working version
 - #10136: Minor clean-ups in runtime/io.c and runtime/caml/io.h
   (Xavier Leroy, review by David Allsopp and Guillaume Munch-Maccagnoni)
 
-- #10188: Switch the default allocation policy to best-fit and adjust the
-  default overhead parameter accordingly.
+- #10188, #10213: Switch the default allocation policy to best-fit and adjust
+  the default overhead parameter accordingly.
   (Damien Doligez, review by Josh Berdine and Xavier Leroy)
 
 - #10212: Simplify and improve the Windows-specific code that connects

runtime/caml/config.h

@@ -270,4 +270,7 @@ typedef uint64_t uintnat;
    Documented in gc.mli */
 #define Custom_minor_max_bsz_def 8192
 
+/* Default allocation policy. */
+#define Allocation_policy_def caml_policy_best_fit
+
 #endif /* CAML_CONFIG_H */

runtime/caml/freelist.h

@@ -52,8 +52,15 @@ Caml_inline void caml_make_free_blocks
   (value *p, mlsize_t size, int do_merge, int color)
   { (*caml_fl_p_make_free_blocks) (p, size, do_merge, color); }
 
-extern void caml_set_allocation_policy (intnat);
+enum {
+  caml_policy_next_fit = 0,
+  caml_policy_first_fit = 1,
+  caml_policy_best_fit = 2,
+};
+extern void caml_set_allocation_policy (uintnat);
+
 extern void caml_fl_reset_and_switch_policy (intnat);
+/* -1 means do not change the allocation policy */
 
 #ifdef DEBUG
 Caml_inline void caml_fl_check (void)

runtime/caml/gc_ctrl.h

@@ -40,11 +40,13 @@
   window    : cf. window_size in gc.mli
   custom_maj: cf. custom_major_ratio in gc.mli
   custom_min: cf. custom_minor_ratio in gc.mli
-  custom_sz : cf. custom_minor_max_size in gc.mli
+  custom_bsz: cf. custom_minor_max_size in gc.mli
+  policy    : cf. allocation_policy in gc.mli
 */
 void caml_init_gc (uintnat minor_size, uintnat major_size, uintnat major_incr,
                    uintnat percent_fr, uintnat percent_m, uintnat window,
-                   uintnat custom_maj, uintnat custom_min, uintnat custom_bsz);
+                   uintnat custom_maj, uintnat custom_min, uintnat custom_bsz,
+                   uintnat policy);
 
 
 CAMLextern value caml_gc_stat(value v);

runtime/caml/startup_aux.h

@@ -35,6 +35,7 @@ extern uintnat caml_init_major_window;
 extern uintnat caml_init_custom_major_ratio;
 extern uintnat caml_init_custom_minor_ratio;
 extern uintnat caml_init_custom_minor_max_bsz;
+extern uintnat caml_init_policy;
 extern uintnat caml_trace_level;
 extern int caml_cleanup_on_exit;
 

runtime/freelist.c

@@ -1747,42 +1747,32 @@ static void bf_make_free_blocks (value *p, mlsize_t size, int do_merge,
   }
 }
 
-/*********************** policy selection *****************************/
-
-enum {
-  policy_next_fit = 0,
-  policy_first_fit = 1,
-  policy_best_fit = 2,
-};
-
-uintnat caml_allocation_policy = policy_best_fit;
-
 /********************* exported functions *****************************/
 
 /* [caml_fl_allocate] does not set the header of the newly allocated block.
    The calling function must do it before any GC function gets called.
    [caml_fl_allocate] returns a head pointer, or NULL if no suitable block
    is found in the free set.
 */
-header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = &nf_allocate;
+header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = NULL;
 
 /* Initialize the merge_block machinery (at start of sweeping). */
-void (*caml_fl_p_init_merge) (void) = &nf_init_merge;
+void (*caml_fl_p_init_merge) (void) = NULL;
 
 /* These are called internally. */
-static void (*caml_fl_p_init) (void) = &nf_init;
-static void (*caml_fl_p_reset) (void) = &nf_reset;
+static void (*caml_fl_p_init) (void) = NULL;
+static void (*caml_fl_p_reset) (void) = NULL;
 
 /* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
    because merging blocks may change the size of [bp]. */
-header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = &nf_merge_block;
+header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = NULL;
 
 /* [bp] must point to a list of blocks of wosize >= 1 chained by their field 0,
    terminated by Val_NULL, and field 1 of the first block must point to
    the last block.
    The blocks must be blue.
 */
-void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks;
+void (*caml_fl_p_add_blocks) (value bp) = NULL;
 
 /* Cut a block of memory into pieces of size [Max_wosize], give them headers,
    and optionally merge them into the free list.
@@ -1796,16 +1786,21 @@ void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks;
 */
 void (*caml_fl_p_make_free_blocks)
   (value *p, mlsize_t size, int do_merge, int color)
-  = &nf_make_free_blocks;
+  = NULL;
+
 #ifdef DEBUG
-void (*caml_fl_p_check) (void) = &nf_check;
+void (*caml_fl_p_check) (void) = NULL;
 #endif
 
-void caml_set_allocation_policy (intnat p)
+/* This variable and the above function pointers must be initialized with
+   a call to [caml_set_allocation_policy]. */
+uintnat caml_allocation_policy = 999;
+
+void caml_set_allocation_policy (uintnat p)
 {
   switch (p){
-  case policy_next_fit: default:
-    caml_allocation_policy = policy_next_fit;
+  case caml_policy_next_fit:
+    caml_allocation_policy = p;
     caml_fl_p_allocate = &nf_allocate;
     caml_fl_p_init_merge = &nf_init_merge;
     caml_fl_p_reset = &nf_reset;
@@ -1817,8 +1812,9 @@ void caml_set_allocation_policy (intnat p)
     caml_fl_p_check = &nf_check;
 #endif
     break;
-  case policy_first_fit:
-    caml_allocation_policy = policy_first_fit;
+
+  case caml_policy_first_fit:
+    caml_allocation_policy = p;
     caml_fl_p_allocate = &ff_allocate;
     caml_fl_p_init_merge = &ff_init_merge;
     caml_fl_p_reset = &ff_reset;
@@ -1830,8 +1826,10 @@ void caml_set_allocation_policy (intnat p)
     caml_fl_p_check = &ff_check;
 #endif
     break;
-  case policy_best_fit:
-    caml_allocation_policy = policy_best_fit;
+
+  default:
+  case caml_policy_best_fit:
+    caml_allocation_policy = caml_policy_best_fit;
     caml_fl_p_allocate = &bf_allocate;
     caml_fl_p_init_merge = &bf_init_merge;
     caml_fl_p_reset = &bf_reset;

runtime/gc_ctrl.c

@@ -678,7 +678,7 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
                    uintnat major_incr, uintnat percent_fr,
                    uintnat percent_m, uintnat window,
                    uintnat custom_maj, uintnat custom_min,
-                   uintnat custom_bsz)
+                   uintnat custom_bsz, uintnat policy)
 {
   uintnat major_bsize;
   if (major_size < Heap_chunk_min) major_size = Heap_chunk_min;
@@ -692,6 +692,7 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
   caml_major_heap_increment = major_incr;
   caml_percent_free = norm_pfree (percent_fr);
   caml_percent_max = norm_pmax (percent_m);
+  caml_set_allocation_policy (policy);
   caml_init_major_heap (major_bsize);
   caml_major_window = norm_window (window);
   caml_custom_major_ratio = norm_custom_maj (custom_maj);

runtime/startup_aux.c

@@ -80,6 +80,7 @@ uintnat caml_init_major_window = Major_window_def;
 uintnat caml_init_custom_major_ratio = Custom_major_ratio_def;
 uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def;
 uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
+uintnat caml_init_policy = Allocation_policy_def;
 extern int caml_parser_trace;
 uintnat caml_trace_level = 0;
 int caml_cleanup_on_exit = 0;
@@ -109,8 +110,7 @@ void caml_parse_ocamlrunparam(void)
   if (opt != NULL){
     while (*opt != '\0'){
       switch (*opt++){
-      case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
-        break;
+      case 'a': scanmult (opt, &caml_init_policy); break;
       case 'b': scanmult (opt, &p); caml_record_backtrace(Val_int (p));
         break;
       case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;

runtime/startup_byt.c

@@ -540,7 +540,7 @@ CAMLexport void caml_main(char_os **argv)
                 caml_init_heap_chunk_sz, caml_init_percent_free,
                 caml_init_max_percent_free, caml_init_major_window,
                 caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
-                caml_init_custom_minor_max_bsz);
+                caml_init_custom_minor_max_bsz, caml_init_policy);
   caml_init_stack (caml_init_max_stack_wsz);
   caml_init_atom_table();
   caml_init_backtrace();
@@ -639,7 +639,7 @@ CAMLexport value caml_startup_code_exn(
                 caml_init_heap_chunk_sz, caml_init_percent_free,
                 caml_init_max_percent_free, caml_init_major_window,
                 caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
-                caml_init_custom_minor_max_bsz);
+                caml_init_custom_minor_max_bsz, caml_init_policy);
   caml_init_stack (caml_init_max_stack_wsz);
   caml_init_atom_table();
   caml_init_backtrace();

runtime/startup_nat.c

@@ -135,7 +135,7 @@ value caml_startup_common(char_os **argv, int pooling)
                 caml_init_heap_chunk_sz, caml_init_percent_free,
                 caml_init_max_percent_free, caml_init_major_window,
                 caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
-                caml_init_custom_minor_max_bsz);
+                caml_init_custom_minor_max_bsz, caml_init_policy);
   init_static();
   caml_init_signals();
 #ifdef _WIN32