Skip to content

Commit c6fabbe

Browse files
EkdohibsTheNumbat
authored andcommitted
Fix problems with GC compaction and non-consecutive function slots (#2674)
1 parent 0a6ae7a commit c6fabbe

File tree

4 files changed

+28
-4
lines changed

4 files changed

+28
-4
lines changed

middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -280,6 +280,10 @@ end = struct
280280
else if starting_offset = slot_offset
281281
then acc
282282
else
283+
(* The space between slot offsets has to be padded with precisely the
284+
value tagged 0, as it is scanned by the GC during compaction. This
285+
value can't be confused with either infix headers or inverted
286+
pointers, as noted in the comment in compact.c *)
283287
List.init (slot_offset - starting_offset) (fun _ -> P.int ~dbg 1n)
284288
@ acc
285289
in

ocaml/runtime/extern.c

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -770,8 +770,15 @@ Caml_inline mlsize_t extern_closure_up_to_env(struct caml_extern_state* s,
770770
startenv = Start_env_closinfo(Closinfo_val(v));
771771
i = 0;
772772
do {
773-
/* The infix header */
774-
if (i > 0) extern_int(s, Long_val(Field(v, i++)));
773+
if (i > 0) {
774+
/* The padding before an infix header */
775+
while (Field(v, i) == Val_long(0)) {
776+
extern_int(s, 0);
777+
i++;
778+
}
779+
/* The infix header */
780+
extern_int(s, Long_val(Field(v, i++)));
781+
}
775782
/* The default entry point */
776783
extern_code_pointer(s, (char *) Field(v, i++));
777784
/* The closure info. */

ocaml/runtime4/compact.c

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -273,6 +273,12 @@ static void do_compaction (intnat new_allocation_policy)
273273
if (Is_last_closinfo (closinfo)) break;
274274
arity = Arity_closinfo (closinfo);
275275
i += 2 + (arity != 0 && arity != 1);
276+
/* If space exists between infix headers, skip it. This space is
277+
padded with Val_long(0), which can't be confused with either an
278+
infix header, or an inverted pointer. */
279+
while (Field(v, i) == Val_long(0)){
280+
++i;
281+
}
276282
CAMLassert (i < Start_env_closinfo (Closinfo_val (v)));
277283

278284
/* Revert the inverted list for infix header at offset [i]. */

ocaml/runtime4/extern.c

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -686,8 +686,15 @@ Caml_inline mlsize_t extern_closure_up_to_env(value v)
686686
startenv = Start_env_closinfo(Closinfo_val(v));
687687
i = 0;
688688
do {
689-
/* The infix header */
690-
if (i > 0) extern_int(Long_val(Field(v, i++)));
689+
if (i > 0) {
690+
/* The padding before an infix header */
691+
while (Field(v, i) == Val_long(0)) {
692+
extern_int(0);
693+
i++;
694+
}
695+
/* The infix header */
696+
extern_int(Long_val(Field(v, i++)));
697+
}
691698
/* The default entry point */
692699
extern_code_pointer((char *) Field(v, i++));
693700
/* The closure info. */

0 commit comments

Comments
 (0)