]> gitweb.factorcode.org Git - factor.git/commitdiff
Windows I/O fixes
authorSlava Pestov <slava@factorcode.org>
Sun, 13 Apr 2008 05:26:44 +0000 (00:26 -0500)
committerSlava Pestov <slava@factorcode.org>
Sun, 13 Apr 2008 05:26:44 +0000 (00:26 -0500)
extra/io/nonblocking/nonblocking.factor
extra/io/windows/nt/monitors/monitors-tests.factor [new file with mode: 0755]
extra/io/windows/nt/monitors/monitors.factor
extra/io/windows/nt/sockets/sockets.factor

index 048a5d7b1cc82388280456876212cd331e5219cf..aa56b507ff48aeb8fad224a32a9e25260c89560a 100755 (executable)
@@ -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 -- )
 
diff --git a/extra/io/windows/nt/monitors/monitors-tests.factor b/extra/io/windows/nt/monitors/monitors-tests.factor
new file mode 100755 (executable)
index 0000000..ef36bae
--- /dev/null
@@ -0,0 +1,4 @@
+IN: io.windows.nt.monitors.tests\r
+USING: io.windows.nt.monitors tools.test ;\r
+\r
+\ fill-queue-thread must-infer\r
index 7f3a13b281497f491c28afefa28236b677737a5e..0dbf08d6a5ba67f049305079ddb79baf990b52db 100755 (executable)
@@ -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 )
     [
index a9d487dad714b558e9166123462f3705b6536f9d..1617b9f9a0cc5f757c559912d2cbb1d2ef16fefa 100755 (executable)
@@ -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