Clean up UDP a little
parent
47e991649c
commit
417e475857
|
@ -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 -- )
|
||||||
|
|
Loading…
Reference in New Issue