unmaintained/ce/sockets/sockets.factor

   1 USING: alien alien.c-types combinators io io.backend io.buffers
   2 io.ports io.sockets io.windows kernel libc
   3 math namespaces prettyprint qualified sequences strings threads
   4 threads.private windows windows.kernel32 io.windows.ce.backend
   5 byte-arrays system ;
   6 QUALIFIED: windows.winsock
   7 IN: io.windows.ce
   8
   9 M: wince WSASocket-flags ( -- DWORD ) 0 ;
  10
  11 M: win32-socket wince-read ( port port-handle -- )
  12     win32-file-handle over buffer-end pick buffer-capacity 0
  13     windows.winsock:recv
  14     dup windows.winsock:SOCKET_ERROR = [
  15         drop port-errored
  16     ] [
  17         dup zero?
  18         [ drop t swap set-port-eof? ] [ swap n>buffer ] if
  19     ] if ;
  20
  21 M: win32-socket wince-write ( port port-handle -- )
  22     win32-file-handle over buffer@ pick buffer-length 0
  23     windows.winsock:send
  24     dup windows.winsock:SOCKET_ERROR =
  25     [ drop port-errored ] [ swap buffer-consume ] if ;
  26
  27 : do-connect ( addrspec -- socket )
  28     [ tcp-socket dup ] keep
  29     make-sockaddr/size
  30     f f f f
  31     windows.winsock:WSAConnect
  32     windows.winsock:winsock-error!=0/f ;
  33
  34 M: wince (client) ( addrspec -- reader writer )
  35     do-connect <win32-socket> dup <ports> ;
  36
  37 M: wince (server) ( addrspec -- handle )
  38     windows.winsock:SOCK_STREAM server-fd
  39     dup listen-on-socket
  40     <win32-socket> ;
  41
  42 M: wince (accept) ( server -- client )
  43     [
  44         [
  45             dup port-handle win32-file-handle
  46             swap server-port-addr sockaddr-type heap-size
  47             dup <byte-array> [
  48                 swap <int> f 0
  49                 windows.winsock:WSAAccept
  50                 dup windows.winsock:INVALID_SOCKET =
  51                 [ windows.winsock:winsock-error ] when
  52             ] keep
  53         ] keep server-port-addr parse-sockaddr swap
  54         <win32-socket> <ports>
  55     ] with-timeout ;
  56
  57 M: wince <datagram> ( addrspec -- datagram )
  58     [
  59         windows.winsock:SOCK_DGRAM server-fd <win32-socket>
  60     ] keep <datagram-port> ;
  61
  62 : packet-size 65536 ; inline
  63
  64 : receive-buffer ( -- buf )
  65     \ receive-buffer get-global expired? [
  66         packet-size malloc \ receive-buffer set-global
  67     ] when
  68     \ receive-buffer get-global ;
  69
  70 : make-WSABUF ( len buf -- ptr )
  71     "WSABUF" <c-object>
  72     [ windows.winsock:set-WSABUF-buf ] keep
  73     [ windows.winsock:set-WSABUF-len ] keep ;
  74
  75 : receive-WSABUF ( -- buf )
  76     packet-size receive-buffer make-WSABUF ;
  77
  78 : packet-data ( len -- byte-array )
  79     receive-buffer swap memory>byte-array ;
  80
  81 packet-size <byte-array> receive-buffer set-global
  82
  83 M: wince receive ( datagram -- packet addrspec )
  84     dup check-datagram-port
  85     [
  86         port-handle win32-file-handle
  87         receive-WSABUF
  88         1
  89         0 <uint> [
  90             0 <uint>
  91             64 "char" <c-array> [
  92                 64 <int>
  93                 f
  94                 f
  95                 windows.winsock:WSARecvFrom
  96                 windows.winsock:winsock-error!=0/f
  97             ] keep
  98         ] keep *uint packet-data swap
  99     ] keep datagram-port-addr parse-sockaddr ;
 100
 101 : send-WSABUF ( byte-array -- ptr )
 102     dup length packet-size > [ "UDP packet too long" throw ] when
 103     dup length receive-buffer rot pick memcpy
 104     receive-buffer make-WSABUF ;
 105
 106 M: wince send ( packet addrspec datagram -- )
 107     3dup check-datagram-send
 108     port-handle win32-file-handle
 109     rot send-WSABUF
 110     rot make-sockaddr/size
 111     >r >r 1 0 <uint> 0 r> r> f f
 112     windows.winsock:WSASendTo
 113     windows.winsock:winsock-error!=0/f ;