]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/backend/windows/nt/nt.factor
Updating code to use with-out-parameters
[factor.git] / basis / io / backend / windows / nt / nt.factor
old mode 100755 (executable)
new mode 100644 (file)
index 1301d69..14a09bd
@@ -40,8 +40,8 @@ M: winnt add-completion ( win32-handle -- )
 : twiddle-thumbs ( overlapped port -- bytes-transferred )
     [
         drop
-        [ >c-ptr pending-overlapped get-global set-at ] curry "I/O" suspend
-        {
+        [ self ] dip >c-ptr pending-overlapped get-global set-at
+        "I/O" suspend {
             { [ dup integer? ] [ ] }
             { [ dup array? ] [
                 first dup eof?
@@ -50,22 +50,18 @@ M: winnt add-completion ( win32-handle -- )
         } cond
     ] with-timeout ;
 
-:: wait-for-overlapped ( usec -- bytes-transferred overlapped error? )
+:: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? )
+    nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout
     master-completion-port get-global
-    0 <int> :> bytes
-    f <void*> :> key
-    f <void*> :> overlapped
-    usec [ 1000 /i ] [ INFINITE ] if* :> timeout
-    bytes key overlapped timeout GetQueuedCompletionStatus zero? :> error?
-
-    bytes *int
-    overlapped *void* dup [ OVERLAPPED memory>struct ] when
-    error? ;
+    { int void* pointer: OVERLAPPED }
+    [ timeout GetQueuedCompletionStatus zero? ] [ ] with-out-parameters
+    :> ( error? bytes key overlapped )
+    bytes overlapped error? ;
 
 : resume-callback ( result overlapped -- )
     >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
 
-: handle-overlapped ( us -- ? )
+: handle-overlapped ( nanos -- ? )
     wait-for-overlapped [
         [
             [ drop GetLastError 1array ] dip resume-callback t
@@ -75,7 +71,7 @@ M: winnt add-completion ( win32-handle -- )
 M: win32-handle cancel-operation
     [ check-disposed ] [ handle>> CancelIo drop ] bi ;
 
-M: winnt io-multiplex ( us -- )
+M: winnt io-multiplex ( nanos -- )
     handle-overlapped [ 0 io-multiplex ] when ;
 
 M: winnt init-io ( -- )
@@ -90,7 +86,7 @@ ERROR: invalid-file-size n ;
 ERROR: seek-before-start n ;
 
 : set-seek-ptr ( n handle -- )
-    [ dup 0 < [ seek-before-start ] when ] dip (>>ptr) ;
+    [ dup 0 < [ seek-before-start ] when ] dip ptr<< ;
 
 M: winnt tell-handle ( handle -- n ) ptr>> ;