Commit edfd821b authored by John van Groningen's avatar John van Groningen

add functions to start, wait for finished and finish code generators,

to implement parallel code generation
parent 89af66b1
......@@ -158,9 +158,6 @@ CompileStartCommand ::
CompileHandleExitCode :: !Int !String !String !Int !(WindowFun *env) !(WindowFun *env) !Pathname
!ListTypes !*env -> (!Pathname,!CompilerMsg,!*env) | FileEnv env
/* old
CompilePollCompleted :: !*env -> (Maybe !(!Int,!Int), !*env) | FileEnv env
*/
:: CompilePollCompletedResult = NoFinishedCompiler | UnknownFinishedCompiler | FinishedCompiler !Int !Int
CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
......@@ -193,3 +190,10 @@ StartCodeGenerator :: !String !(WindowFun *GeneralSt) !CodeGenerateAsmOrCode !Pa
SendRepeatResult :: !Int !.a -> (!Int,!.a)
DelayEventLoop :: !.ps -> .ps
:: StartedCodeGenerator
start_code_generator :: !String !(WindowFun *GeneralSt) !Pathname !Int !Bool !CodeGenOptions !Processor !Pathname !*GeneralSt
-> (!Bool,!Int/*HANDLE*/,!StartedCodeGenerator,!*GeneralSt)
finish_code_generator :: !Int/*HANDLE*/ !StartedCodeGenerator !(WindowFun *GeneralSt) !*GeneralSt -> (!Bool,!*GeneralSt)
wait_for_finished_code_generator :: !{#Int} !*GeneralSt -> (!Int,!*GeneralSt);
......@@ -28,7 +28,7 @@ import UtilIO
trace_n _ f :== f
from Platform import TempDir
tooltempdir =: trace_n ("Tooltempdir",TempDir) TempDir
tooltempdir =: TempDir
//--
......@@ -600,6 +600,59 @@ CodeGen cgen` used_compiler_process_ids wf genAsmOrCode path timeprofile cgo tp
) ps
= (objpath,exit_code==0,compiler_process_ids,ps)
:: StartedCodeGenerator = !{
scg_thread_handle :: !Int,
scg_std_error_handle :: !Int,
scg_abc_path :: !{#Char},
scg_path_without_suffix :: !{#Char},
scg_errors_file_name :: !{#Char}
}
start_code_generator :: !String !(WindowFun *GeneralSt) !Pathname !Int !Bool !CodeGenOptions !Processor !Pathname !*GeneralSt
-> (!Bool,!Int/*HANDLE*/,!StartedCodeGenerator,!*GeneralSt)
start_code_generator cgen` wf abc_path slot timeprofile cgo tp startupdir ps
# (cgen_ok,cgen,cgendir) = mangleGenerator cgen` startupdir
| not cgen_ok
# ps = wf [cgen] ps
# scg = {scg_thread_handle=0,scg_std_error_handle=0,scg_abc_path="",scg_path_without_suffix="",scg_errors_file_name=""}
= (False,0,scg,ps)
# path_without_suffix = RemoveSuffix abc_path
command = cgen +++ MakeCodeGenOptionsString CodeGeneration timeprofile cgo tp +++ " " +++ (quoted_string path_without_suffix)
errors_file_name = errors_file_path tooltempdir slot
(didit,process_handle,thread_handle,std_error_handle,_) = start_process_with_redirected_std_error command cgendir errors_file_name 99
| not didit
# scg = {scg_thread_handle=0,scg_std_error_handle=0,scg_abc_path="",scg_path_without_suffix="",scg_errors_file_name=""}
= (False,0,scg,wf ["Error: Unable to run code generator: "+++cgen] ps)
# scg = {scg_thread_handle=thread_handle,scg_std_error_handle=std_error_handle,
scg_abc_path=abc_path,scg_path_without_suffix=path_without_suffix,scg_errors_file_name=errors_file_name}
= (True,process_handle,scg,ps)
finish_code_generator :: !Int/*HANDLE*/ !StartedCodeGenerator !(WindowFun *GeneralSt) !*GeneralSt -> (!Bool,!*GeneralSt)
finish_code_generator process_handle {scg_thread_handle,scg_std_error_handle,scg_abc_path,scg_path_without_suffix,scg_errors_file_name} wf ps
# (exit_code, os) = finish_process_with_redirected_std_error process_handle scg_thread_handle scg_std_error_handle 99
| os<>99
= undef
# ((_, errors_not_empty, error_text),ps) = accFiles (ReadErrorsAndWarnings scg_errors_file_name) ps
ps = (if errors_not_empty
(wf (StrictListToList error_text))
(if (exit_code <> 0)
(wf ["Error: Code generator failed for '" +++ scg_abc_path +++ "' with exit code: "+++toString exit_code,(quoted_string scg_path_without_suffix)])
id
)
) ps
= (exit_code==0,ps)
wait_for_finished_code_generator :: !{#Int} !*GeneralSt -> (!Int,!*GeneralSt);
wait_for_finished_code_generator handles ps
# n_handles = size handles
# (i,os) = WaitForMultipleObjects n_handles handles False INFINITE 99
| i>=WAIT_OBJECT_0 && i<WAIT_OBJECT_0+n_handles
= (i-WAIT_OBJECT_0,ps)
| i>=WAIT_ABANDONED_0 && i<WAIT_ABANDONED_0+n_handles
= (i-WAIT_ABANDONED_0,ps)
= (-1,ps)
mangleGenerator cgen` startupdir
# (cgen`,opts) = splitOptions cgen`
# (shortOK,cgen) = GetShortPathName (startupdir +++ "\\" +++ cgen` +++ "\0")
......@@ -828,6 +881,46 @@ win_create_process _ _ _
ccall win_create_process "II:VII:I"
}
call_process_with_redirected_std_error :: !{#Char} !{#Char} !{#Char} !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
call_process_with_redirected_std_error command directory errors_file_name os
// = CallProcess command directory "" "" errors_file_name os
| size command>0
# (std_error_handle,os) = create_inheritable_file (errors_file_name+++"\0") os
(ok,process_information,os) = create_process (command+++."\0") (directory+++"\0") std_error_handle os
| not ok
# (_,os) = CloseHandle std_error_handle os
= (False, -1, os)
# process_handle = process_information.[PROCESS_INFORMATION_hProcess_int_offset]
thread_handle = process_information.[PROCESS_INFORMATION_hThread_int_offset]
(_,os) = WaitForSingleObject process_handle INFINITE os
(_,exit_code,os) = GetExitCodeProcess process_handle os
(_,os) = CloseHandle std_error_handle os
(_,os) = CloseHandle thread_handle os
(_,os) = CloseHandle process_handle os
= (True, exit_code, os)
= (False, -1, os)
start_process_with_redirected_std_error :: !{#Char} !{#Char} !{#Char} !*OSToolbox -> (!Bool, !HANDLE, !HANDLE, !HANDLE, !*OSToolbox)
start_process_with_redirected_std_error command directory errors_file_name os
| size command>0
# (std_error_handle,os) = create_inheritable_file (errors_file_name+++"\0") os
(ok,process_information,os) = create_process (command+++."\0") (directory+++"\0") std_error_handle os
| not ok
# (_,os) = CloseHandle std_error_handle os
= (False, 0, 0, 0, os)
# process_handle = process_information.[PROCESS_INFORMATION_hProcess_int_offset]
thread_handle = process_information.[PROCESS_INFORMATION_hThread_int_offset]
= (True,process_handle,thread_handle,std_error_handle,os)
= (False, 0, 0, 0, os)
finish_process_with_redirected_std_error :: !HANDLE !HANDLE !HANDLE !*OSToolbox -> (!Int, !*OSToolbox)
finish_process_with_redirected_std_error process_handle thread_handle std_error_handle os
# (_,exit_code,os) = GetExitCodeProcess process_handle os
(_,os) = CloseHandle std_error_handle os
(_,os) = CloseHandle thread_handle os
(_,os) = CloseHandle process_handle os
= (exit_code, os)
// PERSISTENT STUFF
int_to_hex v
......@@ -853,35 +946,32 @@ compile_with_cache path directory startup_arguments arguments prog=:(CompilingIn
# 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 = trace_n ("Start",path,directory,path+++" "+++begin_arguments) r
| r==0
= trace_n ("A") (False,0,prog)
= (False,0,prog)
# (ok,s) = compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle;
| ok
# ci = CompilingInfo (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle)
= (ok,s,(ci,ps));
= trace_n ("B") (ok,s,prog);
= (ok,s,prog);
compile_with_cache path directory startup_arguments arguments prog=:(CompilingInfo (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle),ps)
# (ok,s) = compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle
| ok
= (ok,s,prog)
= trace_n ("C") (ok,s,(CompilingInfo NoCompiler,ps))
= (ok,s,(CompilingInfo NoCompiler,ps))
compile_with_cache path directory startup_arguments arguments prog=:(NotCompiling,ps)
# command = quoted_string path +++ " " +++ arguments
# (ok,exitcode, os4) = call_process command directory 99
# ok = trace_n ("NotCompiling",command) ok
= (ok,exitcode,prog)
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 = trace_n ("Compile","cocl "+++arguments) r
| r==0
= trace_n ("D") (False,0)
= (False,0)
# (r,a,s) =get_integers_from_thread_message wm_number compiler_thread_handle
| r==0
= trace_n ("E") (False,s)
= (False,s)
= (True,s)
StartCodeGenerator :: !String !(WindowFun *GeneralSt) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !Processor !ApplicationOptions !Pathname !CompilerProcessIds !*GeneralSt -> (!Bool,!Pathname,!CompilerProcessIds,!*GeneralSt)
......@@ -900,4 +990,119 @@ DelayEventLoop ps
wait_message :: !Int -> Int;
wait_message r = code {
ccall WaitMessage@0 "P:V:I"
}
\ No newline at end of file
}
GENERIC_WRITE:==0x40000000;
CREATE_ALWAYS:==2;
FILE_ATTRIBUTE_NORMAL:==0x00000080;
SECURITY_ATTRIBUTES_nLength_int_offset:==0;
SECURITY_ATTRIBUTES_bInheritHandle_int_offset:==2;
SECURITY_ATTRIBUTES_size_int:==3;
SECURITY_ATTRIBUTES_size_bytes_32:==12;
SECURITY_ATTRIBUTES_size_bytes_64:==24;
SECURITY_ATTRIBUTES_size_bytes :== IF_INT_64_OR_32 SECURITY_ATTRIBUTES_size_bytes_64 SECURITY_ATTRIBUTES_size_bytes_32;
:: HANDLE:==Int;
create_inheritable_file :: !{#Char} !*OSToolbox -> (!HANDLE,!*OSToolbox);
create_inheritable_file file_name os
# security_attributes = {createArray SECURITY_ATTRIBUTES_size_int 0 &
[SECURITY_ATTRIBUTES_nLength_int_offset] = SECURITY_ATTRIBUTES_size_bytes,
[SECURITY_ATTRIBUTES_bInheritHandle_int_offset] = 1};
= CreateFile file_name GENERIC_WRITE 0 security_attributes CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL 0 os;
create_process :: !*{#Char} !{#Char} !HANDLE !*OSToolbox -> (!Bool,!{#Int},!*OSToolbox)
create_process command_line current_directory std_error_handle os
# startup_info = {createArray STARTUPINFO_size_int 0 &
[STARTUPINFO_cb_int_offset] = STARTUPINFO_size_bytes,
[IF_INT_64_OR_32 STARTUPINFO_dwFlags_int_h_offset_64 STARTUPINFO_dwFlags_int_offset_32]
= IF_INT_64_OR_32 (STARTF_USESTDHANDLES<<32) STARTF_USESTDHANDLES,
[STARTUPINFO_hStdError_int_offset] = std_error_handle};
process_information = createArray PROCESS_INFORMATION_size_int 0
(ok,os) = CreateProcess 0 command_line 0 0 True DETACHED_PROCESS 0 current_directory startup_info process_information os
= (ok,process_information,os)
CreateFile :: !{#Char} !Int !Int !{#Int} !Int !Int !HANDLE !*OSToolbox -> (!HANDLE,!*OSToolbox);
CreateFile fileName desiredAccess shareMode lpSecurityAttributes creationDisposition flagsAndAttributes templateFile os
= code {
ccall CreateFileA@28 "PsIIAIIp:I:I"
}
:: LPCTSTR:==Int;
:: LPSECURITY_ATTRIBUTES:==Int;
:: LPVOID:==Int;
:: LPSTARTUPINFO:==Int;
:: LPPROCESS_INFORMATION:==Int;
STARTF_USESTDHANDLES:==0x00000100;
STARTUPINFO_size_int_32:==17;
STARTUPINFO_size_bytes_32:==68;
STARTUPINFO_size_int_64:==13;
STARTUPINFO_size_bytes_64:==104;
STARTUPINFO_size_int :== IF_INT_64_OR_32 STARTUPINFO_size_int_64 STARTUPINFO_size_int_32;
STARTUPINFO_size_bytes :== IF_INT_64_OR_32 STARTUPINFO_size_bytes_64 STARTUPINFO_size_bytes_32;
STARTUPINFO_cb_int_offset:==0;
STARTUPINFO_dwFlags_int_offset_32:==11;
STARTUPINFO_hStdError_int_offset_32:==16;
STARTUPINFO_dwFlags_int_h_offset_64:==7;
STARTUPINFO_hStdError_int_offset_64:==12;
STARTUPINFO_hStdError_int_offset :== IF_INT_64_OR_32 STARTUPINFO_hStdError_int_offset_64 STARTUPINFO_hStdError_int_offset_32;
PROCESS_INFORMATION_size_int_32:==4;
PROCESS_INFORMATION_size_int_64:==3;
PROCESS_INFORMATION_size_int :== IF_INT_64_OR_32 PROCESS_INFORMATION_size_int_64 PROCESS_INFORMATION_size_int_32;
PROCESS_INFORMATION_hProcess_int_offset:==0;
PROCESS_INFORMATION_hThread_int_offset:==1;
DETACHED_PROCESS:==8;
CreateProcess :: !LPCTSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!{#Char} !{#Int} !{#Int} !*OSToolbox -> (!Bool,!*OSToolbox)
CreateProcess lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
currentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PpsppIIpsAA:I:I"
}
INFINITE:==0xFFFFFFFF
WaitForSingleObject :: !HANDLE !Int !*OSToolbox -> (!Int,!*OSToolbox);
WaitForSingleObject handle milliseconds os
= code {
ccall WaitForSingleObject@8 "PpI:I:I"
}
WAIT_OBJECT_0:==0;
WAIT_ABANDONED_0:==0x80;
WAIT_TIMEOUT:==258;
WAIT_FAILED:==0xFFFFFFFF;
WaitForMultipleObjects :: !Int !{#Int} !Bool !Int !*OSToolbox -> (!Int,!*OSToolbox);
WaitForMultipleObjects n_handles handles waitAll milliseconds os
= code {
ccall WaitForMultipleObjects@16 "PIAII:I:I"
}
GetExitCodeProcess :: !HANDLE !*OSToolbox -> (!Bool,!Int,!*OSToolbox);
GetExitCodeProcess process os
= code {
ccall GetExitCodeProcess@8 "PI:II:I"
}
CloseHandle :: !HANDLE !*OSToolbox -> (!Bool,!*OSToolbox);
CloseHandle object os
= code {
ccall CloseHandle@4 "PI:I:I"
}
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