Make the GC work harder on low-end hardware instead of calling Gc.compact

src/client/opamCliMain.ml

@@ -13,6 +13,8 @@ open OpamCmdliner
 open OpamStateTypes
 open OpamTypesBase
 
+let log fmt = OpamConsole.log "MAIN" fmt
+
 exception InvalidCLI of OpamCLIVersion.Sourced.t
 
 (* [InvalidFlagContent (flag_name, Some (invalid_value, expected_value))] *)
@@ -437,7 +439,15 @@ let rec main_catch_all f =
     in
     exit exit_code
 
+let set_gc_params total_ram =
+  let two_GB = 2048L in
+  if total_ram > 0L && (total_ram : int64) < two_GB then begin
+    log "Low end machine detected. Setting the GC to work harder";
+    Gc.set {(Gc.get ()) with space_overhead = 20};
+  end
+
 let run () =
+  set_gc_params (OpamStubs.total_ram ());
   Stdlib.Option.iter OpamVersion.set_git OpamGitVersion.version;
   OpamSystem.init ();
   OpamArg.preinit_opam_env_variables ();

src/core/opamCommonStubs.c

@@ -23,9 +23,16 @@
 
 #include <fcntl.h>
 #include <unistd.h>
+#include <sys/resource.h>
+
+#ifdef __linux__
+#include <stdlib.h>
+#include <string.h>
+#endif
 
 #else
 
+#include <windows.h>
 #include <io.h>
 #include <sysinfoapi.h>
 
@@ -71,6 +78,69 @@ CAMLprim value opam_nproc(value _unit) {
 #endif
 }
 
+CAMLprim value opam_total_ram(value _unit) {
+  int64_t total_mem = 0;
+#ifdef _WIN32
+  MEMORYSTATUSEX statex;
+  statex.dwLength = sizeof(statex);
+  if (GlobalMemoryStatusEx(&statex) == 0)
+    return caml_copy_int64(0);
+  total_mem = statex.ullTotalPhys;
+#else
+#ifdef __linux__
+  int cgroup = open("/proc/self/cgroup", O_RDONLY);
+  if (cgroup != -1) {
+    char buf[4096];
+    char prefix[] = "/sys/fs/cgroup/";
+    char suffix[] = "/memory.max";
+    size_t sizeof_prefix = sizeof(prefix) - 1;
+    size_t sizeof_suffix = sizeof(suffix) - 1;
+    char* buf_mid = &buf[sizeof_prefix];
+    size_t buf_mid_len = sizeof(buf) - sizeof_prefix - sizeof_suffix - 1;
+    ssize_t len = read(cgroup, buf_mid, buf_mid_len);
+    if (len >= 4 && len < buf_mid_len &&
+        buf_mid[0] == '0' &&
+        buf_mid[1] == ':' &&
+        buf_mid[2] == ':' &&
+        buf_mid[len - 1] == '\n') {
+      memcpy(buf, prefix, sizeof_prefix);
+      memmove(buf_mid, &buf_mid[3], len - 3);
+      memcpy(&buf[sizeof_prefix + len - 4], suffix, sizeof(suffix));
+      int cgroup_mem_max = open(buf, O_RDONLY);
+      if (cgroup_mem_max != -1) {
+        ssize_t len_mem_max = read(cgroup_mem_max, buf, sizeof(buf) - 1);
+        if (len_mem_max >= 2 && len_mem_max < sizeof(buf) - 1 &&
+            buf[len_mem_max - 1] == '\n') {
+          buf[len_mem_max - 1] = '\0';
+          total_mem = atoll(buf);
+        }
+        close(cgroup_mem_max);
+      }
+    }
+    close(cgroup);
+  }
+#endif
+  int64_t tmp = total_mem;
+  struct rlimit rlim;
+  if (getrlimit(RLIMIT_AS, &rlim) == 0) {
+    if (rlim.rlim_max != RLIM_INFINITY)
+      tmp = rlim.rlim_max;
+    if (rlim.rlim_cur != RLIM_INFINITY)
+      tmp = rlim.rlim_cur;
+    total_mem = (total_mem < tmp) ? total_mem : tmp;
+  }
+  long pagesize = sysconf(_SC_PAGESIZE);
+  long phys_pages = sysconf(_SC_PHYS_PAGES);
+  if (pagesize == -1 || phys_pages == -1)
+    return caml_copy_int64(0);
+  tmp = (int64_t)phys_pages * (int64_t)pagesize;
+  total_mem = (total_mem < tmp) ? total_mem : tmp;
+#endif
+  int64_t one_KB = 1024;
+  int64_t one_MB = one_KB * one_KB;
+  return caml_copy_int64(total_mem / one_MB);
+}
+
 /* This is done here as it simplifies the dune file */
 #ifdef _WIN32
 #include "opamInject.c"

src/core/opamParallel.ml

@@ -58,16 +58,6 @@ 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
@@ -102,8 +92,6 @@ 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
@@ -283,9 +271,6 @@ module Make (G : G) = struct
         run_seq_command nslots ready n cmd
       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

src/core/opamStubsTypes.ml

@@ -128,3 +128,7 @@ external is_executable : string -> bool = "opam_is_executable"
 external nproc : unit -> nativeint = "opam_nproc"
 (** Returns the number of logical processors of the current machine.
     Any value below [1] is an error. *)
+
+external total_ram : unit -> int64 = "opam_total_ram"
+(** Returns the total amount of RAM of the current system in MB.
+    Returns [0L] if that information couldn't be acquired. *)