implement async compilation with module caching on windows

Win/PmCleanSystem.dcl

@@ -19,7 +19,7 @@ NoCompilerProcessIds :: CompilerProcessIds
 
 ClearCompilerCache :: !String !String !.a -> (!Int,!.a)
 ClearCompilerCaches :: !CompilerProcessIds !.a -> (!Int,!.a)
-QuitCleanCompiler :: !Bool !CompilerProcessIds !*(IOSt .l) -> *(IOSt .l)
+QuitCleanCompiler :: !Bool !CompilerProcessIds !.env -> .env
 
 //::	CompileClearCache	= ClearCache | Don`tClearCache
 //instance == CompileClearCache

Win/PmCleanSystem.icl

@@ -16,7 +16,7 @@ from clCCall_12 import winLaunchApp, winLaunchApp2, winCallProcess, winMakeCStri
 from linkargs import ReadLinkErrors,WriteLinkOpts,:: LinkInfo`(..),:: LPathname
 import thread_message
 import lib
-import asynclaunch
+//import asynclaunch
 
 import UtilIO
 
@@ -62,7 +62,13 @@ getLib lib files
 	# slibs					= map RemoveSuffix slibs
 	= (errs,slibs,files)
 
-:: CompilerProcessIds :== [Int] // not used for windows, always []
+:: CompilerProcessHandlesAndId = {
+	compiler_thread_id :: !Int,
+	compiler_thread_handle :: !Int,
+	compiler_process_handle :: !Int
+   }
+
+:: CompilerProcessIds :== [CompilerProcessHandlesAndId]
 
 NoCompilerProcessIds :: CompilerProcessIds
 NoCompilerProcessIds = []
@@ -73,8 +79,19 @@ ClearCompilerCache _ _ ps = (0,ps)
 ClearCompilerCaches :: !CompilerProcessIds !.a -> (!Int,!.a)
 ClearCompilerCaches _ ps = (0,ps)
 
-QuitCleanCompiler :: !Bool !CompilerProcessIds !*(IOSt .l) -> *(IOSt .l)
-QuitCleanCompiler _ _ io = io
+QuitCleanCompiler :: !Bool !CompilerProcessIds !.env -> .env
+QuitCleanCompiler async compiler_process_ids io
+	| async
+		= quit_compilers compiler_process_ids io;
+		with
+			quit_compilers [{compiler_thread_id,compiler_process_handle}:compiler_process_ids] io
+				# wm_number=get_message_number;
+				# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("exit\0")
+				| r==r
+					= quit_compilers compiler_process_ids io;
+			quit_compilers [] io
+				= io;
+	= io;
 
 ExitCleanCompiler :: !*(!*CompilingInfo,*env) -> *(!*CompilingInfo,*env)
 ExitCleanCompiler prog=:(CompilingInfo (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle), ps)
@@ -149,6 +166,7 @@ Compile
 	cocl` use_compiler_process_ids write_module_times errwin typewin compileOrCheckSyntax path paths projectMemoryProfiling
 	projectTimeProfiling projectEagerOrDynamic co=:{CompilerOptions | listTypes}
 	startupdir compiler_process_ids ps
+	# (cocl_ok,cocl,cocldir)	= mangleCompiler cocl` startupdir	// platform dependant mangling...
 	| not cocl_ok
 		# ps					= errwin [cocl] ps
 		= ("",SyntaxError,compiler_process_ids,ps)
@@ -167,7 +185,6 @@ Compile
 where
 	dummy_slot = 0
 	write_module_times_string = if write_module_times " -wmt " " "
-	(cocl_ok,cocl,cocldir)	= mangleCompiler cocl` startupdir	// platform dependant mangling...
 
 mangleCompiler ccstring` startupdir
 	# (ccstring`,rem)			= splitOptions ccstring`
@@ -198,10 +215,12 @@ mangleCompiler2 ccstring` startupdir
 :: ExitCode
 	:== Int
 
+/*
 CompileStartCommand :: !String !Bool !(WindowFun *env) !CompileOrCheckSyntax !Pathname !(List Pathname) !Int !Bool !Bool !Bool
 				!CompilerOptions !Pathname !CompilerProcessIds !*env -> (!Bool,!CompilerProcessIds,!*env) | FileEnv env
 CompileStartCommand cocl` write_module_times errwin compileOrCheckSyntax path paths slot projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic
 					co startupdir compiler_process_ids ps
+	# (cocl_ok,cocl,cocldir)	= mangleCompiler cocl` startupdir	// platform dependant mangling...
 	| not cocl_ok
 		# ps					= errwin [cocl] ps
 		= (False,compiler_process_ids,ps)
@@ -218,19 +237,76 @@ CompileStartCommand cocl` write_module_times errwin compileOrCheckSyntax path pa
 		=	(True,compiler_process_ids,ps)
 where
 	write_module_times_string = if write_module_times " -wmt " " "
-	(cocl_ok,cocl,cocldir)	= mangleCompiler cocl` startupdir	// platform dependant mangling...
+*/
 
