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

implement async compilation with module caching on windows

parent 4450ea5d
......@@ -118,10 +118,15 @@ GenAsmProjectModule path project setproject ps
:: *DriverCompilingInfo
= Sync
| AsyncWin !Int ![CurrentlyCompiled]
| AsyncWin ![CurrentlyCompiled] !AsyncWinCompilingInfo
| Async ![CurrentlyCompiled] !AsyncCompilingInfo
| Pers !*CompilingInfo
:: AsyncWinCompilingInfo = {
win_max_n_processes :: !Int,
win_compiler_process_ids :: !CompilerProcessIds
};
:: AsyncCompilingInfo = {
max_n_processes :: !Int,
compiler_process_ids :: !CompilerProcessIds,
......@@ -219,7 +224,7 @@ MakeTheProject force fileinfo libsinfo abccache project continue ps
# (compinfo,ps) = case method of
CompileSync -> (Sync,ps)
(CompileAsync cmax) -> PlatformDependant
(AsyncWin cmax [],ps) // win
(AsyncWin [] {win_max_n_processes=cmax,win_compiler_process_ids=NoCompilerProcessIds},ps) // win
(let (compiler_process_ids,ps2) = getCompilerProcessIds ps
in (Async [] {max_n_processes=cmax,compiler_process_ids=compiler_process_ids,unknown_finished_processors=NoUnknownFinishedProcessors},ps2) // mac
)
......@@ -375,17 +380,17 @@ step intr (DComp force dircache (Async [] async_compiling_info=:{max_n_processes
# ps = showInfo (Level1 "Generating...") ps
# (paths,ds) = ds!modpaths
= step intr (DGene paths (ASyncCodeGeneration [] async_compiling_info) ds) ps
step intr (DComp force dircache (AsyncWin _ []) Nil ds) ps
step intr (DComp force dircache (AsyncWin [] {win_compiler_process_ids}) Nil ds) ps
// compile phase finished: remove all modules not (indirectly) imported by main module
# project = PR_SetBuilt ds.modpaths ds.project // removes unused modules
# (modpaths,project) = PR_GetModulenames True IclMod project
# ds = {ds & modpaths = modpaths, project = project}
// # (os_error,ps) = ClearCompilerCaches compiler_process_ids ps;
# ps = QuitCleanCompiler True win_compiler_process_ids ps;
# ps = showInfo (Level1 "Generating...") ps
# (paths,ds) = ds!modpaths
= step intr (DGene paths SyncCodeGeneration ds) ps
step intr state=:(DComp force _ (Async _ _) _ _) ps
# ps = traceInfo (Level3 ["check_completed..."]) ps
# (state, ps) = check_completed state ps
......@@ -437,7 +442,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# (completed, current) = removeFromCurrent completedSlot current
# unknown_finished_processors = remove_from_unknown_finished_processors completedSlot unknown_finished_processors
# (startupdir,ps) = getStup ps
typewin = updateTypeWindow True (GetModuleName completed.iclModule) [typeWinKeyboard, typeWinMouse]
# typewin = updateTypeWindow True (GetModuleName completed.iclModule) [typeWinKeyboard, typeWinMouse]
# ccstring = "dummy ccstring for now.."
# (abcpath,res,ps) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
completed.iclModule completed.options.listTypes ps // types param
......@@ -493,7 +498,6 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
currently_compiled next current
= or [c.iclModule == next \\ c <- current]
/*XXX
step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# ps = traceInfo (Level3 ["check_completed..."]) ps
# (state, ps) = check_completed state ps
......@@ -501,8 +505,8 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# (state, ps) = start_compilations state ps
= cont (state, ps)
where
check_completed :: !*DriverState !*(PSt General) -> !(!*DriverState,!*PSt General)
check_completed state=:(DComp _ _ (AsyncWin cmax current=:[_:_]) _ _) ps
check_completed :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
check_completed state=:(DComp _ _ (AsyncWin current=:[_:_] _) _ _) ps
= case (CompilePollCompleted ps) of
(NoFinishedCompiler, ps)
-> (state, ps)
......@@ -514,22 +518,23 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
check_completed state ps
= (state, ps)
process_completed :: !Int !Int !*DriverState !*(PSt General) -> !(!*DriverState,!*PSt General)
process_completed completedSlot exitcode (DComp force dircache (AsyncWin cmax current) todo ds) ps
process_completed :: !Int !Int !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
process_completed completedSlot exitcode (DComp force dircache (AsyncWin current {win_max_n_processes,win_compiler_process_ids}) todo ds) ps
# (completed, current) = removeFromCurrent completedSlot current
# (startupdir,ps) = getStup ps
typewin = updateTypeWindow (GetModuleName completed.iclModule) [typeWinKeyboard, typeWinMouse]
# typewin = updateTypeWindow True (GetModuleName completed.iclModule) [typeWinKeyboard, typeWinMouse]
# ccstring = "dummy ccstring for now.."
# (ps,abcpath,res) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
# (abcpath,res,ps) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
completed.iclModule completed.options.listTypes ps // types param
# (ps,fileinfo,dircache,abccache,project,ok,newpaths`,_,deps)
= ProcessCompilerMsg Compilation completed.options completed.iclModule abcpath res ds.fileinfo dircache ds.abccache ds.project ps
# (_,(ps,fileinfo,dircache,abccache,project,ok,newpaths`,_,deps))
= ProcessCompilerMsg Nothing Compilation completed.options completed.iclModule abcpath res ds.fileinfo dircache ds.abccache ds.project ps
# ds = {ds & newpaths = ds.newpaths || newpaths`, fileinfo = fileinfo, abccache = abccache, project = project, ok = ok}
| ok
# ds = {ds & modpaths = completed.iclModule :! ds.modpaths}
= (DComp force dircache (AsyncWin cmax current) (Concat deps todo) ds, ps)
# ds = {ds & modpaths = icl_to_dcl_file_name completed.iclModule :! ds.modpaths}
= (DComp force dircache (AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}) (Concat deps todo) ds, ps)
// not ok
# (paths,ds) = ds!modpaths
# ps = QuitCleanCompiler True win_compiler_process_ids ps;
= (DGene paths SyncCodeGeneration ds, ps)
where
removeFromCurrent :: Int [CurrentlyCompiled] -> (CurrentlyCompiled, [CurrentlyCompiled])
......@@ -543,30 +548,36 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
= (completed, [current : rest])
start_compilations :: !*DriverState !*(PSt General) -> (!*DriverState,!*PSt General)
start_compilations state=:(DComp force dircache (AsyncWin cmax current) (next :! rest) ds) ps
| length current >= cmax
start_compilations state=:(DComp force dircache (AsyncWin current {win_max_n_processes,win_compiler_process_ids}) (next :! rest) ds) ps
| length current >= win_max_n_processes
# ps = DelayEventLoop ps;
= (state, ps)
// compile phase: check module 'next'
| StringOccurs next ds.modpaths || currently_compiled next current
= start_compilations (DComp force dircache (AsyncWin cmax current) rest ds) ps
# next_icl = dcl_to_icl_file_name next;
| StringOccurs next ds.modpaths || currently_compiled next_icl current
= start_compilations (DComp force dircache (AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}) rest ds) ps
# modname = GetModuleName next
| isProjLibraryModule modname ds.libsinfo
// instead of testing explicitly put libmodules in done <= conflicts with other administration
= (DComp force dircache (AsyncWin cmax current) rest ds, ps)
= (DComp force dircache (AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}) rest ds, ps)
# (ps,dircache,ok,_,rest,compinfo,ds,_)
= UpdateDependencies force next rest (AsyncWin cmax current) dircache ds ps
= UpdateDependencies force next rest (AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}) dircache ds ps
# ds = {ds & ok = ok}
| not ok
#! (paths,ds) = ds!modpaths
# ps = QuitCleanCompiler True win_compiler_process_ids ps;
= (DGene paths SyncCodeGeneration ds, ps)
= start_compilations (DComp force dircache compinfo rest ds) ps
start_compilations state=:(DComp force dircache (AsyncWin [] _) Nil ds) ps
= (state, ps)
start_compilations state ps
# ps = DelayEventLoop ps;
= (state, ps)
currently_compiled :: String [CurrentlyCompiled] -> Bool
currently_compiled next current
= or [c.iclModule == next \\ c <- current]
*/
step intr (DGene Nil SyncCodeGeneration ds) ps
#! ps = showInfo (Level1 "Linking...") ps
= step intr (DLink ds) ps
......@@ -968,10 +979,8 @@ remove_from_unknown_finished_processors completedSlot unknown_finished_processor
= unknown_finished_processors
compiling_info :: !DriverCompilingInfo -> (String,DriverCompilingInfo)
/*
compiling_info info=:(AsyncWin _ current)
compiling_info info=:(AsyncWin current _)
= (compiling_info_async current,info)
*/
compiling_info info=:(Async current _)
= (compiling_info_async current,info);
compiling_info info
......@@ -1003,7 +1012,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
= case compinfo of
Sync -> UpdateSyncDependencies rest impname co dircache ds ps
(Async current async_compiling_info) -> UpdateAsyncDependencies current async_compiling_info rest impname co dircache ds ps
// async=:(AsyncWin _ _)-> UpdateAsyncDependencies async rest impname co dircache ds ps
(AsyncWin current win_compiling_info)-> UpdateAsyncDependenciesWin current win_compiling_info rest impname co dircache ds ps
(Pers info) -> UpdatePersDependencies info rest impname co dircache ds ps
| info.sys // system module
# wrongVersion = info.version <> version
......@@ -1069,7 +1078,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
= case compinfo of
Sync -> UpdateSyncDependencies rest impname co dircache ds ps
(Async current async_compiling_info) -> UpdateAsyncDependencies current async_compiling_info rest impname co dircache ds ps
// async=:(AsyncWin _ _)-> UpdateAsyncDependencies async rest impname co dircache ds ps
(AsyncWin cmax current) -> UpdateAsyncDependenciesWin cmax current rest impname co dircache ds ps
(Pers info) -> UpdatePersDependencies info rest impname co dircache ds ps
# ((ok,mods,xxx_md,xxx_dd,objs,libs,abccache),ps)
= accFiles (ParseABCDependencies` info.abcpath info.abcdate ds.abccache) ps
......@@ -1097,7 +1106,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
= case compinfo of
Sync -> UpdateSyncDependencies rest impname co dircache ds ps
(Async current compiling_info) -> UpdateAsyncDependencies current compiling_info rest impname co dircache ds ps
// async=:(AsyncWin _ _ )-> UpdateAsyncDependencies async rest impname co dircache ds ps
(AsyncWin current win_compiling_info)-> UpdateAsyncDependenciesWin current win_compiling_info rest impname co dircache ds ps
(Pers info) -> UpdatePersDependencies info rest impname co dircache ds ps
where
(prefs,ps) = getPrefs ps` // lift to DriverState
......@@ -1123,28 +1132,27 @@ where
co = case modinfo of
Just modinfo -> modinfo.compilerOptions
_ -> defaultCO
/*
UpdateAsyncDependencies (AsyncWin cmax current) rest impname co dircache ds ps
UpdateAsyncDependenciesWin current {win_max_n_processes,win_compiler_process_ids} rest impname co dircache ds ps
# free_slot = get_free_slot current
# (compileStarted, fileinfo, dircache, abccache, ps)
= CompileTheProjectModuleStart Compilation impname free_slot ds.fileinfo dircache ds.abccache ds.project ps
# (compileStarted, fileinfo, dircache, abccache,win_compiler_process_ids,ps)
= CompileTheProjectModuleStart Compilation impname free_slot ds.fileinfo dircache ds.abccache ds.project win_compiler_process_ids ps;
# ds = {ds & fileinfo = fileinfo, abccache = abccache}
| compileStarted
# current = [{iclModule = impname, options = co, slot = free_slot} : current]
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = AsyncWin cmax current
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
= (ps,dircache,True,False,rest,async,ds,True)
// not compileStarted
# cinf = compiling_info_async current
# ps = showInfo (Level2 cinf) ps
# async = AsyncWin cmax current
# async = AsyncWin current {win_max_n_processes=win_max_n_processes,win_compiler_process_ids=win_compiler_process_ids}
= (ps,dircache,False,False,rest,async,ds,False)
where
get_free_slot :: [CurrentlyCompiled] -> Int
get_free_slot current
= hd (removeMembers [0..] [slot \\ {slot} <- current])
*/
UpdateAsyncDependencies current {max_n_processes,compiler_process_ids,unknown_finished_processors} rest impname co dircache ds ps
# free_slot = get_free_slot current
......
......@@ -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