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

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