Fix problems with GC compaction and non-consecutive function slots (#2674)

Author: Ekdohibs

middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml

@@ -280,6 +280,10 @@ end = struct
         else if starting_offset = slot_offset
         then acc
         else
+          (* The space between slot offsets has to be padded with precisely the
+             value tagged 0, as it is scanned by the GC during compaction. This
+             value can't be confused with either infix headers or inverted
+             pointers, as noted in the comment in compact.c *)
           List.init (slot_offset - starting_offset) (fun _ -> P.int ~dbg 1n)
           @ acc
       in

ocaml/runtime/extern.c

@@ -770,8 +770,15 @@ Caml_inline mlsize_t extern_closure_up_to_env(struct caml_extern_state* s,
   startenv = Start_env_closinfo(Closinfo_val(v));
   i = 0;
   do {
-    /* The infix header */
-    if (i > 0) extern_int(s, Long_val(Field(v, i++)));
+    if (i > 0) {
+      /* The padding before an infix header */
+      while (Field(v, i) == Val_long(0)) {
+        extern_int(s, 0);
+        i++;
+      }
+      /* The infix header */
+      extern_int(s, Long_val(Field(v, i++)));
+    }
     /* The default entry point */
     extern_code_pointer(s, (char *) Field(v, i++));
     /* The closure info. */

ocaml/runtime4/compact.c

@@ -273,6 +273,12 @@ static void do_compaction (intnat new_allocation_policy)
               if (Is_last_closinfo (closinfo)) break;
               arity = Arity_closinfo (closinfo);
               i += 2 + (arity != 0 && arity != 1);
+              /* If space exists between infix headers, skip it. This space is
+                 padded with Val_long(0), which can't be confused with either an
+                 infix header, or an inverted pointer. */
+              while (Field(v, i) == Val_long(0)){
+                ++i;
+              }
               CAMLassert (i < Start_env_closinfo (Closinfo_val (v)));
 
               /* Revert the inverted list for infix header at offset [i]. */

ocaml/runtime4/extern.c

@@ -686,8 +686,15 @@ Caml_inline mlsize_t extern_closure_up_to_env(value v)
   startenv = Start_env_closinfo(Closinfo_val(v));
   i = 0;
   do {
-    /* The infix header */
-    if (i > 0) extern_int(Long_val(Field(v, i++)));
+    if (i > 0) {
+      /* The padding before an infix header */
+      while (Field(v, i) == Val_long(0)) {
+        extern_int(0);
+        i++;
+      }
+      /* The infix header */
+      extern_int(Long_val(Field(v, i++)));
+    }
     /* The default entry point */
     extern_code_pointer((char *) Field(v, i++));
     /* The closure info. */