Skip to content

GitLab

C
clean-ide
Commit 5ed8e23e authored by John van Groningen's avatar John van Groningen
Browse files
Options

create new processes without using c code from ObjectIO or thread_message.c

parent a3c737d4
Hide whitespace changes
Inline Side-by-side
Showing with 83 additions and 94 deletions
Win/PmCleanSystem.icl
View file @ 5ed8e23e
......@@ -16,18 +16,16 @@ import UtilNewlinesFile
import WriteOptionsFile
from PmParse import IsTypeSpec, IsImportError13, IsImportError20
from clCCall_12 import winLaunchApp, winLaunchApp2, winCallProcess, winMakeCString, winReleaseCString, :: OSToolbox, :: CSTR
from linkargs import ReadLinkErrors,WriteLinkOpts,:: LinkInfo`(..),:: LPathname
import thread_message
import lib
//import asynclaunch
import UtilIO
//import dodebug
trace_n _ f :== f
from Platform import TempDir
:: OSToolbox:==Int
tooltempdir =: TempDir
//--
......@@ -186,7 +184,7 @@ Compile
errors_file_name = errors_file_path tooltempdir dummy_slot
# command = cocl +++ write_module_times_string +++
CompileBuildCommand out_file_name errors_file_name compileOrCheckSyntax path paths project_compiler_options co
(didit, exitcode, os4) = call_process command cocldir 99
(didit, exitcode, os4) = call_process_with_directory command cocldir 99
diditall = if (os4 == 99) didit didit
| not diditall
# ps = errwin (["Error: Unable to run compiler: "+++cocl +++ " :"+++toString exitcode]) ps
......@@ -544,11 +542,9 @@ CodeGen cgen` used_compiler_process_ids wf genAsmOrCode abc_path obj_path timepr
+++ " " +++ (quoted_string path_without_suffix)
errorsfilename = tooltempdir +++ DirSeparatorString +++ "errors"
(didit,exit_code,_) = CallProcess command [] cgendir "" "" errorsfilename 99
(didit,exit_code,_) = call_process_with_directory_and_redirected_std_error command cgendir errorsfilename 99
| not didit
= (obj_path,False,compiler_process_ids,wf [ "Error: Unable to run code generator: "+++cgen
// , command
// , startupdir
] ps)
# code_generator_failed_message = "Error: Code generator failed for '" +++ abc_path +++ "' with exit code: "+++toString exit_code
# ((_, errors_not_empty, error_text),ps) = accFiles (ReadErrorsAndWarnings errorsfilename) ps
......@@ -699,7 +695,7 @@ Link linker` winfun path
# linker = linker +++ " -I " +++ quoted_string linkoptspath +++ " -O " +++ quoted_string linkerrspath
# (didit,exit_code,ost) = call_process linker linkerdir 99
# (didit,exit_code,ost) = call_process_with_directory linker linkerdir 99
# diditall = if (ost == 99) didit didit
| not diditall
= (winfun ["Error: Unable to run linker: "+++linker] ps, False)
......@@ -764,7 +760,7 @@ where
Execute` :: !String !*env -> (!Bool,!Int,!*env)
Execute` command ps
# (didit, ec, os4) = CallProcess command [] "" "" "" "" 99
# (didit, ec, os4) = call_process command 99
diditall = if (os4 == 99) didit didit
| diditall
= (True,ec,ps)
......@@ -772,78 +768,41 @@ Execute` command ps
//--- OTHER STUFF
CallProcess :: !String [(!String,!String)] !String !String !String !String !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
CallProcess command environment directory stdin stdout stderr os
| size command > 0
# (commandptr,os) = winMakeCString command os
envstring = MakeEnvironmentString environment
(envptr,os) = case (size envstring == 0) of
True -> (0, os)
false -> (winMakeCString envstring os)
(dirptr, os) = case (size directory == 0) of
True -> (0, os)
false -> (winMakeCString directory os)
(inptr, os) = case (size stdin == 0) of
True -> (0, os)
false -> (winMakeCString stdin os)
(outptr, os) = case (size stdout == 0) of
True -> (0, os)
false -> (winMakeCString stdout os)
(errptr, os) = case (size stderr == 0) of
True -> (0, os)
false -> (winMakeCString stderr os)
(success, exitcode, os)
= winCallProcess commandptr envptr dirptr inptr outptr errptr os
os = winReleaseCString commandptr os
os = case (envptr == 0) of
True -> os
false -> (winReleaseCString envptr os)
os = case (dirptr == 0) of
True -> os
false -> (winReleaseCString dirptr os)
os = case (envptr == 0) of
True -> os
false -> (winReleaseCString inptr os)
os = case (envptr == 0) of
True -> os
false -> (winReleaseCString outptr os)
//error
os = case (envptr == 0) of
True -> os
false -> (winReleaseCString errptr os)
= (success, exitcode, os)
= (False, -1, os)
where
MakeEnvironmentString [] = ""
MakeEnvironmentString [ (name, value):rest ] = name +++ "=" +++ value +++ "\0" +++ MakeEnvironmentString rest
call_process :: !String !String !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
call_process command directory os
| size command > 0
# (commandptr,os) = winMakeCString command os
(dirptr, os) = if (size directory == 0)
(0, os)
(winMakeCString directory os)
(success, exitcode, os) = win_create_process commandptr dirptr os
os = winReleaseCString commandptr os
os = if (dirptr == 0)
os
(winReleaseCString dirptr os)
= (success, exitcode, os)
= (False, -1, os)
win_create_process :: !CSTR !CSTR !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
win_create_process _ _ _
= code {
ccall win_create_process "II:VII:I"
}
call_process :: !{#Char} !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
call_process command os
| size command>0
# (ok,process_information,os) = create_process_with_current_directory_pointer (command+++."\0") 0 True 0 os
| not ok
= (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 thread_handle os
(_,os) = CloseHandle process_handle os
= (True, exit_code, os)
= (False, -1, os)
call_process_with_directory :: !{#Char} !{#Char} !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
call_process_with_directory command directory os
| size command>0
# (ok,process_information,os) = create_process (command+++."\0") (directory+++"\0") False 0 os
| not ok
= (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 thread_handle os
(_,os) = CloseHandle process_handle os
= (True, exit_code, os)
= (False, -1, os)
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
call_process_with_directory_and_redirected_std_error :: !{#Char} !{#Char} !{#Char} !*OSToolbox -> (!Bool, !Int, !*OSToolbox)
call_process_with_directory_and_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
(ok,process_information,os) = create_process (command+++."\0") (directory+++"\0") True std_error_handle os
| not ok
# (_,os) = CloseHandle std_error_handle os
= (False, -1, os)
......@@ -861,7 +820,7 @@ start_process_with_redirected_std_error :: !{#Char} !{#Char} !{#Char} !*OSToolbo
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
(ok,process_information,os) = create_process (command+++."\0") (directory+++"\0") True std_error_handle os
| not ok
# (_,os) = CloseHandle std_error_handle os
= (False, 0, 0, 0, os)
......@@ -916,7 +875,7 @@ compile_with_cache path directory startup_arguments arguments prog=:(CompilingIn
= (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,exitcode, os4) = call_process_with_directory command directory 99
= (ok,exitcode,prog)
compile_with_cache2 :: {#.Char} {#.Char} {#.Char} Int Int Int -> (!Bool,!Int)
......@@ -971,12 +930,12 @@ create_inheritable_file file_name os
(CreateFile file_name GENERIC_WRITE 0 security_attributes CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL 0 os)
(CreateFile_32 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 &
create_process :: !*{#Char} !{#Char} !Bool !HANDLE !*OSToolbox -> (!Bool,!{#Int},!*OSToolbox)
create_process command_line current_directory startf_usestdhandles std_error_handle os
# flags = if startf_usestdhandles (IF_INT_64_OR_32 (STARTF_USESTDHANDLES<<32) STARTF_USESTDHANDLES) 0;
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,
[IF_INT_64_OR_32 STARTUPINFO_dwFlags_int_h_offset_64 STARTUPINFO_dwFlags_int_offset_32] = flags,
[STARTUPINFO_hStdError_int_offset] = std_error_handle};
process_information = createArray PROCESS_INFORMATION_size_int 0
(ok,os) = IF_INT_64_OR_32
......@@ -984,6 +943,19 @@ create_process command_line current_directory std_error_handle os
(CreateProcess_32 0 command_line 0 0 True DETACHED_PROCESS 0 current_directory startup_info process_information os)
= (ok,process_information,os)
create_process_with_current_directory_pointer :: !*{#Char} !Int !Bool !HANDLE !*OSToolbox -> (!Bool,!{#Int},!*OSToolbox)
create_process_with_current_directory_pointer command_line current_directory_p startf_usestdhandles std_error_handle os
# flags = if startf_usestdhandles (IF_INT_64_OR_32 (STARTF_USESTDHANDLES<<32) STARTF_USESTDHANDLES) 0;
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] = flags,
[STARTUPINFO_hStdError_int_offset] = std_error_handle};
process_information = createArray PROCESS_INFORMATION_size_int 0
(ok,os) = IF_INT_64_OR_32
(CreateProcess_with_current_directory_pointer 0 command_line 0 0 True DETACHED_PROCESS 0 current_directory_p startup_info process_information os)
(CreateProcess_with_current_directory_pointer_32 0 command_line 0 0 True DETACHED_PROCESS 0 current_directory_p startup_info process_information os)
= (ok,process_information,os)
CreateFile_32 :: !{#Char} !Int !Int !{#Int} !Int !Int !HANDLE !*OSToolbox -> (!HANDLE,!*OSToolbox);
CreateFile_32 fileName desiredAccess shareMode lpSecurityAttributes creationDisposition flagsAndAttributes templateFile os
= code {
......@@ -996,7 +968,7 @@ CreateFile fileName desiredAccess shareMode lpSecurityAttributes creationDisposi
ccall CreateFileA@28 "PsIIAIIp:I:I"
}
:: LPCTSTR:==Int;
:: LPCSTR:==Int;
:: LPSECURITY_ATTRIBUTES:==Int;
:: LPVOID:==Int;
:: LPSTARTUPINFO:==Int;
......@@ -1034,22 +1006,39 @@ PROCESS_INFORMATION_hThread_int_offset:==1;
DETACHED_PROCESS:==8;
CreateProcess_32 :: !LPCTSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
CreateProcess :: !LPCSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!{#Char} !{#Int} !{#Int} !*OSToolbox -> (!Bool,!*OSToolbox)
CreateProcess_32 lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
CreateProcess lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
currentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PIsIIIIIsAA:I:I"
ccall CreateProcessA@40 "PpsppIIpsAA:I:I"
}
CreateProcess :: !LPCTSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
CreateProcess_32 :: !LPCSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!{#Char} !{#Int} !{#Int} !*OSToolbox -> (!Bool,!*OSToolbox)
CreateProcess lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
CreateProcess_32 lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
currentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PpsppIIpsAA:I:I"
ccall CreateProcessA@40 "PIsIIIIIsAA:I:I"
}
CreateProcess_with_current_directory_pointer :: !LPCSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int
!LPVOID !LPCSTR !{#Int} !{#Int} !*OSToolbox -> (!Bool,!*OSToolbox)
CreateProcess_with_current_directory_pointer lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags
lpEnvironment lpCurrentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PpsppIIppAA:I:I"
}
CreateProcess_with_current_directory_pointer_32 :: !LPCSTR !*{#Char} !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int
!LPVOID !LPCSTR !{#Int} !{#Int} !*OSToolbox -> (!Bool,!*OSToolbox)
CreateProcess_with_current_directory_pointer_32 lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
lpCurrentDirectory lpStartupInfo lpProcessInformation os
= code {
ccall CreateProcessA@40 "PIsIIIIIpAA:I:I"
}
INFINITE:==0xFFFFFFFF
WaitForSingleObject :: !HANDLE !Int !*OSToolbox -> (!Int,!*OSToolbox);
......
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