[BACK]Return to socket.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / unix

Diff for /gforth/unix/socket.fs between versions 1.32 and 1.33

version 1.32, 2009/12/31 15:32:36 version 1.33, 2010/03/23 19:45:30
Line 32  c-function closesocket close n -- n ( fd Line 32  c-function closesocket close n -- n ( fd
 c-function connect connect n a n -- n ( fd sock size -- err )  c-function connect connect n a n -- n ( fd sock size -- err )
 c-function send send n a n n -- n ( socket buffer count flags -- size )  c-function send send n a n n -- n ( socket buffer count flags -- size )
 c-function recv recv n a n n -- n ( socket buffer count flags -- size )  c-function recv recv n a n n -- n ( socket buffer count flags -- size )
   c-function recvfrom recvfrom n a n n a a -- n ( socket buffer count flags srcaddr addrlen -- size )
 c-function listen() listen n n -- n ( socket backlog -- err )  c-function listen() listen n n -- n ( socket backlog -- err )
 c-function bind bind n a n -- n ( socket sockaddr socklen --- err )  c-function bind bind n a n -- n ( socket sockaddr socklen --- err )
 c-function accept() accept n a a -- n ( socket sockaddr addrlen -- fd )  c-function accept() accept n a a -- n ( socket sockaddr addrlen -- fd )
Line 86  sockaddr-tmp sockaddr_in %size dup allot Line 87  sockaddr-tmp sockaddr_in %size dup allot
   
    2 Constant PF_INET     2 Constant PF_INET
    1 Constant SOCK_STREAM     1 Constant SOCK_STREAM
      2 Constant SOCK_DGRAM
      1 Constant IPPROTO_ICMP
    6 Constant IPPROTO_TCP     6 Constant IPPROTO_TCP
     17 Constant IPPROTO_UDP
    4 Constant F_SETFL     4 Constant F_SETFL
   11 Constant EWOULDBLOCK    11 Constant EWOULDBLOCK
 $100 Constant MSG_WAITALL  $100 Constant MSG_WAITALL
Line 94  $802 Constant O_NONBLOCK|O_RDWR Line 98  $802 Constant O_NONBLOCK|O_RDWR
 2variable socket-timeout-d 2000. socket-timeout-d 2!  2variable socket-timeout-d 2000. socket-timeout-d 2!
   
 : new-socket ( -- socket )  : new-socket ( -- socket )
     PF_INET SOCK_STREAM IPPROTO_TCP socket      PF_INET SOCK_STREAM 0 socket
       dup 0<= abort" no free socket" ;
   
   : new-udp-socket ( -- socket )
       PF_INET SOCK_DGRAM 0 socket
     dup 0<= abort" no free socket" ;      dup 0<= abort" no free socket" ;
   
 : >inetaddr ( ip port sockaddr -- ) >r  : >inetaddr ( ip port sockaddr -- ) >r
Line 110  $802 Constant O_NONBLOCK|O_RDWR Line 118  $802 Constant O_NONBLOCK|O_RDWR
     r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"      r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
     r> s" w+" c-string fdopen ;      r> s" w+" c-string fdopen ;
   
   : open-udp-socket ( addr u port -- fid )
       -rot host>addr
       swap sockaddr-tmp >inetaddr
       new-udp-socket >r
       r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
       r> s" w+" c-string fdopen ;
   
 : create-server  ( port# -- lsocket )  : create-server  ( port# -- lsocket )
     sockaddr-tmp 4 CELLS ERASE      sockaddr-tmp sockaddr_in %size erase
     htonl PF_INET OR sockaddr-tmp !      PF_INET sockaddr-tmp family w!
     PF_INET SOCK_STREAM 0 socket      htons   sockaddr-tmp port w!
       new-socket
       dup 0< abort" no free socket" >r
       r@ sockaddr-tmp 16 bind 0= IF  r> exit  ENDIF
       r> drop true abort" bind :: failed" ;
   
   : create-udp-server  ( port# -- lsocket )
       sockaddr-tmp sockaddr_in %size erase
       PF_INET sockaddr-tmp family w!
       htons   sockaddr-tmp port w!
       new-udp-socket
     dup 0< abort" no free socket" >r      dup 0< abort" no free socket" >r
     r@ sockaddr-tmp 16 bind 0= IF  r> exit  ENDIF      r@ sockaddr-tmp 16 bind 0= IF  r> exit  ENDIF
     r> drop true abort" bind :: failed" ;      r> drop true abort" bind :: failed" ;
Line 182  Create crlf 2 c, 13 c, 10 c, Line 207  Create crlf 2 c, 13 c, 10 c,
         utime tmax d< and           utime tmax d< and 
     WHILE       WHILE 
             2drop              2drop
       REPEAT ;
   
   : (rs-from)  ( socket c-addr maxlen -- c-addr size ) 
       2 pick >r  r@ false blocking-mode  rot fileno -rot
       over >r msg_waitall sockaddr-tmp alen  recvfrom
       dup 0<  IF  0 max
           errno dup 0<> swap ewouldblock <> and abort" (rs) :: socket read error"
       THEN
       r> swap
       r> true blocking-mode ;
   
   : read-socket-from ( socket c-addr maxlen -- c-addr u )
       utime socket-timeout-d 2@ d+ { socket c-addr maxlen d: tmax -- c-addr size }
       BEGIN 
           socket c-addr maxlen (rs-from) dup 0=
           utime tmax d< and 
       WHILE 
               2drop
     REPEAT ;      REPEAT ;
Removed from v.1.32  
changed lines
  Added in v.1.33

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>