factor/basis/io/launcher/windows/nt/nt.factor

111 lines
3.2 KiB
Factor
Raw Normal View History

! 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.backend.windows libc io.ports io.pipes windows.types math
2008-09-11 02:27:23 -04:00
windows.kernel32 windows namespaces make io.launcher kernel
2008-02-14 03:20:20 -05:00
sequences windows.errors assocs splitting system strings
io.launcher.windows io.files.windows io.backend io.files
2008-09-11 02:27:23 -04:00
io.files.private combinators shuffle accessors locals ;
2008-12-13 05:41:33 -05:00
IN: io.launcher.windows.nt
: duplicate-handle ( handle -- handle' )
GetCurrentProcess ! source process
swap handle>> ! handle
GetCurrentProcess ! target process
f <void*> [ ! target handle
DUPLICATE_SAME_ACCESS ! desired access
TRUE ! inherit handle
0 ! options
DuplicateHandle win32-error=0/f
] keep *void* <win32-handle> &dispose ;
! /dev/null simulation
: null-input ( -- pipe )
(pipe) [ in>> &dispose ] [ out>> dispose ] bi ;
: null-output ( -- pipe )
(pipe) [ in>> dispose ] [ out>> &dispose ] bi ;
: null-pipe ( mode -- pipe )
{
{ GENERIC_READ [ null-input ] }
{ GENERIC_WRITE [ null-output ] }
} case ;
! The below code is based on the example given in
! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
: redirect-default ( obj access-mode create-mode -- handle )
3drop f ;
: redirect-closed ( obj access-mode create-mode -- handle )
drop nip null-pipe ;
:: redirect-file ( path access-mode create-mode -- handle )
path normalize-path
access-mode
2008-02-14 03:20:20 -05:00
share-mode
default-security-attributes
create-mode
2008-02-14 03:20:20 -05:00
FILE_ATTRIBUTE_NORMAL ! flags and attributes
f ! template file
CreateFile dup invalid-handle? <win32-file> &dispose ;
2008-02-14 03:20:20 -05:00
: redirect-append ( path access-mode create-mode -- handle )
[ path>> ] 2dip
2008-05-06 05:26:46 -04:00
drop OPEN_ALWAYS
redirect-file
dup 0 FILE_END set-file-pointer ;
: redirect-handle ( handle access-mode create-mode -- handle )
2drop ;
: redirect-stream ( stream access-mode create-mode -- handle )
[ underlying-handle ] 2dip redirect-handle ;
: redirect ( obj access-mode create-mode -- handle )
2008-02-14 03:20:20 -05:00
{
{ [ pick not ] [ redirect-default ] }
{ [ pick +closed+ eq? ] [ redirect-closed ] }
{ [ pick string? ] [ redirect-file ] }
2008-05-06 05:26:46 -04:00
{ [ pick appender? ] [ redirect-append ] }
{ [ pick win32-file? ] [ redirect-handle ] }
2008-04-11 13:56:11 -04:00
[ redirect-stream ]
} cond
dup [ dup t set-inherit handle>> ] when ;
2008-02-14 03:20:20 -05:00
: redirect-stdout ( process args -- handle )
drop
2008-05-15 02:45:32 -04:00
stdout>>
GENERIC_WRITE
CREATE_ALWAYS
redirect
STD_OUTPUT_HANDLE GetStdHandle or ;
2008-02-14 03:20:20 -05:00
: redirect-stderr ( process args -- handle )
over stderr>> +stdout+ eq? [
nip
2009-08-25 18:46:07 -04:00
lpStartupInfo>> hStdOutput>>
2008-02-14 03:20:20 -05:00
] [
drop
stderr>>
GENERIC_WRITE
CREATE_ALWAYS
redirect
STD_ERROR_HANDLE GetStdHandle or
2008-02-14 03:20:20 -05:00
] if ;
: redirect-stdin ( process args -- handle )
drop
2008-05-15 02:45:32 -04:00
stdin>>
GENERIC_READ
OPEN_EXISTING
redirect
STD_INPUT_HANDLE GetStdHandle or ;
2008-04-02 21:09:56 -04:00
M: winnt fill-redirection ( process args -- )
2009-08-25 18:46:07 -04:00
dup lpStartupInfo>>
[ [ redirect-stdout ] dip (>>hStdOutput) ]
[ [ redirect-stderr ] dip (>>hStdError) ]
[ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;