diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index da82f2eec3..0c39b24064 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -91,12 +91,15 @@ ERROR: not-a-buffered-port port ; M: fd refill [ check-buffered-port buffer>> ] [ fd>> ] bi* over [ buffer-end ] [ buffer-capacity ] bi read - { fixnum } declare { - { [ dup 0 >= ] [ swap buffer+ f ] } - { [ errno EINTR = ] [ 2drop +retry+ ] } - { [ errno EAGAIN = ] [ 2drop +input+ ] } - [ (io-error) ] - } cond ; + { fixnum } declare dup 0 >= [ + swap buffer+ f + ] [ + errno { + { EINTR [ 2drop +retry+ ] } + { EAGAIN [ 2drop +input+ ] } + [ (io-error) ] + } case + ] if ; M: unix (wait-to-read) ( port -- ) dup @@ -107,15 +110,16 @@ M: unix (wait-to-read) ( port -- ) M: fd drain [ check-buffered-port buffer>> ] [ fd>> ] bi* over [ buffer@ ] [ buffer-length ] bi write - { fixnum } declare { - { [ dup 0 >= ] [ - over buffer-consume - buffer-empty? f +output+ ? - ] } - { [ errno EINTR = ] [ 2drop +retry+ ] } - { [ errno EAGAIN = ] [ 2drop +output+ ] } - [ (io-error) ] - } cond ; + { fixnum } declare dup 0 >= [ + over buffer-consume + buffer-empty? f +output+ ? + ] [ + errno { + { EINTR [ 2drop +retry+ ] } + { EAGAIN [ 2drop +output+ ] } + [ (io-error) ] + } case + ] if ; M: unix (wait-to-write) ( port -- ) dup diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index 73fa906085..085e0a33c4 100644 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -15,10 +15,10 @@ IN: io.sockets.unix : set-socket-option ( fd level opt -- ) [ handle-fd ] 2dip 1 int dup byte-length setsockopt io-error ; -M: unix addrinfo-error-string ( n -- string ) +M: unix addrinfo-error-string gai_strerror ; -M: unix sockaddr-of-family ( alien af -- addrspec ) +M: unix sockaddr-of-family { { AF_INET [ sockaddr-in memory>struct ] } { AF_INET6 [ sockaddr-in6 memory>struct ] } @@ -26,7 +26,7 @@ M: unix sockaddr-of-family ( alien af -- addrspec ) [ 2drop f ] } case ; -M: unix addrspec-of-family ( af -- addrspec ) +M: unix addrspec-of-family { { AF_INET [ T{ ipv4 } ] } { AF_INET6 [ T{ ipv6 } ] } @@ -35,40 +35,41 @@ M: unix addrspec-of-family ( af -- addrspec ) } case ; ! Client sockets - TCP and Unix domain -M: object (get-local-address) ( handle remote -- sockaddr ) +M: object (get-local-address) [ handle-fd ] dip empty-sockaddr/size int [ getsockname io-error ] 2keep drop ; -M: object (get-remote-address) ( handle local -- sockaddr ) +M: object (get-remote-address) [ handle-fd ] dip empty-sockaddr/size int [ getpeername io-error ] 2keep drop ; : init-client-socket ( fd -- ) SOL_SOCKET SO_OOBINLINE set-socket-option ; -: wait-to-connect ( port -- ) - dup handle>> handle-fd f 0 write - { - { [ 0 = ] [ drop ] } - { [ errno EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] } - { [ errno EINTR = ] [ wait-to-connect ] } - [ (io-error) ] - } cond ; +DEFER: wait-to-connect -M:: object establish-connection ( client-out remote -- ) - client-out remote - [ drop ] - [ - [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect - ] 2bi - { - { [ 0 = ] [ drop ] } - { [ errno EINTR = ] [ drop client-out remote establish-connection ] } - { [ errno EINPROGRESS = ] [ - [ +output+ wait-for-port ] [ wait-to-connect ] bi - ] } - [ (io-error) ] - } cond ; +: wait-for-output ( port -- ) + dup +output+ wait-for-port wait-to-connect ; inline + +: wait-to-connect ( port -- ) + dup handle>> handle-fd f 0 write 0 = [ drop ] [ + errno { + { EAGAIN [ wait-for-output ] } + { EINTR [ wait-to-connect ] } + [ (io-error) ] + } case + ] if ; + +M: object establish-connection + 2dup + [ handle>> handle-fd ] [ make-sockaddr/size ] bi* + connect 0 = [ 2drop ] [ + errno { + { EINTR [ establish-connection ] } + { EINPROGRESS [ drop wait-for-output ] } + [ (io-error) ] + } case + ] if ; : ?bind-client ( socket -- ) bind-local-address get [ @@ -78,7 +79,7 @@ M:: object establish-connection ( client-out remote -- ) drop ] if* ; inline -M: object ((client)) ( addrspec -- fd ) +M: object ((client)) [ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd [ init-client-socket ] [ ?bind-client ] [ ] tri ; @@ -91,7 +92,7 @@ M: object ((client)) ( addrspec -- fd ) [ init-server-socket ] keep [ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ; -M: object (server) ( addrspec -- handle ) +M: object (server) [ SOCK_STREAM server-socket-fd dup handle-fd 128 [ listen ] unix-system-call drop @@ -101,19 +102,21 @@ M: object (server) ( addrspec -- handle ) [ handle>> handle-fd ] [ empty-sockaddr/size int ] bi* [ accept ] 2keep drop ; inline -M: object (accept) ( server addrspec -- fd sockaddr ) - 2dup do-accept - { - { [ over 0 >= ] [ [ 2nip init-fd ] dip ] } - { [ errno EINTR = ] [ 2drop (accept) ] } - { [ errno EAGAIN = ] [ - 2drop - [ drop +input+ wait-for-port ] - [ (accept) ] - 2bi - ] } - [ (io-error) ] - } cond ; +M: object (accept) + 2dup do-accept over 0 >= [ + [ 2nip init-fd ] dip + ] [ + errno { + { EINTR [ 2drop (accept) ] } + { EAGAIN [ + 2drop + [ drop +input+ wait-for-port ] + [ (accept) ] + 2bi + ] } + [ (io-error) ] + } case + ] if ; ! Datagram sockets - UDP and Unix domain M: unix (datagram) @@ -140,25 +143,25 @@ M: unix (broadcast) 2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi ] if ; inline recursive -M: unix (receive-unsafe) ( n buf datagram -- count sockaddr ) +M: unix (receive-unsafe) (receive-loop) ; :: do-send ( packet sockaddr len socket datagram -- ) socket handle-fd packet dup length 0 sockaddr len sendto 0 < [ - errno EINTR = [ - packet sockaddr len socket datagram do-send - ] [ - errno EAGAIN = [ + errno { + { EINTR [ + packet sockaddr len socket datagram do-send + ] } + { EAGAIN [ datagram +output+ wait-for-port packet sockaddr len socket datagram do-send - ] [ - (io-error) - ] if - ] if + ] } + [ (io-error) ] + } case ] when ; inline recursive -M: unix (send) ( packet addrspec datagram -- ) +M: unix (send) [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ; ! Unix domain sockets