Revert #12747 changes, keep only eval Domain changes, restore TestTimer test

Co-authored-by: Simn <634365+Simn@users.noreply.github.com>

Author: Copilot

src/codegen/dump.ml

@@ -127,7 +127,7 @@ let dump_types com pretty =
 		);
 		close()
 	in
-	Parallel.run_with_pool com.sctx.pool (fun pool ->
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
 	);
 	restore()
@@ -144,7 +144,7 @@ let dump_record com =
 		Buffer.add_string buf s;
 		close()
 	in
-	Parallel.run_with_pool com.sctx.pool (fun pool ->
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
 	)
 
@@ -169,7 +169,7 @@ let dump_position com =
 			| _ ->
 				()
 	in
-	Parallel.run_with_pool com.sctx.pool (fun pool ->
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
 	)
 

src/compiler/generate.ml

@@ -83,7 +83,7 @@ let check_hxb_output ctx config =
 					None
 			in
 			let a_in = Array.of_list com.modules in
-			let a_out = Parallel.run_with_pool com.sctx.pool (fun pool ->
+			let a_out = Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 				Parallel.ParallelArray.map pool f a_in None
 			) in
 			Array.iter (function

src/compiler/haxe.ml

@@ -63,11 +63,9 @@ let start_semaphore = Semaphore.Binary.make false in
 let run_compiler () =
 	Semaphore.Binary.acquire start_semaphore;
 	let sctx = ServerCompilationContext.create false in
-	Std.finally (fun () -> ServerCompilationContext.dispose sctx) (fun () ->
-		let request_scope = Server.create_request_scope () in
-		let parsed_args = Args.parse_args sctx args in
-		Server.process sctx request_scope Compiler.HighLevel.entry (ServerCommunication.Communication.create_stdio ()) parsed_args;
-	) ()
+	let request_scope = Server.create_request_scope () in
+	let parsed_args = Args.parse_args sctx args in
+	Server.process sctx request_scope Compiler.HighLevel.entry (ServerCommunication.Communication.create_stdio ()) parsed_args
 in
 
 let main_domain = Domain.spawn run_compiler in

src/compiler/server/server.ml

@@ -351,7 +351,7 @@ let wait_loop entry verbose accept =
 	EvalMain.main_domain_hack := worker.domain;
 	(* Main loop: accept connections and enqueue requests for the worker.
 	   The loop exits if the accept function raises an exception (e.g. socket closed). *)
-	begin try
+	(try
 		while true do
 			let conn = accept() in
 			begin try
@@ -373,13 +373,10 @@ let wait_loop entry verbose accept =
 				conn.close()
 			end;
 		done
-	with _ ->
-		()
-	end;
+	with _ -> ());
 	(* Signal the worker to shut down and wait for it to finish *)
 	RequestQueue.shutdown rq;
 	Domain.join worker.domain;
-	ServerCompilationContext.dispose sctx;
 	0
 
 (* Connect to given host/port and return accept function for communication *)

src/compiler/server/serverCompilationContext.ml

@@ -22,8 +22,6 @@ type t = {
 	mutable macro_context_setup : bool;
 	(* Stdin content for the current display request *)
 	mutable current_stdin : string option;
-	(* The server's domain pool. *)
-	pool : Domainslib.Task.pool Lazy.t;
 }
 
 let create_version () =
@@ -36,25 +34,18 @@ let create_version () =
 		extra = Version.version_extra;
 	}
 
-let create verbose =
-	let pool = lazy (Domainslib.Task.setup_pool ~num_domains:(Domain.recommended_domain_count() - 1) ()) in
-	{
-		version = create_version ();
-		verbose;
-		cs = new CompilationCache.cache;
-		class_paths = Hashtbl.create 0;
-		changed_directories = Hashtbl.create 0;
-		compilation_step = 0;
-		delays = [];
-		was_compilation = false;
-		macro_context_setup = false;
-		current_stdin = None;
-		pool;
-	}
-
-let dispose sctx =
-	if Lazy.is_val sctx.pool then
-		Domainslib.Task.teardown_pool (Lazy.force sctx.pool)
+let create verbose = {
+	version = create_version ();
+	verbose;
+	cs = new CompilationCache.cache;
+	class_paths = Hashtbl.create 0;
+	changed_directories = Hashtbl.create 0;
+	compilation_step = 0;
+	delays = [];
+	was_compilation = false;
+	macro_context_setup = false;
+	current_stdin = None;
+}
 
 let add_delay sctx f =
 	sctx.delays <- f :: sctx.delays

src/context/common.ml

@@ -390,7 +390,6 @@ let to_gctx com = {
 	include_files = com.include_files;
 	std = com.std;
 	timer_ctx = com.timer_ctx;
-	pool = com.sctx.pool;
 }
 let enter_stage com stage =
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)

src/context/commonCache.ml

@@ -109,7 +109,7 @@ let rec cache_context cs com =
 				DynArray.add parallels (cc,m,f)
 	in
 	List.iter cache_module com.modules;
