steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing Windows I/O (untested)

db4
Slava Pestov 2008-04-11 21:36:37 -05:00
parent 7a0d6237a7
commit 9269db2fd1
2 changed files with 48 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
extra/io/windows/nt/monitors/monitors.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types destructors io.windows
io.windows.nt.backend kernel math windows windows.kernel32
windows.types libc assocs alien namespaces continuations
io.monitors io.monitors.private io.nonblocking io.buffers
io.files io.timeouts io sequences hashtables sorting arrays
combinators math.bitfields strings system ;
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
windows windows.kernel32 windows.types ;
IN: io.windows.nt.monitors
: open-directory ( path -- handle )
@ -21,69 +21,72 @@ IN: io.windows.nt.monitors
dup add-completion
f <win32-file> ;
TUPLE: win32-monitor path recursive? ;
TUPLE: win32-monitor < monitor port path recursive ;
: <win32-monitor> ( path recursive? port -- monitor )
(monitor) {
set-win32-monitor-path
set-win32-monitor-recursive?
set-delegate
} win32-monitor construct ;
M: winnt <monitor> ( path recursive? -- monitor )
[
over open-directory win32-monitor <buffered-port>
<win32-monitor>
] with-destructors ;
: begin-reading-changes ( monitor -- overlapped )
: begin-reading-changes ( port -- overlapped )
{
[ handle>> handle>> ]
[ buffer>> buffer-ptr ]
[ buffer>> buffer-size ]
[ win32-monitor-recursive? 1 0 ? ]
[ recursive>> 1 0 ? ]
} cleave
FILE_NOTIFY_CHANGE_ALL
0 <uint>
(make-overlapped)
[ f ReadDirectoryChangesW win32-error=0/f ] keep ;
: read-changes ( monitor -- bytes )
: read-changes ( port -- bytes )
[
[
dup begin-reading-changes
swap [ save-callback ] 2keep
dup check-monitor ! we may have closed it...
check-closed ! we may have closed it...
get-overlapped-result
] with-timeout
] with-destructors ;
: parse-action ( action -- changed )
{
{ \ FILE_ACTION_ADDED [ +add-file+ ] }
{ \ FILE_ACTION_REMOVED [ +remove-file+ ] }
{ \ FILE_ACTION_MODIFIED [ +modify-file+ ] }
{ \ FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
{ \ FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
{ FILE_ACTION_ADDED [ +add-file+ ] }
{ FILE_ACTION_REMOVED [ +remove-file+ ] }
{ FILE_ACTION_MODIFIED [ +modify-file+ ] }
{ FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
{ FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
[ drop +modify-file+ ]
} case ;
: memory>u16-string ( alien len -- string )
[ memory>byte-array ] keep 2/ c-ushort-array> >string ;
[ memory>byte-array ] [ 2/ ] bi c-ushort-array> >string ;
: parse-file-notify ( buffer -- changed path )
{
FILE_NOTIFY_INFORMATION-FileName
FILE_NOTIFY_INFORMATION-FileNameLength
FILE_NOTIFY_INFORMATION-Action
} get-slots parse-action 1array -rot memory>u16-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 ;
: (changed-files) ( buffer -- )
dup parse-file-notify changed-file
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
[ 2drop ] [ swap <displaced-alien> (changed-files) ] if ;
: file-notify-records ( buffer -- seq )
[ dup FILE_NOTIFY_INFORMATION-NextEntryOffset 0 > ]
[ [ [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien> ] keep ]
[ ] unfold nip ;
M: win32-monitor fill-queue ( monitor -- )
dup buffer>> buffer-ptr over read-changes
[ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc
swap set-monitor-queue ;
: 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 ;
: fill-queue-thread ( monitor -- )
dup fill-queue fill-queue ;
M:: winnt (monitor) ( path recursive? mailbox -- monitor )
[
path mailbox win32-monitor construct-monitor
path open-directory <buffered-port> >>port
recursive? >>recursive
dup port>> [ fill-queue-thread ] curry spawn drop
] with-destructors ;
M: win32-monitor dispose
port>> dispose ;

2
extra/io/windows/windows.factor
View File

@ -5,7 +5,7 @@ io.buffers io.files io.nonblocking io.sockets io.binary
io.sockets.impl windows.errors strings io.streams.duplex
kernel math namespaces sequences windows windows.kernel32
windows.shell32 windows.types windows.winsock splitting
continuations math.bitfields system ;
continuations math.bitfields system accessors ;
IN: io.windows
M: windows destruct-handle CloseHandle drop ;