From 0ed381f96e0e62819ec5539a87962b9b1120b5d7 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 14:37:49 +0200
Subject: [PATCH 01/30] Initial Gc test

---
 src/gc/dune         |  9 +++++
 src/gc/stm_tests.ml | 95 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 104 insertions(+)
 create mode 100644 src/gc/dune
 create mode 100644 src/gc/stm_tests.ml

diff --git a/src/gc/dune b/src/gc/dune
new file mode 100644
index 00000000..917f750d
--- /dev/null
+++ b/src/gc/dune
@@ -0,0 +1,9 @@
+;; Tests of the stdlib Gc module
+
+(test
+ (name stm_tests)
+ (modules stm_tests)
+ (package multicoretests)
+ (libraries qcheck-stm.sequential qcheck-stm.domain)
+ (action (run %{test} --verbose))
+)
diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
new file mode 100644
index 00000000..e4fce108
--- /dev/null
+++ b/src/gc/stm_tests.ml
@@ -0,0 +1,95 @@
+open QCheck
+open STM
+
+(* sequential and parallel tests of the GC *)
+
+module GCConf =
+struct
+  type cmd =
+    | Counters
+    | Minor
+    | Full_major
+    | Compact
+    | Cons64 of int
+
+  let pp_cmd par fmt x =
+    let open Util.Pp in
+    match x with
+    | Counters   -> cst0 "Counters" fmt
+    | Minor      -> cst0 "Minor" fmt
+    | Full_major -> cst0 "Full_major" fmt
+    | Compact    -> cst0 "Compact" fmt
+    | Cons64 i   -> cst1 pp_int "Cons64" par fmt i
+
+  let show_cmd = Util.Pp.to_show pp_cmd
+
+  type state = unit
+  type sut   = { mutable int64s : int64 list }
+
+  let arb_cmd _s =
+    let int_gen = Gen.small_nat in
+    QCheck.make ~print:show_cmd
+      Gen.(frequency
+             [ 1, return Counters;
+               1, return Minor;
+               1, return Full_major;
+               1, return Compact;
+               20, map (fun i -> Cons64 i) int_gen;
+             ])
+
+  let init_state  = ()
+
+  let next_state n _s = match n with
+    | Counters   -> ()
+    | Minor      -> ()
+    | Full_major -> ()
+    | Compact    -> ()
+    | Cons64 _   -> ()
+
+  let init_sut () = { int64s = [] }
+
+  let cleanup sut =
+    begin
+      sut.int64s <- [];
+      Gc.compact ()
+    end
+
+  let precond n _s = match n with
+    | _ -> true
+
+  type _ ty += Tup3 : 'a ty * 'b ty * 'c ty -> ('a * 'b * 'c) ty
+
+  let tup3 spec_a spec_b spec_c =
+    let (ty_a,show_a) = spec_a in
+    let (ty_b,show_b) = spec_b in
+    let (ty_c,show_c) = spec_c in
+    (Tup3 (ty_a,ty_b,ty_c), QCheck.Print.tup3 show_a show_b show_c)
+
+  let run c sut = match c with
+    | Counters   -> Res (tup3 float float float, Gc.counters ())
+    | Minor      -> Res (unit, Gc.minor ())
+    | Full_major -> Res (unit, Gc.full_major ())
+    | Compact    -> Res (unit, Gc.compact ())
+    | Cons64 i   -> Res (unit, sut.int64s <- (Int64.of_int i)::sut.int64s) (*alloc int64 and cons cell at test runtime*)
+
+  let postcond n (_s: unit) res = match n, res with
+    | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
+      let (minor_words, promoted_words, major_words) = r in
+      minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
+    | Minor,      Res ((Unit,_), ()) -> true
+    | Full_major, Res ((Unit,_), ()) -> true
+    | Compact,    Res ((Unit,_), ()) -> true
+    | Cons64 _,   Res ((Unit,_), ()) -> true
+    | _, _ -> false
+end
+
+
+module GC_STM_seq = STM_sequential.Make(GCConf)
+module GC_STM_dom = STM_domain.Make(GCConf)
+
+let _ =
+  QCheck_base_runner.run_tests_main [
+    GC_STM_seq.agree_test      ~count:1000 ~name:"STM Gc test sequential";
+    GC_STM_dom.agree_test_par  ~count:1000 ~name:"STM Gc test parallel";
+    GC_STM_dom.stress_test_par ~count:1000 ~name:"STM Gc stress test parallel";
+  ]

From 8c86e072d8a0ea6c33705ffda99b1e208d664589 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 16:49:18 +0200
Subject: [PATCH 02/30] Add Gc.minor_words and allocated_bytes and a cmd to
 alloc a string

---
 src/gc/stm_tests.ml | 70 +++++++++++++++++++++++++++++++--------------
 1 file changed, 48 insertions(+), 22 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index e4fce108..8c78166f 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -7,50 +7,70 @@ module GCConf =
 struct
   type cmd =
     | Counters
+    | Minor_words
     | Minor
     | Full_major
     | Compact
+    | Allocated_bytes
     | Cons64 of int
+    | AllocStr of int * int
 
   let pp_cmd par fmt x =
     let open Util.Pp in
     match x with
-    | Counters   -> cst0 "Counters" fmt
-    | Minor      -> cst0 "Minor" fmt
-    | Full_major -> cst0 "Full_major" fmt
-    | Compact    -> cst0 "Compact" fmt
-    | Cons64 i   -> cst1 pp_int "Cons64" par fmt i
+    | Counters    -> cst0 "Counters" fmt
+    | Minor_words -> cst0 "Minor_words" fmt
+    | Minor       -> cst0 "Minor" fmt
+    | Full_major  -> cst0 "Full_major" fmt
+    | Compact     -> cst0 "Compact" fmt
+    | Allocated_bytes -> cst0 "Allocated_bytes" fmt
+    | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
+    | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
 
   let show_cmd = Util.Pp.to_show pp_cmd
 
   type state = unit
-  type sut   = { mutable int64s : int64 list }
+  let init_state  = ()
+
+  let array_length = 8
 
   let arb_cmd _s =
     let int_gen = Gen.small_nat in
+    let len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
+    let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
-             [ 1, return Counters;
+             [ 1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
+               1, return Minor_words;
                1, return Minor;
                1, return Full_major;
                1, return Compact;
-               20, map (fun i -> Cons64 i) int_gen;
+               1, return Allocated_bytes;
+               10, map (fun i -> Cons64 i) int_gen;
+               10, map2 (fun index len -> AllocStr (index,len)) index_gen len_gen;
              ])
 
-  let init_state  = ()
-
   let next_state n _s = match n with
-    | Counters   -> ()
-    | Minor      -> ()
-    | Full_major -> ()
-    | Compact    -> ()
-    | Cons64 _   -> ()
-
-  let init_sut () = { int64s = [] }
+    | Counters    -> ()
+    | Minor_words -> ()
+    | Minor       -> ()
+    | Full_major  -> ()
+    | Compact     -> ()
+    | Allocated_bytes -> ()
+    | Cons64 _    -> ()
+    | AllocStr _   -> ()
+
+  type sut =
+    { mutable int64s  : int64 list;
+      mutable strings : string array; }
+  let init_sut () =
+    { int64s = [];
+      strings = Array.make array_length ""; }
 
   let cleanup sut =
     begin
       sut.int64s <- [];
+      sut.strings <- [| |];
       Gc.compact ()
     end
 
@@ -66,20 +86,26 @@ struct
     (Tup3 (ty_a,ty_b,ty_c), QCheck.Print.tup3 show_a show_b show_c)
 
   let run c sut = match c with
-    | Counters   -> Res (tup3 float float float, Gc.counters ())
-    | Minor      -> Res (unit, Gc.minor ())
-    | Full_major -> Res (unit, Gc.full_major ())
-    | Compact    -> Res (unit, Gc.compact ())
-    | Cons64 i   -> Res (unit, sut.int64s <- (Int64.of_int i)::sut.int64s) (*alloc int64 and cons cell at test runtime*)
+    | Counters    -> Res (tup3 float float float, Gc.counters ())
+    | Minor_words -> Res (float, Gc.minor_words ())
+    | Minor       -> Res (unit, Gc.minor ())
+    | Full_major  -> Res (unit, Gc.full_major ())
+    | Compact     -> Res (unit, Gc.compact ())
+    | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
+    | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
+    | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- (String.make len 'c')) (*alloc string at test runtime*)
 
   let postcond n (_s: unit) res = match n, res with
     | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
       let (minor_words, promoted_words, major_words) = r in
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
+    | Minor_words, Res ((Float,_),r) -> r >= 0.
     | Minor,      Res ((Unit,_), ()) -> true
     | Full_major, Res ((Unit,_), ()) -> true
     | Compact,    Res ((Unit,_), ()) -> true
+    | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
     | Cons64 _,   Res ((Unit,_), ()) -> true
+    | AllocStr _,  Res ((Unit,_), ()) -> true
     | _, _ -> false
 end
 

From 77859e58c20baa355adfb13f485229fa12ed69ec Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 17:07:21 +0200
Subject: [PATCH 03/30] Add Gc.major_slice n and Gc.get_minor_free

---
 src/gc/stm_tests.ml | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 8c78166f..c82a29ed 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -9,9 +9,11 @@ struct
     | Counters
     | Minor_words
     | Minor
+    | Major_slice of int
     | Full_major
     | Compact
     | Allocated_bytes
+    | Get_minor_free
     | Cons64 of int
     | AllocStr of int * int
 
@@ -21,9 +23,11 @@ struct
     | Counters    -> cst0 "Counters" fmt
     | Minor_words -> cst0 "Minor_words" fmt
     | Minor       -> cst0 "Minor" fmt
+    | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
     | Full_major  -> cst0 "Full_major" fmt
     | Compact     -> cst0 "Compact" fmt
     | Allocated_bytes -> cst0 "Allocated_bytes" fmt
+    | Get_minor_free -> cst0 "Get_minor_free" fmt
     | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
 
@@ -43,9 +47,12 @@ struct
              [ 1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
                1, return Minor;
+               1, map (fun i -> Major_slice i) len_gen; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
+               1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
                1, return Full_major;
                1, return Compact;
                1, return Allocated_bytes;
+               1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
                10, map2 (fun index len -> AllocStr (index,len)) index_gen len_gen;
              ])
@@ -54,9 +61,11 @@ struct
     | Counters    -> ()
     | Minor_words -> ()
     | Minor       -> ()
+    | Major_slice _ -> ()
     | Full_major  -> ()
     | Compact     -> ()
     | Allocated_bytes -> ()
+    | Get_minor_free -> ()
     | Cons64 _    -> ()
     | AllocStr _   -> ()
 
@@ -89,9 +98,11 @@ struct
     | Counters    -> Res (tup3 float float float, Gc.counters ())
     | Minor_words -> Res (float, Gc.minor_words ())
     | Minor       -> Res (unit, Gc.minor ())
+    | Major_slice n -> Res (int, Gc.major_slice n)
     | Full_major  -> Res (unit, Gc.full_major ())
     | Compact     -> Res (unit, Gc.compact ())
     | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
+    | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
     | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- (String.make len 'c')) (*alloc string at test runtime*)
 
@@ -101,15 +112,16 @@ struct
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
     | Minor_words, Res ((Float,_),r) -> r >= 0.
     | Minor,      Res ((Unit,_), ()) -> true
+    | Major_slice _, Res ((Int,_),r) -> r=0
     | Full_major, Res ((Unit,_), ()) -> true
     | Compact,    Res ((Unit,_), ()) -> true
     | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
+    | Get_minor_free, Res ((Int,_),r) -> r >= 0
     | Cons64 _,   Res ((Unit,_), ()) -> true
     | AllocStr _,  Res ((Unit,_), ()) -> true
     | _, _ -> false
 end
 
-
 module GC_STM_seq = STM_sequential.Make(GCConf)
 module GC_STM_dom = STM_domain.Make(GCConf)
 

From 8b1aa6fde635f32b82ce36171d2e38a3778f8157 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 17:27:43 +0200
Subject: [PATCH 04/30] Add Gc.major

---
 src/gc/stm_tests.ml | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index c82a29ed..83b3aafc 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -10,6 +10,7 @@ struct
     | Minor_words
     | Minor
     | Major_slice of int
+    | Major
     | Full_major
     | Compact
     | Allocated_bytes
@@ -24,6 +25,7 @@ struct
     | Minor_words -> cst0 "Minor_words" fmt
     | Minor       -> cst0 "Minor" fmt
     | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
+    | Major       -> cst0 "Major" fmt
     | Full_major  -> cst0 "Full_major" fmt
     | Compact     -> cst0 "Compact" fmt
     | Allocated_bytes -> cst0 "Allocated_bytes" fmt
@@ -49,6 +51,7 @@ struct
                1, return Minor;
                1, map (fun i -> Major_slice i) len_gen; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
                1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
+               1, return Major;
                1, return Full_major;
                1, return Compact;
                1, return Allocated_bytes;
@@ -62,6 +65,7 @@ struct
     | Minor_words -> ()
     | Minor       -> ()
     | Major_slice _ -> ()
+    | Major       -> ()
     | Full_major  -> ()
     | Compact     -> ()
     | Allocated_bytes -> ()
@@ -99,6 +103,7 @@ struct
     | Minor_words -> Res (float, Gc.minor_words ())
     | Minor       -> Res (unit, Gc.minor ())
     | Major_slice n -> Res (int, Gc.major_slice n)
+    | Major       -> Res (unit, Gc.major ())
     | Full_major  -> Res (unit, Gc.full_major ())
     | Compact     -> Res (unit, Gc.compact ())
     | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
@@ -113,6 +118,7 @@ struct
     | Minor_words, Res ((Float,_),r) -> r >= 0.
     | Minor,      Res ((Unit,_), ()) -> true
     | Major_slice _, Res ((Int,_),r) -> r=0
+    | Major,      Res ((Unit,_), ()) -> true
     | Full_major, Res ((Unit,_), ()) -> true
     | Compact,    Res ((Unit,_), ()) -> true
     | Allocated_bytes, Res ((Float,_),r) -> r >= 0.

From 56109e7979feba51fa4ec1533509b14b269ca9c2 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 17:41:48 +0200
Subject: [PATCH 05/30] Add List allocation

---
 src/gc/stm_tests.ml | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 83b3aafc..e176b4a7 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -17,6 +17,7 @@ struct
     | Get_minor_free
     | Cons64 of int
     | AllocStr of int * int
+    | AllocList of int * int
 
   let pp_cmd par fmt x =
     let open Util.Pp in
@@ -32,6 +33,7 @@ struct
     | Get_minor_free -> cst0 "Get_minor_free" fmt
     | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
+    | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
 
   let show_cmd = Util.Pp.to_show pp_cmd
 
@@ -58,6 +60,7 @@ struct
                1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
                10, map2 (fun index len -> AllocStr (index,len)) index_gen len_gen;
+               10, map2 (fun index len -> AllocList (index,len)) index_gen len_gen;
              ])
 
   let next_state n _s = match n with
@@ -71,19 +74,24 @@ struct
     | Allocated_bytes -> ()
     | Get_minor_free -> ()
     | Cons64 _    -> ()
-    | AllocStr _   -> ()
+    | AllocStr _  -> ()
+    | AllocList _ -> ()
 
   type sut =
     { mutable int64s  : int64 list;
-      mutable strings : string array; }
+      mutable strings : string array;
+      mutable lists   : char list array; }
   let init_sut () =
     { int64s = [];
-      strings = Array.make array_length ""; }
+      strings = Array.make array_length "";
+      lists   = Array.make array_length [];
+    }
 
   let cleanup sut =
     begin
       sut.int64s <- [];
       sut.strings <- [| |];
+      sut.lists <- [| |];
       Gc.compact ()
     end
 
@@ -110,6 +118,7 @@ struct
     | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
     | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- (String.make len 'c')) (*alloc string at test runtime*)
+    | AllocList (i,len) -> Res (unit, sut.lists.(i) <- (List.init len (fun _ -> 'a'))) (*alloc list at test runtime*)
 
   let postcond n (_s: unit) res = match n, res with
     | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
@@ -125,6 +134,7 @@ struct
     | Get_minor_free, Res ((Int,_),r) -> r >= 0
     | Cons64 _,   Res ((Unit,_), ()) -> true
     | AllocStr _,  Res ((Unit,_), ()) -> true
