Merge pull request #9128 from jhjourdan/caml_atom_table_padding

Add padding before and after the atom table

(cherry picked from commit 11b518258abc098e6bc0da9750f6ba8b62405626)

8 files changed, 46 insertions, 21 deletions

diff --git a/Changes b/Changes
index 977b751bf1..a610d9ddf0 100644
--- a/Changes
+++ b/Changes
@@ -512,6 +512,13 @@ OCaml 4.09 maintenance branch:
 - #9050, #9076: install missing compilerlibs/ocamlmiddleend archives
   (Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering)
 
+- #9128: Fix a bug in bytecode mode which could lead to a segmentation
+  fault. The bug was caused by the fact that the atom table shared a
+  page with some bytecode. The fix makes sure both the atom table and
+  the minor heap have their own pages.
+  (Jacques-Henri Jourdan, review by Stephen Dolan, Xavier Leroy and
+   Gabriel Scherer)
+
 OCaml 4.09.0 (19 September 2019):
 ---------------------------------
 
diff --git a/runtime/caml/gc_ctrl.h b/runtime/caml/gc_ctrl.h
index 38e02c52aa..2d499c55f1 100644
--- a/runtime/caml/gc_ctrl.h
+++ b/runtime/caml/gc_ctrl.h
@@ -20,8 +20,6 @@
 
 #include "misc.h"
 
-uintnat caml_normalize_heap_increment (uintnat);
-
 /*
   minor_size: cf. minor_heap_size in gc.mli
   major_size: Size in words of the initial major heap
diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h
index 93474fb73b..780c014ef1 100644
--- a/runtime/caml/mlvalues.h
+++ b/runtime/caml/mlvalues.h
@@ -354,7 +354,7 @@ CAMLextern int64_t caml_Int64_val(value v);
 
 /* 3- Atoms are 0-tuples.  They are statically allocated once and for all. */
 
-CAMLextern header_t caml_atom_table[];
+CAMLextern header_t *caml_atom_table;
 #define Atom(tag) (Val_hp (&(caml_atom_table [(tag)])))
 
 /* Booleans are integers 0 or 1 */
diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c
index 3d7821dad8..e444b9c5cd 100644
--- a/runtime/gc_ctrl.c
+++ b/runtime/gc_ctrl.c
@@ -388,8 +388,13 @@ static uintnat norm_pmax (uintnat p)
 
 static intnat norm_minsize (intnat s)
 {
+  intnat page_wsize = Wsize_bsize(Page_size);
   if (s < Minor_heap_min) s = Minor_heap_min;
   if (s > Minor_heap_max) s = Minor_heap_max;
+  /* PR#9128 : Make sure the minor heap occupies an integral number of
+     pages, so that no page contains both bytecode and OCaml
+     values. This would confuse, e.g., caml_hash. */
+  s = (s + page_wsize - 1) / page_wsize * page_wsize;
   return s;
 }
 
@@ -627,14 +632,6 @@ CAMLprim value caml_get_major_credit (value v)
   return Val_long ((long) (caml_major_work_credit * 1e6));
 }
 
-uintnat caml_normalize_heap_increment (uintnat i)
-{
-  if (i < Bsize_wsize (Heap_chunk_min)){
-    i = Bsize_wsize (Heap_chunk_min);
-  }
-  return ((i + Page_size - 1) >> Page_log) << Page_log;
-}
-
 /* [minor_size] and [major_size] are numbers of words
    [major_incr] is either a percentage or a number of words */
 void caml_init_gc (uintnat minor_size, uintnat major_size,
@@ -643,18 +640,20 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
                    uintnat custom_maj, uintnat custom_min,
                    uintnat custom_bsz)
 {
-  uintnat major_heap_size =
-    Bsize_wsize (caml_normalize_heap_increment (major_size));
+  uintnat major_bsize;
+  if (major_size < Heap_chunk_min) major_size = Heap_chunk_min;
+  major_bsize = Bsize_wsize(major_size);
+  major_bsize = ((major_bsize + Page_size - 1) >> Page_log) << Page_log;
 
   caml_instr_init ();
-  if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_heap_size)){
+  if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_bsize)){
     caml_fatal_error ("cannot initialize page table");
   }
   caml_set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size)));
   caml_major_heap_increment = major_incr;
   caml_percent_free = norm_pfree (percent_fr);
   caml_percent_max = norm_pmax (percent_m);
-  caml_init_major_heap (major_heap_size);
+  caml_init_major_heap (major_bsize);
   caml_major_window = norm_window (window);
   caml_custom_major_ratio = norm_custom_maj (custom_maj);
   caml_custom_minor_ratio = norm_custom_min (custom_min);
