Run garbage collection once when the main process is waiting for

master_changes.md

@@ -97,6 +97,7 @@ users)
 ## Shell
 
 ## Internal
+  * Run `Gc.compact` in OpamParallel, when the main process is waiting for the children processes for the first time [#5396 @kkeundotnet]
 
 ## Internal: Windows
 
@@ -127,3 +128,4 @@ users)
 ## opam-format
 
 ## opam-core
+  * `OpamParallel.*.{map,reduce,iter}`: Run `Gc.compact` when the main process is waiting for the children processes for the first time [#5396 @kkeundotnet]

src/core/opamParallel.ml

@@ -58,6 +58,16 @@ module type SIG = sig
   exception Cyclic of G.V.t list list
 end
 
+let gc_compact () =
+  let get_heap () =
+    let {Gc.heap_words; _} = Gc.quick_stat () in
+    heap_words * Sys.word_size / 8 / 1024 / 1024
+  in
+  let before = get_heap () in
+  Gc.compact ();
+  let after = get_heap () in
+  log "GC compact (heap %d MB -> %d MB)" before after
+
 module Make (G : G) = struct
 
   module G = G
@@ -92,6 +102,8 @@ module Make (G : G) = struct
       default :: defined
     in
 
+    let gc_compacted = ref false in
+
     if G.has_cycle g then (
       let sccs = G.scc_list g in
       let sccs = List.filter (function _::_::_ -> true | _ -> false) sccs in
@@ -264,8 +276,12 @@ module Make (G : G) = struct
             (get_slots nslots n)
         in
         run_seq_command nslots ready n cmd
-      else
+      else (
       (* Wait for a process to end *)
+      if not !gc_compacted then (
+        gc_compact ();
+        gc_compacted := true
+      );
       let processes =
         M.fold (fun n (p,x,_) acc -> (p,(n,x)) :: acc) running []
       in
@@ -285,7 +301,7 @@ module Make (G : G) = struct
           OpamProcess.cleanup result;
           fail n e in
       OpamProcess.cleanup result;
-      run_seq_command nslots ready n next
+      run_seq_command nslots ready n next )
     in
     let roots =
       G.fold_vertex