Windows I/O fixes
parent
55e777476c
commit
d45b12b3ed
extra/io
nonblocking
windows/nt
sockets
|
@ -3,7 +3,7 @@
|
|||
USING: math kernel io sequences io.buffers io.timeouts generic
|
||||
byte-vectors system io.streams.duplex io.encodings
|
||||
io.backend continuations debugger classes byte-arrays namespaces
|
||||
splitting dlists assocs io.encodings.binary accessors ;
|
||||
splitting dlists assocs io.encodings.binary inspector accessors ;
|
||||
IN: io.nonblocking
|
||||
|
||||
SYMBOL: default-buffer-size
|
||||
|
@ -43,8 +43,13 @@ TUPLE: output-port < port ;
|
|||
: pending-error ( port -- )
|
||||
[ f ] change-error drop [ throw ] when* ;
|
||||
|
||||
ERROR: port-closed-error port ;
|
||||
|
||||
M: port-closed-error summary
|
||||
drop "Port has been closed" ;
|
||||
|
||||
: check-closed ( port -- port )
|
||||
dup closed>> [ "Port closed" throw ] when ;
|
||||
dup closed>> [ port-closed-error ] when ;
|
||||
|
||||
HOOK: cancel-io io-backend ( port -- )
|
||||
|
||||
|
|
|
@ -0,0 +1,4 @@
|
|||
IN: io.windows.nt.monitors.tests
|
||||
USING: io.windows.nt.monitors tools.test ;
|
||||
|
||||
\ fill-queue-thread must-infer
|
|
@ -3,12 +3,14 @@
|
|||
USING: alien alien.c-types libc destructors locals
|
||||
kernel math assocs namespaces continuations sequences hashtables
|
||||
sorting arrays combinators math.bitfields strings system
|
||||
io.windows io.windows.nt.backend io.monitors io.nonblocking
|
||||
io.buffers io.files io.timeouts io accessors threads
|
||||
accessors threads
|
||||
io.backend io.windows io.windows.nt.backend io.monitors
|
||||
io.nonblocking io.buffers io.files io.timeouts io
|
||||
windows windows.kernel32 windows.types ;
|
||||
IN: io.windows.nt.monitors
|
||||
|
||||
: open-directory ( path -- handle )
|
||||
normalize-path
|
||||
FILE_LIST_DIRECTORY
|
||||
share-mode
|
||||
f
|
||||
|
@ -28,8 +30,8 @@ TUPLE: win32-monitor < monitor port ;
|
|||
: begin-reading-changes ( port -- overlapped )
|
||||
{
|
||||
[ handle>> handle>> ]
|
||||
[ buffer>> buffer-ptr ]
|
||||
[ buffer>> buffer-size ]
|
||||
[ buffer>> ptr>> ]
|
||||
[ buffer>> size>> ]
|
||||
[ recursive>> 1 0 ? ]
|
||||
} cleave
|
||||
FILE_NOTIFY_CHANGE_ALL
|
||||
|
@ -39,12 +41,11 @@ TUPLE: win32-monitor < monitor port ;
|
|||
|
||||
: read-changes ( port -- bytes )
|
||||
[
|
||||
[
|
||||
dup begin-reading-changes
|
||||
swap [ save-callback ] 2keep
|
||||
check-closed ! we may have closed it...
|
||||
get-overlapped-result
|
||||
] with-timeout
|
||||
dup begin-reading-changes
|
||||
swap [ save-callback ] 2keep
|
||||
check-closed ! we may have closed it...
|
||||
dup eof>> [ "EOF??" throw ] when
|
||||
get-overlapped-result
|
||||
] with-destructors ;
|
||||
|
||||
: parse-action ( action -- changed )
|
||||
|
@ -55,32 +56,45 @@ TUPLE: win32-monitor < monitor port ;
|
|||
{ FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
|
||||
{ FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
|
||||
[ drop +modify-file+ ]
|
||||
} case ;
|
||||
} case 1array ;
|
||||
|
||||
: memory>u16-string ( alien len -- string )
|
||||
[ memory>byte-array ] keep 2/ c-ushort-array> >string ;
|
||||
|
||||
: parse-notify-record ( buffer -- changed path )
|
||||
[ FILE_NOTIFY_INFORMATION-Action parse-action ]
|
||||
[ FILE_NOTIFY_INFORMATION-FileName ]
|
||||
[ FILE_NOTIFY_INFORMATION-FileNameLength ] tri
|
||||
memory>u16-string ;
|
||||
: parse-notify-record ( buffer -- path changed )
|
||||
[
|
||||
[ FILE_NOTIFY_INFORMATION-FileName ]
|
||||
[ FILE_NOTIFY_INFORMATION-FileNameLength ]
|
||||
bi memory>u16-string
|
||||
]
|
||||
[ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
|
||||
|
||||
: (file-notify-records) ( buffer -- buffer )
|
||||
dup ,
|
||||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
|
||||
[ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
|
||||
(file-notify-records)
|
||||
] unless ;
|
||||
|
||||
: file-notify-records ( buffer -- seq )
|
||||
[ dup FILE_NOTIFY_INFORMATION-NextEntryOffset 0 > ]
|
||||
[ [ [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien> ] keep ]
|
||||
[ ] unfold nip ;
|
||||
[ (file-notify-records) drop ] { } make ;
|
||||
|
||||
: parse-notify-records ( monitor buffer -- )
|
||||
file-notify-records
|
||||
[ parse-notify-record rot queue-change ] with each ;
|
||||
|
||||
: fill-queue ( monitor -- )
|
||||
dup port>> [ buffer>> buffer-ptr ] [ read-changes zero? ] bi
|
||||
[ 2dup parse-notify-records ] unless 2drop ;
|
||||
dup port>> check-closed
|
||||
[ buffer>> ptr>> ] [ read-changes zero? ] bi
|
||||
[ 2dup parse-notify-records ] unless
|
||||
2drop ;
|
||||
|
||||
: (fill-queue-thread) ( monitor -- )
|
||||
dup fill-queue (fill-queue-thread) ;
|
||||
|
||||
: fill-queue-thread ( monitor -- )
|
||||
dup fill-queue fill-queue ;
|
||||
[ dup fill-queue (fill-queue-thread) ]
|
||||
[ dup port-closed-error? [ 2drop ] [ rethrow ] if ] recover ;
|
||||
|
||||
M:: winnt (monitor) ( path recursive? mailbox -- monitor )
|
||||
[
|
||||
|
|
|
@ -50,7 +50,7 @@ TUPLE: ConnectEx-args port
|
|||
2dup save-callback
|
||||
get-overlapped-result drop ;
|
||||
|
||||
M: winnt (client) ( addrspec -- client-in client-out )
|
||||
M: winnt ((client)) ( addrspec -- client-in client-out )
|
||||
[
|
||||
\ ConnectEx-args construct-empty
|
||||
over make-sockaddr/size pick init-connect
|
||||
|
|
Loading…
Reference in New Issue