-:: CompilePollCompletedResult = NoFinishedCompiler | UnknownFinishedCompiler | FinishedCompiler !Int !Int
+CompileStartCommand :: !String !Bool !(WindowFun *env) !CompileOrCheckSyntax !Pathname !(List Pathname) !Int !Bool !Bool !Bool
+						!CompilerOptions !Pathname !CompilerProcessIds !*env
+										 -> (!Bool,!CompilerProcessIds,!*env) | FileEnv env
+CompileStartCommand cocl` write_module_times errwin compileOrCheckSyntax path paths slot projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic
+					co startupdir compiler_process_ids ps
+	# (cocl_ok,cocl,cocl_dir,cocl_startup,options)	= mangleCompiler2 cocl` startupdir	// platform dependant mangling...
+	| not cocl_ok
+		# ps = errwin [cocl] ps
+		= (False,compiler_process_ids,ps)
+	# out_file_name		=  out_file_path tooltempdir slot
+	# errors_file_name	=  errors_file_path tooltempdir slot
+	# cocl_arguments
+		= " -id " +++toString slot+++" "+++options +++ write_module_times_string +++. 
+			CompileBuildCommand out_file_name errors_file_name compileOrCheckSyntax path paths projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic co
+	# (compile_ok,compiler_process_ids,ps) = start_compile_with_cache cocl slot cocl_dir cocl_startup cocl_arguments compiler_process_ids ps;
+	| not compile_ok
+  		# ps = errwin ["Error: Unable to run compiler: "+++cocl] ps
+  		= (False,compiler_process_ids,ps)
+	= (True,compiler_process_ids,ps)
+where
+	write_module_times_string = if write_module_times " -wmt " " "
 
-CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
+start_compile_with_cache :: String Int String String String CompilerProcessIds *env -> (!Bool,!CompilerProcessIds,!*env)
+start_compile_with_cache path slot directory startup_arguments arguments compiler_process_ids ps
+	| slot<length compiler_process_ids
+		# compiler_handles_and_id = compiler_process_ids !! slot
+		= start_compile_with_cache2 path compiler_handles_and_id directory arguments compiler_process_ids ps
+	# thread_id=get_current_thread_id;
+	# begin_arguments=startup_arguments+++" -ide "+++int_to_hex thread_id;
+	# (r,compiler_thread_id,compiler_thread_handle,compiler_process_handle) = start_compiler_process (path+++"\0") (directory+++"\0") (path+++" "+++begin_arguments+++"\0");
+	| r==0
+		= (False,compiler_process_ids,ps)
+	# compiler_handles_and_id = {compiler_thread_id=compiler_thread_id,compiler_thread_handle=compiler_thread_handle,compiler_process_handle=compiler_process_handle}
+	# compiler_process_ids = compiler_process_ids++[compiler_handles_and_id]
+	= start_compile_with_cache2 path compiler_handles_and_id directory arguments compiler_process_ids ps
+
+start_compile_with_cache2 :: {#.Char} CompilerProcessHandlesAndId {#.Char} {#.Char} CompilerProcessIds *env -> (!Bool,!CompilerProcessIds,!*env)
+start_compile_with_cache2 path {compiler_thread_id,compiler_thread_handle,compiler_process_handle} directory arguments compiler_process_ids ps
+	# wm_number=get_message_number
+	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
+	| r==0
+		= (False,compiler_process_ids,ps)
+	= (True,compiler_process_ids,ps)
+
+:: CompilePollCompletedResult = NoFinishedCompiler | UnknownFinishedCompiler | FinishedCompiler !Int !Int
+/*
 CompilePollCompleted ps
 	# (ok, exitCode, slot, os)
 		=	AsyncPollCompleted 99
 //	| trace_n ("CompilePollCompleted ok=" +++ toString ok +++ " slot/r=" +++ toString slot) ok
 	| ok
-		=	wait 100 (FinishedCompiler slot exitCode, ps)
+		=	//wait 100
+			(FinishedCompiler slot exitCode, ps)
 	// not ok
 		=	(NoFinishedCompiler, ps)
+*/
+
+CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
+CompilePollCompleted ps
+	# (compiler_id,exit_code) = get_finished_compiler_id_and_exit_code
+	| compiler_id<0
+		= (NoFinishedCompiler,ps)
+		= (FinishedCompiler compiler_id exit_code,ps);
+
+get_finished_compiler_id_and_exit_code :: (!Int/*compiler_id*/,!Int/*exit_code*/);
+get_finished_compiler_id_and_exit_code = code {
+	ccall get_finished_compiler_id_and_exit_code ":II"
+ }
 
 //-- Persistent compilation stuff...synchronous for now...
 
@@ -285,10 +361,10 @@ CompileBuildCommand out_file_name errors_file_name compileOrCheckSyntax path pat
 
 CompileHandleExitCode :: !Int !String !String !Int !(WindowFun *env) !(WindowFun *env) !Pathname
 				!ListTypes !*env -> (!Pathname,!CompilerMsg,!*env) | FileEnv env
-CompileHandleExitCode exitcode cocl tooltempdir slot errwin typewin path
+CompileHandleExitCode exitcode cocl startupdir slot errwin typewin path
 					listTypes ps
-	#	out_file_name		=  out_file_path tooltempdir 0
-		errors_file_name	=  errors_file_path tooltempdir 0
+	#	out_file_name		=  out_file_path tooltempdir slot
+		errors_file_name	=  errors_file_path tooltempdir slot
 	#	((type_text_not_empty,type_text),ps)
 			= accFiles (ReadTypesInfo (listTypes<>NoTypes) out_file_name) ps
 		((errors,errors_and_messages_not_empty,errors_and_messages),ps)
@@ -759,7 +835,6 @@ compile_with_cache path directory startup_arguments arguments prog=:(NotCompilin
 compile_with_cache2 :: {#.Char} {#.Char} {#.Char} Int Int Int -> (!Bool,!Int)
 compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle
 	# wm_number=get_message_number
-//	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
 	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
 	# r = trace_n ("Compile","cocl "+++arguments) r
 	| r==0
@@ -776,4 +851,11 @@ SendRepeatResult :: !Int !.a -> (!Int,!.a)
 SendRepeatResult _ _ = undef
 
 DelayEventLoop :: !.ps -> .ps
-DelayEventLoop ps = ps // only used on the Mac
+DelayEventLoop ps
+	| wait_message 0==0
+		= ps
+
+wait_message :: !Int -> Int;
+wait_message r = code {
+	ccall WaitMessage@0 "P:V:I"
+}
\ No newline at end of file

Win/thread_message.c

@@ -4,6 +4,8 @@
 #include "Clean.h"
 #include "thread_message.h"
 
+static int CleanCompiler_message_nunber;
+
 int get_message_number (void)
 {
 	return RegisterWindowMessage ("CleanCompiler");
@@ -14,6 +16,36 @@ int get_current_thread_id (void)
 	return GetCurrentThreadId();
 }
 
+int compiler_result_handler_installed=0;
+
+extern void (*dispatch_null_message_hook) (MSG*);
+
+#define MAX_N_COMPILERS 32
+
+int compiler_finished[MAX_N_COMPILERS];
+int compiler_exit_codes[MAX_N_COMPILERS];
+
+void compiler_result_handler (MSG *msg)
+{	
+	if (msg->message==CleanCompiler_message_nunber){
+		unsigned int compiler_n;
+
+		compiler_n=msg->wParam;
+
+		if (compiler_n<MAX_N_COMPILERS){
+			compiler_exit_codes[compiler_n]=msg->lParam;
+			compiler_finished[compiler_n]=1;
+		}
+	}
+}
+
+void install_compiler_result_handler (void)
+{
+	CleanCompiler_message_nunber=get_message_number();
+
+	dispatch_null_message_hook = &compiler_result_handler;
+}
+
 int start_compiler_process (CleanString compiler_path,CleanString compiler_directory,CleanString command,
 							int *compiler_thread_id_p,int *compiler_thread_handle_p,int *compiler_process_handle_p)
 {
@@ -22,6 +54,11 @@ int start_compiler_process (CleanString compiler_path,CleanString compiler_direc
 	PROCESS_INFORMATION pi;
 	int r;
 
+	if (!compiler_result_handler_installed){
+		install_compiler_result_handler();
+		compiler_result_handler_installed=1;
+	}
+
 	application_name=CleanStringCharacters (compiler_path);
 	dir=CleanStringCharacters (compiler_directory);
 	command_line=CleanStringCharacters (command);
@@ -185,3 +222,31 @@ int send_integers_to_thread (int thread_id,int wm_number,int i1,int i2)
 	
 	return r;
 }
+
+int compiler_id=-1;
+
+int set_compiler_id (int compiler_id_p)
+{
+	compiler_id=compiler_id_p;
+	return compiler_id_p;
+}
+
+int get_compiler_id (void)
+{
+	return compiler_id;
+}
+
+int get_finished_compiler_id_and_exit_code (int *exit_code_p)
+{
+	int compiler_n;
+	
+	for (compiler_n=0; compiler_n<MAX_N_COMPILERS; ++compiler_n)
+		if (compiler_finished[compiler_n]){
+			*exit_code_p=compiler_exit_codes[compiler_n];
+			compiler_finished[compiler_n]=0;
+			return compiler_n;
+		}
+	
+	*exit_code_p=0;
+	return -1;
+}