Skip to content
GitLab
Commit 981f599c authored by John van Groningen's avatar John van Groningen
Browse files

implement async compilation with module caching on windows

parent 4450ea5d
Hide whitespace changes
Inline Side-by-side
Pm/PmDriver.icl
View file @ 981f599c
......@@ -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
......
Win/PmCleanSystem.dcl
View file @ 981f599c
......@@ -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
View file @ 981f599c
......@@ -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
View file @ 981f599c
......@@ -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;
}
Supports Markdown
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