Illustration of the spurious slice problem.

prombench.ml

(* Author: Stephen Dolan *)
(* Modified by Damien Doligez *)

let large_allocs = true
let promotion_rate = 50
let collection_rate = 30
let ballast_mb = 100
let iters_m = 50

let rand =
  let counter = ref 43928071 in
  fun () ->
    let n = !counter in
    counter := n * 454339144066433781 + 1;
    n lsr 29

type junk =
  | A of int
  | B of int array
  | C of (unit -> unit)
  | D of int Lazy.t

let make_junk () =
  let i = Sys.opaque_identity 42 in
  match rand () land 3 with
  | 0 -> A i
  | 1 -> B [| 0; 1; 2; 3; 4; 5 |]
  | 2 -> C (fun x -> print_int i)
  | 3 -> D (lazy (print_int i; i))
  | _ -> assert false

let kilobyte () =
  let rec w16 n =
    if n = 0 then []
    else [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11 |] :: w16 (n - 1) in
  w16 (1024 / 8 / 16)

let megabyte () =
  Array.init (1024-8) (fun _ -> kilobyte ())

let ballast = Sys.opaque_identity (List.init ballast_mb (fun _ -> megabyte ()))


let junkq : junk list Queue.t = Queue.create ()

let () =
  let stat_before = Gc.quick_stat () in
  let before = Unix.gettimeofday () in
  let r = ref [] in
  for i = 1 to iters_m * 1_000_000 do
    let x = make_junk () in
    let cons = x :: !r in
    if rand () mod 100 < promotion_rate then begin
      r := cons;
    end;
    if i mod 1000 = 0 then begin
      if large_allocs then ignore (Sys.opaque_identity (Bytes.create (257*8)));
      Queue.push !r junkq;
      r := [];
      if rand () mod 100 < collection_rate then begin
        ignore (Queue.pop junkq);
      end;
    end;
  done;
  let after = Unix.gettimeofday () in
  let stat_minor_after = Gc.quick_stat () in
  Gc.major ();
  let stat_major_after = Gc.quick_stat () in
  let heap_before = stat_before.top_heap_words * 8 in
  let heap_after = stat_major_after.top_heap_words * 8 in
  let b_to_mb n = (n + 512 * 1024) / (1024 * 1024) in

  Printf.printf "%20s: %.2f\n" "time (s)" (after -. before);
  Printf.printf "%20s: %d\n" "heap before (mb)" (b_to_mb heap_before);
  Printf.printf "%20s: %d\n" "heap after (mb)" (b_to_mb heap_after);
  Printf.printf "%20s: %.0f\n" "heap growth (mb/s)" (float_of_int (heap_after - heap_before) /. (1024. *. 1024. *. (after -. before)));
  Printf.printf "%20s: %d\n" "minors" (stat_minor_after.minor_collections - stat_before.minor_collections);
  Printf.printf "%20s: %d\n" "majors" (stat_minor_after.major_collections - stat_before.major_collections);
  ()

original code: https://gist.github.com/stedolan/06fb028a6d6b3be38a67433d4f9ec7d5