factor/unmaintained/ce/sockets/sockets.factor

114 lines
3.3 KiB
Factor
Executable File

USING: alien alien.c-types combinators io io.backend io.buffers
io.ports io.sockets io.windows kernel libc
math namespaces prettyprint qualified sequences strings threads
threads.private windows windows.kernel32 io.windows.ce.backend
byte-arrays system ;
QUALIFIED: windows.winsock
IN: io.windows.ce
M: wince WSASocket-flags ( -- DWORD ) 0 ;
M: win32-socket wince-read ( port port-handle -- )
win32-file-handle over buffer-end pick buffer-capacity 0
windows.winsock:recv
dup windows.winsock:SOCKET_ERROR = [
drop port-errored
] [
dup zero?
[ drop t swap set-port-eof? ] [ swap n>buffer ] if
] if ;
M: win32-socket wince-write ( port port-handle -- )
win32-file-handle over buffer@ pick buffer-length 0
windows.winsock:send
dup windows.winsock:SOCKET_ERROR =
[ drop port-errored ] [ swap buffer-consume ] if ;
: do-connect ( addrspec -- socket )
[ tcp-socket dup ] keep
make-sockaddr/size
f f f f
windows.winsock:WSAConnect
windows.winsock:winsock-error!=0/f ;
M: wince (client) ( addrspec -- reader writer )
do-connect <win32-socket> dup <ports> ;
M: wince (server) ( addrspec -- handle )
windows.winsock:SOCK_STREAM server-fd
dup listen-on-socket
<win32-socket> ;
M: wince (accept) ( server -- client )
[
[
dup port-handle win32-file-handle
swap server-port-addr sockaddr-type heap-size
dup <byte-array> [
swap <int> f 0
windows.winsock:WSAAccept
dup windows.winsock:INVALID_SOCKET =
[ windows.winsock:winsock-error ] when
] keep
] keep server-port-addr parse-sockaddr swap
<win32-socket> <ports>
] with-timeout ;
M: wince <datagram> ( addrspec -- datagram )
[
windows.winsock:SOCK_DGRAM server-fd <win32-socket>
] keep <datagram-port> ;
: packet-size 65536 ; inline
: receive-buffer ( -- buf )
\ receive-buffer get-global expired? [
packet-size malloc \ receive-buffer set-global
] when
\ receive-buffer get-global ;
: make-WSABUF ( len buf -- ptr )
"WSABUF" <c-object>
[ windows.winsock:set-WSABUF-buf ] keep
[ windows.winsock:set-WSABUF-len ] keep ;
: receive-WSABUF ( -- buf )
packet-size receive-buffer make-WSABUF ;
: packet-data ( len -- byte-array )
receive-buffer swap memory>byte-array ;
packet-size <byte-array> receive-buffer set-global
M: wince receive ( datagram -- packet addrspec )
dup check-datagram-port
[
port-handle win32-file-handle
receive-WSABUF
1
0 <uint> [
0 <uint>
64 "char" <c-array> [
64 <int>
f
f
windows.winsock:WSARecvFrom
windows.winsock:winsock-error!=0/f
] keep
] keep *uint packet-data swap
] keep datagram-port-addr parse-sockaddr ;
: send-WSABUF ( byte-array -- ptr )
dup length packet-size > [ "UDP packet too long" throw ] when
dup length receive-buffer rot pick memcpy
receive-buffer make-WSABUF ;
M: wince send ( packet addrspec datagram -- )
3dup check-datagram-send
port-handle win32-file-handle
rot send-WSABUF
rot make-sockaddr/size
>r >r 1 0 <uint> 0 r> r> f f
windows.winsock:WSASendTo
windows.winsock:winsock-error!=0/f ;