-USING: alien alien.c-types arrays assocs combinators
-continuations destructors io io.backend io.ports io.timeouts
-io.backend.windows io.files.windows io.files.windows.nt io.files
-io.pathnames io.buffers io.streams.c libc kernel math namespaces
-sequences threads windows windows.errors windows.kernel32
-strings splitting ascii system accessors locals ;
-QUALIFIED: windows.winsock
+USING: alien alien.c-types arrays assocs combinators continuations
+destructors io io.backend io.ports io.timeouts io.backend.windows
+io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
+io.streams.c io.streams.null libc kernel math namespaces sequences
+threads windows windows.errors windows.kernel32 strings splitting
+ascii system accessors locals classes.struct combinators.short-circuit ;
IN: io.backend.windows.nt
! Global variable with assoc mapping overlapped to threads
C: <io-callback> io-callback
: (make-overlapped) ( -- overlapped-ext )
- "OVERLAPPED" malloc-object &free ;
+ OVERLAPPED malloc-struct &free ;
: make-overlapped ( port -- overlapped-ext )
[ (make-overlapped) ] dip
- handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
+ handle>> ptr>> [ >>offset ] when* ;
M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ;
handle>> master-completion-port get-global <completion-port> drop ;
: eof? ( error -- ? )
- [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ;
+ { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ;
: twiddle-thumbs ( overlapped port -- bytes-transferred )
[
drop
- [ 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?
- [ drop 0 ] [ win32-error-string throw ] if
+ [ drop 0 ] [ n>win32-error-string throw ] if
] }
} 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*
- ] keep *int spin ;
+ { int void* pointer: OVERLAPPED }
+ [ timeout GetQueuedCompletionStatus zero? ] [ ] with-out-parameters
+ :> ( error? bytes key overlapped )
+ bytes overlapped error? ;
: resume-callback ( result overlapped -- )
- pending-overlapped get-global delete-at* drop resume-with ;
+ >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
-: handle-overlapped ( us -- ? )
+: handle-overlapped ( nanos -- ? )
wait-for-overlapped [
- dup [
+ [
[ drop GetLastError 1array ] dip resume-callback t
- ] [ 2drop f ] if
+ ] [ drop f ] if*
] [ resume-callback t ] if ;
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 ( -- )
<master-completion-port> master-completion-port set-global
- H{ } clone pending-overlapped set-global
- windows.winsock:init-winsock ;
+ H{ } clone pending-overlapped set-global ;
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>> ;
M: winnt seek-handle ( n seek-type handle -- )
swap {
: console-app? ( -- ? ) GetConsoleWindow >boolean ;
-M: winnt (init-stdio)
- console-app? [ init-c-stdio t ] [ f f f f ] if ;
+M: winnt init-stdio
+ console-app?
+ [ init-c-stdio ]
+ [ null-reader null-writer null-writer set-stdio ] if ;
winnt set-io-backend