steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io: use errno case instead of cond.

db4
John Benediktsson 2014-11-20 19:46:14 -08:00
parent 0ba693b3fa
commit 45bd145596
2 changed files with 74 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
basis/io/backend/unix/unix.factor
View File

@ -91,12 +91,15 @@ ERROR: not-a-buffered-port port ;
M: fd refill M: fd refill
[ check-buffered-port buffer>> ] [ fd>> ] bi* [ check-buffered-port buffer>> ] [ fd>> ] bi*
over [ buffer-end ] [ buffer-capacity ] bi read over [ buffer-end ] [ buffer-capacity ] bi read
{ fixnum } declare { { fixnum } declare dup 0 >= [
{ [ dup 0 >= ] [ swap buffer+ f ] } swap buffer+ f
{ [ errno EINTR = ] [ 2drop +retry+ ] } ] [
{ [ errno EAGAIN = ] [ 2drop +input+ ] } errno {
{ EINTR [ 2drop +retry+ ] }
{ EAGAIN [ 2drop +input+ ] }
[ (io-error) ] [ (io-error) ]
} cond ; } case
] if ;
M: unix (wait-to-read) ( port -- ) M: unix (wait-to-read) ( port -- )
dup dup
@ -107,15 +110,16 @@ M: unix (wait-to-read) ( port -- )
M: fd drain M: fd drain
[ check-buffered-port buffer>> ] [ fd>> ] bi* [ check-buffered-port buffer>> ] [ fd>> ] bi*
over [ buffer@ ] [ buffer-length ] bi write over [ buffer@ ] [ buffer-length ] bi write
{ fixnum } declare { { fixnum } declare dup 0 >= [
{ [ dup 0 >= ] [
over buffer-consume over buffer-consume
buffer-empty? f +output+ ? buffer-empty? f +output+ ?
] } ] [
{ [ errno EINTR = ] [ 2drop +retry+ ] } errno {
{ [ errno EAGAIN = ] [ 2drop +output+ ] } { EINTR [ 2drop +retry+ ] }
{ EAGAIN [ 2drop +output+ ] }
[ (io-error) ] [ (io-error) ]
} cond ; } case
] if ;
M: unix (wait-to-write) ( port -- ) M: unix (wait-to-write) ( port -- )
dup dup

91
basis/io/sockets/unix/unix.factor
View File