+    | AllocList _,  Res ((Unit,_), ()) -> true
     | _, _ -> false
 end
 

From c8e4a435ea9018a60bc24152210df0a85ff7239b Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 27 Aug 2024 17:50:02 +0200
Subject: [PATCH 06/30] Add list reversal cmd

---
 src/gc/stm_tests.ml | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index e176b4a7..a29d39cd 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -15,9 +15,11 @@ struct
     | Compact
     | Allocated_bytes
     | Get_minor_free
+    (* cmds to allocate memory *)
     | Cons64 of int
     | AllocStr of int * int
     | AllocList of int * int
+    | RevList of int
 
   let pp_cmd par fmt x =
     let open Util.Pp in
@@ -34,6 +36,7 @@ struct
     | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
     | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
+    | RevList i   -> cst1 pp_int "RevList" par fmt i
 
   let show_cmd = Util.Pp.to_show pp_cmd
 
@@ -61,6 +64,7 @@ struct
                10, map (fun i -> Cons64 i) int_gen;
                10, map2 (fun index len -> AllocStr (index,len)) index_gen len_gen;
                10, map2 (fun index len -> AllocList (index,len)) index_gen len_gen;
+               10, map (fun index -> RevList index) index_gen;
              ])
 
   let next_state n _s = match n with
@@ -76,6 +80,7 @@ struct
     | Cons64 _    -> ()
     | AllocStr _  -> ()
     | AllocList _ -> ()
+    | RevList _   -> ()
 
   type sut =
     { mutable int64s  : int64 list;
@@ -117,8 +122,9 @@ struct
     | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
     | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
-    | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- (String.make len 'c')) (*alloc string at test runtime*)
-    | AllocList (i,len) -> Res (unit, sut.lists.(i) <- (List.init len (fun _ -> 'a'))) (*alloc list at test runtime*)
+    | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
+    | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
+    | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
   let postcond n (_s: unit) res = match n, res with
     | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
@@ -133,8 +139,9 @@ struct
     | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
     | Get_minor_free, Res ((Int,_),r) -> r >= 0
     | Cons64 _,   Res ((Unit,_), ()) -> true
-    | AllocStr _,  Res ((Unit,_), ()) -> true
-    | AllocList _,  Res ((Unit,_), ()) -> true
+    | AllocStr _, Res ((Unit,_), ()) -> true
+    | AllocList _, Res ((Unit,_), ()) -> true
+    | RevList _,  Res ((Unit,_), ()) -> true
     | _, _ -> false
 end
 

From 9ef90b52ff955ddc7e0c53df3cde4f1a0852ca72 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Thu, 29 Aug 2024 11:07:57 +0200
Subject: [PATCH 07/30] Remove stress test as the parallel test is positive and
 hence stress tests

---
 src/gc/stm_tests.ml | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index a29d39cd..3ab48a09 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -150,7 +150,6 @@ module GC_STM_dom = STM_domain.Make(GCConf)
 
 let _ =
   QCheck_base_runner.run_tests_main [
-    GC_STM_seq.agree_test      ~count:1000 ~name:"STM Gc test sequential";
-    GC_STM_dom.agree_test_par  ~count:1000 ~name:"STM Gc test parallel";
-    GC_STM_dom.stress_test_par ~count:1000 ~name:"STM Gc stress test parallel";
+    GC_STM_seq.agree_test     ~count:1000 ~name:"STM Gc test sequential";
+    GC_STM_dom.agree_test_par ~count:1000 ~name:"STM Gc test parallel";
   ]

From 8daf5d188ff7cb0ad7d84120be6e1c23b7299790 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 3 Sep 2024 13:01:25 +0200
Subject: [PATCH 08/30] Rename len_gen generator

---
 src/gc/stm_tests.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 3ab48a09..f4e1f3ad 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -47,14 +47,14 @@ struct
 
   let arb_cmd _s =
     let int_gen = Gen.small_nat in
-    let len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
+    let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
     let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
              [ 1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
                1, return Minor;
-               1, map (fun i -> Major_slice i) len_gen; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
+               1, map (fun i -> Major_slice i) str_len_gen; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
                1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
                1, return Major;
                1, return Full_major;
@@ -62,8 +62,8 @@ struct
                1, return Allocated_bytes;
                1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
-               10, map2 (fun index len -> AllocStr (index,len)) index_gen len_gen;
-               10, map2 (fun index len -> AllocList (index,len)) index_gen len_gen;
+               10, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
+               10, map2 (fun index len -> AllocList (index,len)) index_gen str_len_gen;
                10, map (fun index -> RevList index) index_gen;
              ])
 

From b931080ccda12ff9c8fd15321857a1556fb326db Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 3 Sep 2024 13:08:41 +0200
Subject: [PATCH 09/30] Just use Gen.nat for major_slice and list allocation

---
 src/gc/stm_tests.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index f4e1f3ad..189c493f 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -54,7 +54,7 @@ struct
              [ 1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
                1, return Minor;
-               1, map (fun i -> Major_slice i) str_len_gen; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
+               1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
                1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
                1, return Major;
                1, return Full_major;
@@ -63,7 +63,7 @@ struct
                1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
                10, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
-               10, map2 (fun index len -> AllocList (index,len)) index_gen str_len_gen;
+               10, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
                10, map (fun index -> RevList index) index_gen;
              ])
 

From 6b2669b916a802e6f59e8ac27b14452453a08772 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 3 Sep 2024 13:10:09 +0200
Subject: [PATCH 10/30] Add initial stresstest for parent-child GC interaction

---
 src/gc/stm_tests.ml | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 189c493f..bc24b6e4 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -148,8 +148,17 @@ end
 module GC_STM_seq = STM_sequential.Make(GCConf)
 module GC_STM_dom = STM_domain.Make(GCConf)
 
+(* Run seq. property in a child domain to stresstest parent-child GC *)
+let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
+  | Ok r -> r
+  | Error e -> raise e
+
+let agree_child_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds GCConf.init_state) agree_child_prop
+
 let _ =
   QCheck_base_runner.run_tests_main [
     GC_STM_seq.agree_test     ~count:1000 ~name:"STM Gc test sequential";
+    agree_child_test          ~count:1000 ~name:"STM Gc test sequential in child domain";
     GC_STM_dom.agree_test_par ~count:1000 ~name:"STM Gc test parallel";
   ]

From 8564731b1075cedf969e9d96821dea4181055825 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Thu, 5 Sep 2024 17:40:57 +0200
Subject: [PATCH 11/30] Add CatStr, combining strings potentially from
 different major heaps

---
 src/gc/stm_tests.ml | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index bc24b6e4..5700c601 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -18,6 +18,7 @@ struct
     (* cmds to allocate memory *)
     | Cons64 of int
     | AllocStr of int * int
+    | CatStr of int * int * int
     | AllocList of int * int
     | RevList of int
 
@@ -35,6 +36,7 @@ struct
     | Get_minor_free -> cst0 "Get_minor_free" fmt
     | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
+    | CatStr (s1,s2,t) -> cst3 pp_int pp_int pp_int "CatStr" par fmt s1 s2 t
     | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
     | RevList i   -> cst1 pp_int "RevList" par fmt i
 
@@ -63,6 +65,7 @@ struct
                1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
                10, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
+               5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
                10, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
                10, map (fun index -> RevList index) index_gen;
              ])
@@ -79,6 +82,7 @@ struct
     | Get_minor_free -> ()
     | Cons64 _    -> ()
     | AllocStr _  -> ()
+    | CatStr _    -> ()
     | AllocList _ -> ()
     | RevList _   -> ()
 
@@ -123,6 +127,7 @@ struct
     | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
     | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
+    | CatStr (src1,src2,tgt) -> Res (unit, sut.strings.(tgt) <- String.cat sut.strings.(src1) sut.strings.(src2))
     | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
     | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
@@ -140,6 +145,7 @@ struct
     | Get_minor_free, Res ((Int,_),r) -> r >= 0
     | Cons64 _,   Res ((Unit,_), ()) -> true
     | AllocStr _, Res ((Unit,_), ()) -> true
+    | CatStr _,  Res ((Unit,_), ()) -> true
     | AllocList _, Res ((Unit,_), ()) -> true
     | RevList _,  Res ((Unit,_), ()) -> true
     | _, _ -> false

From 6e07b4121e97354bb1268754dca9da692850e44e Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Sun, 8 Sep 2024 20:32:06 +0200
Subject: [PATCH 12/30] Add stat and quick_stat commands

---
 src/gc/stm_tests.ml | 76 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 75 insertions(+), 1 deletion(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 5700c601..2c297db7 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -6,6 +6,8 @@ open STM
 module GCConf =
 struct
   type cmd =
+    | Stat
+    | Quick_stat
     | Counters
     | Minor_words
     | Minor
@@ -25,6 +27,8 @@ struct
   let pp_cmd par fmt x =
     let open Util.Pp in
     match x with
+    | Stat        -> cst0 "Stat" fmt
+    | Quick_stat  -> cst0 "Quick_stat" fmt
     | Counters    -> cst0 "Counters" fmt
     | Minor_words -> cst0 "Minor_words" fmt
     | Minor       -> cst0 "Minor" fmt
@@ -53,7 +57,9 @@ struct
     let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
-             [ 1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
+             [ 1, return Stat;
+               1, return Quick_stat;
+               1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
                1, return Minor;
                1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
@@ -71,6 +77,8 @@ struct
              ])
 
   let next_state n _s = match n with
+    | Stat        -> ()
+    | Quick_stat  -> ()
     | Counters    -> ()
     | Minor_words -> ()
     | Minor       -> ()
@@ -108,6 +116,7 @@ struct
     | _ -> true
 
   type _ ty += Tup3 : 'a ty * 'b ty * 'c ty -> ('a * 'b * 'c) ty
+            | GcStat: Gc.stat ty
 
   let tup3 spec_a spec_b spec_c =
     let (ty_a,show_a) = spec_a in
@@ -115,7 +124,36 @@ struct
     let (ty_c,show_c) = spec_c in
     (Tup3 (ty_a,ty_b,ty_c), QCheck.Print.tup3 show_a show_b show_c)
 
+  let pp_gcstat par fmt s =
+    let open Util.Pp in
+    pp_record par fmt
+      [
+        pp_field "minor_words" pp_float s.Gc.minor_words;
+        pp_field "promoted_words" pp_float s.Gc.promoted_words;
+        pp_field "major_words" pp_float s.Gc.major_words;
+        pp_field "minor_collections" pp_int s.Gc.minor_collections;
+        pp_field "major_collections" pp_int s.Gc.major_collections;
+        pp_field "heap_words" pp_int s.Gc.heap_words;
+        pp_field "heap_chunks" pp_int s.Gc.heap_chunks;
+        pp_field "live_words" pp_int s.Gc.live_words;
+        pp_field "live_blocks" pp_int s.Gc.live_blocks;
+        pp_field "free_words" pp_int s.Gc.free_words;
+        pp_field "free_blocks" pp_int s.Gc.free_blocks;
+        pp_field "largest_free" pp_int s.Gc.largest_free;
+        pp_field "fragments" pp_int s.Gc.fragments;
+        pp_field "compactions" pp_int s.Gc.compactions;
+        pp_field "top_heap_words" pp_int s.Gc.top_heap_words;
+        pp_field "stack_size" pp_int s.Gc.stack_size;
+        pp_field "forced_major_collections" pp_int s.Gc.forced_major_collections;
+      ]
+
+  let show_gcstat = Util.Pp.to_show pp_gcstat
+
+  let gcstat = (GcStat, show_gcstat)
+
   let run c sut = match c with
+    | Stat        -> Res (gcstat, Gc.stat ())
+    | Quick_stat  -> Res (gcstat, Gc.quick_stat ())
     | Counters    -> Res (tup3 float float float, Gc.counters ())
     | Minor_words -> Res (float, Gc.minor_words ())
     | Minor       -> Res (unit, Gc.minor ())
@@ -132,6 +170,42 @@ struct
     | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
   let postcond n (_s: unit) res = match n, res with
+    | Stat, Res ((GcStat,_),r) ->
+      r.Gc.minor_words >= 0. &&
+      r.Gc.promoted_words >= 0. &&
+      r.Gc.major_words >= 0. &&
+      r.Gc.minor_collections >= 0 &&
+      r.Gc.major_collections >= 0 &&
+      r.Gc.heap_words >= 0 &&
+      r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+      r.Gc.live_words >= 0 &&
+      r.Gc.live_blocks >= 0 &&
+      r.Gc.free_words >= 0 &&
+      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
+      r.Gc.fragments >= 0 &&
+      r.Gc.compactions >= 0 &&
+      r.Gc.top_heap_words >= 0 &&
+      r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
+      r.Gc.forced_major_collections >= 0
+    | Quick_stat, Res ((GcStat,_),r) ->
+      r.Gc.minor_words >= 0. &&
+      r.Gc.promoted_words >= 0. &&
+      r.Gc.major_words >= 0. &&
+      r.Gc.minor_collections >= 0 &&
+      r.Gc.major_collections >= 0 &&
+      r.Gc.heap_words >= 0 &&
+      r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+      r.Gc.live_words >= 0 &&  (* Spec bug: live_words = 396863; *)
+      r.Gc.live_blocks >= 0 && (* Spec bug: live_blocks = 91632; *)
+      r.Gc.free_words >= 0 &&  (* Spec bug: free_words = 81565; *)
+      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)  (* doc oops: dbl-zero *)
+      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *) (* doc oops: dbl-zero *)
+      r.Gc.fragments >= 0 &&   (* Spec bug: fragments = 3111; *)
+      r.Gc.compactions >= 0 &&
+      r.Gc.top_heap_words >= 0 &&
+      r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
+      r.Gc.forced_major_collections >= 0
     | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
       let (minor_words, promoted_words, major_words) = r in
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.

From 35d9e9da0c51763dfb6f9d5ed32247fb6cdb2a04 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 9 Sep 2024 13:22:17 +0200
Subject: [PATCH 13/30] Add Gc.get command

---
 src/gc/stm_tests.ml | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 2c297db7..b25caafd 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -10,6 +10,7 @@ struct
     | Quick_stat
     | Counters
     | Minor_words
+    | Get
     | Minor
     | Major_slice of int
     | Major
@@ -31,6 +32,7 @@ struct
     | Quick_stat  -> cst0 "Quick_stat" fmt
     | Counters    -> cst0 "Counters" fmt
     | Minor_words -> cst0 "Minor_words" fmt
+    | Get         -> cst0 "Get" fmt
     | Minor       -> cst0 "Minor" fmt
     | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
     | Major       -> cst0 "Major" fmt
@@ -61,6 +63,7 @@ struct
                1, return Quick_stat;
                1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
+               1, return Get;
                1, return Minor;
                1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
                1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
@@ -81,6 +84,7 @@ struct
     | Quick_stat  -> ()
     | Counters    -> ()
     | Minor_words -> ()
+    | Get         -> ()
     | Minor       -> ()
     | Major_slice _ -> ()
     | Major       -> ()
@@ -117,6 +121,7 @@ struct
 
   type _ ty += Tup3 : 'a ty * 'b ty * 'c ty -> ('a * 'b * 'c) ty
             | GcStat: Gc.stat ty
+            | GcControl: Gc.control ty
 
   let tup3 spec_a spec_b spec_c =
     let (ty_a,show_a) = spec_a in
@@ -151,11 +156,33 @@ struct
 
   let gcstat = (GcStat, show_gcstat)
 
+  let pp_gccontrol par fmt c =
+    let open Util.Pp in
+    pp_record par fmt
+      [
+        pp_field "minor_heap_size" pp_int c.Gc.minor_heap_size;
+        pp_field "major_heap_increment" pp_int c.Gc.major_heap_increment;
+        pp_field "space_overhead" pp_int c.Gc.space_overhead;
+        pp_field "verbose" pp_int c.Gc.verbose;
+        pp_field "max_overhead" pp_int c.Gc.max_overhead;
+        pp_field "stack_limit" pp_int c.Gc.stack_limit;
+        pp_field "allocation_policy" pp_int c.Gc.allocation_policy;
+        pp_field "window_size" pp_int c.Gc.window_size;
+        pp_field "custom_major_ratio" pp_int c.Gc.custom_major_ratio;
+        pp_field "custom_minor_ratio" pp_int c.Gc.custom_minor_ratio;
+        pp_field "custom_minor_max_size" pp_int c.Gc.custom_minor_max_size;
+      ]
+
+  let show_gccontrol = Util.Pp.to_show pp_gccontrol
+
+  let gccontrol = (GcControl, show_gccontrol)
+
   let run c sut = match c with
     | Stat        -> Res (gcstat, Gc.stat ())
     | Quick_stat  -> Res (gcstat, Gc.quick_stat ())
     | Counters    -> Res (tup3 float float float, Gc.counters ())
     | Minor_words -> Res (float, Gc.minor_words ())
