X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Funix%2Funix.factor;h=2d09096451db447bb591a23b054cbf03a57afda0;hp=11792d91a72320eb80065fdcd0d7e6bd0ee12a31;hb=1542ebe47c58f140e5929772ad71f5d2ad46ec51;hpb=70b10a28d63dd11af7e956c779fcf59cf8a5af20 diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 11792d91a7..2d09096451 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -1,222 +1,92 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! 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 vocabs.loader accessors -stack-checker macros locals generalizations unix.types -io vocabs classes.struct unix.time ; +USING: accessors alien.c-types alien.syntax byte-arrays +combinators.short-circuit combinators.smart generalizations kernel +libc math sequences sequences.generalizations strings system +unix.ffi vocabs.loader ; IN: unix -CONSTANT: PROT_NONE 0 -CONSTANT: PROT_READ 1 -CONSTANT: PROT_WRITE 2 -CONSTANT: PROT_EXEC 4 - -CONSTANT: MAP_FILE 0 -CONSTANT: MAP_SHARED 1 -CONSTANT: MAP_PRIVATE 2 - -CONSTANT: SEEK_SET 0 -CONSTANT: SEEK_CUR 1 -CONSTANT: SEEK_END 2 - -: MAP_FAILED ( -- alien ) -1 ; inline - -CONSTANT: NGROUPS_MAX 16 - -CONSTANT: DT_UNKNOWN 0 -CONSTANT: DT_FIFO 1 -CONSTANT: DT_CHR 2 -CONSTANT: DT_DIR 4 -CONSTANT: DT_BLK 6 -CONSTANT: DT_REG 8 -CONSTANT: DT_LNK 10 -CONSTANT: DT_SOCK 12 -CONSTANT: DT_WHT 14 - -LIBRARY: libc - -FUNCTION: char* strerror ( int errno ) ; - -ERROR: unix-error errno message ; - -: (io-error) ( -- * ) errno dup strerror unix-error ; - -: io-error ( n -- ) 0 < [ (io-error) ] when ; - ERROR: unix-system-call-error args errno message word ; -MACRO:: unix-system-call ( quot -- ) - quot infer in>> :> n +: unix-call-failed? ( ret -- ? ) + { + [ { [ integer? ] [ 0 < ] } 1&& ] + [ not ] + } 1|| ; + +MACRO:: unix-system-call ( quot -- 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 + ] ; + +MACRO:: unix-system-call-allow-eintr ( quot -- quot ) + quot inputs :> n + quot first :> word + 0 :> ret! + [ + n ndup quot call ret! + ret unix-call-failed? [ + ! Bug #908 + ! Allow EINTR for close(2) + errno EINTR = [ + n narray + errno dup strerror + word unix-system-call-error + ] unless + ] [ + n ndrop + ret ] if ] ; HOOK: open-file os ( path flags mode -- fd ) -<< - -{ - { [ os linux? ] [ "unix.linux" require ] } - { [ os bsd? ] [ "unix.bsd" require ] } - { [ os solaris? ] [ "unix.solaris" require ] } -} cond - -"debugger" vocab [ - "unix.debugger" require -] when - ->> - -STRUCT: group - { gr_name char* } - { gr_passwd char* } - { gr_gid int } - { gr_mem char** } ; - -FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ; -FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; -FUNCTION: int chdir ( char* path ) ; -FUNCTION: int chmod ( char* path, mode_t mode ) ; -FUNCTION: int fchmod ( int fd, mode_t mode ) ; -FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; -FUNCTION: int chroot ( char* path ) ; - -FUNCTION: int close ( int fd ) ; -FUNCTION: int closedir ( DIR* dirp ) ; - -: close-file ( fd -- ) [ close ] unix-system-call drop ; - -FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; -FUNCTION: int dup2 ( int oldd, int newd ) ; -! FUNCTION: int dup ( int oldd ) ; -: _exit ( status -- * ) - #! We throw to give this a terminating stack effect. - int f "_exit" { int } alien-invoke "Exit failed" throw ; -FUNCTION: void endpwent ( ) ; -FUNCTION: int fchdir ( int fd ) ; -FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; -FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; -FUNCTION: int flock ( int fd, int operation ) ; -FUNCTION: void freeaddrinfo ( addrinfo* ai ) ; -FUNCTION: int futimes ( int id, timeval[2] times ) ; -FUNCTION: char* gai_strerror ( int ecode ) ; -FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ; -FUNCTION: char* getcwd ( char* buf, size_t size ) ; -FUNCTION: pid_t getpid ; -FUNCTION: int getdtablesize ; -FUNCTION: gid_t getegid ; -FUNCTION: uid_t geteuid ; -FUNCTION: gid_t getgid ; -FUNCTION: char* getenv ( char* name ) ; - -FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ; -FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ; -FUNCTION: passwd* getpwent ( ) ; -FUNCTION: passwd* getpwuid ( uid_t uid ) ; -FUNCTION: passwd* getpwnam ( char* login ) ; -FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ; -FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; -FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; -FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ; -FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ; - -FUNCTION: int getpriority ( int which, id_t who ) ; -FUNCTION: int setpriority ( int which, id_t who, int prio ) ; - -FUNCTION: int getrusage ( int who, rusage* r_usage ) ; - -FUNCTION: group* getgrent ; -FUNCTION: int gethostname ( char* name, int len ) ; -FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ; -FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ; -FUNCTION: uid_t getuid ; -FUNCTION: uint htonl ( uint n ) ; -FUNCTION: ushort htons ( ushort n ) ; -! FUNCTION: int issetugid ; -FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ; -FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; -FUNCTION: int listen ( int s, int backlog ) ; -FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ; -FUNCTION: int mkdir ( char* path, mode_t mode ) ; -FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ; -FUNCTION: int munmap ( void* addr, size_t len ) ; -FUNCTION: uint ntohl ( uint n ) ; -FUNCTION: ushort ntohs ( ushort n ) ; -FUNCTION: int shutdown ( int fd, int how ) ; - -FUNCTION: int open ( char* path, int flags, int prot ) ; +: close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ; -M: unix open-file [ open ] unix-system-call ; +FUNCTION: int _exit ( int status ) -FUNCTION: DIR* opendir ( char* path ) ; +M: unix open-file [ open ] unix-system-call ; -STRUCT: utimbuf - { actime time_t } - { modtime time_t } ; +: make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ; -FUNCTION: int utime ( char* path, utimbuf* buf ) ; +: truncate-file ( path n -- ) [ truncate ] unix-system-call drop ; : touch ( filename -- ) f [ utime ] unix-system-call drop ; : change-file-times ( filename access modification -- ) - utimbuf + utimbuf new swap >>modtime swap >>actime [ utime ] unix-system-call drop ; -FUNCTION: int pclose ( void* file ) ; -FUNCTION: int pipe ( int* filedes ) ; -FUNCTION: void* popen ( char* command, char* type ) ; -FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; - -FUNCTION: dirent* readdir ( DIR* dirp ) ; -FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ; -FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; - -CONSTANT: PATH_MAX 1024 +: (read-symbolic-link) ( path bufsiz -- path' ) + dup 3dup swap [ readlink ] unix-system-call + pick dupd < [ head >string 2nip ] [ + 2nip 2 * (read-symbolic-link) + ] if ; : read-symbolic-link ( path -- path ) - PATH_MAX dup [ - PATH_MAX - [ readlink ] unix-system-call - ] dip swap head-slice >string ; - -FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; -FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; -FUNCTION: int rename ( char* from, char* to ) ; -FUNCTION: int rmdir ( char* path ) ; -FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ; -FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ; -FUNCTION: int setenv ( char* name, char* value, int overwrite ) ; -FUNCTION: int unsetenv ( char* name ) ; -FUNCTION: int setegid ( gid_t egid ) ; -FUNCTION: int seteuid ( uid_t euid ) ; -FUNCTION: int setgid ( gid_t gid ) ; -FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ; -FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ; -FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; -FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ; -FUNCTION: int setuid ( uid_t uid ) ; -FUNCTION: int socket ( int domain, int type, int protocol ) ; -FUNCTION: int symlink ( char* path1, char* path2 ) ; -FUNCTION: int link ( char* path1, char* path2 ) ; -FUNCTION: int system ( char* command ) ; - -FUNCTION: int unlink ( char* path ) ; + 4096 (read-symbolic-link) ; : unlink-file ( path -- ) [ unlink ] unix-system-call drop ; -FUNCTION: int utimes ( char* path, timeval[2] times ) ; - -FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; - +{ "unix" "debugger" } "unix.debugger" require-when