Revert "Let ocaml GC do its thing (#12287)"

This reverts commit 69f6e0dc7128a3a9244fa1c9c8fceef269d6a6b4.

src/compiler/server.ml

@@ -850,6 +850,26 @@ and wait_loop verbose accept =
 	let sctx = ServerCompilationContext.create verbose in
 	let cs = sctx.cs in
 	enable_cache_mode sctx;
+	let ring = Ring.create 10 0. in
+	let gc_heap_stats () =
+		let stats = Gc.quick_stat() in
+		stats.major_words,stats.heap_words
+	in
+	let heap_stats_start = ref (gc_heap_stats()) in
+	let update_heap () =
+		(* On every compilation: Track how many words were allocated for this compilation (working memory). *)
+		let heap_stats_now = gc_heap_stats() in
+		let words_allocated = (fst heap_stats_now) -. (fst !heap_stats_start) in
+		let heap_size = float_of_int (snd heap_stats_now) in
+		Ring.push ring words_allocated;
+		if Ring.is_filled ring then begin
+			Ring.reset_filled ring;
+			 (* Maximum working memory for the last X compilations. *)
+			let max = Ring.fold ring 0. (fun m i -> if i > m then i else m) in
+			cs#add_task (new Tasks.gc_task max heap_size)
+		end;
+		heap_stats_start := heap_stats_now;
+	in
 	(* Main loop: accept connections and process arguments *)
 	while true do
 		let support_nonblock, read, write, close = accept() in
@@ -895,6 +915,7 @@ and wait_loop verbose accept =
 		close();
 		current_stdin := None;
 		cleanup();
+		update_heap();
 		(* If our connection always blocks, we have to execute all pending tasks now. *)
 		if not support_nonblock then
 			while cs#has_task do cs#get_task#run done

src/compiler/tasks.ml

@@ -2,6 +2,34 @@
 open Type
 open CompilationCache
 
+class gc_task (max_working_memory : float) (heap_size : float) = object(self)
+	inherit server_task ["gc"] 100
+
+	method private execute =
+		let t0 = Extc.time() in
+		let stats = Gc.stat() in
+		let live_words = float_of_int stats.live_words in
+		(* Maximum heap size needed for the last X compilations = sum of what's live + max working memory. *)
+		let needed_max = live_words +. max_working_memory in
+		(* Additional heap percentage needed = what's live / max of what was live. *)
+		let percent_needed = (1. -. live_words /. needed_max) in
+		(* Effective cache size percentage = what's live / heap size. *)
+		let percent_used = live_words /. heap_size in
+		(* Set allowed space_overhead to the maximum of what we needed during the last X compilations. *)
+		let new_space_overhead = int_of_float ((percent_needed +. 0.05) *. 100.) in
+		let old_gc = Gc.get() in
+		Gc.set { old_gc with Gc.space_overhead = new_space_overhead; };
+		(* Compact if less than 80% of our heap words consist of the cache and there's less than 50% overhead. *)
+		let do_compact = percent_used < 0.8 && percent_needed < 0.5 in
+		begin if do_compact then
+			Gc.compact()
+		else
+			Gc.full_major();
+		end;
+		Gc.set old_gc;
+		ServerMessage.gc_stats (Extc.time() -. t0) stats do_compact new_space_overhead
+end
+
 class class_maintenance_task (cs : CompilationCache.t) (c : tclass) = object(self)
 	inherit server_task ["module maintenance"] 70
 
@@ -36,4 +64,4 @@ class server_exploration_task (cs : CompilationCache.t) = object(self)
 
 	method private execute =
 		cs#iter_modules (fun m -> cs#add_task (new module_maintenance_task cs m))
-end
+end