@ -15,10 +15,10 @@ IN: io.sockets.unix
: set-socket-option ( fd level opt -- ) : set-socket-option ( fd level opt -- )
[ handle-fd ] 2dip 1 int <ref> dup byte-length setsockopt io-error ; [ handle-fd ] 2dip 1 int <ref> dup byte-length setsockopt io-error ;
M: unix addrinfo-error-string ( n -- string ) M: unix addrinfo-error-string
gai_strerror ; gai_strerror ;
M: unix sockaddr-of-family ( alien af -- addrspec ) M: unix sockaddr-of-family
{ {
{ AF_INET [ sockaddr-in memory>struct ] } { AF_INET [ sockaddr-in memory>struct ] }
{ AF_INET6 [ sockaddr-in6 memory>struct ] } { AF_INET6 [ sockaddr-in6 memory>struct ] }
@ -26,7 +26,7 @@ M: unix sockaddr-of-family ( alien af -- addrspec )
[ 2drop f ] [ 2drop f ]
} case ; } case ;
M: unix addrspec-of-family ( af -- addrspec ) M: unix addrspec-of-family
{ {
{ AF_INET [ T{ ipv4 } ] } { AF_INET [ T{ ipv4 } ] }
{ AF_INET6 [ T{ ipv6 } ] } { AF_INET6 [ T{ ipv6 } ] }
@ -35,40 +35,41 @@ M: unix addrspec-of-family ( af -- addrspec )
} case ; } case ;
! Client sockets - TCP and Unix domain ! 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 <ref> [ handle-fd ] dip empty-sockaddr/size int <ref>
[ getsockname io-error ] 2keep drop ; [ 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 <ref> [ handle-fd ] dip empty-sockaddr/size int <ref>
[ getpeername io-error ] 2keep drop ; [ getpeername io-error ] 2keep drop ;
: init-client-socket ( fd -- ) : init-client-socket ( fd -- )
SOL_SOCKET SO_OOBINLINE set-socket-option ; SOL_SOCKET SO_OOBINLINE set-socket-option ;
: wait-to-connect ( port -- ) DEFER: wait-to-connect
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 ;
M:: object establish-connection ( client-out remote -- ) : wait-for-output ( port -- )
client-out remote dup +output+ wait-for-port wait-to-connect ; inline
[ drop ]
[ : wait-to-connect ( port -- )
[ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect dup handle>> handle-fd f 0 write 0 = [ drop ] [
] 2bi errno {
{ { EAGAIN [ wait-for-output ] }
{ [ 0 = ] [ drop ] } { EINTR [ wait-to-connect ] }
{ [ errno EINTR = ] [ drop client-out remote establish-connection ] }
{ [ errno EINPROGRESS = ] [
[ +output+ wait-for-port ] [ wait-to-connect ] bi
] }
[ (io-error) ] [ (io-error) ]
} cond ; } 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-client ( socket -- )
bind-local-address get [ bind-local-address get [
@ -78,7 +79,7 @@ M:: object establish-connection ( client-out remote -- )
drop drop
] if* ; inline ] if* ; inline
M: object ((client)) ( addrspec -- fd ) M: object ((client))
[ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd [ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd
[ init-client-socket ] [ ?bind-client ] [ ] tri ; [ init-client-socket ] [ ?bind-client ] [ ] tri ;
@ -91,7 +92,7 @@ M: object ((client)) ( addrspec -- fd )
[ init-server-socket ] keep [ init-server-socket ] keep
[ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] 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 SOCK_STREAM server-socket-fd
dup handle-fd 128 [ listen ] unix-system-call drop 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 <ref> ] bi* [ handle>> handle-fd ] [ empty-sockaddr/size int <ref> ] bi*
[ accept ] 2keep drop ; inline [ accept ] 2keep drop ; inline
M: object (accept) ( server addrspec -- fd sockaddr ) M: object (accept)
2dup do-accept 2dup do-accept over 0 >= [
{ [ 2nip <fd> init-fd ] dip
{ [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] } ] [
{ [ errno EINTR = ] [ 2drop (accept) ] } errno {
{ [ errno EAGAIN = ] [ { EINTR [ 2drop (accept) ] }
{ EAGAIN [
2drop 2drop
[ drop +input+ wait-for-port ] [ drop +input+ wait-for-port ]
[ (accept) ] [ (accept) ]
2bi 2bi
] } ] }
[ (io-error) ] [ (io-error) ]
} cond ; } case
] if ;
! Datagram sockets - UDP and Unix domain ! Datagram sockets - UDP and Unix domain
M: unix (datagram) M: unix (datagram)
@ -140,25 +143,25 @@ M: unix (broadcast)
2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi 2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi
] if ; inline recursive ] if ; inline recursive
M: unix (receive-unsafe) ( n buf datagram -- count sockaddr ) M: unix (receive-unsafe)
(receive-loop) ; (receive-loop) ;
:: do-send ( packet sockaddr len socket datagram -- ) :: do-send ( packet sockaddr len socket datagram -- )
socket handle-fd packet dup length 0 sockaddr len sendto socket handle-fd packet dup length 0 sockaddr len sendto
0 < [ 0 < [
errno EINTR = [ errno {
{ EINTR [
packet sockaddr len socket datagram do-send packet sockaddr len socket datagram do-send
] [ ] }
errno EAGAIN = [ { EAGAIN [
datagram +output+ wait-for-port datagram +output+ wait-for-port
packet sockaddr len socket datagram do-send packet sockaddr len socket datagram do-send
] [ ] }
(io-error) [ (io-error) ]
] if } case
] if
] when ; inline recursive ] when ; inline recursive
M: unix (send) ( packet addrspec datagram -- ) M: unix (send)
[ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ; [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ;
! Unix domain sockets ! Unix domain sockets