Fix misindexing related to Gc.finalise_last

[ncik-roberts]

The runtime exposes multiple ways for the users to register finalisers; one way is Gc.finalise_last. The runtime occasionally checks whether any finaliser registered with finalise_last should be run. This check first counts how much work it should do:

ocaml/runtime/finalise.c

Lines 239 to 245 in e30d23f

	for (uintnat i = final->old; i < final->young; i++){
	CAMLassert (Is_block (final->table[i].val));
	if (Is_young(final->table[i].val) &&
	caml_get_header_val(final->table[i].val) != 0){
	++ todo_count;
	}
	}

And then adds work to the queue:

ocaml/runtime/finalise.c

Lines 261 to 276 in e30d23f

	for (i = final->old; i < final->young; i++) {
	CAMLassert (Is_block (final->table[i].val));
	CAMLassert (Tag_val (final->table[i].val) != Forward_tag);
	if (Is_young(final->table[j].val) &&
	caml_get_header_val(final->table[i].val) != 0) {
	/** dead */
	fi->todo_tail->item[k] = final->table[i];
	/* The finalisation function is called with unit not with the value */
	fi->todo_tail->item[k].val = Val_unit;
	fi->todo_tail->item[k].offset = 0;
	k++;
	} else {
	/** alive */
	final->table[j++] = final->table[i];
	}
	}

The indexing in the if-conditions are different, causing a bug. One way this bug can trigger: the first condition is true less often than the second condition, leading to the extra work enqueued (because the second condition was true) being dropped (because the length of the work queue is calculated from the number of times the first condition was true).

On my system, you can repro the issue with this program:

let glob = ref []

let allocate_a_lot_on_the_major_heap () =
  for _ = 0 to 10_000_000 do
    glob := ref 1 :: !glob
  done

let go () =
  allocate_a_lot_on_the_major_heap ();
  let small = Array.init 10 (fun _ -> ()) in
  Gc.finalise_last (fun () -> print_endline "small") small;
  let large = Array.init 100_000 (fun _ -> ()) in
  Gc.finalise_last (fun () -> print_endline "large") large;
  ignore (Sys.opaque_identity (large, small) : _);
  Gc.full_major ()

let () = go ()

This program only prints small for me. (And large will never be printed for as long as the program runs.) The PR fixes the issue so that both small and large are printed.

[mshinwell]

This bug appears to have been present since finalisers were first added to the OCaml 5 runtime.

[Octachron]

This fix looks like a good candidate for backporting to 5.2.1. Any counter-indication?

[ncik-roberts]

(I'm not aware of any counter-indication.)

[kayceesrk]

LGTM.

I confirmed that I had introduced the original bug. I'm a bit surprised that it got in in the first place and survived for this long. Thanks for fixing this.

[dra27]

Cherry-picked for both 5.2.1 and 5.3.0