+    | Get         -> Res (gccontrol, Gc.get ())
     | Minor       -> Res (unit, Gc.minor ())
     | Major_slice n -> Res (int, Gc.major_slice n)
     | Major       -> Res (unit, Gc.major ())
@@ -210,6 +237,18 @@ struct
       let (minor_words, promoted_words, major_words) = r in
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
     | Minor_words, Res ((Float,_),r) -> r >= 0.
+    | Get,         Res ((GcControl,_),r) ->
+      r.Gc.minor_heap_size >= 0 &&
+      r.Gc.major_heap_increment >= 0 &&  (* ALWAYS 0? *)
+      r.Gc.space_overhead >= 0 &&
+      r.Gc.verbose land 0x7ff = r.Gc.verbose &&
+      r.Gc.max_overhead >= 0 &&          (* ALWAYS 0? *)
+      r.Gc.stack_limit >= 0 &&
+      r.Gc.allocation_policy >= 0 &&     (* ignored in OCaml5 *)
+      (*1*)0 <= r.Gc.window_size && r.Gc.window_size <= 50 &&  (* BUG: ALWAYS 0, window_size = 0 *)
+      0 <= r.Gc.custom_major_ratio && r.Gc.custom_major_ratio <= 100 &&
+      0 <= r.Gc.custom_minor_ratio && r.Gc.custom_minor_ratio <= 100 &&
+      r.Gc.custom_minor_max_size >= 0
     | Minor,      Res ((Unit,_), ()) -> true
     | Major_slice _, Res ((Int,_),r) -> r=0
     | Major,      Res ((Unit,_), ()) -> true

From e9c9a6a2b23c8fc6a0dd2ee3040b1aebcbd4dd09 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 9 Sep 2024 13:46:42 +0200
Subject: [PATCH 14/30] Avoid triggering Gc.counters memory unsafety on 5.2 and
 earlier

---
 src/gc/stm_tests.ml | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index b25caafd..41b743b9 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -59,9 +59,9 @@ struct
     let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
+           (let gens =
              [ 1, return Stat;
                1, return Quick_stat;
-               1, return Counters;  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
                1, return Minor_words;
                1, return Get;
                1, return Minor;
@@ -77,7 +77,10 @@ struct
                5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
                10, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
                10, map (fun index -> RevList index) index_gen;
-             ])
+             ] in
+           if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
+           then (1, return Counters)::gens  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
+           else gens))
 
   let next_state n _s = match n with
     | Stat        -> ()

From ea6a5162e25c4e131e37b61ba8b407f2c41786e9 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 17 Sep 2024 09:47:19 +0200
Subject: [PATCH 15/30] Initial support for Gc.set cmd

---
 src/gc/stm_tests.ml | 167 +++++++++++++++++++++++++++++++++++++-------
 1 file changed, 141 insertions(+), 26 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 41b743b9..d48d98e6 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -3,14 +3,35 @@ open STM
 
 (* sequential and parallel tests of the GC *)
 
+(* TODO:
+   - support OCAMLRUNPARAM / ... in init_state
+   - add bigarray
+   - support allocations in both parent and child domains
+   - split into an implicit and an explicit Gc test
+ *)
+
 module GCConf =
 struct
+  type setcmd =
+    | Minor_heap_size of int
+    | Major_heap_increment of int (* 1: currently ignored it seems? *)
+    | Space_overhead of int
+    (* | Verbose *)
+    | Max_overhead of int         (* 4: currently ignored it seems? *)
+    | Stack_limit of int
+    (* | Allocation_policy *)     (* "This option is ignored in OCaml 5.x." *)
+    (* | Window_size of int *)    (* 7: currently ignored it seems? *)
+    | Custom_major_ratio of int
+    | Custom_minor_ratio of int
+    | Custom_minor_max_size of int
+
   type cmd =
     | Stat
     | Quick_stat
     | Counters
     | Minor_words
     | Get
+    | Set of setcmd
     | Minor
     | Major_slice of int
     | Major
@@ -33,6 +54,16 @@ struct
     | Counters    -> cst0 "Counters" fmt
     | Minor_words -> cst0 "Minor_words" fmt
     | Get         -> cst0 "Get" fmt
+    | Set subcmd -> (match subcmd with
+        | Minor_heap_size i       -> cst1 pp_int "Set minor_heap_size" par fmt i
+        | Major_heap_increment i  -> cst1 pp_int "Set major_heap_increment" par fmt i
+        | Space_overhead i        -> cst1 pp_int "Set space_overhead" par fmt i
+        | Max_overhead i          -> cst1 pp_int "Set max_overhead" par fmt i
+        | Stack_limit i           -> cst1 pp_int "Set stack_limit" par fmt i
+        | Custom_major_ratio i    -> cst1 pp_int "Set custom_major_ratio" par fmt i
+        | Custom_minor_ratio i    -> cst1 pp_int "Set custom_minor_ratio" par fmt i
+        | Custom_minor_max_size i -> cst1 pp_int "Set custom_minor_max_size" par fmt i
+      )
     | Minor       -> cst0 "Minor" fmt
     | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
     | Major       -> cst0 "Major" fmt
@@ -48,12 +79,40 @@ struct
 
   let show_cmd = Util.Pp.to_show pp_cmd
 
-  type state = unit
-  let init_state  = ()
+  let default_control = Gc.{
+      minor_heap_size = 262_144;      (* Default: 256k. *)
+      major_heap_increment = 0;       (* Default: 15. -- BUG: 0 *)
+      space_overhead = 120;           (* Default: 120. *)
+      verbose = 0;                    (* Default: 0. *)
+      max_overhead = 0;               (* Default: 500. -- BUG: 0 *)
+      stack_limit = 134_217_728;      (* Default: 1024k. -- BUG: 134_217_728? "#define Max_stack_def (128 * 1024 * 1024)" *)
+      allocation_policy = 0;          (* "This option is ignored in OCaml 5.x." *)
+      window_size = 0;                (* Default: 1. --- BUG: 0 *)
+      custom_major_ratio = 44;        (* Default: 44. *)
+      custom_minor_ratio = 100;       (* Default: 100. *)
+      custom_minor_max_size = 70_000; (* Default: 70000 bytes. *)
+    }
 
+  type state = Gc.control
+  let init_state = default_control
+  (* try Sys.getenv "OCAMLRUNPARAM"
+         with  FIXME *)
   let array_length = 8
 
   let arb_cmd _s =
+    let minor_heap_size_gen = Gen.oneofl [512;1024;2048;4096;8192;16384;32768] in
+    let major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
+                                          Gen.int_range 101 1000;   (* percentage increment *)
+                                          Gen.int_range 1000 10000; (* word increment *)
+                                         ] in
+    let space_overhead = Gen.int_range 20 200 in   (* percentage increment *)
+    let max_overhead = Gen.oneof [Gen.return 0; (* "If max_overhead is set to 0, heap compaction is triggered at the end of each major GC cycle" *)
+                                  Gen.int_range 1 1000;
+                                  Gen.return 1_000_000; ] in (* "If max_overhead >= 1000000 , compaction is never triggered." *)
+    let stack_limit = Gen.int_range 3284 1_000_000 in
+    let custom_major_ratio = Gen.int_range 1 100 in
+    let custom_minor_ratio = Gen.int_range 1 100 in
+    let custom_minor_max_size = Gen.int_range 10 1_000_000 in
     let int_gen = Gen.small_nat in
     let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
     let index_gen = Gen.int_bound (array_length-1) in
@@ -63,7 +122,15 @@ struct
              [ 1, return Stat;
                1, return Quick_stat;
                1, return Minor_words;
-               1, return Get;
+               10, return Get;
+               1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
+               1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;
+               1, map (fun i -> Set (Space_overhead i)) space_overhead;
+               1, map (fun i -> Set (Max_overhead i)) max_overhead;
+               1, map (fun i -> Set (Stack_limit i)) stack_limit;
+               1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
+               1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
+               1, map (fun i -> Set (Custom_minor_max_size i)) custom_minor_max_size;
                1, return Minor;
                1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
                1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
@@ -82,25 +149,46 @@ struct
            then (1, return Counters)::gens  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
            else gens))
 
-  let next_state n _s = match n with
-    | Stat        -> ()
-    | Quick_stat  -> ()
-    | Counters    -> ()
-    | Minor_words -> ()
-    | Get         -> ()
-    | Minor       -> ()
-    | Major_slice _ -> ()
-    | Major       -> ()
-    | Full_major  -> ()
-    | Compact     -> ()
-    | Allocated_bytes -> ()
-    | Get_minor_free -> ()
-    | Cons64 _    -> ()
-    | AllocStr _  -> ()
-    | CatStr _    -> ()
-    | AllocList _ -> ()
-    | RevList _   -> ()
+  let next_state n s = match n with
+    | Stat        -> s
+    | Quick_stat  -> s
+    | Counters    -> s
+    | Minor_words -> s
+    | Get         -> s
+    | Set subcmd -> (match subcmd with
+        | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = mhs }
+        | Major_heap_increment _mhi -> s (* { s with Gc.major_heap_increment = mhi }*) (* BUG *)
+        | Space_overhead so         -> { s with Gc.space_overhead = so }
+        | Max_overhead _mo          -> s (* { s with Gc.max_overhead = mo }*) (* BUG *)
+        | Stack_limit sl            -> { s with Gc.stack_limit = sl }
+        | Custom_major_ratio cmr    -> { s with Gc.custom_major_ratio = cmr }
+        | Custom_minor_ratio cmr    -> { s with Gc.custom_minor_ratio = cmr }
+        | Custom_minor_max_size ms  -> { s with Gc.custom_minor_max_size = ms }
+      )
+    | Minor       -> s
+    | Major_slice _ -> s
+    | Major       -> s
+    | Full_major  -> s
+    | Compact     -> s
+    | Allocated_bytes -> s
+    | Get_minor_free -> s
+    | Cons64 _    -> s
+    | AllocStr _  -> s
+    | CatStr _    -> s
+    | AllocList _ -> s
+    | RevList _   -> s
+
+(*
+BUG
+...
+   Set stack_limit 3283 : ()
+...
+  Get : { minor_heap_size = 8192; major_heap_increment = 0; space_overhead = 183; verbose = 0; max_overhead = 0; stack_limit = 3284; allocation_policy = 0; window_size = 0; custom_major_ratio = 44; custom_minor_ratio = 100; custom_minor_max_size = 70000 }
+
+calls 'caml_change_max_stack_size' in runtime/fiber.c:70 which may expand the size slightly it see
 
+also `caml_maybe_expand_stack` may do so
+*)
   type sut =
     { mutable int64s  : int64 list;
       mutable strings : string array;
@@ -116,6 +204,7 @@ struct
       sut.int64s <- [];
       sut.strings <- [| |];
       sut.lists <- [| |];
+      Gc.set default_control;
       Gc.compact ()
     end
 
@@ -186,6 +275,16 @@ struct
     | Counters    -> Res (tup3 float float float, Gc.counters ())
     | Minor_words -> Res (float, Gc.minor_words ())
     | Get         -> Res (gccontrol, Gc.get ())
+    | Set subcmd -> (match subcmd with
+        | Minor_heap_size i       -> Res (unit, let prev = Gc.get () in Gc.set { prev with minor_heap_size = i; })
+        | Major_heap_increment i  -> Res (unit, let prev = Gc.get () in Gc.set { prev with major_heap_increment = i; })
+        | Space_overhead i        -> Res (unit, let prev = Gc.get () in Gc.set { prev with space_overhead = i; })
+        | Max_overhead i          -> Res (unit, let prev = Gc.get () in Gc.set { prev with max_overhead = i; })
+        | Stack_limit i           -> Res (unit, let prev = Gc.get () in Gc.set { prev with stack_limit = i; })
+        | Custom_major_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_major_ratio = i; })
+        | Custom_minor_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_ratio = i; })
+        | Custom_minor_max_size i -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_max_size = i; })
+      )
     | Minor       -> Res (unit, Gc.minor ())
     | Major_slice n -> Res (int, Gc.major_slice n)
     | Major       -> Res (unit, Gc.major ())
@@ -199,7 +298,7 @@ struct
     | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
     | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
-  let postcond n (_s: unit) res = match n, res with
+  let postcond n (s: state) res = match n, res with
     | Stat, Res ((GcStat,_),r) ->
       r.Gc.minor_words >= 0. &&
       r.Gc.promoted_words >= 0. &&
@@ -241,6 +340,10 @@ struct
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
     | Minor_words, Res ((Float,_),r) -> r >= 0.
     | Get,         Res ((GcControl,_),r) ->
+      (* stack_limit may have been expanded *)
+      r = { s with stack_limit = r.Gc.stack_limit } &&
+      r.Gc.stack_limit >= s.Gc.stack_limit
+      (*
       r.Gc.minor_heap_size >= 0 &&
       r.Gc.major_heap_increment >= 0 &&  (* ALWAYS 0? *)
       r.Gc.space_overhead >= 0 &&
@@ -252,8 +355,10 @@ struct
       0 <= r.Gc.custom_major_ratio && r.Gc.custom_major_ratio <= 100 &&
       0 <= r.Gc.custom_minor_ratio && r.Gc.custom_minor_ratio <= 100 &&
       r.Gc.custom_minor_max_size >= 0
+      *)
+    | Set _,      Res ((Unit,_), ()) -> true
     | Minor,      Res ((Unit,_), ()) -> true
-    | Major_slice _, Res ((Int,_),r) -> r=0
+    | Major_slice _, Res ((Int,_),r) -> r = 0
     | Major,      Res ((Unit,_), ()) -> true
     | Full_major, Res ((Unit,_), ()) -> true
     | Compact,    Res ((Unit,_), ()) -> true
@@ -270,17 +375,27 @@ end
 module GC_STM_seq = STM_sequential.Make(GCConf)
 module GC_STM_dom = STM_domain.Make(GCConf)
 
+let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
 (* Run seq. property in a child domain to stresstest parent-child GC *)
 let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
   | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
   | Error e -> raise e
 
+let agree_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds GCConf.init_state) agree_prop
+
 let agree_child_test ~count ~name =
   Test.make ~name ~count (GC_STM_seq.arb_cmds GCConf.init_state) agree_child_prop
 
 let _ =
   QCheck_base_runner.run_tests_main [
-    GC_STM_seq.agree_test     ~count:1000 ~name:"STM Gc test sequential";
-    agree_child_test          ~count:1000 ~name:"STM Gc test sequential in child domain";
-    GC_STM_dom.agree_test_par ~count:1000 ~name:"STM Gc test parallel";
+    agree_test                    ~count:1000 ~name:"STM Gc test sequential";
+    agree_child_test              ~count:1000 ~name:"STM Gc test sequential in child domain";
+    GC_STM_dom.neg_agree_test_par ~count:1000 ~name:"STM Gc test parallel";
+    GC_STM_dom.stress_test_par    ~count:1000 ~name:"STM Gc stress test parallel";
   ]

From b1532b8571829549935d6cb8dcfd38f69b1c996f Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 23 Sep 2024 15:13:27 +0200
Subject: [PATCH 16/30] Test polishing

---
 src/gc/stm_tests.ml | 51 +++++++++++++++++----------------------------
 1 file changed, 19 insertions(+), 32 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index d48d98e6..415e48a5 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -14,13 +14,13 @@ module GCConf =
 struct
   type setcmd =
     | Minor_heap_size of int
-    | Major_heap_increment of int (* 1: currently ignored it seems? *)
+    | Major_heap_increment of int (* 1: "This field is currently not available in OCaml 5: the field value is always [0]." *)
     | Space_overhead of int
     (* | Verbose *)
