Windows I/O fixes

db4
Slava Pestov 2008-04-13 00:26:44 -05:00
parent 55e777476c
commit d45b12b3ed
4 changed files with 48 additions and 25 deletions

View File

@ -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 -- )

View File

@ -0,0 +1,4 @@
IN: io.windows.nt.monitors.tests
USING: io.windows.nt.monitors tools.test ;
\ fill-queue-thread must-infer

View File

@ -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 )
[

View File

@ -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