From 9269db2fd1639681a0a28e2e4454f48f61227e33 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Apr 2008 21:36:37 -0500
Subject: [PATCH] Fixing Windows I/O (untested)

---
 extra/io/windows/nt/monitors/monitors.factor | 91 ++++++++++----------
 extra/io/windows/windows.factor              |  2 +-
 2 files changed, 48 insertions(+), 45 deletions(-)

diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor
index 8f873ee23b..7594e037a5 100755
--- a/extra/io/windows/nt/monitors/monitors.factor
+++ b/extra/io/windows/nt/monitors/monitors.factor
@@ -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 ;
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index 89a78f1f74..d4e202013b 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -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 ;