Minor win32 I/O cleanup

slava 2006-02-19 21:17:09 +00:00
parent ff4d87161c
commit 68071fedab
2 changed files with 8 additions and 15 deletions

View File

@ -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 ( -- )

View File

@ -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