Skip to content

Instantly share code, notes, and snippets.

@damiendoligez
Created April 9, 2024 12:50
Show Gist options
  • Save damiendoligez/4d65d0ade50e6d0b2726e812a0eb7a14 to your computer and use it in GitHub Desktop.
Save damiendoligez/4d65d0ade50e6d0b2726e812a0eb7a14 to your computer and use it in GitHub Desktop.
Illustration of the spurious slice problem.
(* 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);
()
@damiendoligez
Copy link
Author

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment