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

Clean up UDP a little

db4
Slava Pestov 2008-01-28 01:06:27 -06:00
parent 47e991649c
commit 417e475857
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extra/io/windows/nt/sockets/sockets.factor
View File

@ -162,6 +162,11 @@ TUPLE: WSARecvFrom-args port
s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd* s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd*
lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ; lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ;
: make-receive-buffer ( -- WSABUF )
"WSABUF" malloc-object dup free-always
default-buffer-size get over set-WSABUF-len
default-buffer-size get malloc dup free-always over set-WSABUF-buf ;
: init-WSARecvFrom ( datagram WSARecvFrom -- ) : init-WSARecvFrom ( datagram WSARecvFrom -- )
[ set-WSARecvFrom-args-port ] 2keep [ set-WSARecvFrom-args-port ] 2keep
[ [
@ -172,11 +177,7 @@ TUPLE: WSARecvFrom-args port
2dup >r malloc dup free-always r> set-WSARecvFrom-args-lpFrom* 2dup >r malloc dup free-always r> set-WSARecvFrom-args-lpFrom*
>r malloc-int dup free-always r> set-WSARecvFrom-args-lpFromLen* >r malloc-int dup free-always r> set-WSARecvFrom-args-lpFromLen*
] keep ] keep
"WSABUF" malloc-object dup free-always make-receive-buffer over set-WSARecvFrom-args-lpBuffers*
2dup swap set-WSARecvFrom-args-lpBuffers*
default-buffer-size get [ malloc dup free-always ] keep
pick set-WSABUF-len
swap set-WSABUF-buf
1 over set-WSARecvFrom-args-dwBufferCount* 1 over set-WSARecvFrom-args-dwBufferCount*
0 malloc-int dup free-always over set-WSARecvFrom-args-lpFlags* 0 malloc-int dup free-always over set-WSARecvFrom-args-lpFlags*
0 malloc-int dup free-always over set-WSARecvFrom-args-lpNumberOfBytesRecvd* 0 malloc-int dup free-always over set-WSARecvFrom-args-lpNumberOfBytesRecvd*
@ -215,26 +216,29 @@ TUPLE: WSASendTo-args port
s* lpBuffers* dwBufferCount* lpNumberOfBytesSent* s* lpBuffers* dwBufferCount* lpNumberOfBytesSent*
dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ; dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ;
: make-send-buffer ( packet -- WSABUF )
"WSABUF" malloc-object dup free-always
over malloc-byte-array dup free-always over set-WSABUF-buf
swap length over set-WSABUF-len ;
: init-WSASendTo ( packet addrspec datagram WSASendTo -- ) : init-WSASendTo ( packet addrspec datagram WSASendTo -- )
[ set-WSASendTo-args-port ] 2keep [ set-WSASendTo-args-port ] 2keep
[ [
>r delegate port-handle win32-file-handle r> >r port-handle win32-file-handle r> set-WSASendTo-args-s*
set-WSASendTo-args-s* ] keep
] keep [ [
>r make-sockaddr/size >r >r make-sockaddr/size >r
malloc-byte-array dup free-always malloc-byte-array dup free-always
r> r> r> r>
[ set-WSASendTo-args-iToLen* ] keep [ set-WSASendTo-args-iToLen* ] keep
set-WSASendTo-args-lpTo* set-WSASendTo-args-lpTo*
] keep [ ] keep
"WSABUF" malloc-object dup free-always [
dup rot set-WSASendTo-args-lpBuffers* >r make-send-buffer r> set-WSASendTo-args-lpBuffers*
swap [ malloc-byte-array dup free-always ] keep length
rot [ set-WSABUF-len ] keep
set-WSABUF-buf
] keep ] keep
1 over set-WSASendTo-args-dwBufferCount* 1 over set-WSASendTo-args-dwBufferCount*
0 over set-WSASendTo-args-dwFlags* 0 over set-WSASendTo-args-dwFlags*
0 <uint> over set-WSASendTo-args-lpNumberOfBytesSent*
(make-overlapped) swap set-WSASendTo-args-lpOverlapped* ; (make-overlapped) swap set-WSASendTo-args-lpOverlapped* ;
: WSASendTo-continuation ( WSASendTo -- ) : WSASendTo-continuation ( WSASendTo -- )