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

Make unix-system-call retry the call immediately upon hitting EINTR. Use unix-system-call wherever EAGAIN or EINPROGRESS are not handled. Handle EINTR if connect returns it.

db4
Doug Coleman 2010-01-19 16:53:15 -06:00
parent bbd4e27275
commit 07fcb43a06
8 changed files with 59 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,8 +17,8 @@ TUPLE: fd < disposable fd ;
: init-fd ( fd -- fd )
[
|dispose
dup fd>> F_SETFL O_NONBLOCK fcntl io-error
dup fd>> F_SETFD FD_CLOEXEC fcntl io-error
dup fd>> F_SETFL O_NONBLOCK [ fcntl ] unix-system-call io-error
dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call io-error
] with-destructors ;
: <fd> ( n -- fd )
@ -50,7 +50,7 @@ M: fd cancel-operation ( fd -- )
] if ;
M: unix tell-handle ( handle -- n )
fd>> 0 SEEK_CUR lseek [ io-error ] [ ] bi ;
fd>> 0 SEEK_CUR [ lseek ] unix-system-call [ io-error ] [ ] bi ;
M: unix seek-handle ( n seek-type handle -- )
swap {
@ -59,7 +59,7 @@ M: unix seek-handle ( n seek-type handle -- )
{ io:seek-end [ SEEK_END ] }
[ io:bad-seek-type ]
} case
[ fd>> swap ] dip lseek io-error ;
[ fd>> swap ] dip [ lseek ] unix-system-call io-error ;
SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+

2
basis/io/directories/unix/linux/linux.factor
View File

