: 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?
} cond
] with-timeout ;
-:: wait-for-overlapped ( us -- 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
- us [ 1000 /i ] [ INFINITE ] if* ! timeout
- GetQueuedCompletionStatus zero?
- ] keep
- *void* dup [ OVERLAPPED memory>struct ] when
- ] keep *int spin ;
+ { 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
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 ( -- )
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>> ;
M: winnt seek-handle ( n seek-type handle -- )
swap {