Fix +closed+

db4
Slava Pestov 2008-02-14 02:20:20 -06:00
parent 2e1e38db89
commit ce076166fe
5 changed files with 96 additions and 68 deletions

View File

@ -50,15 +50,16 @@ MEMO: 'arguments' ( -- parser )
: redirect ( obj mode fd -- )
{
{ [ pick not ] [ 2nip F_SETFL 0 fcntl io-error ] }
{ [ pick +closed+ eq? ] [ close 2drop ] }
{ [ pick string? ] [ (redirect) ] }
} cond ;
: ?closed dup +closed+ eq? [ drop "/dev/null" ] when ;
: setup-redirection ( -- )
+stdin+ get read-flags 0 redirect
+stdout+ get write-flags 1 redirect
+stdin+ get ?closed read-flags 0 redirect
+stdout+ get ?closed write-flags 1 redirect
+stderr+ get dup +stdout+ eq?
[ drop 1 2 dup2 io-error ] [ write-flags 2 redirect ] if ;
[ drop 1 2 dup2 io-error ] [ ?closed write-flags 2 redirect ] if ;
: spawn-process ( -- )
[

View File

@ -1,7 +1,7 @@
! 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 io.windows.pipes libc io.nonblocking
io.windows io.windows.nt.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 ;
@ -87,75 +87,26 @@ 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 t ] }
{ [ pick string? ] [ (redirect) ] }
} cond ;
: ?closed or dup t eq? [ drop f ] when ;
: 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 ?closed ;
: inherited-stderr ( args -- handle )
drop STD_ERROR_HANDLE GetStdHandle ;
: redirect-stderr ( args -- handle )
+stderr+ get
dup +stdout+ eq? [
drop
CreateProcess-args-lpStartupInfo STARTUPINFO-hStdOutput
] [
GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stderr ?closed
] if ;
: 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 ?closed ;
: fill-startup-info
dup CreateProcess-args-lpStartupInfo
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
STARTF_USESTDHANDLES swap set-STARTUPINFO-dwFlags ;
over redirect-stdout over set-STARTUPINFO-hStdOutput
over redirect-stderr over set-STARTUPINFO-hStdError
over redirect-stdin over set-STARTUPINFO-hStdInput
HOOK: fill-redirection io-backend ( args -- args )
drop ;
M: windows-ce-io fill-redirection ;
: 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 fill-startup-info
make-CreateProcess-args
fill-redirection
dup call-CreateProcess
CreateProcess-args-lpProcessInformation <process>
] with-descriptor

View File

@ -3,13 +3,63 @@
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.pipes ;
sequences windows.errors assocs splitting system strings
io.windows.launcher io.windows.nt.pipes io.backend
combinators ;
IN: io.windows.nt.launcher
! The below code is based on the example given in
! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
: (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? ] [ drop nip null-pipe ] }
{ [ pick string? ] [ (redirect) ] }
} cond ;
: ?closed or dup t eq? [ drop f ] when ;
: 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 ?closed ;
: inherited-stderr ( args -- handle )
drop STD_ERROR_HANDLE GetStdHandle ;
: redirect-stderr ( args -- handle )
+stderr+ get
dup +stdout+ eq? [
drop
CreateProcess-args-lpStartupInfo STARTUPINFO-hStdOutput
] [
GENERIC_WRITE CREATE_ALWAYS redirect
swap inherited-stderr ?closed
] if ;
: 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 ?closed ;
: set-inherit ( handle ? -- )
>r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
@ -30,14 +80,22 @@ IN: io.windows.nt.launcher
dup pipe-out f set-inherit
over set-CreateProcess-args-stdin-pipe ;
M: windows-io process-stream*
M: windows-nt-io fill-redirection
dup CreateProcess-args-lpStartupInfo
over redirect-stdout over set-STARTUPINFO-hStdOutput
over redirect-stderr over set-STARTUPINFO-hStdError
over redirect-stdin over set-STARTUPINFO-hStdInput
drop ;
M: windows-nt-io process-stream*
[
[
make-CreateProcess-args
fill-stdout-pipe
fill-stdin-pipe
fill-startup-info
fill-redirection
dup call-CreateProcess

View File

@ -1,9 +1,10 @@
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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.pipes
sequences windows.errors assocs math.parser system random
combinators ;
IN: io.windows.nt.pipes
! This code is based on
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
@ -65,3 +66,20 @@ TUPLE: pipe in out ;
: <unique-outgoing-pipe> ( -- pipe )
unique-pipe-name <outgoing-pipe> ;
! /dev/null simulation
: null-input ( -- pipe )
<unique-outgoing-pipe>
dup pipe-out CloseHandle drop
pipe-in ;
: null-output ( -- pipe )
<unique-incoming-pipe>
dup pipe-in CloseHandle drop
pipe-out ;
: null-pipe ( mode -- pipe )
{
{ [ dup GENERIC_READ = ] [ drop null-input ] }
{ [ dup GENERIC_WRITE = ] [ drop null-output ] }
} cond ;