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

unix-system-call io-error -> unix-system-call drop 

make unix.ffi, unix.ffi.linux unportable
fix spacing in io.cpp before refactoring
db4
Doug Coleman 2010-01-23 09:07:35 -06:00
parent f0a4223ab4
commit 7c40fc1a36
11 changed files with 43 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
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 ] unix-system-call io-error
dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call io-error
dup fd>> F_SETFL O_NONBLOCK [ fcntl ] unix-system-call drop
dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call drop
] with-destructors ;
: <fd> ( n -- fd )
@ -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 ] unix-system-call io-error ;
[ fd>> swap ] dip [ lseek ] unix-system-call drop ;
SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+

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 ] unix-system-call io-error ;
[ normalize-path ] bi@ [ rename ] unix-system-call drop ;
M: unix delete-file ( path -- ) normalize-path unlink-file ;
M: unix make-directory ( path -- )
normalize-path OCT: 777 [ mkdir ] unix-system-call io-error ;
normalize-path OCT: 777 [ mkdir ] unix-system-call drop ;
M: unix delete-directory ( path -- )
normalize-path [ rmdir ] unix-system-call io-error ;
normalize-path [ rmdir ] unix-system-call drop ;
M: unix copy-file ( from to -- )
[ normalize-path ] bi@ call-next-method ;
: with-unix-directory ( path quot -- )
[ [ opendir ] unix-system-call dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ [ closedir ] unix-system-call io-error ] [ ] cleanup ; inline
[ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ closedir 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 ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
: dirent-type>file-type ( ch -- type )

8
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 ] unix-system-call io-error ;
[ bitor ] [ unmask ] if [ chmod ] unix-system-call drop ;
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 ] unix-system-call io-error ;
[ normalize-path ] dip [ chmod ] unix-system-call drop ;
: 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 ] unix-system-call io-error ;
timestamps>byte-array [ utimes ] unix-system-call drop ;
: set-file-access-time ( path timestamp -- )
f 2array set-file-times ;
@ -212,7 +212,7 @@ PRIVATE>
: set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip [ -1 or ] bi@
[ chown ] unix-system-call io-error ;
[ chown ] unix-system-call drop ;
GENERIC: set-file-user ( path string/id -- )

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

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

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

@ -34,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 ] unix-system-call io-error
dup 0 SEEK_END [ lseek ] unix-system-call drop
] with-destructors ;
M: unix (file-appender) ( path -- stream )

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

@ -77,7 +77,7 @@ M:: object establish-connection ( client-out remote -- )
: ?bind-client ( socket -- )
bind-local-address get [
[ fd>> ] dip make-sockaddr/size
[ bind ] unix-system-call io-error
[ bind ] unix-system-call drop
] [
drop
] if* ; inline
@ -93,12 +93,12 @@ 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 ] unix-system-call io-error ] keep ;
[ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ;
M: object (server) ( addrspec -- handle )
[
SOCK_STREAM server-socket-fd
dup handle-fd 128 listen io-error
dup handle-fd 128 [ listen ] unix-system-call drop
] with-destructors ;
: do-accept ( server addrspec -- fd sockaddr )

1
basis/unix/ffi/linux/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

1
basis/unix/ffi/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

10
basis/unix/groups/groups.factor
View File

@ -31,12 +31,12 @@ GENERIC: group-struct ( obj -- group/f )
M: integer group-struct ( id -- group/f )
(group-struct)
[ [ unix.ffi:getgrgid_r ] unix-system-call io-error ] keep
[ [ unix.ffi:getgrgid_r ] unix-system-call drop ] keep
check-group-struct ;
M: string group-struct ( string -- group/f )
(group-struct)
[ [ unix.ffi:getgrnam_r ] unix-system-call io-error ] keep
[ [ unix.ffi:getgrnam_r ] unix-system-call drop ] keep
check-group-struct ;
: group-struct>group ( group-struct -- group )
@ -69,7 +69,7 @@ PRIVATE>
: (user-groups) ( string -- seq )
#! first group is -1337, legacy unix code
-1337 unix.ffi:NGROUPS_MAX [ 4 * <byte-array> ] keep
<int> [ [ unix.ffi:getgrouplist ] unix-system-call io-error ] 2keep
<int> [ [ unix.ffi:getgrouplist ] unix-system-call drop ] 2keep
[ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE>
@ -115,10 +115,10 @@ GENERIC: set-effective-group ( obj -- )
<PRIVATE
: (set-real-group) ( id -- )
[ unix.ffi:setgid ] unix-system-call io-error ; inline
[ unix.ffi:setgid ] unix-system-call drop ; inline
: (set-effective-group) ( id -- )
[ unix.ffi:setegid ] unix-system-call io-error ; inline
[ unix.ffi:setegid ] unix-system-call drop ; inline
PRIVATE>

4
basis/unix/users/users.factor
View File

@ -93,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- )
<PRIVATE
: (set-real-user) ( id -- )
[ unix.ffi:setuid ] unix-system-call io-error ; inline
[ unix.ffi:setuid ] unix-system-call drop ; inline
: (set-effective-user) ( id -- )
[ unix.ffi:seteuid ] unix-system-call io-error ; inline
[ unix.ffi:seteuid ] unix-system-call drop ; inline
PRIVATE>

30
vm/io.cpp
View File

@ -33,35 +33,35 @@ void factor_vm::io_error()
size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_read = 0;
size_t items_read = 0;
do {
items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
} while(items_read != nitems && errno == EINTR);
do {
items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
} while(items_read != nitems && errno == EINTR);
return items_read;
return items_read;
}
size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_written = 0;
size_t items_written = 0;
do {
items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
} while(items_written != nitems && errno == EINTR);
do {
items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
} while(items_written != nitems && errno == EINTR);
return items_written;
return items_written;
}
int safe_fclose(FILE *stream)
{
int ret = 0;
int ret = 0;
do {
ret = fclose(stream);
} while(ret != 0 && errno == EINTR);
do {
ret = fclose(stream);
} while(ret != 0 && errno == EINTR);
return ret;
return ret;
}
void factor_vm::primitive_fopen()