steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use structs in process launcher

db4
Doug Coleman 2009-08-25 17:46:07 -05:00
parent c50eaf1c29
commit 003db124e2
3 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/io/launcher/windows/nt/nt.factor
View File

@ -85,7 +85,7 @@ IN: io.launcher.windows.nt
: redirect-stderr ( process args -- handle ) : redirect-stderr ( process args -- handle )
over stderr>> +stdout+ eq? [ over stderr>> +stdout+ eq? [
nip nip
lpStartupInfo>> STARTUPINFO-hStdOutput lpStartupInfo>> hStdOutput>>
] [ ] [
drop drop
stderr>> stderr>>
@ -104,7 +104,7 @@ IN: io.launcher.windows.nt
STD_INPUT_HANDLE GetStdHandle or ; STD_INPUT_HANDLE GetStdHandle or ;
M: winnt fill-redirection ( process args -- ) M: winnt fill-redirection ( process args -- )
[ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput dup lpStartupInfo>>
[ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError [ [ redirect-stdout ] dip (>>hStdOutput) ]
[ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput [ [ redirect-stderr ] dip (>>hStdError) ]
2drop ; [ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;

22
basis/io/launcher/windows/windows.factor
View File

@ -7,7 +7,7 @@ namespaces make io.launcher kernel sequences windows.errors
splitting system threads init strings combinators splitting system threads init strings combinators
io.backend accessors concurrency.flags io.files assocs io.backend accessors concurrency.flags io.files assocs
io.files.private windows destructors specialized-arrays.ushort io.files.private windows destructors specialized-arrays.ushort
specialized-arrays.alien ; specialized-arrays.alien classes classes.struct ;
IN: io.launcher.windows IN: io.launcher.windows
TUPLE: CreateProcess-args TUPLE: CreateProcess-args
@ -24,9 +24,10 @@ TUPLE: CreateProcess-args
: default-CreateProcess-args ( -- obj ) : default-CreateProcess-args ( -- obj )
CreateProcess-args new CreateProcess-args new
"STARTUPINFO" <c-object> STARTUPINFO <struct>
"STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo dup class heap-size >>cb
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation >>lpStartupInfo
PROCESS_INFORMATION <struct> >>lpProcessInformation
TRUE >>bInheritHandles TRUE >>bInheritHandles
0 >>dwCreateFlags ; 0 >>dwCreateFlags ;
@ -108,7 +109,7 @@ TUPLE: CreateProcess-args
] when ; ] when ;
: fill-startup-info ( process args -- process args ) : fill-startup-info ( process args -- process args )
STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ; dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
HOOK: fill-redirection io-backend ( process args -- ) HOOK: fill-redirection io-backend ( process args -- )
@ -136,17 +137,16 @@ M: windows run-process* ( process -- handle )
] with-destructors ; ] with-destructors ;
M: windows kill-process* ( handle -- ) M: windows kill-process* ( handle -- )
PROCESS_INFORMATION-hProcess hProcess>> 255 TerminateProcess win32-error=0/f ;
255 TerminateProcess win32-error=0/f ;
: dispose-process ( process-information -- ) : dispose-process ( process-information -- )
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed #! From MSDN: "Handles in PROCESS_INFORMATION must be closed
#! with CloseHandle when they are no longer needed." #! with CloseHandle when they are no longer needed."
dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when* [ hProcess>> [ CloseHandle drop ] when* ]
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ; [ hThread>> [ CloseHandle drop ] when* ] bi ;
: exit-code ( process -- n ) : exit-code ( process -- n )
PROCESS_INFORMATION-hProcess hProcess>>
0 <ulong> [ GetExitCodeProcess ] keep *ulong 0 <ulong> [ GetExitCodeProcess ] keep *ulong
swap win32-error=0/f ; swap win32-error=0/f ;
@ -157,7 +157,7 @@ M: windows kill-process* ( handle -- )
M: windows wait-for-processes ( -- ? ) M: windows wait-for-processes ( -- ? )
processes get keys dup processes get keys dup
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as [ handle>> hProcess>> ] void*-array{ } map-as
[ length ] keep 0 0 [ length ] keep 0 0
WaitForMultipleObjects WaitForMultipleObjects
dup HEX: ffffffff = [ win32-error ] when dup HEX: ffffffff = [ win32-error ] when

48
basis/windows/kernel32/kernel32.factor
View File

@ -239,33 +239,33 @@ STRUCT: FILETIME
{ dwLowDateTime DWORD } { dwLowDateTime DWORD }
{ dwHighDateTime DWORD } ; { dwHighDateTime DWORD } ;
C-STRUCT: STARTUPINFO STRUCT: STARTUPINFO
{ "DWORD" "cb" } { cb DWORD }
{ "LPTSTR" "lpReserved" } { lpReserved LPTSTR }
{ "LPTSTR" "lpDesktop" } { lpDesktop LPTSTR }
{ "LPTSTR" "lpTitle" } { lpTitle LPTSTR }
{ "DWORD" "dwX" } { dwX DWORD }
{ "DWORD" "dwY" } { dwY DWORD }
{ "DWORD" "dwXSize" } { dwXSize DWORD }
{ "DWORD" "dwYSize" } { dwYSize DWORD }
{ "DWORD" "dwXCountChars" } { dwXCountChars DWORD }
{ "DWORD" "dwYCountChars" } { dwYCountChars DWORD }
{ "DWORD" "dwFillAttribute" } { dwFillAttribute DWORD }
{ "DWORD" "dwFlags" } { dwFlags DWORD }
{ "WORD" "wShowWindow" } { wShowWindow WORD }
{ "WORD" "cbReserved2" } { cbReserved2 WORD }
{ "LPBYTE" "lpReserved2" } { lpReserved2 LPBYTE }
{ "HANDLE" "hStdInput" } { hStdInput HANDLE }
{ "HANDLE" "hStdOutput" } { hStdOutput HANDLE }
{ "HANDLE" "hStdError" } ; { hStdError HANDLE } ;
TYPEDEF: void* LPSTARTUPINFO TYPEDEF: void* LPSTARTUPINFO
C-STRUCT: PROCESS_INFORMATION STRUCT: PROCESS_INFORMATION
{ "HANDLE" "hProcess" } { hProcess HANDLE }
{ "HANDLE" "hThread" } { hThread HANDLE }
{ "DWORD" "dwProcessId" } { dwProcessId DWORD }
{ "DWORD" "dwThreadId" } ; { dwThreadId DWORD } ;
C-STRUCT: SYSTEM_INFO C-STRUCT: SYSTEM_INFO
{ "DWORD" "dwOemId" } { "DWORD" "dwOemId" }