@ -7,5 +7,5 @@ IN: io.directories.unix.linux
M: unix find-next-file ( DIR* -- dirent )
dirent <struct>
f <void*>
[ readdir64_r 0 = [ (io-error) ] unless ] 2keep
[ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;

12
basis/io/directories/unix/unix.factor
View File

@ -17,29 +17,29 @@ M: unix touch-file ( path -- )
] if ;
M: unix move-file ( from to -- )
[ normalize-path ] bi@ rename io-error ;
[ normalize-path ] bi@ [ rename ] unix-system-call io-error ;
M: unix delete-file ( path -- ) normalize-path unlink-file ;
M: unix make-directory ( path -- )
normalize-path OCT: 777 mkdir io-error ;
normalize-path OCT: 777 [ mkdir ] unix-system-call io-error ;
M: unix delete-directory ( path -- )
normalize-path rmdir io-error ;
normalize-path [ rmdir ] unix-system-call io-error ;
M: unix copy-file ( from to -- )
[ normalize-path ] bi@ call-next-method ;
: with-unix-directory ( path quot -- )
[ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
[ [ opendir ] unix-system-call dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ [ closedir ] unix-system-call io-error ] [ ] cleanup ; inline
HOOK: find-next-file os ( DIR* -- byte-array )
M: unix find-next-file ( DIR* -- byte-array )
dirent <struct>
f <void*>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
[ [ readdir_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
: dirent-type>file-type ( ch -- type )

9
basis/io/files/info/unix/unix.factor
View File

@ -109,7 +109,7 @@ M: unix stat>type ( stat -- type )
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
[ bitor ] [ unmask ] if chmod io-error ;
[ bitor ] [ unmask ] if [ chmod ] unix-system-call io-error ;
GENERIC# file-mode? 1 ( obj mask -- ? )
@ -174,7 +174,7 @@ CONSTANT: ALL-EXECUTE OCT: 0000111
: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
: set-file-permissions ( path n -- )
[ normalize-path ] dip chmod io-error ;
[ normalize-path ] dip [ chmod ] unix-system-call io-error ;
: file-permissions ( path -- n )
normalize-path file-info permissions>> ;
@ -202,7 +202,7 @@ PRIVATE>
: set-file-times ( path timestamps -- )
#! set access, write
[ normalize-path ] dip
timestamps>byte-array utimes io-error ;
timestamps>byte-array [ utimes ] unix-system-call io-error ;
: set-file-access-time ( path timestamp -- )
f 2array set-file-times ;
@ -211,7 +211,8 @@ PRIVATE>
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip [ -1 or ] bi@ chown io-error ;
[ normalize-path ] 2dip [ -1 or ] bi@
[ chown ] unix-system-call io-error ;
GENERIC: set-file-user ( path string/id -- )

4
basis/io/files/links/unix/unix.factor
View File

@ -5,10 +5,10 @@ io.files sequences ;
IN: io.files.links.unix
M: unix make-link ( path1 path2 -- )
normalize-path symlink io-error ;
normalize-path [ symlink ] unix-system-call io-error ;
M: unix make-hard-link ( path1 path2 -- )
normalize-path link io-error ;
normalize-path [ link ] unix-system-call io-error ;
M: unix read-link ( path -- path' )
normalize-path read-symbolic-link ;

5
basis/io/files/unix/unix.factor
View File

@ -6,7 +6,8 @@ destructors system ;
IN: io.files.unix
M: unix cwd ( -- path )
MAXPATHLEN [ <byte-array> ] keep getcwd
MAXPATHLEN [ <byte-array> ] keep
[ getcwd ] unix-system-call
[ (io-error) ] unless* ;
M: unix cd ( path -- ) [ chdir ] unix-system-call drop ;
@ -33,7 +34,7 @@ M: unix (file-writer) ( path -- stream )
: open-append ( path -- fd )
[
append-flags file-mode open-file |dispose
dup 0 SEEK_END lseek io-error
dup 0 SEEK_END [ lseek ] unix-system-call io-error
] with-destructors ;
M: unix (file-appender) ( path -- stream )

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

@ -59,10 +59,15 @@ M: object (get-remote-address) ( handle local -- sockaddr )
[ (io-error) ]
} cond ;
M: object establish-connection ( client-out remote -- )
[ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi
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
] }
@ -70,7 +75,12 @@ M: object establish-connection ( client-out remote -- )
} cond ;
: ?bind-client ( socket -- )
bind-local-address get [ [ fd>> ] dip make-sockaddr/size bind io-error ] [ drop ] if* ; inline
bind-local-address get [
[ fd>> ] dip make-sockaddr/size
[ bind ] unix-system-call io-error
] [
drop
] if* ; inline
M: object ((client)) ( addrspec -- fd )
protocol-family SOCK_STREAM socket-fd
@ -83,7 +93,7 @@ M: object ((client)) ( addrspec -- fd )
: server-socket-fd ( addrspec type -- fd )
[ dup protocol-family ] dip socket-fd
[ init-server-socket ] keep
[ handle-fd swap make-sockaddr/size bind io-error ] keep ;
[ handle-fd swap make-sockaddr/size [ bind ] unix-system-call io-error ] keep ;
M: object (server) ( addrspec -- handle )
[

32
basis/unix/unix.factor
View File

@ -1,11 +1,12 @@
! Copyright (C) 2005, 2010 Slava Pestov.
! Copyright (C) 2008 Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc sequences
continuations byte-arrays strings math namespaces system
combinators combinators.smart vocabs.loader accessors
stack-checker macros locals generalizations unix.types io vocabs
classes.struct unix.time alien.libraries ;
USING: accessors alien alien.c-types alien.libraries
alien.syntax byte-arrays classes.struct combinators
combinators.short-circuit combinators.smart continuations
generalizations io kernel libc locals macros math namespaces
sequences stack-checker strings system unix.time unix.types
vocabs vocabs.loader ;
IN: unix
CONSTANT: PROT_NONE 0
@ -47,17 +48,32 @@ ERROR: unix-error errno message ;
ERROR: unix-system-call-error args errno message word ;
: unix-call-failed? ( ret -- ? )
{
[ { [ integer? ] [ 0 < ] } 1&& ]
[ not ]
} 1|| ;
MACRO:: unix-system-call ( quot -- )
quot inputs :> n
quot first :> word
0 :> ret!
f :> failed!
[
n ndup quot call dup 0 < [
drop
[
n ndup quot call ret!
ret {
[ unix-call-failed? dup failed! ]
[ drop errno EINTR = ]
} 1&&
] loop
failed [
n narray
errno dup strerror
word unix-system-call-error
] [
n nnip
n ndrop
ret
] if
] ;