@@ -664,7 +663,7 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
                    Caml_state->minor_heap_wsz / 1024);
   caml_gc_message (0x20, "Initial major heap size: %"
                    ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
-                   major_heap_size / 1024);
+                   major_bsize / 1024);
   caml_gc_message (0x20, "Initial space overhead: %"
                    ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free);
   caml_gc_message (0x20, "Initial max overhead: %"
diff --git a/runtime/interp.c b/runtime/interp.c
index ac549b455b..6bee2b0eaa 100644
--- a/runtime/interp.c
+++ b/runtime/interp.c
@@ -533,6 +533,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
         Alloc_small(accu, num_args + 2, Closure_tag);
         Field(accu, 1) = env;
         for (i = 0; i < num_args; i++) Field(accu, i + 2) = sp[i];
+        CAMLassert(!Is_in_value_area(pc-3));
         Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
         sp += num_args;
         pc = (code_t)(sp[0]);
@@ -560,6 +561,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       }
       /* The code pointer is not in the heap, so no need to go through
          caml_initialize. */
+      CAMLassert(!Is_in_value_area(pc + *pc));
       Code_val(accu) = pc + *pc;
       pc++;
       sp += nvars;
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
index c1ddfc5171..e4dacfc51a 100644
--- a/runtime/minor_gc.c
+++ b/runtime/minor_gc.c
@@ -142,6 +142,7 @@ void caml_set_minor_heap_size (asize_t bsz)
 
   CAMLassert (bsz >= Bsize_wsize(Minor_heap_min));
   CAMLassert (bsz <= Bsize_wsize(Minor_heap_max));
+  CAMLassert (bsz % Page_size == 0);
   CAMLassert (bsz % sizeof (value) == 0);
   if (Caml_state->young_ptr != Caml_state->young_alloc_end){
     CAML_INSTR_INT ("force_minor/set_minor_heap_size@", 1);
diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c
index f01c0610fd..d265ac69b6 100644
--- a/runtime/startup_aux.c
+++ b/runtime/startup_aux.c
@@ -34,12 +34,30 @@
 extern void caml_win32_unregister_overflow_detection (void);
 #endif
 
-/* Initialize the atom table */
+CAMLexport header_t *caml_atom_table = NULL;
 
-CAMLexport header_t caml_atom_table[256];
+/* Initialize the atom table */
 void caml_init_atom_table(void)
 {
+  caml_stat_block b;
   int i;
+
+  /* PR#9128: We need to give the atom table its own page to make sure
+     it does not share a page with a non-value, which would break code
+     which depend on the correctness of the page table. For example,
+     if the atom table shares a page with bytecode, then functions in
+     the runtime may decide to follow a code pointer in a closure, as
+     if it were a pointer to a value.
+
+     We add 1 padding at the end of the atom table because the atom
+     pointer actually points to the word *following* the corresponding
+     entry in the table (the entry is an empty block *header*).
+  */
+  asize_t request = (256 + 1) * sizeof(header_t);
+  request = (request + Page_size - 1) / Page_size * Page_size;
+  caml_atom_table =
+    caml_stat_alloc_aligned_noexc(request, 0, &b);
+
   for(i = 0; i < 256; i++) {
 #ifdef NATIVE_CODE
     caml_atom_table[i] = Make_header_allocated_here(0, i, Caml_white);
@@ -48,7 +66,7 @@ void caml_init_atom_table(void)
 #endif
   }
   if (caml_page_table_add(In_static_data,
-                          caml_atom_table, caml_atom_table + 256) != 0) {
+                          caml_atom_table, caml_atom_table + 256 + 1) != 0) {
     caml_fatal_error("not enough memory for initial page table");
   }
 }
diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c
index 5734b06de4..7dec51eaa7 100644
--- a/testsuite/tests/c-api/alloc_async_stubs.c
+++ b/testsuite/tests/c-api/alloc_async_stubs.c
@@ -12,9 +12,9 @@ value stub(value ref)
 
   printf("C, before: %d\n", Int_val(Field(ref, 0)));
 
-  /* First, do enough major allocation to trigger a major collection */
+  /* First, do enough major allocations to do a full major collection cycle */
   coll_before = Caml_state_field(stat_major_collections);
-  while (Caml_state_field(stat_major_collections) == coll_before) {
+  while (Caml_state_field(stat_major_collections) <= coll_before+1) {
     caml_alloc(10000, 0);
   }