Minor win32 I/O cleanup
parent
ff4d87161c
commit
68071fedab
|
@ -72,10 +72,6 @@ GENERIC: expire
|
|||
dup add-completion
|
||||
] with-scope ;
|
||||
|
||||
BEGIN-STRUCT: indirect-pointer
|
||||
FIELD: int value
|
||||
END-STRUCT
|
||||
|
||||
: <overlapped> ( -- overlapped )
|
||||
"overlapped-ext" c-size malloc <alien> ;
|
||||
|
||||
|
@ -103,14 +99,11 @@ C: io-callback ( -- callback )
|
|||
io-callback-quotation ;
|
||||
|
||||
: (wait-for-io) ( timeout -- error overlapped len )
|
||||
>r completion-port get
|
||||
"indirect-pointer" <c-object> [ 0 swap set-indirect-pointer-value ] keep
|
||||
"indirect-pointer" <c-object>
|
||||
"indirect-pointer" <c-object>
|
||||
>r completion-port get <int> 0 <int> 0 <int>
|
||||
pick over r> -rot >r >r GetQueuedCompletionStatus r> r> ;
|
||||
|
||||
: overlapped>callback ( overlapped -- callback )
|
||||
indirect-pointer-value dup zero? [
|
||||
*int dup zero? [
|
||||
drop f
|
||||
] [
|
||||
<alien> overlapped-ext-user-data get-io-callback
|
||||
|
@ -121,7 +114,7 @@ C: io-callback ( -- callback )
|
|||
io-queue-callbacks [ io-callback-stream [ expire ] when* ] each ;
|
||||
|
||||
: wait-for-io ( timeout -- callback len )
|
||||
(wait-for-io) overlapped>callback swap indirect-pointer-value
|
||||
(wait-for-io) overlapped>callback swap *int
|
||||
rot [ queue-error ] unless ;
|
||||
|
||||
: win32-init-stdio ( -- )
|
||||
|
|
|
@ -66,11 +66,11 @@ SYMBOL: socket
|
|||
dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ;
|
||||
|
||||
: extract-remote-host ( buffer -- port host )
|
||||
buffer-ptr <alien> 0 32 32 "indirect-pointer" <c-object>
|
||||
"indirect-pointer" <c-object>
|
||||
"indirect-pointer" <c-object>
|
||||
dup >r "indirect-pointer" <c-object>
|
||||
GetAcceptExSockaddrs r> indirect-pointer-value <alien> sockaddr> ;
|
||||
buffer-ptr <alien> 0 32 32 0 <int>
|
||||
0 <int>
|
||||
0 <int>
|
||||
dup >r 0 <int>
|
||||
GetAcceptExSockaddrs r> *int <alien> sockaddr> ;
|
||||
|
||||
C: win32-client-stream ( buf stream -- stream )
|
||||
[ set-delegate extract-remote-host ] keep
|
||||
|
|
Loading…
Reference in New Issue