-	let a = Parallel.run_with_pool com.sctx.pool (fun pool ->
+	let a = Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		Parallel.ParallelArray.map pool (fun (cc,m,f) ->
 			let chunks = f() in
 			(cc,m,chunks)

src/context/parallel.ml

@@ -44,10 +44,3 @@ let run_in_new_pool timer_ctx f =
 	else
 		let pool = Timer.time timer_ctx ["domainslib";"setup"] (Domainslib.Task.setup_pool ~num_domains:(Domain.recommended_domain_count() - 1)) () in
 		Std.finally (fun () -> Timer.time timer_ctx ["domainslib";"teardown"] Domainslib.Task.teardown_pool pool) (Domainslib.Task.run pool) (fun () -> f (Some pool))
-
-let run_with_pool pool f =
-	if not !enable then
-		f None
-	else
-		let pool = Lazy.force pool in
-		Domainslib.Task.run pool (fun () -> f (Some pool))

src/core/tFunctions.ml

@@ -91,8 +91,8 @@ let alloc_var =
 	alloc_var
 
 let alloc_mid =
-	let mid = Atomic.make 0 in
-	(fun() -> Atomic.incr mid; Atomic.get mid)
+	let mid = ref 0 in
+	(fun() -> incr mid; !mid)
 
 let mk e t p = { eexpr = e; etype = t; epos = p }
 
@@ -563,17 +563,19 @@ let apply_typedef td tl =
 let monomorphs eparams t =
 	apply_params eparams (List.map (fun _ -> mk_mono()) eparams) t
 
-let try_apply_params_rec stack cparams params t success =
-	let old_stack = !stack in
+let apply_params_stack = ref []
+
+let try_apply_params_rec cparams params t success =
+	let old_stack = !apply_params_stack in
 	try
-		let result = success (apply_params ~stack:stack cparams params t) in
-		stack := old_stack;
+		let result = success (apply_params ~stack:apply_params_stack cparams params t) in
+		apply_params_stack := old_stack;
 		result
 	with
 		| ApplyParamsRecursion ->
-			stack := old_stack;
+			apply_params_stack := old_stack;
 		| err ->
-			stack := old_stack;
+			apply_params_stack := old_stack;
 			raise err
 
 let rec follow t =

src/core/tUnification.ml

@@ -60,7 +60,6 @@ type unification_context = {
 	variance_stack          : (t * t) rec_stack;
 	abstract_cast_stack     : (t * t) rec_stack;
 	unify_new_monos         : t rec_stack;
-	apply_params_stack      : (t * t list) list ref;
 }
 
 type unify_min_result =
@@ -95,7 +94,6 @@ let default_unification_context () = {
 	variance_stack          = new_rec_stack();
 	abstract_cast_stack     = new_rec_stack();
 	unify_new_monos         = new_rec_stack();
-	apply_params_stack      = ref [];
 }
 
 (* Unify like targets (e.g. Java) probably would. *)
@@ -114,7 +112,6 @@ let native_unification_context = {
 	variance_stack          = new_rec_stack();
 	abstract_cast_stack     = new_rec_stack();
 	unify_new_monos         = new_rec_stack();
-	apply_params_stack      = ref [];
 }
 
 module Monomorph = struct
@@ -627,11 +624,11 @@ let rec type_eq uctx a b =
 		type_eq_params uctx a b tl1 tl2
 	| TType (t,tl) , _ when can_follow a ->
 		rec_stack uctx.eq_stack (a,b) (fast_eq_pair (a,b))
-			(fun() -> try_apply_params_rec uctx.apply_params_stack t.t_params tl t.t_type (fun a -> type_eq uctx a b))
+			(fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> type_eq uctx a b))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) when can_follow b ->
 		rec_stack uctx.eq_stack (a,b) (fast_eq_pair (a,b))
-			(fun() -> try_apply_params_rec uctx.apply_params_stack t.t_params tl t.t_type (type_eq uctx a))
+			(fun() -> try_apply_params_rec t.t_params tl t.t_type (type_eq uctx a))
 			(fun l -> error (cannot_unify a b :: l))
 	| TEnum (e1,tl1) , TEnum (e2,tl2) ->
 		if e1 != e2 && not (param = EqCoreType && e1.e_path = e2.e_path) then error [cannot_unify a b];
@@ -767,12 +764,12 @@ let rec unify (uctx : unification_context) a b =
 	| TType (t,tl) , _ ->
 		rec_stack uctx.unify_stack (a,b)
 			(fun(a2,b2) -> fast_eq_unbound_mono a a2 && fast_eq b b2)
-			(fun() -> try_apply_params_rec uctx.apply_params_stack t.t_params tl t.t_type (fun a -> unify uctx a b))
+			(fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> unify uctx a b))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) ->
 		rec_stack uctx.unify_stack (a,b)
 			(fun(a2,b2) -> fast_eq a a2 && fast_eq_unbound_mono b b2)
-			(fun() -> try_apply_params_rec uctx.apply_params_stack t.t_params tl t.t_type (unify uctx a))
+			(fun() -> try_apply_params_rec t.t_params tl t.t_type (unify uctx a))
 			(fun l -> error (cannot_unify a b :: l))
 	| TEnum (ea,tl1) , TEnum (eb,tl2) ->
 		if ea != eb then error [cannot_unify a b];