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 ) : init-fd ( fd -- fd )
[ [
|dispose |dispose
dup fd>> F_SETFL O_NONBLOCK [ 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 io-error dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call drop
] with-destructors ; ] with-destructors ;
: <fd> ( n -- fd ) : <fd> ( n -- fd )
@ -59,7 +59,7 @@ M: unix seek-handle ( n seek-type handle -- )
{ io:seek-end [ SEEK_END ] } { io:seek-end [ SEEK_END ] }
[ io:bad-seek-type ] [ io:bad-seek-type ]
} case } 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: +retry+ ! just try the operation again without blocking
SYMBOL: +input+ SYMBOL: +input+

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

@ -17,29 +17,29 @@ M: unix touch-file ( path -- )
] if ; ] if ;
M: unix move-file ( from to -- ) 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 delete-file ( path -- ) normalize-path unlink-file ;
M: unix make-directory ( path -- ) 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 -- ) 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 -- ) M: unix copy-file ( from to -- )
[ normalize-path ] bi@ call-next-method ; [ normalize-path ] bi@ call-next-method ;
: with-unix-directory ( path quot -- ) : with-unix-directory ( path quot -- )
[ [ opendir ] unix-system-call dup [ (io-error) ] unless ] dip [ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ [ closedir ] unix-system-call io-error ] [ ] cleanup ; inline dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
HOOK: find-next-file os ( DIR* -- byte-array ) HOOK: find-next-file os ( DIR* -- byte-array )
M: unix find-next-file ( DIR* -- byte-array ) M: unix find-next-file ( DIR* -- byte-array )
dirent <struct> dirent <struct>
f <void*> f <void*>
[ [ readdir_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep [ readdir_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ; *void* [ drop f ] unless ;
: dirent-type>file-type ( ch -- type ) : 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 ? -- ) : chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip [ 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 -- ? ) 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-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
: set-file-permissions ( path n -- ) : 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 ) : file-permissions ( path -- n )
normalize-path file-info permissions>> ; normalize-path file-info permissions>> ;
@ -202,7 +202,7 @@ PRIVATE>
: set-file-times ( path timestamps -- ) : set-file-times ( path timestamps -- )
#! set access, write #! set access, write
[ normalize-path ] dip [ 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 -- ) : set-file-access-time ( path timestamp -- )
f 2array set-file-times ; f 2array set-file-times ;
@ -212,7 +212,7 @@ PRIVATE>
: set-file-ids ( path uid gid -- ) : set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip [ -1 or ] bi@ [ normalize-path ] 2dip [ -1 or ] bi@
[ chown ] unix-system-call io-error ; [ chown ] unix-system-call drop ;
GENERIC: set-file-user ( path string/id -- ) 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 IN: io.files.links.unix
M: unix make-link ( path1 path2 -- ) 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 -- ) 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' ) M: unix read-link ( path -- path' )
normalize-path read-symbolic-link ; 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 ) : open-append ( path -- fd )
[ [
append-flags file-mode open-file |dispose 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 ; ] with-destructors ;
M: unix (file-appender) ( path -- stream ) 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-client ( socket -- )
bind-local-address get [ bind-local-address get [
[ fd>> ] dip make-sockaddr/size [ fd>> ] dip make-sockaddr/size
[ bind ] unix-system-call io-error [ bind ] unix-system-call drop
] [ ] [
drop drop
] if* ; inline ] if* ; inline
@ -93,12 +93,12 @@ M: object ((client)) ( addrspec -- fd )
: server-socket-fd ( addrspec type -- fd ) : server-socket-fd ( addrspec type -- fd )
[ dup protocol-family ] dip socket-fd [ dup protocol-family ] dip socket-fd
[ init-server-socket ] keep [ 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 ) M: object (server) ( addrspec -- handle )
[ [
SOCK_STREAM server-socket-fd SOCK_STREAM server-socket-fd
dup handle-fd 128 listen io-error dup handle-fd 128 [ listen ] unix-system-call drop
] with-destructors ; ] with-destructors ;
: do-accept ( server addrspec -- fd sockaddr ) : 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 ) M: integer group-struct ( id -- group/f )
(group-struct) (group-struct)
[ [ unix.ffi:getgrgid_r ] unix-system-call io-error ] keep [ [ unix.ffi:getgrgid_r ] unix-system-call drop ] keep
check-group-struct ; check-group-struct ;
M: string group-struct ( string -- group/f ) M: string group-struct ( string -- group/f )
(group-struct) (group-struct)
[ [ unix.ffi:getgrnam_r ] unix-system-call io-error ] keep [ [ unix.ffi:getgrnam_r ] unix-system-call drop ] keep
check-group-struct ; check-group-struct ;
: group-struct>group ( group-struct -- group ) : group-struct>group ( group-struct -- group )
@ -69,7 +69,7 @@ PRIVATE>
: (user-groups) ( string -- seq ) : (user-groups) ( string -- seq )
#! first group is -1337, legacy unix code #! first group is -1337, legacy unix code
-1337 unix.ffi:NGROUPS_MAX [ 4 * <byte-array> ] keep -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 ; [ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE> PRIVATE>
@ -115,10 +115,10 @@ GENERIC: set-effective-group ( obj -- )
<PRIVATE <PRIVATE
: (set-real-group) ( id -- ) : (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 -- ) : (set-effective-group) ( id -- )
[ unix.ffi:setegid ] unix-system-call io-error ; inline [ unix.ffi:setegid ] unix-system-call drop ; inline
PRIVATE> PRIVATE>

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

@ -93,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- )
<PRIVATE <PRIVATE
: (set-real-user) ( id -- ) : (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 -- ) : (set-effective-user) ( id -- )
[ unix.ffi:seteuid ] unix-system-call io-error ; inline [ unix.ffi:seteuid ] unix-system-call drop ; inline
PRIVATE> 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 safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
{ {
size_t items_read = 0; size_t items_read = 0;
do { do {
items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream); items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
} while(items_read != nitems && errno == EINTR); } 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 safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
{ {
size_t items_written = 0; size_t items_written = 0;
do { do {
items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream); items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
} while(items_written != nitems && errno == EINTR); } while(items_written != nitems && errno == EINTR);
return items_written; return items_written;
} }
int safe_fclose(FILE *stream) int safe_fclose(FILE *stream)
{ {
int ret = 0; int ret = 0;
do { do {
ret = fclose(stream); ret = fclose(stream);
} while(ret != 0 && errno == EINTR); } while(ret != 0 && errno == EINTR);
return ret; return ret;
} }
void factor_vm::primitive_fopen() void factor_vm::primitive_fopen()