From baa026525e8c3f7780ae47a9ad30d1db34633dd5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Jan 2008 18:59:47 -0600 Subject: [PATCH 1/2] start windows file change code --- extra/io/windows/directory/directory.factor | 34 +++++++++++++++++++++ extra/io/windows/nt/backend/backend.factor | 6 +++- 2 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 extra/io/windows/directory/directory.factor diff --git a/extra/io/windows/directory/directory.factor b/extra/io/windows/directory/directory.factor new file mode 100644 index 0000000000..4728a063a0 --- /dev/null +++ b/extra/io/windows/directory/directory.factor @@ -0,0 +1,34 @@ +USING: alien.c-types destructors io.windows +io.windows.nt.backend kernel math windows +windows.kernel32 windows.types libc ; +IN: io.windows.directory + +: open-directory ( path -- handle ) + [ + FILE_LIST_DIRECTORY + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor + f + CreateFile + dup invalid-handle? dup close-later + dup add-completion + ] with-destructors ; + +: directory-notifications ( -- n ) + FILE_NOTIFY_CHANGE_FILE_NAME FILE_NOTIFY_CHANGE_DIR_NAME bitor ; + +: read-directory-changes ( handle -- ) + [ + 65536 dup malloc + swap + TRUE + directory-notifications + 0 + (make-overlapped) + ! f works here, blocking + f + ReadDirectoryChangesW win32-error=0/f + ] with-destructors ; + diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 0d1f2cec0b..c107c36b5a 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -132,7 +132,11 @@ M: windows-nt-io add-completion ( handle -- ) ] if ] if ] [ - lookup-callback io-callback-continuation + lookup-callback [ + io-callback-continuation + ] [ + "unhandled io event" print flush f + ] if* ] if ; : maybe-expire ( io-callbck -- ) From 62ded50c8bc9f9864803574c31df1d472b4d2786 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 26 Jan 2008 03:40:09 -0400 Subject: [PATCH 2/2] Directory change notification work in progress. Only on Windows right now, blocking --- core/assocs/assocs.factor | 3 + core/compiler/compiler.factor | 3 - extra/io/monitor/monitor.factor | 11 +++ extra/io/windows/directory/directory.factor | 34 ---------- extra/io/windows/nt/monitor/monitor.factor | 74 +++++++++++++++++++++ extra/windows/kernel32/kernel32.factor | 2 +- 6 files changed, 89 insertions(+), 38 deletions(-) mode change 100644 => 100755 core/assocs/assocs.factor create mode 100755 extra/io/monitor/monitor.factor delete mode 100644 extra/io/windows/directory/directory.factor create mode 100755 extra/io/windows/nt/monitor/monitor.factor diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor old mode 100644 new mode 100755 index 799a6eb367..1983608624 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -77,6 +77,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : rename-at ( newkey key assoc -- ) tuck delete-at* [ -rot set-at ] [ 3drop ] if ; +: delete-any ( assoc -- element ) + [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ; + : assoc-empty? ( assoc -- ? ) assoc-size zero? ; diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 8d9f004270..9378642951 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -42,9 +42,6 @@ IN: compiler [ dupd compile-failed f save-effect ] recover ; -: delete-any ( assoc -- element ) - [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ; - : compile-loop ( assoc -- ) dup assoc-empty? [ drop ] [ dup delete-any (compile) diff --git a/extra/io/monitor/monitor.factor b/extra/io/monitor/monitor.factor new file mode 100755 index 0000000000..c74a449181 --- /dev/null +++ b/extra/io/monitor/monitor.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.backend ; +IN: io.monitor + +HOOK: io-backend ( path -- monitor ) + +HOOK: next-change io-backend ( monitor -- path ) + +: with-monitor ( directory quot -- ) + >r r> over [ close-monitor ] curry [ ] cleanup ; diff --git a/extra/io/windows/directory/directory.factor b/extra/io/windows/directory/directory.factor deleted file mode 100644 index 4728a063a0..0000000000 --- a/extra/io/windows/directory/directory.factor +++ /dev/null @@ -1,34 +0,0 @@ -USING: alien.c-types destructors io.windows -io.windows.nt.backend kernel math windows -windows.kernel32 windows.types libc ; -IN: io.windows.directory - -: open-directory ( path -- handle ) - [ - FILE_LIST_DIRECTORY - share-mode - f - OPEN_EXISTING - FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor - f - CreateFile - dup invalid-handle? dup close-later - dup add-completion - ] with-destructors ; - -: directory-notifications ( -- n ) - FILE_NOTIFY_CHANGE_FILE_NAME FILE_NOTIFY_CHANGE_DIR_NAME bitor ; - -: read-directory-changes ( handle -- ) - [ - 65536 dup malloc - swap - TRUE - directory-notifications - 0 - (make-overlapped) - ! f works here, blocking - f - ReadDirectoryChangesW win32-error=0/f - ] with-destructors ; - diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor new file mode 100755 index 0000000000..2b3b87b2bd --- /dev/null +++ b/extra/io/windows/nt/monitor/monitor.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types destructors io.windows kernel math windows +windows.kernel32 windows.types libc assocs alien namespaces +continuations io.monitor ; +IN: io.windows.nt.monitor + +TUPLE: monitor handle buffer queue closed? ; + +: open-directory ( path -- handle ) + [ + FILE_LIST_DIRECTORY + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor + f + CreateFile dup invalid-handle? dup close-later + ] with-destructors ; + +: buffer-size 65536 ; inline + +M: windows-nt-io ( path -- monitor ) + [ + open-directory + buffer-size malloc dup free-later f + ] with-destructors + f monitor construct-boa ; + +: check-closed ( monitor -- ) + monitor-closed? [ "Monitor closed" throw ] when ; + +: close-monitor ( monitor -- ) + dup check-closed + dup monitor-buffer free + dup monitor-handle CloseHandle drop + t swap set-monitor-closed? ; + +: fill-buffer ( monitor -- bytes ) + [ + dup monitor-handle + swap monitor-buffer + buffer-size + TRUE + FILE_NOTIFY_CHANGE_ALL + 0 [ + f + f + ReadDirectoryChangesW win32-error=0/f + ] keep *uint + ] with-destructors ; + +: (changed-files) ( buffer -- ) + dup { + FILE_NOTIFY_INFORMATION-NextEntryOffset + FILE_NOTIFY_INFORMATION-FileName + FILE_NOTIFY_INFORMATION-FileNameLength + } get-slots memory>string dup set + dup zero? [ 2drop ] [ + swap (changed-files) + ] if ; + +: changed-files ( buffer len -- assoc ) + [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc ; + +: fill-queue ( monitor -- ) + dup monitor-buffer + over fill-buffer changed-files + swap set-monitor-queue ; + +M: windows-nt-io next-change ( monitor -- path ) + dup check-closed + dup monitor-queue dup assoc-empty? + [ drop dup fill-queue next-change ] [ nip delete-any ] if ; diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index 1c75e33698..15bdcd3e37 100755 --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -87,7 +87,7 @@ C-STRUCT: FILE_NOTIFY_INFORMATION { "DWORD" "NextEntryOffset" } { "DWORD" "Action" } { "DWORD" "FileNameLength" } - { "WCHAR*" "FileName" } ; + { "WCHAR[1]" "FileName" } ; TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : STD_INPUT_HANDLE -10 ; inline