io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock
-splitting continuations math.bitwise accessors ;
+splitting continuations math.bitwise accessors init sets assocs ;
IN: io.backend.windows
+: win32-handles ( -- assoc )
+ \ win32-handles [ H{ } clone ] initialize-alien ;
+
+TUPLE: win32-handle < identity-tuple handle disposed ;
+
+M: win32-handle hashcode* handle>> hashcode* ;
+
: set-inherit ( handle ? -- )
- [ HANDLE_FLAG_INHERIT ] dip
+ [ handle>> HANDLE_FLAG_INHERIT ] dip
>BOOLEAN SetHandleInformation win32-error=0/f ;
-TUPLE: win32-handle handle disposed ;
-
: new-win32-handle ( handle class -- win32-handle )
- new swap [ >>handle ] [ f set-inherit ] bi ;
+ new swap >>handle
+ dup f set-inherit
+ dup win32-handles conjoin ;
: <win32-handle> ( handle -- win32-handle )
win32-handle new-win32-handle ;
+ERROR: disposing-twice ;
+
+: unregister-handle ( handle -- )
+ win32-handles delete-at*
+ [ t >>disposed drop ] [ disposing-twice ] if ;
+
M: win32-handle dispose* ( handle -- )
- handle>> CloseHandle drop ;
+ [ unregister-handle ] [ handle>> CloseHandle win32-error=0/f ] bi ;
TUPLE: win32-file < win32-handle ptr ;
GetLastError ERROR_ALREADY_EXISTS = not ;
: set-file-pointer ( handle length method -- )
- [ dupd d>w/w <uint> ] dip SetFilePointer
- INVALID_SET_FILE_POINTER = [
- CloseHandle "SetFilePointer failed" throw
- ] when drop ;
+ [ [ handle>> ] dip d>w/w <uint> ] dip SetFilePointer
+ INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ;
HOOK: open-append os ( path -- win32-file )
"append-test" temp-file ascii file-contents
] unit-test
+[ "( scratchpad ) " ] [
+ console-vm "-run=listener" 2array
+ ascii [ "USE: system 0 exit" print flush readln ] with-process-stream
+] unit-test
+
+[ ] [
+ console-vm "-run=listener" 2array
+ ascii [ "USE: system 0 exit" print ] with-process-writer
+] unit-test
+[ ] [
+ <process>
+ console-vm "-run=listener" 2array >>command
+ "vocab:io/launcher/windows/nt/test/input.txt" >>stdin
+ try-process
+] unit-test
: duplicate-handle ( handle -- handle' )
GetCurrentProcess ! source process
- swap ! handle
+ swap handle>> ! handle
GetCurrentProcess ! target process
f <void*> [ ! target handle
DUPLICATE_SAME_ACCESS ! desired access
TRUE ! inherit handle
- DUPLICATE_CLOSE_SOURCE ! options
+ 0 ! options
DuplicateHandle win32-error=0/f
- ] keep *void* ;
+ ] keep *void* <win32-handle> &dispose ;
! /dev/null simulation
: null-input ( -- pipe )
- (pipe) [ in>> handle>> ] [ out>> dispose ] bi ;
+ (pipe) [ in>> &dispose ] [ out>> dispose ] bi ;
: null-output ( -- pipe )
- (pipe) [ in>> dispose ] [ out>> handle>> ] bi ;
+ (pipe) [ in>> dispose ] [ out>> &dispose ] bi ;
: null-pipe ( mode -- pipe )
{
create-mode
FILE_ATTRIBUTE_NORMAL ! flags and attributes
f ! template file
- CreateFile dup invalid-handle? <win32-file> &dispose handle>> ;
+ CreateFile dup invalid-handle? <win32-file> &dispose ;
: redirect-append ( path access-mode create-mode -- handle )
[ path>> ] 2dip
dup 0 FILE_END set-file-pointer ;
: redirect-handle ( handle access-mode create-mode -- handle )
- 2drop handle>> duplicate-handle ;
+ 2drop ;
: redirect-stream ( stream access-mode create-mode -- handle )
- [ underlying-handle handle>> ] 2dip redirect-handle ;
+ [ underlying-handle ] 2dip redirect-handle ;
: redirect ( obj access-mode create-mode -- handle )
{
{ [ pick win32-file? ] [ redirect-handle ] }
[ redirect-stream ]
} cond
- dup [ dup t set-inherit ] when ;
+ dup [ dup t set-inherit handle>> ] when ;
: redirect-stdout ( process args -- handle )
drop
--- /dev/null
+USE: system 0 exit\r