steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
library/win32/win32-io-internals.factor
View File

@ -72,10 +72,6 @@ GENERIC: expire
dup add-completion dup add-completion
] with-scope ; ] with-scope ;
BEGIN-STRUCT: indirect-pointer
FIELD: int value
END-STRUCT
: <overlapped> ( -- overlapped ) : <overlapped> ( -- overlapped )
"overlapped-ext" c-size malloc <alien> ; "overlapped-ext" c-size malloc <alien> ;
@ -103,14 +99,11 @@ C: io-callback ( -- callback )
io-callback-quotation ; io-callback-quotation ;
: (wait-for-io) ( timeout -- error overlapped len ) : (wait-for-io) ( timeout -- error overlapped len )
>r completion-port get >r completion-port get <int> 0 <int> 0 <int>
"indirect-pointer" <c-object> [ 0 swap set-indirect-pointer-value ] keep
"indirect-pointer" <c-object>
"indirect-pointer" <c-object>
pick over r> -rot >r >r GetQueuedCompletionStatus r> r> ; pick over r> -rot >r >r GetQueuedCompletionStatus r> r> ;
: overlapped>callback ( overlapped -- callback ) : overlapped>callback ( overlapped -- callback )
indirect-pointer-value dup zero? [ *int dup zero? [
drop f drop f
] [ ] [
<alien> overlapped-ext-user-data get-io-callback <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 ; io-queue-callbacks [ io-callback-stream [ expire ] when* ] each ;
: wait-for-io ( timeout -- callback len ) : 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 ; rot [ queue-error ] unless ;
: win32-init-stdio ( -- ) : win32-init-stdio ( -- )

10
library/win32/win32-server.factor
View File

@ -66,11 +66,11 @@ SYMBOL: socket
dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ; dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ;
: extract-remote-host ( buffer -- port host ) : extract-remote-host ( buffer -- port host )
buffer-ptr <alien> 0 32 32 "indirect-pointer" <c-object> buffer-ptr <alien> 0 32 32 0 <int>
"indirect-pointer" <c-object> 0 <int>
"indirect-pointer" <c-object> 0 <int>
dup >r "indirect-pointer" <c-object> dup >r 0 <int>
GetAcceptExSockaddrs r> indirect-pointer-value <alien> sockaddr> ; GetAcceptExSockaddrs r> *int <alien> sockaddr> ;
C: win32-client-stream ( buf stream -- stream ) C: win32-client-stream ( buf stream -- stream )
[ set-delegate extract-remote-host ] keep [ set-delegate extract-remote-host ] keep