Commit 981f599c authored by John van Groningen's avatar John van Groningen

implement async compilation with module caching on windows

parent 4450ea5d
This diff is collapsed.
......@@ -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
......
......@@ -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
......@@ -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;
}
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment