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

Windows launcher work in progress

db4
Slava Pestov 2008-01-25 01:49:03 -04:00
parent d09bc942ac
commit 034b4dcaa6
4 changed files with 75 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
extra/io/windows/launcher/launcher.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations destructors io
io.windows libc io.nonblocking io.streams.duplex windows.types
math windows.kernel32 windows namespaces io.launcher kernel
sequences windows.errors assocs splitting system threads init ;
io.windows io.windows.pipes libc io.nonblocking
io.streams.duplex windows.types math windows.kernel32 windows
namespaces io.launcher kernel sequences windows.errors assocs
splitting system threads init strings combinators io.backend ;
IN: io.windows.launcher
TUPLE: CreateProcess-args
@ -86,18 +87,73 @@ TUPLE: CreateProcess-args
over set-CreateProcess-args-lpEnvironment
] when ;
: (redirect) ( path access-mode create-mode -- handle )
>r >r
normalize-pathname
r> ! access-mode
share-mode
security-attributes-inherit
r> ! create-mode
FILE_ATTRIBUTE_NORMAL ! flags and attributes
f ! template file
CreateFile dup invalid-handle? dup close-later ;
: redirect ( obj access-mode create-mode -- handle )
{
{ [ pick not ] [ 3drop f ] }
{ [ pick +closed+ eq? ] [ 3drop f ] }
{ [ pick string? ] [ (redirect) ] }
} cond ;
: inherited-stdout ( args -- handle )
CreateProcess-args-stdout-pipe
[ pipe-out ] [ STD_OUTPUT_HANDLE GetStdHandle ] if* ;
: redirect-stdout ( args -- handle )
+stdout+ get GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stdout or ;
: inherited-stderr ( args -- handle )
CreateProcess-args-stdout-pipe
[ pipe-out ] [ STD_ERROR_HANDLE GetStdHandle ] if* ;
: redirect-stderr ( args -- handle )
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stderr or ;
: inherited-stdin ( args -- handle )
CreateProcess-args-stdin-pipe
[ pipe-in ] [ STD_INPUT_HANDLE GetStdHandle ] if* ;
: redirect-stdin ( args -- handle )
+stdin+ get GENERIC_READ OPEN_EXISTING redirect
swap inherited-stdin or ;
: fill-startup-info
dup CreateProcess-args-lpStartupInfo
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
over redirect-stdout over set-STARTUPINFO-hStdOutput
over redirect-stderr over set-STARTUPINFO-hStdError
over redirect-stdin over set-STARTUPINFO-hStdInput
drop ;
: make-CreateProcess-args ( -- args )
default-CreateProcess-args
wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
fill-dwCreateFlags
fill-lpEnvironment ;
fill-lpEnvironment
fill-startup-info ;
M: windows-io run-process* ( desc -- handle )
[
make-CreateProcess-args
dup call-CreateProcess
CreateProcess-args-lpProcessInformation <process>
] with-descriptor ;
[
make-CreateProcess-args
dup call-CreateProcess
CreateProcess-args-lpProcessInformation <process>
] with-descriptor
] with-destructors ;
: dispose-process ( process-information -- )
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed

14
extra/io/windows/nt/launcher/launcher.factor
View File

@ -4,7 +4,7 @@ USING: alien alien.c-types arrays continuations destructors io
io.windows libc io.nonblocking io.streams.duplex windows.types
math windows.kernel32 windows namespaces io.launcher kernel
sequences windows.errors assocs splitting system
io.windows.launcher io.windows.nt.pipes ;
io.windows.launcher io.windows.pipes ;
IN: io.windows.nt.launcher
! The below code is based on the example given in
@ -30,17 +30,6 @@ IN: io.windows.nt.launcher
dup pipe-out f set-inherit
over set-CreateProcess-args-stdin-pipe ;
: fill-startup-info
dup CreateProcess-args-lpStartupInfo
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
over CreateProcess-args-stdout-pipe
pipe-out over set-STARTUPINFO-hStdOutput
over CreateProcess-args-stdout-pipe
pipe-out over set-STARTUPINFO-hStdError
over CreateProcess-args-stdin-pipe
pipe-in swap set-STARTUPINFO-hStdInput ;
M: windows-io process-stream*
[
[
@ -49,7 +38,6 @@ M: windows-io process-stream*
fill-stdout-pipe
fill-stdin-pipe
fill-startup-info
dup call-CreateProcess

10
extra/io/windows/nt/pipes/pipes.factor → extra/io/windows/pipes/pipes.factor
View File

@ -3,19 +3,11 @@
USING: alien alien.c-types arrays destructors io io.windows libc
windows.types math windows.kernel32 windows namespaces kernel
sequences windows.errors assocs math.parser system random ;
IN: io.windows.nt.pipes
IN: io.windows.pipes
! This code is based on
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
: default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object>
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
: security-attributes-inherit ( -- obj )
default-security-attributes
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
: create-named-pipe ( name mode -- handle )
FILE_FLAG_OVERLAPPED bitor
PIPE_TYPE_BYTE

10
extra/io/windows/windows.factor
View File

@ -4,7 +4,7 @@ USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
io.sockets.impl windows.errors strings io.streams.duplex kernel
math namespaces sequences windows windows.kernel32
windows.shell32 windows.winsock splitting ;
windows.shell32 windows.types windows.winsock splitting ;
IN: io.windows
TUPLE: windows-nt-io ;
@ -34,6 +34,14 @@ M: windows-io normalize-directory ( string -- string )
FILE_SHARE_READ FILE_SHARE_WRITE bitor
FILE_SHARE_DELETE bitor ; foldable
: default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object>
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
: security-attributes-inherit ( -- obj )
default-security-attributes
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
M: win32-file init-handle ( handle -- )
drop ;