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
: 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 -- )
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
: 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
: 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 )
{ 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 )
[