io.launcher.windows.nt: don't call duplicate-handle, and fix memory leak; io.backend.windows: track win32-handle instances in global win32-handles set to help find leaks
parent
d7594c3381
commit
5fe3a62446
|
@ -4,23 +4,36 @@ USING: alien alien.c-types arrays destructors io io.backend
|
||||||
io.buffers io.files io.ports io.binary io.timeouts system
|
io.buffers io.files io.ports io.binary io.timeouts system
|
||||||
strings kernel math namespaces sequences windows.errors
|
strings kernel math namespaces sequences windows.errors
|
||||||
windows.kernel32 windows.shell32 windows.types windows.winsock
|
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
|
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 ? -- )
|
: set-inherit ( handle ? -- )
|
||||||
[ HANDLE_FLAG_INHERIT ] dip
|
[ handle>> HANDLE_FLAG_INHERIT ] dip
|
||||||
>BOOLEAN SetHandleInformation win32-error=0/f ;
|
>BOOLEAN SetHandleInformation win32-error=0/f ;
|
||||||
|
|
||||||
TUPLE: win32-handle handle disposed ;
|
|
||||||
|
|
||||||
: new-win32-handle ( handle class -- win32-handle )
|
: 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> ( handle -- win32-handle )
|
||||||
win32-handle new-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 -- )
|
M: win32-handle dispose* ( handle -- )
|
||||||
handle>> CloseHandle drop ;
|
[ unregister-handle ] [ handle>> CloseHandle win32-error=0/f ] bi ;
|
||||||
|
|
||||||
TUPLE: win32-file < win32-handle ptr ;
|
TUPLE: win32-file < win32-handle ptr ;
|
||||||
|
|
||||||
|
|
|
@ -47,10 +47,8 @@ IN: io.files.windows
|
||||||
GetLastError ERROR_ALREADY_EXISTS = not ;
|
GetLastError ERROR_ALREADY_EXISTS = not ;
|
||||||
|
|
||||||
: set-file-pointer ( handle length method -- )
|
: set-file-pointer ( handle length method -- )
|
||||||
[ dupd d>w/w <uint> ] dip SetFilePointer
|
[ [ handle>> ] dip d>w/w <uint> ] dip SetFilePointer
|
||||||
INVALID_SET_FILE_POINTER = [
|
INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ;
|
||||||
CloseHandle "SetFilePointer failed" throw
|
|
||||||
] when drop ;
|
|
||||||
|
|
||||||
HOOK: open-append os ( path -- win32-file )
|
HOOK: open-append os ( path -- win32-file )
|
||||||
|
|
||||||
|
|
|
@ -164,4 +164,19 @@ IN: io.launcher.windows.nt.tests
|
||||||
"append-test" temp-file ascii file-contents
|
"append-test" temp-file ascii file-contents
|
||||||
] unit-test
|
] 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
|
||||||
|
|
|
@ -10,21 +10,21 @@ IN: io.launcher.windows.nt
|
||||||
|
|
||||||
: duplicate-handle ( handle -- handle' )
|
: duplicate-handle ( handle -- handle' )
|
||||||
GetCurrentProcess ! source process
|
GetCurrentProcess ! source process
|
||||||
swap ! handle
|
swap handle>> ! handle
|
||||||
GetCurrentProcess ! target process
|
GetCurrentProcess ! target process
|
||||||
f <void*> [ ! target handle
|
f <void*> [ ! target handle
|
||||||
DUPLICATE_SAME_ACCESS ! desired access
|
DUPLICATE_SAME_ACCESS ! desired access
|
||||||
TRUE ! inherit handle
|
TRUE ! inherit handle
|
||||||
DUPLICATE_CLOSE_SOURCE ! options
|
0 ! options
|
||||||
DuplicateHandle win32-error=0/f
|
DuplicateHandle win32-error=0/f
|
||||||
] keep *void* ;
|
] keep *void* <win32-handle> &dispose ;
|
||||||
|
|
||||||
! /dev/null simulation
|
! /dev/null simulation
|
||||||
: null-input ( -- pipe )
|
: null-input ( -- pipe )
|
||||||
(pipe) [ in>> handle>> ] [ out>> dispose ] bi ;
|
(pipe) [ in>> &dispose ] [ out>> dispose ] bi ;
|
||||||
|
|
||||||
: null-output ( -- pipe )
|
: null-output ( -- pipe )
|
||||||
(pipe) [ in>> dispose ] [ out>> handle>> ] bi ;
|
(pipe) [ in>> dispose ] [ out>> &dispose ] bi ;
|
||||||
|
|
||||||
: null-pipe ( mode -- pipe )
|
: null-pipe ( mode -- pipe )
|
||||||
{
|
{
|
||||||
|
@ -49,7 +49,7 @@ IN: io.launcher.windows.nt
|
||||||
create-mode
|
create-mode
|
||||||
FILE_ATTRIBUTE_NORMAL ! flags and attributes
|
FILE_ATTRIBUTE_NORMAL ! flags and attributes
|
||||||
f ! template file
|
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 )
|
: redirect-append ( path access-mode create-mode -- handle )
|
||||||
[ path>> ] 2dip
|
[ path>> ] 2dip
|
||||||
|
@ -58,10 +58,10 @@ IN: io.launcher.windows.nt
|
||||||
dup 0 FILE_END set-file-pointer ;
|
dup 0 FILE_END set-file-pointer ;
|
||||||
|
|
||||||
: redirect-handle ( handle access-mode create-mode -- handle )
|
: redirect-handle ( handle access-mode create-mode -- handle )
|
||||||
2drop handle>> duplicate-handle ;
|
2drop ;
|
||||||
|
|
||||||
: redirect-stream ( stream access-mode create-mode -- handle )
|
: 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 )
|
: redirect ( obj access-mode create-mode -- handle )
|
||||||
{
|
{
|
||||||
|
@ -72,7 +72,7 @@ IN: io.launcher.windows.nt
|
||||||
{ [ pick win32-file? ] [ redirect-handle ] }
|
{ [ pick win32-file? ] [ redirect-handle ] }
|
||||||
[ redirect-stream ]
|
[ redirect-stream ]
|
||||||
} cond
|
} cond
|
||||||
dup [ dup t set-inherit ] when ;
|
dup [ dup t set-inherit handle>> ] when ;
|
||||||
|
|
||||||
: redirect-stdout ( process args -- handle )
|
: redirect-stdout ( process args -- handle )
|
||||||
drop
|
drop
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
USE: system 0 exit
|
Loading…
Reference in New Issue