-    | Max_overhead of int         (* 4: currently ignored it seems? *)
+    | Max_overhead of int         (* 4: "This field is currently not available in OCaml 5: the field value is always [0]." *)
     | Stack_limit of int
-    (* | Allocation_policy *)     (* "This option is ignored in OCaml 5.x." *)
-    (* | Window_size of int *)    (* 7: currently ignored it seems? *)
+    (* | Allocation_policy *)     (* 6: "This field is currently not available in OCaml 5: the field value is always [0]." *)
+    (* | Window_size of int *)    (* 7: "This field is currently not available in OCaml 5: the field value is always [0]." *)
     | Custom_major_ratio of int
     | Custom_minor_ratio of int
     | Custom_minor_max_size of int
@@ -81,13 +81,13 @@ struct
 
   let default_control = Gc.{
       minor_heap_size = 262_144;      (* Default: 256k. *)
-      major_heap_increment = 0;       (* Default: 15. -- BUG: 0 *)
+      major_heap_increment = 0;       (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
       space_overhead = 120;           (* Default: 120. *)
       verbose = 0;                    (* Default: 0. *)
-      max_overhead = 0;               (* Default: 500. -- BUG: 0 *)
-      stack_limit = 134_217_728;      (* Default: 1024k. -- BUG: 134_217_728? "#define Max_stack_def (128 * 1024 * 1024)" *)
+      max_overhead = 0;               (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
+      stack_limit = 134_217_728;      (* Default: 128M. https://github.com/ocaml/ocaml/pull/13440 *)
       allocation_policy = 0;          (* "This option is ignored in OCaml 5.x." *)
-      window_size = 0;                (* Default: 1. --- BUG: 0 *)
+      window_size = 0;                (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
       custom_major_ratio = 44;        (* Default: 44. *)
       custom_minor_ratio = 100;       (* Default: 100. *)
       custom_minor_max_size = 70_000; (* Default: 70000 bytes. *)
@@ -124,9 +124,9 @@ struct
                1, return Minor_words;
                10, return Get;
                1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
-               1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;
+             (*1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;*)
                1, map (fun i -> Set (Space_overhead i)) space_overhead;
-               1, map (fun i -> Set (Max_overhead i)) max_overhead;
+             (*1, map (fun i -> Set (Max_overhead i)) max_overhead;*)
                1, map (fun i -> Set (Stack_limit i)) stack_limit;
                1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
                1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
@@ -157,9 +157,9 @@ struct
     | Get         -> s
     | Set subcmd -> (match subcmd with
         | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = mhs }
-        | Major_heap_increment _mhi -> s (* { s with Gc.major_heap_increment = mhi }*) (* BUG *)
+        | Major_heap_increment _mhi -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
         | Space_overhead so         -> { s with Gc.space_overhead = so }
-        | Max_overhead _mo          -> s (* { s with Gc.max_overhead = mo }*) (* BUG *)
+        | Max_overhead _mo          -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
         | Stack_limit sl            -> { s with Gc.stack_limit = sl }
         | Custom_major_ratio cmr    -> { s with Gc.custom_major_ratio = cmr }
         | Custom_minor_ratio cmr    -> { s with Gc.custom_minor_ratio = cmr }
@@ -325,12 +325,12 @@ also `caml_maybe_expand_stack` may do so
       r.Gc.major_collections >= 0 &&
       r.Gc.heap_words >= 0 &&
       r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-      r.Gc.live_words >= 0 &&  (* Spec bug: live_words = 396863; *)
-      r.Gc.live_blocks >= 0 && (* Spec bug: live_blocks = 91632; *)
-      r.Gc.free_words >= 0 &&  (* Spec bug: free_words = 81565; *)
-      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)  (* doc oops: dbl-zero *)
-      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *) (* doc oops: dbl-zero *)
-      r.Gc.fragments >= 0 &&   (* Spec bug: fragments = 3111; *)
+      r.Gc.live_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+      r.Gc.live_blocks >= 0 && (* https://github.com/ocaml/ocaml/pull/13424 *)
+      r.Gc.free_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
+      r.Gc.fragments >= 0 &&   (* https://github.com/ocaml/ocaml/pull/13424 *)
       r.Gc.compactions >= 0 &&
       r.Gc.top_heap_words >= 0 &&
       r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
@@ -340,22 +340,9 @@ also `caml_maybe_expand_stack` may do so
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
     | Minor_words, Res ((Float,_),r) -> r >= 0.
     | Get,         Res ((GcControl,_),r) ->
-      (* stack_limit may have been expanded *)
+      (* model-agreement modulo stack_limit which may have been expanded *)
       r = { s with stack_limit = r.Gc.stack_limit } &&
       r.Gc.stack_limit >= s.Gc.stack_limit
-      (*
-      r.Gc.minor_heap_size >= 0 &&
-      r.Gc.major_heap_increment >= 0 &&  (* ALWAYS 0? *)
-      r.Gc.space_overhead >= 0 &&
-      r.Gc.verbose land 0x7ff = r.Gc.verbose &&
-      r.Gc.max_overhead >= 0 &&          (* ALWAYS 0? *)
-      r.Gc.stack_limit >= 0 &&
-      r.Gc.allocation_policy >= 0 &&     (* ignored in OCaml5 *)
-      (*1*)0 <= r.Gc.window_size && r.Gc.window_size <= 50 &&  (* BUG: ALWAYS 0, window_size = 0 *)
-      0 <= r.Gc.custom_major_ratio && r.Gc.custom_major_ratio <= 100 &&
-      0 <= r.Gc.custom_minor_ratio && r.Gc.custom_minor_ratio <= 100 &&
-      r.Gc.custom_minor_max_size >= 0
-      *)
     | Set _,      Res ((Unit,_), ()) -> true
     | Minor,      Res ((Unit,_), ()) -> true
     | Major_slice _, Res ((Int,_),r) -> r = 0

From 3c20bf737b90f9bd31d062a919f58ec8b7845ec5 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 23 Sep 2024 15:24:08 +0200
Subject: [PATCH 17/30] unused vars

---
 src/gc/stm_tests.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 415e48a5..6d6b5ef2 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -101,12 +101,12 @@ struct
 
   let arb_cmd _s =
     let minor_heap_size_gen = Gen.oneofl [512;1024;2048;4096;8192;16384;32768] in
-    let major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
+    let _major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
                                           Gen.int_range 101 1000;   (* percentage increment *)
                                           Gen.int_range 1000 10000; (* word increment *)
                                          ] in
     let space_overhead = Gen.int_range 20 200 in   (* percentage increment *)
-    let max_overhead = Gen.oneof [Gen.return 0; (* "If max_overhead is set to 0, heap compaction is triggered at the end of each major GC cycle" *)
+    let _max_overhead = Gen.oneof [Gen.return 0; (* "If max_overhead is set to 0, heap compaction is triggered at the end of each major GC cycle" *)
                                   Gen.int_range 1 1000;
                                   Gen.return 1_000_000; ] in (* "If max_overhead >= 1000000 , compaction is never triggered." *)
     let stack_limit = Gen.int_range 3284 1_000_000 in

From a11e342f05f910b64eeeaab2ce872eabec6c1665 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 23 Sep 2024 15:25:12 +0200
Subject: [PATCH 18/30] Factor stat/quick_stat property

---
 src/gc/stm_tests.ml | 57 +++++++++++++++++----------------------------
 1 file changed, 21 insertions(+), 36 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 6d6b5ef2..ac8e3dd4 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -298,43 +298,28 @@ also `caml_maybe_expand_stack` may do so
     | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
     | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
+  let check_gc_stats r =
+    r.Gc.minor_words >= 0. &&
+    r.Gc.promoted_words >= 0. &&
+    r.Gc.major_words >= 0. &&
+    r.Gc.minor_collections >= 0 &&
+    r.Gc.major_collections >= 0 &&
+    r.Gc.heap_words >= 0 &&
+    r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+    r.Gc.live_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+    r.Gc.live_blocks >= 0 && (* https://github.com/ocaml/ocaml/pull/13424 *)
+    r.Gc.free_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+    r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+    r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
+    r.Gc.fragments >= 0 &&   (* https://github.com/ocaml/ocaml/pull/13424 *)
+    r.Gc.compactions >= 0 &&
+    r.Gc.top_heap_words >= 0 &&
+    r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
+    r.Gc.forced_major_collections >= 0
+
   let postcond n (s: state) res = match n, res with
-    | Stat, Res ((GcStat,_),r) ->
-      r.Gc.minor_words >= 0. &&
-      r.Gc.promoted_words >= 0. &&
-      r.Gc.major_words >= 0. &&
-      r.Gc.minor_collections >= 0 &&
-      r.Gc.major_collections >= 0 &&
-      r.Gc.heap_words >= 0 &&
-      r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-      r.Gc.live_words >= 0 &&
-      r.Gc.live_blocks >= 0 &&
-      r.Gc.free_words >= 0 &&
-      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
-      r.Gc.fragments >= 0 &&
-      r.Gc.compactions >= 0 &&
-      r.Gc.top_heap_words >= 0 &&
-      r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
-      r.Gc.forced_major_collections >= 0
-    | Quick_stat, Res ((GcStat,_),r) ->
-      r.Gc.minor_words >= 0. &&
-      r.Gc.promoted_words >= 0. &&
-      r.Gc.major_words >= 0. &&
-      r.Gc.minor_collections >= 0 &&
-      r.Gc.major_collections >= 0 &&
-      r.Gc.heap_words >= 0 &&
-      r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-      r.Gc.live_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
-      r.Gc.live_blocks >= 0 && (* https://github.com/ocaml/ocaml/pull/13424 *)
-      r.Gc.free_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
-      r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-      r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
-      r.Gc.fragments >= 0 &&   (* https://github.com/ocaml/ocaml/pull/13424 *)
-      r.Gc.compactions >= 0 &&
-      r.Gc.top_heap_words >= 0 &&
-      r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
-      r.Gc.forced_major_collections >= 0
+    | Stat, Res ((GcStat,_),r) -> check_gc_stats r
+    | Quick_stat, Res ((GcStat,_),r) -> check_gc_stats r
     | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
       let (minor_words, promoted_words, major_words) = r in
       minor_words >= 0. && promoted_words >= 0. && major_words >= 0.

From 76c32bf9ca96669de855858ef1496b7fbfe0ab81 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Mon, 23 Sep 2024 17:06:37 +0200
Subject: [PATCH 19/30] Support (O)CAMLRUNPARAM

---
 src/gc/stm_tests.ml | 55 ++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 50 insertions(+), 5 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index ac8e3dd4..dc062ada 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -4,7 +4,6 @@ open STM
 (* sequential and parallel tests of the GC *)
 
 (* TODO:
-   - support OCAMLRUNPARAM / ... in init_state
    - add bigarray
    - support allocations in both parent and child domains
    - split into an implicit and an explicit Gc test
@@ -94,9 +93,55 @@ struct
     }
 
   type state = Gc.control
-  let init_state = default_control
-  (* try Sys.getenv "OCAMLRUNPARAM"
-         with  FIXME *)
+
+  (* Non-pretty OCAMLRUNPARAM parsing code *)
+  let parse_params params = (* "l=2M,b,m=55,M=50,n=50,s=4k,o=75" *)
+    let parse_pair s =
+      (match String.split_on_char '=' s with
+       | [lhs;rhs] -> Some (lhs, rhs)
+       | _ -> None) in
+    let convert_rhs rhs =
+      if rhs="" then None else
+        let len = String.length rhs in
+        (match rhs.[len - 1] with
+         | 'k' -> Some ((1 lsl 10) * int_of_string (String.sub rhs 0 (len - 1)))
+         | 'M' -> Some ((1 lsl 20) * int_of_string (String.sub rhs 0 (len - 1)))
+         | 'G' -> Some ((1 lsl 30) * int_of_string (String.sub rhs 0 (len - 1)))
+         | c ->
+           if '0' <= c && c <= '9'
+           then Some (int_of_string rhs)
+           else None) in
+    let param_list = String.split_on_char ',' params in
+    let pairs =
+      List.fold_right
+        (fun s acc -> match parse_pair s with None -> acc | Some pair -> pair::acc)
+        param_list [] in
+    let num_pairs =
+      List.fold_right
+        (fun (lhs,rhs) acc -> match convert_rhs rhs with None -> acc | Some num -> (lhs,num)::acc)
+        pairs [] in
+    num_pairs
+
+  let rec interpret_params paramlist s =
+    match paramlist with
+    | [] -> s
+    | pair::ps ->
+      let s' = match pair with (* FIXME: The multiplier is k, M, or G, for multiplication by 2^10, 2^20, and 2^30 respectively.*)
+        | ("l",sl)  -> { s with Gc.stack_limit = sl }
+        | ("m",cmr) -> { s with Gc.custom_minor_ratio = cmr }
+        | ("M",cmr) -> { s with Gc.custom_major_ratio = cmr }
+        | ("n",cms) -> { s with Gc.custom_minor_max_size = cms }
+        | ("o",so)  -> { s with Gc.space_overhead = so }
+        | ("s",hs)  -> { s with Gc.minor_heap_size = hs }
+        | _ -> s in
+      interpret_params ps s'
+
+  let init_state =
+    let params =
+      try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
+      try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
+    interpret_params (parse_params params) default_control
+
   let array_length = 8
 
   let arb_cmd _s =
@@ -204,7 +249,7 @@ also `caml_maybe_expand_stack` may do so
       sut.int64s <- [];
       sut.strings <- [| |];
       sut.lists <- [| |];
-      Gc.set default_control;
+      Gc.set init_state;
       Gc.compact ()
     end
 

From d9666f4402dcf717af1ac1c1755d65e4d56fbb26 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 24 Sep 2024 10:44:44 +0200
Subject: [PATCH 20/30] Add PreAllocStr cmd

---
 src/gc/stm_tests.ml | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index dc062ada..ee7dd218 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -4,6 +4,7 @@ open STM
 (* sequential and parallel tests of the GC *)
 
 (* TODO:
+   - --profile=debug-runtime sets `(link_flags :standard -runtime-variant=d)` causing verbose=63? without v=0
    - add bigarray
    - support allocations in both parent and child domains
    - split into an implicit and an explicit Gc test
@@ -40,6 +41,7 @@ struct
     | Get_minor_free
     (* cmds to allocate memory *)
     | Cons64 of int
+    | PreAllocStr of int * string
     | AllocStr of int * int
     | CatStr of int * int * int
     | AllocList of int * int
@@ -71,6 +73,7 @@ struct
     | Allocated_bytes -> cst0 "Allocated_bytes" fmt
     | Get_minor_free -> cst0 "Get_minor_free" fmt
     | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
+    | PreAllocStr (i,s) -> cst2 pp_int pp_string "PreAllocStr" par fmt i s
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
     | CatStr (s1,s2,t) -> cst3 pp_int pp_int pp_int "CatStr" par fmt s1 s2 t
     | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
@@ -160,6 +163,7 @@ struct
     let custom_minor_max_size = Gen.int_range 10 1_000_000 in
     let int_gen = Gen.small_nat in
     let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
+    let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
     let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
@@ -185,7 +189,8 @@ struct
                1, return Allocated_bytes;
                1, return Get_minor_free;
                10, map (fun i -> Cons64 i) int_gen;
-               10, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
+               5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
+               5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
                5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
                10, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
                10, map (fun index -> RevList index) index_gen;
@@ -218,6 +223,7 @@ struct
     | Allocated_bytes -> s
     | Get_minor_free -> s
     | Cons64 _    -> s
+    | PreAllocStr _ -> s
     | AllocStr _  -> s
     | CatStr _    -> s
     | AllocList _ -> s
@@ -338,6 +344,7 @@ also `caml_maybe_expand_stack` may do so
     | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
     | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
+    | PreAllocStr (i,s) -> Res (unit, sut.strings.(i) <- s) (*alloc string in parent domain*)
     | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
     | CatStr (src1,src2,tgt) -> Res (unit, sut.strings.(tgt) <- String.cat sut.strings.(src1) sut.strings.(src2))
     | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
@@ -382,6 +389,7 @@ also `caml_maybe_expand_stack` may do so
     | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
     | Get_minor_free, Res ((Int,_),r) -> r >= 0
     | Cons64 _,   Res ((Unit,_), ()) -> true
+    | PreAllocStr _, Res ((Unit,_), ()) -> true
     | AllocStr _, Res ((Unit,_), ()) -> true
     | CatStr _,  Res ((Unit,_), ()) -> true
     | AllocList _, Res ((Unit,_), ()) -> true

From 8d945c25f3010681b36e4ca4c4dabaad01055bb9 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 24 Sep 2024 11:02:54 +0200
Subject: [PATCH 21/30] Add PreAllocList cmd

---
 src/gc/stm_tests.ml | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index ee7dd218..a2117ce7 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -6,7 +6,6 @@ open STM
 (* TODO:
    - --profile=debug-runtime sets `(link_flags :standard -runtime-variant=d)` causing verbose=63? without v=0
    - add bigarray
-   - support allocations in both parent and child domains
    - split into an implicit and an explicit Gc test
  *)
 
@@ -44,6 +43,7 @@ struct
     | PreAllocStr of int * string
     | AllocStr of int * int
     | CatStr of int * int * int
+    | PreAllocList of int * char list
     | AllocList of int * int
     | RevList of int
 
@@ -76,6 +76,7 @@ struct
     | PreAllocStr (i,s) -> cst2 pp_int pp_string "PreAllocStr" par fmt i s
     | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
     | CatStr (s1,s2,t) -> cst3 pp_int pp_int pp_int "CatStr" par fmt s1 s2 t
+    | PreAllocList (i,l) -> cst2 pp_int (pp_list pp_char) "PreAllocList" par fmt i l
     | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
     | RevList i   -> cst1 pp_int "RevList" par fmt i
 
@@ -164,6 +165,7 @@ struct
     let int_gen = Gen.small_nat in
     let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
     let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
+    let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
     let index_gen = Gen.int_bound (array_length-1) in
     QCheck.make ~print:show_cmd
       Gen.(frequency
@@ -192,7 +194,8 @@ struct
                5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
                5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
                5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
-               10, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
+               5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
+               5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
                10, map (fun index -> RevList index) index_gen;
              ] in
            if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
@@ -226,6 +229,7 @@ struct
     | PreAllocStr _ -> s
     | AllocStr _  -> s
     | CatStr _    -> s
+    | PreAllocList _ -> s
     | AllocList _ -> s
     | RevList _   -> s
 
@@ -344,9 +348,10 @@ also `caml_maybe_expand_stack` may do so
     | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
     | Get_minor_free -> Res (int, Gc.get_minor_free ())
     | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
-    | PreAllocStr (i,s) -> Res (unit, sut.strings.(i) <- s) (*alloc string in parent domain*)
+    | PreAllocStr (i,s) -> Res (unit, sut.strings.(i) <- s) (*alloc string in parent domain in test-input*)
     | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
     | CatStr (src1,src2,tgt) -> Res (unit, sut.strings.(tgt) <- String.cat sut.strings.(src1) sut.strings.(src2))
+    | PreAllocList (i,l) -> Res (unit, sut.lists.(i) <- l) (*alloc list in parent domain in test-input*)
     | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
     | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
 
@@ -392,6 +397,7 @@ also `caml_maybe_expand_stack` may do so
     | PreAllocStr _, Res ((Unit,_), ()) -> true
     | AllocStr _, Res ((Unit,_), ()) -> true
     | CatStr _,  Res ((Unit,_), ()) -> true
+    | PreAllocList _, Res ((Unit,_), ()) -> true
     | AllocList _, Res ((Unit,_), ()) -> true
     | RevList _,  Res ((Unit,_), ()) -> true
     | _, _ -> false

From 6c1252f79558ee15a1f49945581caa24b487c547 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 24 Sep 2024 11:14:56 +0200
Subject: [PATCH 22/30] Silence warnings

---
 src/gc/dune | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/gc/dune b/src/gc/dune
index 917f750d..93008e3d 100644
--- a/src/gc/dune
+++ b/src/gc/dune
@@ -4,6 +4,7 @@
  (name stm_tests)
  (modules stm_tests)
  (package multicoretests)
+ (flags (:standard -w -37))
  (libraries qcheck-stm.sequential qcheck-stm.domain)
  (action (run %{test} --verbose))
 )

From bc334f563a3deab9e6350b8a74390bbeb6c4bddc Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 24 Sep 2024 11:55:07 +0200
Subject: [PATCH 23/30] Factor configuration into a separate module and adjust
 dune file

---
 src/gc/GCConf.ml    | 393 +++++++++++++++++++++++++++++++++++++++++++
 src/gc/dune         |   2 +-
 src/gc/stm_tests.ml | 395 --------------------------------------------
 3 files changed, 394 insertions(+), 396 deletions(-)
 create mode 100644 src/gc/GCConf.ml

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
new file mode 100644
index 00000000..2d1aab2b
--- /dev/null
+++ b/src/gc/GCConf.ml
@@ -0,0 +1,393 @@
+open QCheck
+open STM
+
+type setcmd =
+  | Minor_heap_size of int
+  | Major_heap_increment of int (* 1: "This field is currently not available in OCaml 5: the field value is always [0]." *)
+  | Space_overhead of int
+  (* | Verbose *)
+  | Max_overhead of int         (* 4: "This field is currently not available in OCaml 5: the field value is always [0]." *)
+  | Stack_limit of int
+  (* | Allocation_policy *)     (* 6: "This field is currently not available in OCaml 5: the field value is always [0]." *)
+  (* | Window_size of int *)    (* 7: "This field is currently not available in OCaml 5: the field value is always [0]." *)
+  | Custom_major_ratio of int
+  | Custom_minor_ratio of int
+  | Custom_minor_max_size of int
+
+type cmd =
+  | Stat
+  | Quick_stat
+  | Counters
+  | Minor_words
+  | Get
+  | Set of setcmd
+  | Minor
+  | Major_slice of int
+  | Major
+  | Full_major
+  | Compact
+  | Allocated_bytes
+  | Get_minor_free
+  (* cmds to allocate memory *)
+  | Cons64 of int
+  | PreAllocStr of int * string
+  | AllocStr of int * int
+  | CatStr of int * int * int
+  | PreAllocList of int * char list
+  | AllocList of int * int
+  | RevList of int
+
+let pp_cmd par fmt x =
+  let open Util.Pp in
+  match x with
+  | Stat        -> cst0 "Stat" fmt
+  | Quick_stat  -> cst0 "Quick_stat" fmt
+  | Counters    -> cst0 "Counters" fmt
+  | Minor_words -> cst0 "Minor_words" fmt
+  | Get         -> cst0 "Get" fmt
+  | Set subcmd -> (match subcmd with
+      | Minor_heap_size i       -> cst1 pp_int "Set minor_heap_size" par fmt i
+      | Major_heap_increment i  -> cst1 pp_int "Set major_heap_increment" par fmt i
+      | Space_overhead i        -> cst1 pp_int "Set space_overhead" par fmt i
+      | Max_overhead i          -> cst1 pp_int "Set max_overhead" par fmt i
+      | Stack_limit i           -> cst1 pp_int "Set stack_limit" par fmt i
+      | Custom_major_ratio i    -> cst1 pp_int "Set custom_major_ratio" par fmt i
+      | Custom_minor_ratio i    -> cst1 pp_int "Set custom_minor_ratio" par fmt i
+      | Custom_minor_max_size i -> cst1 pp_int "Set custom_minor_max_size" par fmt i
+    )
+  | Minor       -> cst0 "Minor" fmt
+  | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
+  | Major       -> cst0 "Major" fmt
+  | Full_major  -> cst0 "Full_major" fmt
+  | Compact     -> cst0 "Compact" fmt
+  | Allocated_bytes -> cst0 "Allocated_bytes" fmt
+  | Get_minor_free -> cst0 "Get_minor_free" fmt
+  | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
+  | PreAllocStr (i,s) -> cst2 pp_int pp_string "PreAllocStr" par fmt i s
+  | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
+  | CatStr (s1,s2,t) -> cst3 pp_int pp_int pp_int "CatStr" par fmt s1 s2 t
+  | PreAllocList (i,l) -> cst2 pp_int (pp_list pp_char) "PreAllocList" par fmt i l
+  | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
+  | RevList i   -> cst1 pp_int "RevList" par fmt i
+
+let show_cmd = Util.Pp.to_show pp_cmd
+
+let default_control = Gc.{
+    minor_heap_size = 262_144;      (* Default: 256k. *)
+    major_heap_increment = 0;       (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
+    space_overhead = 120;           (* Default: 120. *)
+    verbose = 0;                    (* Default: 0. *)
+    max_overhead = 0;               (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
+    stack_limit = 134_217_728;      (* Default: 128M. https://github.com/ocaml/ocaml/pull/13440 *)
+    allocation_policy = 0;          (* "This option is ignored in OCaml 5.x." *)
+    window_size = 0;                (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
+    custom_major_ratio = 44;        (* Default: 44. *)
+    custom_minor_ratio = 100;       (* Default: 100. *)
+    custom_minor_max_size = 70_000; (* Default: 70000 bytes. *)
+  }
+
+type state = Gc.control
+
+(* Non-pretty OCAMLRUNPARAM parsing code *)
+let parse_params params = (* "l=2M,b,m=55,M=50,n=50,s=4k,o=75" *)
+  let parse_pair s =
+    (match String.split_on_char '=' s with
+     | [lhs;rhs] -> Some (lhs, rhs)
+     | _ -> None) in
+  let convert_rhs rhs =
+    if rhs="" then None else
+      let len = String.length rhs in
+      (match rhs.[len - 1] with
+       | 'k' -> Some ((1 lsl 10) * int_of_string (String.sub rhs 0 (len - 1)))
+       | 'M' -> Some ((1 lsl 20) * int_of_string (String.sub rhs 0 (len - 1)))
+       | 'G' -> Some ((1 lsl 30) * int_of_string (String.sub rhs 0 (len - 1)))
+       | c ->
+         if '0' <= c && c <= '9'
+         then Some (int_of_string rhs)
+         else None) in
+  let param_list = String.split_on_char ',' params in
+  let pairs =
+    List.fold_right
+      (fun s acc -> match parse_pair s with None -> acc | Some pair -> pair::acc)
+      param_list [] in
+  let num_pairs =
+    List.fold_right
+      (fun (lhs,rhs) acc -> match convert_rhs rhs with None -> acc | Some num -> (lhs,num)::acc)
+      pairs [] in
+  num_pairs
+
+let rec interpret_params paramlist s =
+  match paramlist with
+  | [] -> s
+  | pair::ps ->
+    let s' = match pair with (* FIXME: The multiplier is k, M, or G, for multiplication by 2^10, 2^20, and 2^30 respectively.*)
+      | ("l",sl)  -> { s with Gc.stack_limit = sl }
+      | ("m",cmr) -> { s with Gc.custom_minor_ratio = cmr }
+      | ("M",cmr) -> { s with Gc.custom_major_ratio = cmr }
+      | ("n",cms) -> { s with Gc.custom_minor_max_size = cms }
+      | ("o",so)  -> { s with Gc.space_overhead = so }
+      | ("s",hs)  -> { s with Gc.minor_heap_size = hs }
+      | _ -> s in
+    interpret_params ps s'
+
+let init_state =
+  let params =
+    try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
+    try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
+  interpret_params (parse_params params) default_control
+
+let array_length = 8
+
+let arb_cmd _s =
+  let minor_heap_size_gen = Gen.oneofl [512;1024;2048;4096;8192;16384;32768] in
+  let _major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
+                                         Gen.int_range 101 1000;   (* percentage increment *)
+                                         Gen.int_range 1000 10000; (* word increment *)
+                                        ] in
+  let space_overhead = Gen.int_range 20 200 in   (* percentage increment *)
+  let _max_overhead = Gen.oneof [Gen.return 0; (* "If max_overhead is set to 0, heap compaction is triggered at the end of each major GC cycle" *)
+                                 Gen.int_range 1 1000;
+                                 Gen.return 1_000_000; ] in (* "If max_overhead >= 1000000 , compaction is never triggered." *)
+  let stack_limit = Gen.int_range 3284 1_000_000 in
+  let custom_major_ratio = Gen.int_range 1 100 in
+  let custom_minor_ratio = Gen.int_range 1 100 in
+  let custom_minor_max_size = Gen.int_range 10 1_000_000 in
+  let int_gen = Gen.small_nat in
+  let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
+  let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
+  let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
+  let index_gen = Gen.int_bound (array_length-1) in
+  QCheck.make ~print:show_cmd
+    Gen.(frequency
+           (let gens =
+             [ 1, return Stat;
+               1, return Quick_stat;
+               1, return Minor_words;
+               10, return Get;
+               1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
+             (*1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;*)
+               1, map (fun i -> Set (Space_overhead i)) space_overhead;
+             (*1, map (fun i -> Set (Max_overhead i)) max_overhead;*)
+               1, map (fun i -> Set (Stack_limit i)) stack_limit;
+               1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
+               1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
+               1, map (fun i -> Set (Custom_minor_max_size i)) custom_minor_max_size;
+               1, return Minor;
+               1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
+               1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
+               1, return Major;
+               1, return Full_major;
+               1, return Compact;
+               1, return Allocated_bytes;
+               1, return Get_minor_free;
+               10, map (fun i -> Cons64 i) int_gen;
+               5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
+               5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
+               5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
+               5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
+               5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
+               10, map (fun index -> RevList index) index_gen;
+             ] in
+            if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
+            then (1, return Counters)::gens  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
+            else gens))
+
+let next_state n s = match n with
+  | Stat        -> s
+  | Quick_stat  -> s
+  | Counters    -> s
+  | Minor_words -> s
+  | Get         -> s
+  | Set subcmd -> (match subcmd with
+      | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = mhs }
+      | Major_heap_increment _mhi -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
+      | Space_overhead so         -> { s with Gc.space_overhead = so }
+      | Max_overhead _mo          -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
+      | Stack_limit sl            -> { s with Gc.stack_limit = sl }
+      | Custom_major_ratio cmr    -> { s with Gc.custom_major_ratio = cmr }
+      | Custom_minor_ratio cmr    -> { s with Gc.custom_minor_ratio = cmr }
+      | Custom_minor_max_size ms  -> { s with Gc.custom_minor_max_size = ms }
+    )
+  | Minor       -> s
+  | Major_slice _ -> s
+  | Major       -> s
+  | Full_major  -> s
+  | Compact     -> s
+  | Allocated_bytes -> s
+  | Get_minor_free -> s
+  | Cons64 _    -> s
+  | PreAllocStr _ -> s
+  | AllocStr _  -> s
+  | CatStr _    -> s
+  | PreAllocList _ -> s
+  | AllocList _ -> s
+  | RevList _   -> s
+
+(*
+BUG
+...
+   Set stack_limit 3283 : ()
+...
+  Get : { minor_heap_size = 8192; major_heap_increment = 0; space_overhead = 183; verbose = 0; max_overhead = 0; stack_limit = 3284; allocation_policy = 0; window_size = 0; custom_major_ratio = 44; custom_minor_ratio = 100; custom_minor_max_size = 70000 }
+
+calls 'caml_change_max_stack_size' in runtime/fiber.c:70 which may expand the size slightly it see
+
+also `caml_maybe_expand_stack` may do so
+*)
+type sut =
+  { mutable int64s  : int64 list;
+    mutable strings : string array;
+    mutable lists   : char list array; }
+let init_sut () =
+  { int64s = [];
+    strings = Array.make array_length "";
+    lists   = Array.make array_length [];
+  }
+
+let cleanup sut =
+  begin
+    sut.int64s <- [];
+    sut.strings <- [| |];
+    sut.lists <- [| |];
+    Gc.set init_state;
+    Gc.compact ()
+  end
+
+let precond n _s = match n with
+  | _ -> true
+
+type _ ty += Tup3 : 'a ty * 'b ty * 'c ty -> ('a * 'b * 'c) ty
+          | GcStat: Gc.stat ty
+          | GcControl: Gc.control ty
+
+let tup3 spec_a spec_b spec_c =
+  let (ty_a,show_a) = spec_a in
+  let (ty_b,show_b) = spec_b in
+  let (ty_c,show_c) = spec_c in
+  (Tup3 (ty_a,ty_b,ty_c), QCheck.Print.tup3 show_a show_b show_c)
+
+let pp_gcstat par fmt s =
+  let open Util.Pp in
+  pp_record par fmt
+    [
+      pp_field "minor_words" pp_float s.Gc.minor_words;
+      pp_field "promoted_words" pp_float s.Gc.promoted_words;
+      pp_field "major_words" pp_float s.Gc.major_words;
+      pp_field "minor_collections" pp_int s.Gc.minor_collections;
+      pp_field "major_collections" pp_int s.Gc.major_collections;
+      pp_field "heap_words" pp_int s.Gc.heap_words;
+      pp_field "heap_chunks" pp_int s.Gc.heap_chunks;
+      pp_field "live_words" pp_int s.Gc.live_words;
+      pp_field "live_blocks" pp_int s.Gc.live_blocks;
+      pp_field "free_words" pp_int s.Gc.free_words;
+      pp_field "free_blocks" pp_int s.Gc.free_blocks;
+      pp_field "largest_free" pp_int s.Gc.largest_free;
+      pp_field "fragments" pp_int s.Gc.fragments;
+      pp_field "compactions" pp_int s.Gc.compactions;
+      pp_field "top_heap_words" pp_int s.Gc.top_heap_words;
+      pp_field "stack_size" pp_int s.Gc.stack_size;
+      pp_field "forced_major_collections" pp_int s.Gc.forced_major_collections;
+    ]
+
+let show_gcstat = Util.Pp.to_show pp_gcstat
+
+let gcstat = (GcStat, show_gcstat)
+
+let pp_gccontrol par fmt c =
+  let open Util.Pp in
+  pp_record par fmt
+    [
+      pp_field "minor_heap_size" pp_int c.Gc.minor_heap_size;
+      pp_field "major_heap_increment" pp_int c.Gc.major_heap_increment;
+      pp_field "space_overhead" pp_int c.Gc.space_overhead;
+      pp_field "verbose" pp_int c.Gc.verbose;
+      pp_field "max_overhead" pp_int c.Gc.max_overhead;
+      pp_field "stack_limit" pp_int c.Gc.stack_limit;
+      pp_field "allocation_policy" pp_int c.Gc.allocation_policy;
+      pp_field "window_size" pp_int c.Gc.window_size;
+      pp_field "custom_major_ratio" pp_int c.Gc.custom_major_ratio;
+      pp_field "custom_minor_ratio" pp_int c.Gc.custom_minor_ratio;
+      pp_field "custom_minor_max_size" pp_int c.Gc.custom_minor_max_size;
+    ]
+
+let show_gccontrol = Util.Pp.to_show pp_gccontrol
+
+let gccontrol = (GcControl, show_gccontrol)
+
+let run c sut = match c with
+  | Stat        -> Res (gcstat, Gc.stat ())
+  | Quick_stat  -> Res (gcstat, Gc.quick_stat ())
+  | Counters    -> Res (tup3 float float float, Gc.counters ())
+  | Minor_words -> Res (float, Gc.minor_words ())
+  | Get         -> Res (gccontrol, Gc.get ())
+  | Set subcmd -> (match subcmd with
+      | Minor_heap_size i       -> Res (unit, let prev = Gc.get () in Gc.set { prev with minor_heap_size = i; })
+      | Major_heap_increment i  -> Res (unit, let prev = Gc.get () in Gc.set { prev with major_heap_increment = i; })
+      | Space_overhead i        -> Res (unit, let prev = Gc.get () in Gc.set { prev with space_overhead = i; })
+      | Max_overhead i          -> Res (unit, let prev = Gc.get () in Gc.set { prev with max_overhead = i; })
+      | Stack_limit i           -> Res (unit, let prev = Gc.get () in Gc.set { prev with stack_limit = i; })
+      | Custom_major_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_major_ratio = i; })
+      | Custom_minor_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_ratio = i; })
+      | Custom_minor_max_size i -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_max_size = i; })
+    )
+  | Minor       -> Res (unit, Gc.minor ())
+  | Major_slice n -> Res (int, Gc.major_slice n)
+  | Major       -> Res (unit, Gc.major ())
+  | Full_major  -> Res (unit, Gc.full_major ())
+  | Compact     -> Res (unit, Gc.compact ())
+  | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
+  | Get_minor_free -> Res (int, Gc.get_minor_free ())
+  | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
+  | PreAllocStr (i,s) -> Res (unit, sut.strings.(i) <- s) (*alloc string in parent domain in test-input*)
+  | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
+  | CatStr (src1,src2,tgt) -> Res (unit, sut.strings.(tgt) <- String.cat sut.strings.(src1) sut.strings.(src2))
+  | PreAllocList (i,l) -> Res (unit, sut.lists.(i) <- l) (*alloc list in parent domain in test-input*)
+  | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
+  | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
+
+let check_gc_stats r =
+  r.Gc.minor_words >= 0. &&
+  r.Gc.promoted_words >= 0. &&
+  r.Gc.major_words >= 0. &&
+  r.Gc.minor_collections >= 0 &&
+  r.Gc.major_collections >= 0 &&
+  r.Gc.heap_words >= 0 &&
+  r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+  r.Gc.live_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+  r.Gc.live_blocks >= 0 && (* https://github.com/ocaml/ocaml/pull/13424 *)
+  r.Gc.free_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
+  r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
+  r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
+  r.Gc.fragments >= 0 &&   (* https://github.com/ocaml/ocaml/pull/13424 *)
+  r.Gc.compactions >= 0 &&
+  r.Gc.top_heap_words >= 0 &&
+  r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
+  r.Gc.forced_major_collections >= 0
+
+let postcond n (s: state) res = match n, res with
+  | Stat, Res ((GcStat,_),r) -> check_gc_stats r
+  | Quick_stat, Res ((GcStat,_),r) -> check_gc_stats r
+  | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
+    let (minor_words, promoted_words, major_words) = r in
+    minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
+  | Minor_words, Res ((Float,_),r) -> r >= 0.
+  | Get,         Res ((GcControl,_),r) ->
+    (* model-agreement modulo stack_limit which may have been expanded *)
+    r = { s with stack_limit = r.Gc.stack_limit } &&
+    r.Gc.stack_limit >= s.Gc.stack_limit
+  | Set _,      Res ((Unit,_), ()) -> true
+  | Minor,      Res ((Unit,_), ()) -> true
+  | Major_slice _, Res ((Int,_),r) -> r = 0
+  | Major,      Res ((Unit,_), ()) -> true
+  | Full_major, Res ((Unit,_), ()) -> true
+  | Compact,    Res ((Unit,_), ()) -> true
+  | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
+  | Get_minor_free, Res ((Int,_),r) -> r >= 0
+  | Cons64 _,   Res ((Unit,_), ()) -> true
+  | PreAllocStr _, Res ((Unit,_), ()) -> true
+  | AllocStr _, Res ((Unit,_), ()) -> true
+  | CatStr _,  Res ((Unit,_), ()) -> true
+  | PreAllocList _, Res ((Unit,_), ()) -> true
+  | AllocList _, Res ((Unit,_), ()) -> true
+  | RevList _,  Res ((Unit,_), ()) -> true
+  | _, _ -> false
diff --git a/src/gc/dune b/src/gc/dune
index 93008e3d..8b0b9b6e 100644
--- a/src/gc/dune
+++ b/src/gc/dune
@@ -2,7 +2,7 @@
 
 (test
  (name stm_tests)
- (modules stm_tests)
+ (modules GCConf stm_tests)
  (package multicoretests)
  (flags (:standard -w -37))
  (libraries qcheck-stm.sequential qcheck-stm.domain)
diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index a2117ce7..5b4ba131 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -1,5 +1,4 @@
 open QCheck
-open STM
 
 (* sequential and parallel tests of the GC *)
 
@@ -9,400 +8,6 @@ open STM
    - split into an implicit and an explicit Gc test
  *)
 
-module GCConf =
-struct
-  type setcmd =
-    | Minor_heap_size of int
-    | Major_heap_increment of int (* 1: "This field is currently not available in OCaml 5: the field value is always [0]." *)
-    | Space_overhead of int
-    (* | Verbose *)
-    | Max_overhead of int         (* 4: "This field is currently not available in OCaml 5: the field value is always [0]." *)
-    | Stack_limit of int
-    (* | Allocation_policy *)     (* 6: "This field is currently not available in OCaml 5: the field value is always [0]." *)
-    (* | Window_size of int *)    (* 7: "This field is currently not available in OCaml 5: the field value is always [0]." *)
-    | Custom_major_ratio of int
-    | Custom_minor_ratio of int
-    | Custom_minor_max_size of int
-
-  type cmd =
-    | Stat
-    | Quick_stat
-    | Counters
-    | Minor_words
-    | Get
-    | Set of setcmd
-    | Minor
-    | Major_slice of int
-    | Major
-    | Full_major
-    | Compact
-    | Allocated_bytes
-    | Get_minor_free
-    (* cmds to allocate memory *)
-    | Cons64 of int
-    | PreAllocStr of int * string
-    | AllocStr of int * int
-    | CatStr of int * int * int
-    | PreAllocList of int * char list
-    | AllocList of int * int
-    | RevList of int
-
-  let pp_cmd par fmt x =
-    let open Util.Pp in
-    match x with
-    | Stat        -> cst0 "Stat" fmt
-    | Quick_stat  -> cst0 "Quick_stat" fmt
-    | Counters    -> cst0 "Counters" fmt
-    | Minor_words -> cst0 "Minor_words" fmt
-    | Get         -> cst0 "Get" fmt
-    | Set subcmd -> (match subcmd with
-        | Minor_heap_size i       -> cst1 pp_int "Set minor_heap_size" par fmt i
-        | Major_heap_increment i  -> cst1 pp_int "Set major_heap_increment" par fmt i
-        | Space_overhead i        -> cst1 pp_int "Set space_overhead" par fmt i
-        | Max_overhead i          -> cst1 pp_int "Set max_overhead" par fmt i
-        | Stack_limit i           -> cst1 pp_int "Set stack_limit" par fmt i
-        | Custom_major_ratio i    -> cst1 pp_int "Set custom_major_ratio" par fmt i
-        | Custom_minor_ratio i    -> cst1 pp_int "Set custom_minor_ratio" par fmt i
-        | Custom_minor_max_size i -> cst1 pp_int "Set custom_minor_max_size" par fmt i
-      )
-    | Minor       -> cst0 "Minor" fmt
-    | Major_slice n -> cst1 pp_int "Major_slice" par fmt n
-    | Major       -> cst0 "Major" fmt
-    | Full_major  -> cst0 "Full_major" fmt
-    | Compact     -> cst0 "Compact" fmt
-    | Allocated_bytes -> cst0 "Allocated_bytes" fmt
-    | Get_minor_free -> cst0 "Get_minor_free" fmt
-    | Cons64 i    -> cst1 pp_int "Cons64" par fmt i
-    | PreAllocStr (i,s) -> cst2 pp_int pp_string "PreAllocStr" par fmt i s
-    | AllocStr (i,l) -> cst2 pp_int pp_int "AllocStr" par fmt i l
-    | CatStr (s1,s2,t) -> cst3 pp_int pp_int pp_int "CatStr" par fmt s1 s2 t
-    | PreAllocList (i,l) -> cst2 pp_int (pp_list pp_char) "PreAllocList" par fmt i l
-    | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
-    | RevList i   -> cst1 pp_int "RevList" par fmt i
-
-  let show_cmd = Util.Pp.to_show pp_cmd
-
-  let default_control = Gc.{
-      minor_heap_size = 262_144;      (* Default: 256k. *)
-      major_heap_increment = 0;       (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
-      space_overhead = 120;           (* Default: 120. *)
-      verbose = 0;                    (* Default: 0. *)
-      max_overhead = 0;               (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
-      stack_limit = 134_217_728;      (* Default: 128M. https://github.com/ocaml/ocaml/pull/13440 *)
-      allocation_policy = 0;          (* "This option is ignored in OCaml 5.x." *)
-      window_size = 0;                (* Default: https://github.com/ocaml/ocaml/pull/13440 *)
-      custom_major_ratio = 44;        (* Default: 44. *)
-      custom_minor_ratio = 100;       (* Default: 100. *)
-      custom_minor_max_size = 70_000; (* Default: 70000 bytes. *)
-    }
-
-  type state = Gc.control
-
-  (* Non-pretty OCAMLRUNPARAM parsing code *)
-  let parse_params params = (* "l=2M,b,m=55,M=50,n=50,s=4k,o=75" *)
-    let parse_pair s =
-      (match String.split_on_char '=' s with
-       | [lhs;rhs] -> Some (lhs, rhs)
-       | _ -> None) in
-    let convert_rhs rhs =
-      if rhs="" then None else
-        let len = String.length rhs in
-        (match rhs.[len - 1] with
-         | 'k' -> Some ((1 lsl 10) * int_of_string (String.sub rhs 0 (len - 1)))
-         | 'M' -> Some ((1 lsl 20) * int_of_string (String.sub rhs 0 (len - 1)))
-         | 'G' -> Some ((1 lsl 30) * int_of_string (String.sub rhs 0 (len - 1)))
-         | c ->
-           if '0' <= c && c <= '9'
-           then Some (int_of_string rhs)
-           else None) in
-    let param_list = String.split_on_char ',' params in
-    let pairs =
-      List.fold_right
-        (fun s acc -> match parse_pair s with None -> acc | Some pair -> pair::acc)
-        param_list [] in
-    let num_pairs =
-      List.fold_right
-        (fun (lhs,rhs) acc -> match convert_rhs rhs with None -> acc | Some num -> (lhs,num)::acc)
-        pairs [] in
-    num_pairs
-
-  let rec interpret_params paramlist s =
-    match paramlist with
-    | [] -> s
-    | pair::ps ->
-      let s' = match pair with (* FIXME: The multiplier is k, M, or G, for multiplication by 2^10, 2^20, and 2^30 respectively.*)
-        | ("l",sl)  -> { s with Gc.stack_limit = sl }
-        | ("m",cmr) -> { s with Gc.custom_minor_ratio = cmr }
-        | ("M",cmr) -> { s with Gc.custom_major_ratio = cmr }
-        | ("n",cms) -> { s with Gc.custom_minor_max_size = cms }
-        | ("o",so)  -> { s with Gc.space_overhead = so }
-        | ("s",hs)  -> { s with Gc.minor_heap_size = hs }
-        | _ -> s in
-      interpret_params ps s'
-
-  let init_state =
-    let params =
-      try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
-      try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
-    interpret_params (parse_params params) default_control
-
-  let array_length = 8
-
-  let arb_cmd _s =
-    let minor_heap_size_gen = Gen.oneofl [512;1024;2048;4096;8192;16384;32768] in
-    let _major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
-                                          Gen.int_range 101 1000;   (* percentage increment *)
-                                          Gen.int_range 1000 10000; (* word increment *)
-                                         ] in
-    let space_overhead = Gen.int_range 20 200 in   (* percentage increment *)
-    let _max_overhead = Gen.oneof [Gen.return 0; (* "If max_overhead is set to 0, heap compaction is triggered at the end of each major GC cycle" *)
-                                  Gen.int_range 1 1000;
-                                  Gen.return 1_000_000; ] in (* "If max_overhead >= 1000000 , compaction is never triggered." *)
-    let stack_limit = Gen.int_range 3284 1_000_000 in
-    let custom_major_ratio = Gen.int_range 1 100 in
-    let custom_minor_ratio = Gen.int_range 1 100 in
-    let custom_minor_max_size = Gen.int_range 10 1_000_000 in
-    let int_gen = Gen.small_nat in
-    let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
-    let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
-    let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
-    let index_gen = Gen.int_bound (array_length-1) in
-    QCheck.make ~print:show_cmd
-      Gen.(frequency
-           (let gens =
-             [ 1, return Stat;
-               1, return Quick_stat;
-               1, return Minor_words;
-               10, return Get;
-               1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
-             (*1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;*)
-               1, map (fun i -> Set (Space_overhead i)) space_overhead;
-             (*1, map (fun i -> Set (Max_overhead i)) max_overhead;*)
-               1, map (fun i -> Set (Stack_limit i)) stack_limit;
-               1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
-               1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
-               1, map (fun i -> Set (Custom_minor_max_size i)) custom_minor_max_size;
-               1, return Minor;
-               1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
-               1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
-               1, return Major;
-               1, return Full_major;
-               1, return Compact;
-               1, return Allocated_bytes;
-               1, return Get_minor_free;
-               10, map (fun i -> Cons64 i) int_gen;
-               5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
-               5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
-               5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
-               5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
-               5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
-               10, map (fun index -> RevList index) index_gen;
-             ] in
-           if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
-           then (1, return Counters)::gens  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
-           else gens))
-
-  let next_state n s = match n with
-    | Stat        -> s
-    | Quick_stat  -> s
-    | Counters    -> s
-    | Minor_words -> s
-    | Get         -> s
-    | Set subcmd -> (match subcmd with
-        | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = mhs }
-        | Major_heap_increment _mhi -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
-        | Space_overhead so         -> { s with Gc.space_overhead = so }
-        | Max_overhead _mo          -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
-        | Stack_limit sl            -> { s with Gc.stack_limit = sl }
-        | Custom_major_ratio cmr    -> { s with Gc.custom_major_ratio = cmr }
-        | Custom_minor_ratio cmr    -> { s with Gc.custom_minor_ratio = cmr }
-        | Custom_minor_max_size ms  -> { s with Gc.custom_minor_max_size = ms }
-      )
-    | Minor       -> s
-    | Major_slice _ -> s
-    | Major       -> s
-    | Full_major  -> s
-    | Compact     -> s
-    | Allocated_bytes -> s
-    | Get_minor_free -> s
-    | Cons64 _    -> s
-    | PreAllocStr _ -> s
-    | AllocStr _  -> s
-    | CatStr _    -> s
-    | PreAllocList _ -> s
-    | AllocList _ -> s
-    | RevList _   -> s
-
-(*
-BUG
-...
-   Set stack_limit 3283 : ()
-...
-  Get : { minor_heap_size = 8192; major_heap_increment = 0; space_overhead = 183; verbose = 0; max_overhead = 0; stack_limit = 3284; allocation_policy = 0; window_size = 0; custom_major_ratio = 44; custom_minor_ratio = 100; custom_minor_max_size = 70000 }
-
-calls 'caml_change_max_stack_size' in runtime/fiber.c:70 which may expand the size slightly it see
-
-also `caml_maybe_expand_stack` may do so
-*)
-  type sut =
-    { mutable int64s  : int64 list;
-      mutable strings : string array;
-      mutable lists   : char list array; }
-  let init_sut () =
-    { int64s = [];
-      strings = Array.make array_length "";
-      lists   = Array.make array_length [];
-    }
-
-  let cleanup sut =
-    begin
-      sut.int64s <- [];
-      sut.strings <- [| |];
-      sut.lists <- [| |];
-      Gc.set init_state;
-      Gc.compact ()
-    end
-
-  let precond n _s = match n with
-    | _ -> true
-
-  type _ ty += Tup3 : 'a ty * 'b ty * 'c ty -> ('a * 'b * 'c) ty
-            | GcStat: Gc.stat ty
-            | GcControl: Gc.control ty
-
-  let tup3 spec_a spec_b spec_c =
-    let (ty_a,show_a) = spec_a in
-    let (ty_b,show_b) = spec_b in
-    let (ty_c,show_c) = spec_c in
-    (Tup3 (ty_a,ty_b,ty_c), QCheck.Print.tup3 show_a show_b show_c)
-
-  let pp_gcstat par fmt s =
-    let open Util.Pp in
-    pp_record par fmt
-      [
-        pp_field "minor_words" pp_float s.Gc.minor_words;
-        pp_field "promoted_words" pp_float s.Gc.promoted_words;
-        pp_field "major_words" pp_float s.Gc.major_words;
-        pp_field "minor_collections" pp_int s.Gc.minor_collections;
-        pp_field "major_collections" pp_int s.Gc.major_collections;
-        pp_field "heap_words" pp_int s.Gc.heap_words;
-        pp_field "heap_chunks" pp_int s.Gc.heap_chunks;
-        pp_field "live_words" pp_int s.Gc.live_words;
-        pp_field "live_blocks" pp_int s.Gc.live_blocks;
-        pp_field "free_words" pp_int s.Gc.free_words;
-        pp_field "free_blocks" pp_int s.Gc.free_blocks;
-        pp_field "largest_free" pp_int s.Gc.largest_free;
-        pp_field "fragments" pp_int s.Gc.fragments;
-        pp_field "compactions" pp_int s.Gc.compactions;
-        pp_field "top_heap_words" pp_int s.Gc.top_heap_words;
-        pp_field "stack_size" pp_int s.Gc.stack_size;
-        pp_field "forced_major_collections" pp_int s.Gc.forced_major_collections;
-      ]
-
-  let show_gcstat = Util.Pp.to_show pp_gcstat
-
-  let gcstat = (GcStat, show_gcstat)
-
-  let pp_gccontrol par fmt c =
-    let open Util.Pp in
-    pp_record par fmt
-      [
-        pp_field "minor_heap_size" pp_int c.Gc.minor_heap_size;
-        pp_field "major_heap_increment" pp_int c.Gc.major_heap_increment;
-        pp_field "space_overhead" pp_int c.Gc.space_overhead;
-        pp_field "verbose" pp_int c.Gc.verbose;
-        pp_field "max_overhead" pp_int c.Gc.max_overhead;
-        pp_field "stack_limit" pp_int c.Gc.stack_limit;
-        pp_field "allocation_policy" pp_int c.Gc.allocation_policy;
-        pp_field "window_size" pp_int c.Gc.window_size;
-        pp_field "custom_major_ratio" pp_int c.Gc.custom_major_ratio;
-        pp_field "custom_minor_ratio" pp_int c.Gc.custom_minor_ratio;
-        pp_field "custom_minor_max_size" pp_int c.Gc.custom_minor_max_size;
-      ]
-
-  let show_gccontrol = Util.Pp.to_show pp_gccontrol
-
-  let gccontrol = (GcControl, show_gccontrol)
-
-  let run c sut = match c with
-    | Stat        -> Res (gcstat, Gc.stat ())
-    | Quick_stat  -> Res (gcstat, Gc.quick_stat ())
-    | Counters    -> Res (tup3 float float float, Gc.counters ())
-    | Minor_words -> Res (float, Gc.minor_words ())
-    | Get         -> Res (gccontrol, Gc.get ())
-    | Set subcmd -> (match subcmd with
-        | Minor_heap_size i       -> Res (unit, let prev = Gc.get () in Gc.set { prev with minor_heap_size = i; })
-        | Major_heap_increment i  -> Res (unit, let prev = Gc.get () in Gc.set { prev with major_heap_increment = i; })
-        | Space_overhead i        -> Res (unit, let prev = Gc.get () in Gc.set { prev with space_overhead = i; })
-        | Max_overhead i          -> Res (unit, let prev = Gc.get () in Gc.set { prev with max_overhead = i; })
-        | Stack_limit i           -> Res (unit, let prev = Gc.get () in Gc.set { prev with stack_limit = i; })
-        | Custom_major_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_major_ratio = i; })
-        | Custom_minor_ratio i    -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_ratio = i; })
-        | Custom_minor_max_size i -> Res (unit, let prev = Gc.get () in Gc.set { prev with custom_minor_max_size = i; })
-      )
-    | Minor       -> Res (unit, Gc.minor ())
-    | Major_slice n -> Res (int, Gc.major_slice n)
-    | Major       -> Res (unit, Gc.major ())
-    | Full_major  -> Res (unit, Gc.full_major ())
-    | Compact     -> Res (unit, Gc.compact ())
-    | Allocated_bytes -> Res (float, Gc.allocated_bytes ())
-    | Get_minor_free -> Res (int, Gc.get_minor_free ())
-    | Cons64 i    -> Res (unit, sut.int64s <- ((Int64.of_int i)::sut.int64s)) (*alloc int64 and cons cell at test runtime*)
-    | PreAllocStr (i,s) -> Res (unit, sut.strings.(i) <- s) (*alloc string in parent domain in test-input*)
-    | AllocStr (i,len) -> Res (unit, sut.strings.(i) <- String.make len 'c') (*alloc string at test runtime*)
-    | CatStr (src1,src2,tgt) -> Res (unit, sut.strings.(tgt) <- String.cat sut.strings.(src1) sut.strings.(src2))
-    | PreAllocList (i,l) -> Res (unit, sut.lists.(i) <- l) (*alloc list in parent domain in test-input*)
-    | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
-    | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
-
-  let check_gc_stats r =
-    r.Gc.minor_words >= 0. &&
-    r.Gc.promoted_words >= 0. &&
-    r.Gc.major_words >= 0. &&
-    r.Gc.minor_collections >= 0 &&
-    r.Gc.major_collections >= 0 &&
-    r.Gc.heap_words >= 0 &&
-    r.Gc.heap_chunks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-    r.Gc.live_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
-    r.Gc.live_blocks >= 0 && (* https://github.com/ocaml/ocaml/pull/13424 *)
-    r.Gc.free_words >= 0 &&  (* https://github.com/ocaml/ocaml/pull/13424 *)
-    r.Gc.free_blocks = 0 &&  (* Note: currently always 0 in OCaml5 *)
-    r.Gc.largest_free = 0 && (* Note: currently always 0 in OCaml5 *)
-    r.Gc.fragments >= 0 &&   (* https://github.com/ocaml/ocaml/pull/13424 *)
-    r.Gc.compactions >= 0 &&
-    r.Gc.top_heap_words >= 0 &&
-    r.Gc.stack_size = 0 &&   (* Note: currently always 0 in OCaml5 *)
-    r.Gc.forced_major_collections >= 0
-
-  let postcond n (s: state) res = match n, res with
-    | Stat, Res ((GcStat,_),r) -> check_gc_stats r
-    | Quick_stat, Res ((GcStat,_),r) -> check_gc_stats r
-    | Counters, Res ((Tup3 (Float,Float,Float),_),r) ->
-      let (minor_words, promoted_words, major_words) = r in
-      minor_words >= 0. && promoted_words >= 0. && major_words >= 0.
-    | Minor_words, Res ((Float,_),r) -> r >= 0.
-    | Get,         Res ((GcControl,_),r) ->
-      (* model-agreement modulo stack_limit which may have been expanded *)
-      r = { s with stack_limit = r.Gc.stack_limit } &&
-      r.Gc.stack_limit >= s.Gc.stack_limit
-    | Set _,      Res ((Unit,_), ()) -> true
-    | Minor,      Res ((Unit,_), ()) -> true
-    | Major_slice _, Res ((Int,_),r) -> r = 0
-    | Major,      Res ((Unit,_), ()) -> true
-    | Full_major, Res ((Unit,_), ()) -> true
-    | Compact,    Res ((Unit,_), ()) -> true
-    | Allocated_bytes, Res ((Float,_),r) -> r >= 0.
-    | Get_minor_free, Res ((Int,_),r) -> r >= 0
-    | Cons64 _,   Res ((Unit,_), ()) -> true
-    | PreAllocStr _, Res ((Unit,_), ()) -> true
-    | AllocStr _, Res ((Unit,_), ()) -> true
-    | CatStr _,  Res ((Unit,_), ()) -> true
-    | PreAllocList _, Res ((Unit,_), ()) -> true
-    | AllocList _, Res ((Unit,_), ()) -> true
-    | RevList _,  Res ((Unit,_), ()) -> true
-    | _, _ -> false
-end
-
 module GC_STM_seq = STM_sequential.Make(GCConf)
 module GC_STM_dom = STM_domain.Make(GCConf)
 

From 3bdf3b2a6beb56dca0a416bd8d2389f9ab2f7ee3 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Tue, 24 Sep 2024 12:23:40 +0200
Subject: [PATCH 24/30] Support v=63 under runtime-variant=d

---
 src/gc/GCConf.ml    | 7 ++++++-
 src/gc/stm_tests.ml | 1 -
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
index 2d1aab2b..24726058 100644
--- a/src/gc/GCConf.ml
+++ b/src/gc/GCConf.ml
@@ -127,14 +127,19 @@ let rec interpret_params paramlist s =
       | ("n",cms) -> { s with Gc.custom_minor_max_size = cms }
       | ("o",so)  -> { s with Gc.space_overhead = so }
       | ("s",hs)  -> { s with Gc.minor_heap_size = hs }
+      | ("v",vs)  -> { s with Gc.verbose = vs }
       | _ -> s in
     interpret_params ps s'
 
 let init_state =
+  let control =
+    if Sys.runtime_variant () = "d"
+    then { default_control with Gc.verbose = 63 } (* -runtime-variant=d causes verbose=63 *)
+    else default_control in
   let params =
     try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
     try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
-  interpret_params (parse_params params) default_control
+  interpret_params (parse_params params) control
 
 let array_length = 8
 
diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 5b4ba131..9f6a7708 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -3,7 +3,6 @@ open QCheck
 (* sequential and parallel tests of the GC *)
 
 (* TODO:
-   - --profile=debug-runtime sets `(link_flags :standard -runtime-variant=d)` causing verbose=63? without v=0
    - add bigarray
    - split into an implicit and an explicit Gc test
  *)

From fd0a3fd4cc23c7ea0df84b1d45460d113fb97595 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Wed, 25 Sep 2024 15:47:10 +0200
Subject: [PATCH 25/30] Adjust minor_heap_size test to be pagesize-aware

---
 src/gc/GCConf.ml      | 13 +++++++++++--
 src/gc/dune           | 11 ++++++++++-
 src/gc/pagesize.ml    |  1 +
 src/gc/pagesizestub.c | 25 +++++++++++++++++++++++++
 src/gc/stm_tests.ml   |  1 +
 5 files changed, 48 insertions(+), 3 deletions(-)
 create mode 100644 src/gc/pagesize.ml
 create mode 100644 src/gc/pagesizestub.c

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
index 24726058..d9620143 100644
--- a/src/gc/GCConf.ml
+++ b/src/gc/GCConf.ml
@@ -88,6 +88,15 @@ let default_control = Gc.{
 
 type state = Gc.control
 
+let page_size =
+  let bytes_per_word = Sys.word_size / 8 in (* bytes per word *)
+  Pagesize.get () / bytes_per_word (* page size in words *)
+
+let round_heap_size i =
+  if i mod page_size > 0
+  then page_size * (1 + (i / page_size))
+  else i
+
 (* Non-pretty OCAMLRUNPARAM parsing code *)
 let parse_params params = (* "l=2M,b,m=55,M=50,n=50,s=4k,o=75" *)
   let parse_pair s =
@@ -126,7 +135,7 @@ let rec interpret_params paramlist s =
       | ("M",cmr) -> { s with Gc.custom_major_ratio = cmr }
       | ("n",cms) -> { s with Gc.custom_minor_max_size = cms }
       | ("o",so)  -> { s with Gc.space_overhead = so }
-      | ("s",hs)  -> { s with Gc.minor_heap_size = hs }
+      | ("s",hs)  -> { s with Gc.minor_heap_size = round_heap_size hs }
       | ("v",vs)  -> { s with Gc.verbose = vs }
       | _ -> s in
     interpret_params ps s'
@@ -204,7 +213,7 @@ let next_state n s = match n with
   | Minor_words -> s
   | Get         -> s
   | Set subcmd -> (match subcmd with
-      | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = mhs }
+      | Minor_heap_size mhs       -> { s with Gc.minor_heap_size = round_heap_size mhs }
       | Major_heap_increment _mhi -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
       | Space_overhead so         -> { s with Gc.space_overhead = so }
       | Max_overhead _mo          -> s (* "This field is currently not available in OCaml 5: the field value is always [0]." *)
diff --git a/src/gc/dune b/src/gc/dune
index 8b0b9b6e..6b1f071b 100644
--- a/src/gc/dune
+++ b/src/gc/dune
@@ -1,10 +1,19 @@
 ;; Tests of the stdlib Gc module
 
+(library
+ (name pagesize)
+ (modules pagesize)
+ (foreign_stubs
+  (language c)
+  (names pagesizestub)
+  (flags (:standard)))
+)
+
 (test
  (name stm_tests)
  (modules GCConf stm_tests)
  (package multicoretests)
  (flags (:standard -w -37))
- (libraries qcheck-stm.sequential qcheck-stm.domain)
+ (libraries pagesize qcheck-stm.sequential qcheck-stm.domain)
  (action (run %{test} --verbose))
 )
diff --git a/src/gc/pagesize.ml b/src/gc/pagesize.ml
new file mode 100644
index 00000000..ff776d64
--- /dev/null
+++ b/src/gc/pagesize.ml
@@ -0,0 +1 @@
+external get : unit -> int = "page_size"
diff --git a/src/gc/pagesizestub.c b/src/gc/pagesizestub.c
new file mode 100644
index 00000000..2b3233c0
--- /dev/null
+++ b/src/gc/pagesizestub.c
@@ -0,0 +1,25 @@
+#ifdef _WIN32
+#include <sysinfoapi.h>
+#else
+#include <unistd.h>
+#endif
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+
+CAMLprim value page_size(value ignored) {
+  CAMLparam1(ignored);
+  CAMLlocal1(result);
+
+  long ps;
+#ifdef _WIN32
+  SYSTEM_INFO si;
+  GetSystemInfo(&si);
+  ps = si.dwPageSize;
+#else
+  ps = sysconf(_SC_PAGESIZE); // page size in bytes
+#endif
+
+  result = Val_int(ps);
+  CAMLreturn(result);
+}
diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 9f6a7708..25486df0 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -28,6 +28,7 @@ let agree_child_test ~count ~name =
   Test.make ~name ~count (GC_STM_seq.arb_cmds GCConf.init_state) agree_child_prop
 
 let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
   QCheck_base_runner.run_tests_main [
     agree_test                    ~count:1000 ~name:"STM Gc test sequential";
     agree_child_test              ~count:1000 ~name:"STM Gc test sequential in child domain";

From 1ebdda4d7c6db5d460d6621b95536db98bc8c7ea Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Wed, 25 Sep 2024 17:27:29 +0200
Subject: [PATCH 26/30] Fix attempt for pagesize headers on MSVC

---
 src/gc/pagesizestub.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/gc/pagesizestub.c b/src/gc/pagesizestub.c
index 2b3233c0..f35bd832 100644
--- a/src/gc/pagesizestub.c
+++ b/src/gc/pagesizestub.c
@@ -1,4 +1,6 @@
 #ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
 #include <sysinfoapi.h>
 #else
 #include <unistd.h>

From 1cf2dc34f05215eb511fead37c71cc142686d96b Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Fri, 27 Sep 2024 15:46:53 +0200
Subject: [PATCH 27/30] Factor Gc tests into two: with and without explicit Gc
 invocations

---
 src/gc/GCConf.ml         | 86 ++++++++++++++++++++++++----------------
 src/gc/dune              |  9 +++++
 src/gc/stm_tests.ml      |  7 +---
 src/gc/stm_tests_impl.ml | 38 ++++++++++++++++++
 4 files changed, 99 insertions(+), 41 deletions(-)
 create mode 100644 src/gc/stm_tests_impl.ml

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
index d9620143..29198510 100644
--- a/src/gc/GCConf.ml
+++ b/src/gc/GCConf.ml
@@ -1,6 +1,10 @@
 open QCheck
 open STM
 
+(* TODO:
+   - add bigarray
+*)
+
 type setcmd =
   | Minor_heap_size of int
   | Major_heap_increment of int (* 1: "This field is currently not available in OCaml 5: the field value is always [0]." *)
@@ -152,7 +156,7 @@ let init_state =
 
 let array_length = 8
 
-let arb_cmd _s =
+let alloc_cmds, gc_cmds =
   let minor_heap_size_gen = Gen.oneofl [512;1024;2048;4096;8192;16384;32768] in
   let _major_heap_increment = Gen.oneof [Gen.int_bound 100;        (* percentage increment *)
                                          Gen.int_range 101 1000;   (* percentage increment *)
@@ -171,40 +175,52 @@ let arb_cmd _s =
   let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
   let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
   let index_gen = Gen.int_bound (array_length-1) in
-  QCheck.make ~print:show_cmd
-    Gen.(frequency
-           (let gens =
-             [ 1, return Stat;
-               1, return Quick_stat;
-               1, return Minor_words;
-               10, return Get;
-               1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
-             (*1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;*)
-               1, map (fun i -> Set (Space_overhead i)) space_overhead;
-             (*1, map (fun i -> Set (Max_overhead i)) max_overhead;*)
-               1, map (fun i -> Set (Stack_limit i)) stack_limit;
-               1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
-               1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
-               1, map (fun i -> Set (Custom_minor_max_size i)) custom_minor_max_size;
-               1, return Minor;
-               1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
-               1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
-               1, return Major;
-               1, return Full_major;
-               1, return Compact;
-               1, return Allocated_bytes;
-               1, return Get_minor_free;
-               10, map (fun i -> Cons64 i) int_gen;
-               5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
-               5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
-               5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
-               5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
-               5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
-               10, map (fun index -> RevList index) index_gen;
-             ] in
-            if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
-            then (1, return Counters)::gens  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
-            else gens))
+  let alloc_cmds =
+    Gen.([
+        (* purely observational cmds *)
+        1, return Stat;
+        1, return Quick_stat;
+        1, return Minor_words;
+        10, return Get;
+        1, return Allocated_bytes;
+        1, return Get_minor_free;
+        (* allocating cmds to activate the Gc *)
+        10, map (fun i -> Cons64 i) int_gen;
+        5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
+        5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
+        5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
+        5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
+        5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
+        10, map (fun index -> RevList index) index_gen;
+      ]) in
+  let gc_cmds =
+    let gc_cmds =
+      Gen.([
+          1, map (fun i -> Set (Minor_heap_size i)) minor_heap_size_gen;
+          (*1, map (fun i -> Set (Major_heap_increment i)) major_heap_increment;*)
+          1, map (fun i -> Set (Space_overhead i)) space_overhead;
+          (*1, map (fun i -> Set (Max_overhead i)) max_overhead;*)
+          1, map (fun i -> Set (Stack_limit i)) stack_limit;
+          1, map (fun i -> Set (Custom_major_ratio i)) custom_major_ratio;
+          1, map (fun i -> Set (Custom_minor_ratio i)) custom_minor_ratio;
+          1, map (fun i -> Set (Custom_minor_max_size i)) custom_minor_max_size;
+          1, return Minor;
+          1, map (fun i -> Major_slice i) Gen.nat; (* "n is the size of the slice: the GC will do enough work to free (on average) n words of memory." *)
+          1, return (Major_slice 0); (* cornercase: "If n = 0, the GC will try to do enough work to ensure that the next automatic slice has no work to do" *)
+          1, return Major;
+          1, return Full_major;
+          1, return Compact;
+        ]) @ alloc_cmds in
+    if Sys.(ocaml_release.major,ocaml_release.minor) > (5,3)
+    then (1, Gen.return Counters)::gc_cmds  (* known problem with Counters on <= 5.2: https://github.com/ocaml/ocaml/pull/13370 *)
+    else gc_cmds in
+  alloc_cmds, gc_cmds
+
+let arb_cmd _s =
+  QCheck.make ~print:show_cmd (Gen.frequency gc_cmds)
+
+let arb_alloc_cmd _s =
+  QCheck.make ~print:show_cmd (Gen.frequency alloc_cmds)
 
 let next_state n s = match n with
   | Stat        -> s
diff --git a/src/gc/dune b/src/gc/dune
index 6b1f071b..98ebfde4 100644
--- a/src/gc/dune
+++ b/src/gc/dune
@@ -17,3 +17,12 @@
  (libraries pagesize qcheck-stm.sequential qcheck-stm.domain)
  (action (run %{test} --verbose))
 )
+
+(test
+ (name stm_tests_impl)
+ (modules GCConf stm_tests_impl)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.sequential qcheck-stm.domain)
+ (action (run %{test} --verbose))
+)
diff --git a/src/gc/stm_tests.ml b/src/gc/stm_tests.ml
index 25486df0..e008d24c 100644
--- a/src/gc/stm_tests.ml
+++ b/src/gc/stm_tests.ml
@@ -1,11 +1,6 @@
 open QCheck
 
-(* sequential and parallel tests of the GC *)
-
-(* TODO:
-   - add bigarray
-   - split into an implicit and an explicit Gc test
- *)
+(* sequential and parallel tests of the GC with explicit Gc invocations *)
 
 module GC_STM_seq = STM_sequential.Make(GCConf)
 module GC_STM_dom = STM_domain.Make(GCConf)
diff --git a/src/gc/stm_tests_impl.ml b/src/gc/stm_tests_impl.ml
new file mode 100644
index 00000000..eb4b029d
--- /dev/null
+++ b/src/gc/stm_tests_impl.ml
@@ -0,0 +1,38 @@
+open QCheck
+
+(* sequential and parallel tests of the GC, without explicit Gc invocations *)
+
+module ImplGCConf =
+struct
+  include GCConf
+  let arb_cmd = arb_alloc_cmd
+end
+
+module GC_STM_seq = STM_sequential.Make(ImplGCConf)
+module GC_STM_dom = STM_domain.Make(ImplGCConf)
+
+let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+(* Run seq. property in a child domain to stresstest parent-child GC *)
+let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+let agree_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_prop
+
+let agree_child_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_child_prop
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    agree_test                 ~count:1000 ~name:"STM implicit Gc test sequential";
+    agree_child_test           ~count:1000 ~name:"STM implicit Gc test sequential in child domain";
+    GC_STM_dom.agree_test_par  ~count:1000 ~name:"STM implicit Gc test parallel";
+    GC_STM_dom.stress_test_par ~count:1000 ~name:"STM implicit Gc stress test parallel";
+  ]

From e5b93d3dd903fc6244954c31cb5dd264dbf031b2 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Fri, 27 Sep 2024 16:08:09 +0200
Subject: [PATCH 28/30] Adjust frequencies

---
 src/gc/GCConf.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
index 29198510..62c96db0 100644
--- a/src/gc/GCConf.ml
+++ b/src/gc/GCConf.ml
@@ -181,17 +181,17 @@ let alloc_cmds, gc_cmds =
         1, return Stat;
         1, return Quick_stat;
         1, return Minor_words;
-        10, return Get;
+        5, return Get;
         1, return Allocated_bytes;
         1, return Get_minor_free;
         (* allocating cmds to activate the Gc *)
-        10, map (fun i -> Cons64 i) int_gen;
+        5, map (fun i -> Cons64 i) int_gen;
         5, map2 (fun index str -> PreAllocStr (index,str)) index_gen str_gen;
         5, map2 (fun index len -> AllocStr (index,len)) index_gen str_len_gen;
         5, map3 (fun src1 src2 tgt -> CatStr (src1,src2,tgt)) index_gen index_gen index_gen;
         5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
         5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
-        10, map (fun index -> RevList index) index_gen;
+        5, map (fun index -> RevList index) index_gen;
       ]) in
   let gc_cmds =
     let gc_cmds =

From 656677a1311399c10082d61f7b4cf064f8970f70 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Fri, 27 Sep 2024 18:25:03 +0200
Subject: [PATCH 29/30] Add Bigarray support

---
 src/gc/GCConf.ml | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/src/gc/GCConf.ml b/src/gc/GCConf.ml
index 62c96db0..57084834 100644
--- a/src/gc/GCConf.ml
+++ b/src/gc/GCConf.ml
@@ -1,8 +1,10 @@
 open QCheck
 open STM
 
-(* TODO:
-   - add bigarray
+(* ideas for extensions:
+- Weak
+- Ephemerons
+- finalizers
 *)
 
 type setcmd =
@@ -40,6 +42,8 @@ type cmd =
   | PreAllocList of int * char list
   | AllocList of int * int
   | RevList of int
+  | PreAllocBigarray of int * (int, Bigarray.int_elt, Bigarray.c_layout) Bigarray.Array1.t
+  | AllocBigarray of int * int
 
 let pp_cmd par fmt x =
   let open Util.Pp in
@@ -73,6 +77,8 @@ let pp_cmd par fmt x =
   | PreAllocList (i,l) -> cst2 pp_int (pp_list pp_char) "PreAllocList" par fmt i l
   | AllocList (i,l) -> cst2 pp_int pp_int "AllocList" par fmt i l
   | RevList i   -> cst1 pp_int "RevList" par fmt i
+  | PreAllocBigarray (i,_l) -> cst2 pp_int pp_string "AllocBigarray" par fmt i "[|...|]"
+  | AllocBigarray (i,l) -> cst2 pp_int pp_int "AllocBigarray" par fmt i l
 
 let show_cmd = Util.Pp.to_show pp_cmd
 
@@ -174,6 +180,7 @@ let alloc_cmds, gc_cmds =
   let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
   let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
   let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
+  let bigarray_gen = Gen.map (fun l -> Bigarray.(Array1.create int C_layout l)) Gen.nat in
   let index_gen = Gen.int_bound (array_length-1) in
   let alloc_cmds =
     Gen.([
@@ -192,6 +199,8 @@ let alloc_cmds, gc_cmds =
         5, map2 (fun index list -> PreAllocList (index,list)) index_gen list_gen;
         5, map2 (fun index len -> AllocList (index,len)) index_gen Gen.nat;
         5, map (fun index -> RevList index) index_gen;
+        5, map2 (fun index ba -> PreAllocBigarray (index,ba)) index_gen bigarray_gen;
+        5, map2 (fun index len -> AllocBigarray (index,len)) index_gen Gen.nat;
       ]) in
   let gc_cmds =
     let gc_cmds =
@@ -252,6 +261,8 @@ let next_state n s = match n with
   | PreAllocList _ -> s
   | AllocList _ -> s
   | RevList _   -> s
+  | PreAllocBigarray _ -> s
+  | AllocBigarray _ -> s
 
 (*
 BUG
@@ -267,11 +278,13 @@ also `caml_maybe_expand_stack` may do so
 type sut =
   { mutable int64s  : int64 list;
     mutable strings : string array;
-    mutable lists   : char list array; }
+    mutable lists   : char list array;
+    mutable bigarrays : (int, Bigarray.int_elt, Bigarray.c_layout) Bigarray.Array1.t array; }
 let init_sut () =
   { int64s = [];
     strings = Array.make array_length "";
     lists   = Array.make array_length [];
+    bigarrays = Array.make array_length Bigarray.(Array1.create int C_layout 0);
   }
 
 let cleanup sut =
@@ -279,6 +292,7 @@ let cleanup sut =
     sut.int64s <- [];
     sut.strings <- [| |];
     sut.lists <- [| |];
+    sut.bigarrays <- [| |];
     Gc.set init_state;
     Gc.compact ()
   end
@@ -374,6 +388,10 @@ let run c sut = match c with
   | PreAllocList (i,l) -> Res (unit, sut.lists.(i) <- l) (*alloc list in parent domain in test-input*)
   | AllocList (i,len) -> Res (unit, sut.lists.(i) <- List.init len (fun _ -> 'a')) (*alloc list at test runtime*)
   | RevList i -> Res (unit, sut.lists.(i) <- List.rev sut.lists.(i)) (*alloc list at test runtime*)
+  | PreAllocBigarray (i,ba) -> Res (unit, sut.bigarrays.(i) <- ba) (*alloc bigarray in parent domain in test-input*)
+  | AllocBigarray (i,len) -> Res (unit, let ba = Bigarray.(Array1.create int C_layout len) in
+                                  Bigarray.Array1.fill ba 0xbeef;
+                                  sut.bigarrays.(i) <- ba) (*alloc bigarray at test runtime*)
 
 let check_gc_stats r =
   r.Gc.minor_words >= 0. &&
@@ -420,4 +438,6 @@ let postcond n (s: state) res = match n, res with
   | PreAllocList _, Res ((Unit,_), ()) -> true
   | AllocList _, Res ((Unit,_), ()) -> true
   | RevList _,  Res ((Unit,_), ()) -> true
+  | PreAllocBigarray _, Res ((Unit,_), ()) -> true
+  | AllocBigarray _, Res ((Unit,_), ()) -> true
   | _, _ -> false

From 4a934626278ac6b60501e9be6b231b73dcc3b315 Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Wed, 23 Oct 2024 14:16:04 +0200
Subject: [PATCH 30/30] Silence explicit GC test under the debug runtime, which
 by default will use v=63 adding lots of CI log noise

---
 src/gc/dune | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/gc/dune b/src/gc/dune
index 98ebfde4..68cf172d 100644
--- a/src/gc/dune
+++ b/src/gc/dune
@@ -15,7 +15,9 @@
  (package multicoretests)
  (flags (:standard -w -37))
  (libraries pagesize qcheck-stm.sequential qcheck-stm.domain)
- (action (run %{test} --verbose))
+ (action
+  (setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
+   (run %{test} --verbose)))
 )
 
 (test