cmucl-cvs

Download

cmucl-cvs@common-lisp.net

May 2015

1 participants
32 discussions

[cmucl/cmucl][master] Fix warnings about destructive functions discarding their results
by Raymond Toy 23 May '15

23 May '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 63d1896f by Raymond Toy at 2015-05-23T11:47:18Z Fix warnings about destructive functions discarding their results (sort an delete) - - - - - 2 changed files: - src/hemlock/bit-screen.lisp - src/hemlock/eval-server.lisp Changes: ===================================== src/hemlock/bit-screen.lisp ===================================== --- a/src/hemlock/bit-screen.lisp +++ b/src/hemlock/bit-screen.lisp @@ -1581,10 +1581,11 @@ ;; Probably shoulds insertion sort them, but I'm lame. ;; (xlib:with-state (xparent) - (sort affected-windows #'< - :key #'(lambda (window) - (xlib:drawable-y - (bitmap-hunk-xwindow (window-hunk window)))))) + (setf affected-windows + (sort affected-windows #'< + :key #'(lambda (window) + (xlib:drawable-y + (bitmap-hunk-xwindow (window-hunk window))))))) (let ((start 0)) (declare (fixnum start)) (do ((windows affected-windows (cdr windows))) ===================================== src/hemlock/eval-server.lisp ===================================== --- a/src/hemlock/eval-server.lisp +++ b/src/hemlock/eval-server.lisp @@ -223,7 +223,7 @@ (find-if-not #'null array :from-end t :end current))))) - (delete nil array) + (setf array (delete nil array)) (setf (server-info-error-index server) (position current array)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/63d1896f5c0d28371d9a7356d…

1 0

[cmucl/cmucl][master] 61 commits: First cut at simplifying unix.lisp.
by Raymond Toy 19 May '15

19 May '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 9245bc06 by Raymond Toy at 2014-11-15T17:04:49Z First cut at simplifying unix.lisp. * Moved original unix.lisp to src/contrib/unix/unix.lisp. * Copied just enough from unix.lisp to compile and load the first build. (Second build doesn't yet work.) * Trimmed exports.lisp to the current UNIX symbols. This is currently for Darwin/x86. Nothing else is supported yet. - - - - - fdc539f9 by Raymond Toy at 2014-11-16T09:22:39Z Add more stuff to unix.lisp. Not yet enough to compile cmucl. - - - - - fe8f398c by Raymond Toy at 2014-11-16T14:49:08Z Add more unix stuff. * asdf wants unix-rmdir * Add some missing structs. - - - - - 836d21bf by Raymond Toy at 2014-11-16T20:20:04Z Add more unix functions, for motif and hemlock. - - - - - a71198af by Raymond Toy at 2014-11-16T20:20:23Z Fix indentation. - - - - - 11ecbb80 by Raymond Toy at 2014-11-16T21:14:42Z More support for hemlock. - - - - - db12154d by Raymond Toy at 2014-11-18T21:35:46Z Add UNIX-SYMLINK. This allows the testsuite to run. Tests behave as expected. - - - - - 5efddf51 by Raymond Toy at 2014-12-02T19:57:34Z Merge branch 'master' into rtoy-unix-core - - - - - 31cb9cfe by Raymond Toy at 2014-12-02T19:58:45Z Fix some silly typos! - - - - - 822beed8 by Raymond Toy at 2014-12-02T20:18:57Z Try to collect some of the unix export names by file in which they are used. Mostly as information on who uses what, but otherwise not necessary. - - - - - 2a6b55bb by Raymond Toy at 2015-04-16T19:04:59Z Merge branch 'master' into rtoy-unix-core - - - - - d3f0167d by Raymond Toy at 2015-04-18T16:39:26Z Put back a comment. - - - - - 852b35a7 by Raymond Toy at 2015-04-18T16:40:05Z Remove items that are already in code/unix.lisp. - - - - - 17c7bba5 by Raymond Toy at 2015-04-18T16:42:53Z Add a unix module so users can (require :unix) to get the rest of the unix package functions. This is for backward copmatibility. - - - - - b81c7be3 by Raymond Toy at 2015-04-21T19:55:56Z %name->file and %file->name macros need to be defined for contrib/unix/unix.lisp. Why are these macros anyway? Can't they be functions? - - - - - 4f53f883 by Raymond Toy at 2015-04-21T19:57:45Z Install unix.lisp along with asdf and defsystem. - - - - - 77a830ba by Raymond Toy at 2015-04-21T20:43:58Z Compile unix.lisp like we do for asdf and defsystem. - - - - - f2601215 by Raymond Toy at 2015-04-21T20:49:44Z Regenerated. - - - - - 743c80c8 by Raymond Toy at 2015-05-03T22:46:09Z Move unix-glibc2.lisp to contrib/unix. - - - - - d6b8e188 by Raymond Toy at 2015-05-03T22:48:18Z Small version of unix-glibc2.lisp that will compile lisp. This is enough to get do a full build of cmucl, but not motif. More work needed; I didn't yet check build logs for warnings or errors. - - - - - 3a837db1 by Raymond Toy at 2015-05-06T21:01:31Z Add support for hemlock. With these additions, hemlock builds now and runs. (I only tested that hemlock starts and that text can be entered.) - - - - - 3191f538 by Raymond Toy at 2015-05-06T21:07:00Z For linux, Load unix-glibc2.lisp instead of unix.lisp. - - - - - 19997c21 by Raymond Toy at 2015-05-06T22:03:22Z Compile the appropriate unix contrib file. - - - - - e549b338 by Raymond Toy at 2015-05-07T22:39:30Z Don't pass in the command line args to lisp when building asdf and friends. The command line args aren't relevant to lisp. - - - - - 6b33a1f0 by Raymond Toy at 2015-05-07T22:43:06Z Install the appropriate compiled unix file. - - - - - d76358f8 by Raymond Toy at 2015-05-08T18:35:30Z Split the UNIX exports into linux and non-linux parts. For the non-linux part, add all of the other symbols that are currently exported from the UNIX package. - - - - - 1fe89808 by Raymond Toy at 2015-05-08T21:34:31Z Remove exports. - - - - - 1b5ef8a9 by Raymond Toy at 2015-05-08T21:34:52Z Fix typo in reader conditional. Should be +linux. - - - - - 6abb21d8 by Raymond Toy at 2015-05-08T21:38:14Z Export other symbols from the UNIX package. - - - - - 4de937f5 by Raymond Toy at 2015-05-09T14:13:10Z Clean up UNIX exports, putting common items together. - - - - - 16f35f1a by Raymond Toy at 2015-05-09T15:15:11Z Add UNIX functions that were previously missed. - - - - - c5dfebd6 by Raymond Toy at 2015-05-09T15:19:26Z Merge branch 'master' into rtoy-unix-core - - - - - 1bc6485e by Raymond Toy at 2015-05-10T09:23:45Z fchmod, creat, and utimes are in both unix and unix-glibc2. - - - - - 494e09f2 by Raymond Toy at 2015-05-10T09:28:27Z Need unix-symlink in unix-glibc2 for tests. - - - - - 8a9a7ae2 by Raymond Toy at 2015-05-10T09:43:23Z unix-glibc2 needs unix-munmap. prot_read is available for both. - - - - - f957ba84 by Raymond Toy at 2015-05-10T09:58:38Z Both unix.lisp and unix-glibc2.lisp have unix-rmdir. - - - - - 9a9c5377 by Raymond Toy at 2015-05-10T10:29:34Z Add a few comments. - - - - - b7436b55 by Raymond Toy at 2015-05-10T10:29:50Z Remove the things that are already in code/unix-glibc2. - - - - - f5368940 by Raymond Toy at 2015-05-10T10:47:55Z Oops. Forgot to remove mmap stuff for contrib/unix/unix-glibc2.lisp. - - - - - eb4a83b4 by Raymond Toy at 2015-05-10T14:16:20Z Load up the unix fasl file using compile-file-pathname. - - - - - 1f888009 by Raymond Toy at 2015-05-10T14:23:23Z Remove set -x that was accidentally left in. - - - - - b3b95e25 by Raymond Toy at 2015-05-10T14:33:06Z Gather the other common symbols into one place, and leave conditionals for the ones that differ. - - - - - 13513a76 by Raymond Toy at 2015-05-10T15:56:35Z Remove sgttyb from unix exports; run-program doesn't use it on linux. - - - - - be68140d by Raymond Toy at 2015-05-11T19:34:06Z Add terminal-speeds to unix-glibc2.lisp. - - - - - bff46014 by Raymond Toy at 2015-05-11T19:34:39Z Export FIONREAD and TERMINAL-SPEEDS. Bot unix and unix-glibc2 have these. - - - - - 30055476 by Raymond Toy at 2015-05-11T19:44:18Z Remove terminal-speeds since it's in code/unix-glibc2.lisp now. - - - - - e79435f6 by Raymond Toy at 2015-05-13T20:29:36Z Add support for solaris/sparc. Includes * support for large files * unix-times * unix-get-minutes-west and friends * unix-uname - - - - - dd85f37a by Raymond Toy at 2015-05-13T21:42:13Z Solaris needs u-int64-t. - - - - - 56dac608 by Raymond Toy at 2015-05-13T21:44:15Z unix-uname needs struct utsname. - - - - - f4d7036b by Raymond Toy at 2015-05-16T13:50:01Z Add stat and friends for solaris. - - - - - 72afb878 by Raymond Toy at 2015-05-16T21:33:11Z Add timestruc-t for solaris. Needed by stat and stat64. - - - - - 42675559 by Raymond Toy at 2015-05-16T21:59:29Z Export unix-uname. Used on linux and solaris. - - - - - c076d550 by Raymond Toy at 2015-05-16T22:09:57Z Support for netbsd. From Robert Swindells. - - - - - a08b9be0 by Raymond Toy at 2015-05-16T22:16:15Z Remove utsname and unix-uname. - - - - - 68001f49 by Raymond Toy at 2015-05-17T07:45:18Z Add some comments from unix/unix.lisp. - - - - - a85043ac by Raymond Toy at 2015-05-17T07:45:34Z Remove items that are in code/unix.lisp - - - - - 0f59b9a3 by Raymond Toy at 2015-05-17T08:00:51Z Regenerated. - - - - - e46eaa11 by Raymond Toy at 2015-05-17T08:15:28Z Regenerated. - - - - - 7f683946 by Raymond Toy at 2015-05-17T17:04:37Z Add exported symbols for solaris unix.lisp. - - - - - 7be5c100 by Raymond Toy at 2015-05-17T17:57:44Z More exported symbols for solaris. - - - - - 0e3ab8bd by Raymond Toy at 2015-05-18T18:52:30Z Make sure the target directory exists before compiling the unix contrib. - - - - - 11 changed files: - bin/build.sh - bin/make-main-dist.sh - src/code/exports.lisp - src/code/module.lisp - src/code/unix-glibc2.lisp - src/code/unix.lisp - + src/contrib/load-unix.lisp - + src/contrib/unix/unix-glibc2.lisp - + src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-unix-glibc2.pot - src/i18n/locale/cmucl-unix.pot Changes: ===================================== bin/build.sh ===================================== --- a/bin/build.sh +++ b/bin/build.sh @@ -251,7 +251,7 @@ buildit # Asdf and friends are part of the base install, so we need to build # them now. -$TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3 +$TARGET/lisp/lisp -noinit -nositeinit -batch << EOF || exit 3 (in-package :cl-user) (setf (ext:search-list "target:") '("$TARGET/" "src/")) @@ -260,6 +260,12 @@ $TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3 (compile-file "modules:asdf/asdf") (compile-file "modules:defsystem/defsystem") +(intl::install) +(ext:without-package-locks + (let ((path #-linux "modules:unix/unix" + #+linux "modules:unix/unix-glibc2")) + (ensure-directories-exist (compile-file-pathname path)) + (compile-file path))) EOF ===================================== bin/make-main-dist.sh ===================================== --- a/bin/make-main-dist.sh +++ b/bin/make-main-dist.sh @@ -133,6 +133,14 @@ do install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f done +case `uname -s` in + Linux*) UCONTRIB="unix-glibc2" ;; + *) UCONTRIB="unix" ;; +esac + +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/unix +install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/lib/cmucl/lib/contrib/unix + # Copy the source files for asdf and defsystem for f in `(cd src; find contrib/asdf contrib/defsystem -type f -print | grep -v CVS)` do ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -196,200 +196,349 @@ "NEGATE-BIGNUM" "SUBTRACT-BIGNUM")) (defpackage "UNIX" - (:export "CADDR-T" "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" - "DADDR-T" "DEV-T" "DIRECT" "EXECGRP" "EXECOTH" "EXECOWN" "F-DUPFD" - "F-GETFD" "F-GETFL" "F-GETOWN" "F-SETFD" "F-SETFL" "F-SETOWN" - "FSFILCNT-T" "FSBLKCNT-T" "BLKCNT-T" - "FAPPEND" "FASYNC" "FCREAT" "FEXCL" "FIONREAD" "FNDELAY" "FTRUNC" - "F_TEST" "F_TLOCK" "UNIX-LOCKF" "F_LOCK" "F_ULOCK" - "F_OK" "GET-UNIX-ERROR-MSG" "GID-T" "INO-T" "IT-INTERVAL" - "IT-VALUE" "ITIMERVAL" "UNIX-SETITIMER" "UNIX-GETITIMER" - "BLKCNT-T" "FSBLKCNT-T" "FSFILCNT-T" - "F_TEST" "F_TLOCK" "F_LOCK" "F_ULOCK" "UNIX-LOCKF" - "PROT_READ" "PROT_WRITE" "PROT_EXEC" "PROT_NONE" - "MAP_SHARED" "MAP_PRIVATE" "MAP_FIXED" "MAP_ANONYMOUS" - "MS_ASYNC" "MS_SYNC" "MS_INVALIDATE" - "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" "UNIX-MPROTECT" - "KBDCGET" "KBDCRESET" "KBDCRST" "KBDCSET" - "KBDCSSTD" "KBDGCLICK" "KBDSCLICK" "KBDSGET" "L_INCR" "L_SET" - "L_XTND" "OFF-T" "O_APPEND" "O_CREAT" "O_EXCL" "O_RDONLY" "O_RDWR" - "O_TRUNC" "O_WRONLY" "READGRP" "READOTH" "READOWN" "RLIM-CUR" - "RLIM-MAX" "RLIMIT" "RU-IDRSS" "RU-INBLOCK" "RU-ISRSS" "RU-IXRSS" - "RU-MAJFLT" "RU-MAXRSS" "RU-MINFLT" "RU-MSGRCV" "RU-MSGSND" - "RU-NIVCSW" "RU-NSIGNALS" "RU-NSWAP" "RU-NVCSW" "RU-OUBLOCK" - "RU-STIME" "RU-UTIME" "RUSAGE_CHILDREN" "RUSAGE_SELF" "RUSEAGE" - "R_OK" "S-IEXEC" "S-IFBLK" "S-IFCHR" "S-IFDIR" "S-IFLNK" "S-IFMT" - "S-IFREG" "S-IFSOCK" "S-IREAD" "S-ISGID" "S-ISUID" "S-ISVTX" - "S-IWRITE" "SAVETEXT" "SC-MASK" "SC-ONSTACK" "SC-PC" "SETGIDEXEC" - "SETUIDEXEC" "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL" - "SG-OSPEED" "SGTTYB" "SIGCONTEXT" "SIZE-T" "ST-ATIME" "ST-BLKSIZE" - "ST-BLOCKS" "ST-CTIME" "ST-DEV" "ST-GID" "ST-MODE" "ST-MTIME" - "ST-NLINK" "ST-RDEV" "ST-SIZE" "ST-UID" "STAT" "SWBLK-T" "T-BRKC" - "T-DSUSPC" "T-EOFC" "T-FLUSHC" "T-INTRC" "T-LNEXTC" "T-QUITC" - "T-RPRNTC" "T-STARTC" "T-STOPC" "T-SUSPC" "T-WERASC" "TCHARS" - "TERMINAL-SPEEDS" "TIME-T" "TIMEVAL" "TIMEZONE" "TIOCFLUSH" - "TIOCGETC" "TIOCGETP" "TIOCGLTC" "TIOCGPGRP" "TIOCGWINSZ" - "TIOCNOTTY" "TIOCSETC" "TIOCSETP" "TIOCSLTC" "TIOCSPGRP" - "TIOCSWINSZ" "TTY-CBREAK" "TTY-CRMOD" "TTY-LCASE" - "TTY-RAW" "TTY-TANDEM" "TV-SEC" "TV-USEC" "TZ-DSTTIME" - "TZ-MINUTESWEST" "UID-T" "UNIX-ACCEPT" "UNIX-ACCESS" "UNIX-BIND" - "UNIX-CHDIR" "UNIX-CHMOD" "UNIX-CHOWN" "UNIX-CLOSE" "UNIX-CONNECT" - "UNIX-CREAT" "UNIX-CURRENT-DIRECTORY" "UNIX-DUP" "UNIX-DUP2" - "UNIX-ERRNO" "UNIX-EXECVE" "UNIX-EXIT" "UNIX-FCHMOD" "UNIX-FCHOWN" - "UNIX-FCNTL" "UNIX-FD" "UNIX-FILE-MODE" "UNIX-FORK" "UNIX-FSTAT" - "UNIX-FSYNC" "UNIX-FTRUNCATE" "UNIX-GETDTABLESIZE" "UNIX-GETEGID" - "UNIX-GETGID" "UNIX-GETHOSTID" "UNIX-GETHOSTNAME" - "UNIX-GETPAGESIZE" "UNIX-GETPEERNAME" "UNIX-GETPGRP" - "UNIX-GETPID" "UNIX-GETPPID" "UNIX-GETRUSAGE" "UNIX-GETSOCKNAME" - "UNIX-GETSOCKOPT" "UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID" - "UNIX-IOCTL" "UNIX-ISATTY" "UNIX-LINK" "UNIX-LISTEN" "UNIX-LSEEK" - "UNIX-LSTAT" "UNIX-MKDIR" "UNIX-OPEN" "UNIX-PATHNAME" "UNIX-PID" - "UNIX-PIPE" "UNIX-READ" "UNIX-READLINK" "UNIX-RECV" "UNIX-RENAME" - "UNIX-RMDIR" "UNIX-SCHED-YIELD" "UNIX-SELECT" - "UNIX-SEND" "UNIX-SETPGID" "UNIX-SETPGRP" - "UNIX-SETREGID" "UNIX-SETREUID" "UNIX-SETSOCKOPT" "UNIX-SOCKET" - "UNIX-SETUID" "UNIX-SETGID" - "UNIX-STAT" "UNIX-SYMLINK" "UNIX-SYNC" - "UNIX-TIMES" "UNIX-TRUNCATE" "UNIX-TTYNAME" "UNIX-UID" - "UNIX-UNAME" "UNIX-UNLINK" "UNIX-UTIMES" "UNIX-WRITE" "WINSIZE" - "WRITEGRP" "WRITEOTH" "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL" - "WS-YPIXEL" "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO" - "SIGEMSG" "SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2" - "EALREADY" "SIGPIPE" "EACCES" "SIGXCPU" "EOPNOTSUPP" - "SIGFPE" "SIGHUP" "ENOTSOCK" "OPEN-DIR" "SIGMASK" "EINTR" - "SIGCONT" "UNIX-RESOLVE-LINKS" "SIGKILL" "EMSGSIZE" "ERANGE" - "EPROTOTYPE" "UNIX-SIGNAL-NUMBER" "EPFNOSUPPORT" "SIGILL" - "EDOM" "UNIX-SIGPAUSE" "EDQUOT" "FD-SETSIZE" "SIGTSTP" - "EAFNOSUPPORT" "TCGETPGRP" "EMFILE" "ECONNRESET" - "EADDRNOTAVAIL" "SIGALRM" "ENETDOWN" "EVICEOP" - "UNIX-FAST-GETRUSAGE" "EPERM" "SIGINT" "EXDEV" "EDEADLK" - "ENOSPC" "ECONNREFUSED" "SIGWINCH" "ENOPROTOOPT" "ESRCH" - "EUSERS" "SIGVTALRM" "ENOTCONN" "ESUCCESS" "EPIPE" - "UNIX-SIMPLIFY-PATHNAME" "EISCONN" "FD-ISSET" "SIGMSG" - "ESHUTDOWN" "EBUSY" "SIGTERM" "ENAMETOOLONG" "EMLINK" - "EADDRINUSE" "SIGBUS" "ERESTART" "TTY-PROCESS-GROUP" - "UNIX-SIGNAL-NAME" "ETIMEDOUT" "ECHILD" "EFBIG" "SIGTRAP" - "UNIX-KILLPG" "ENOTBLK" "SIGIOT" "SIGUSR1" "ECONNABORTED" - "EHOSTUNREACH" "EBADF" "EINVAL" "FD-SET" "CLOSE-DIR" "EISDIR" - "SIGTTIN" "UNIX-KILL" "ENOTDIR" "EHOSTDOWN" "E2BIG" "ESPIPE" - "UNIX-FAST-SELECT" "ENXIO" "ENOTTY" "ELOOP" "LTCHARS" - "UNIX-SIGNAL-DESCRIPTION" "SIGXFSZ" "EINPROGRESS" "ENOENT" - "EPROTONOSUPPORT" "UNIX-SIGBLOCK" "SIGIO" "ENOMEM" "SIGEMT" - "EFAULT" "ENODEV" "EIO" "EVICEERR" "ETXTBSY" "EWOULDBLOCK" - "EAGAIN" "EDESTADDRREQ" "ENOEXEC" "ENETUNREACH" "ENOTEMPTY" - "READ-DIR" "UNIX-MAYBE-PREPEND-CURRENT-DIRECTORY" "ENFILE" - "SIGTTOU" "EEXIST" "SIGPROF" "SIGSTOP" "ENETRESET" "SIGURG" - "ENOBUFS" "EPROCLIM" "EROFS" "ETOOMANYREFS" "UNIX-FILE-KIND" - "ELOCAL" "UNIX-SIGSETMASK" "EREMOTE" "ESOCKTNOSUPPORT" - "TIOCSIGSEND" "SIGWAITING" "SIGABRT" - "C-IFLAG" "UNIX-TCGETATTR" "C-LFLAG" "C-OFLAG" "C-CFLAG" - "TCSAFLUSH" "C-CC" "C-ISPEED" "C-OSPEED" "SIOCSPGRP" "TERMIOS" - "UNIX-TCSETATTR" "O_NDELAY" "O_NOCTTY" - "O_NONBLOCK" "TCSANOW" "TCSADRAIN" "TCIFLUSH" "TCOFLUSH" - "TCIOFLUSH" "UNIX-CFGETOSPEED" "UNIX-CFSETOSPEED" - "UNIX-CFGETISPEED" "UNIX-CFSETISPEED" - "TTY-IGNBRK" "TTY-BRKINT" "TTY-IGNPAR" "TTY-PARMRK" - "TTY-INPCK" "TTY-ISTRIP" "TTY-INLCR" "TTY-IGNCR" "TTY-ICRNL" - "TTY-IUCLC" "TTY-IXON" "TTY-IXANY" "TTY-IXOFF" "TTY-IENQAK" - "TTY-IMAXBEL" "TTY-OPOST" "TTY-OLCUC" "TTY-ONLCR" "TTY-OCRNL" - "TTY-ONOCR" "TTY-ONLRET" "TTY-OFILL" "TTY-OFDEL" "TTY-ISIG" - "TTY-ICANON" "TTY-XCASE" "TTY-ECHO" "TTY-ECHOE" "TTY-ECHOK" - "TTY-ECHONL" "TTY-NOFLSH" "TTY-IEXTEN" "TTY-TOSTOP" "TTY-ECHOCTL" - "TTY-ECHOPRT" "TTY-ECHOKE" "TTY-DEFECHO" "TTY-FLUSHO" - "TTY-PENDIN" "TTY-CSTOPB" "TTY-CREAD" "TTY-PARENB" "TTY-PARODD" - "TTY-HUPCL" "TTY-CLOCAL" "RCV1EN" "XMT1EN" "TTY-LOBLK" "VINTR" - "VQUIT" "VERASE" "VKILL" "VEOF" "VEOL" "VEOL2" "TTY-CBAUD" - "TTY-CSIZE" "TTY-CS5" "TTY-CS6" "TTY-CS7" "TTY-CS8" "VMIN" "VTIME" - "VSUSP" "VSTART" "VSTOP" "VDSUSP" "UNIX-TCSENDBREAK" - "UNIX-TCDRAIN" "UNIX-TCFLUSH" "UNIX-TCFLOW" - "UNIX-GETENV" "UNIX-SETENV" "UNIX-PUTENV" "UNIX-UNSETENV" - - #+(or svr4 bsd linux) "O_NDELAY" - "CHECK" - - "UNIX-RECVFROM" "UNIX-SENDTO" "UNIX-SHUTDOWN" - "UNIX-OPENPTY") - #+(or svr4 linux) - (:export "EADDRINUSE" "EADDRNOTAVAIL" "EADV" "EAFNOSUPPORT" - "EALREADY" "EBADE" "EBADFD" "EBADMSG" "EBADR" "EBADRQC" - "EBADSLT" "EBFONT" #+svr4 "ECANCELED" "ECHRNG" "ECOMM" - "ECONNABORTED" "ECONNREFUSED" "ECONNRESET" "EDEADLK" - "EDEADLOCK" "EDESTADDRREQ" #+linux "EDOTDOT" #+linux "EDQUOT" - "EHOSTDOWN" "EHOSTUNREACH" "EIDRM" "EILSEQ" "EINPROGRESS" - "EISCONN" #+linux "EISNAM" "EL2HLT" "EL2NSYNC" "EL3HLT" - "EL3RST" "ELIBACC" "ELIBBAD" "ELIBEXEC" "ELIBMAX" "ELIBSCN" - "ELNRNG" "ELOOP" "EMSGSIZE" "EMULTIHOP" "ENAMETOOLONG" - #+linux "ENAVAIL" "ENETDOWN" "ENETRESET" "ENETUNREACH" "ENOANO" - "ENOBUFS" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" - "ENOPKG" "ENOPROTOOPT" "ENOSR" "ENOSTR" "ENOSYS" "ENOTCONN" - "ENOTEMPTY" #+linux "ENOTNAM" "ENOTSOCK" #+svr4 "ENOTSUP" - "ENOTUNIQ" "EOPNOTSUPP" "EOVERFLOW" "EPFNOSUPPORT" "EPROTO" - "EPROTONOSUPPORT" "EPROTOTYPE" "EREMCHG" "EREMOTE" - #+linux "EREMOTEIO" "ERESTART" "ESHUTDOWN" "ESOCKTNOSUPPORT" - "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" "ETIMEDOUT" "ETOOMANYREFS" - #+linux "EUCLEAN" "EUNATCH" "EUSERS" "EWOULDBLOCK" "EXFULL" - "UTSNAME" - #+linux "SIGSTKFLT" - "UNIX-GETPWNAM" "UNIX-GETPWUID" "UNIX-GETGRNAM" "UNIX-GETGRGID" - "USER-INFO" "USER-INFO-NAME" "USER-INFO-PASSWORD" "USER-INFO-UID" - "USER-INFO-GID" "USER-INFO-GECOS" "USER-INFO-DIR" "USER-INFO-SHELL" - "GROUP-INFO" "GROUP-INFO-NAME" "GROUP-INFO-GID" "GROUP-INFO-MEMBERS") - #+freebsd - (:export "GROUP-INFO" - "GROUP-INFO-GID" - "GROUP-INFO-MEMBERS" - "GROUP-INFO-NAME" - "UNIX-GETGRGID" - "UNIX-GETGRNAM" - "UNIX-GETPWNAM" - "UNIX-GETPWUID" - "USER-INFO" - "USER-INFO-DIR" - "USER-INFO-GECOS" - "USER-INFO-GID" - "USER-INFO-NAME" - "USER-INFO-PASSWORD" - "USER-INFO-SHELL" - "USER-INFO-UID") - #+ppc - (:export "UNIX-GETPWUID" - "USER-INFO" - "USER-INFO-SHELL" - "USER-INFO-GECOS" - "UNIX-GETPWNAM" - "GROUP-INFO-NAME" - "GROUP-INFO-MEMBERS" + (:export "UNIX-CURRENT-DIRECTORY" + "UNIX-OPEN" + "UNIX-READ" + "UNIX-WRITE" + "UNIX-GETPAGESIZE" + "UNIX-ERRNO" + "UNIX-MAYBE-PREPEND-CURRENT-DIRECTORY" + "UNIX-RESOLVE-LINKS" + "UNIX-SIMPLIFY-PATHNAME" + "UNIX-CLOSE" + "UNIX-STAT" + "UNIX-LSTAT" + "UNIX-FSTAT" + "UNIX-GETHOSTNAME" + "UNIX-LSEEK" + "UNIX-EXIT" + "UNIX-CHDIR" + "UNIX-ACCESS" + "UNIX-DUP" + "UNIX-CHMOD" + "UNIX-READLINK" + "UNIX-RENAME" + "UNIX-SELECT" + "UNIX-FAST-GETRUSAGE" + "UNIX-GETRUSAGE" + "UNIX-GETTIMEOFDAY" + "UNIX-ISATTY" + "UNIX-MKDIR" + "UNIX-RMDIR" + "UNIX-UNLINK" + "TIMEZONE" + "TIMEVAL" + "SIZE-T" + "OFF-T" + "INO-T" + "DEV-T" + "TIME-T" "USER-INFO-NAME" - "USER-INFO-PASSWORD" - "GROUP-INFO" - "USER-INFO-UID" - "USER-INFO-DIR" - "USER-INFO-GID" - "GROUP-INFO-GID" - "UNIX-GETGRNAM" - "UNIX-GETGRGID") - #+(and solaris svr4) - (:export "UNIX-SYSINFO" - "SI-SYSNAME" "SI-HOSTNAME" "SI-RELEASE" "SI-VERSION" "SI-MACHINE" - "SI-ARCHITECTURE" "SI-HW-SERIAL" "SI-HW-PROVIDER" "SI-SRPC-DOMAIN" - "SI-PLATFORM" "SI-ISALIST" "SI-DHCP-CACHE" - - "UNIX-GETRLIMIT" - "RLIMIT_CPU" "RLIMIT_FSIZE" "RLIMIT_DATA" "RLIMIT_STACK" "RLIMIT_CORE" - "RLIMIT_AS" "RLIMIT_VMEM" "RLIMIT_NOFILE") - ;; Should this be conditionalized on glibc2? These come from - ;; unix-glibc2.lisp. - #+(and darwin x86) - (:export "GROUP-INFO" "UNIX-GETPWUID" "USER-INFO-DIR" "UNIX-GETPWNAM" - "USER-INFO-SHELL" "USER-INFO-PASSWORD" "USER-INFO-UID" - "GROUP-INFO-GID" "USER-INFO" "USER-INFO-NAME" "USER-INFO-GID" - "GROUP-INFO-MEMBERS" "UNIX-GETGRGID" "USER-INFO-GECOS" - "GROUP-INFO-NAME" - "UNIX-GETGRNAM" - - "UNIX-GETRLIMIT" - "RLIMIT_CPU" "RLIMIT_FSIZE" "RLIMIT_DATA" "RLIMIT_STACK" "RLIMIT_CORE" - "RLIMIT_AS" "RLIMIT_RSS" "RLIMIT_MEMLOCK" "RLIMIT_NPROC" "RLIMIT_NOFILE")) + "INT64-T" + "MODE-T" + "UNIX-FAST-SELECT" + "UNIX-PIPE" + "UNIX-GETPID" + "UNIX-GETHOSTID" + "UNIX-UID" + "UNIX-GID" + "GET-UNIX-ERROR-MSG" + "WINSIZE" + "TIMEVAL" + "CLOSE-DIR" + "OPEN-DIR" + "READ-DIR" + + ;; linux-os, sunos-os. + "UNIX-UNAME" + + ;; filesys.lisp + "UNIX-GETPWUID" + + ;; multi-proc.lisp + "UNIX-SETITIMER" + + ;; run-program.lisp + "UNIX-TTYNAME" + "UNIX-IOCTL" + "UNIX-OPENPTY" + + ;; alien-callback.lisp + "UNIX-MPROTECT" + + ;; internet.lisp + "UNIX-SOCKET" + "UNIX-CONNECT" + "UNIX-BIND" + "UNIX-LISTEN" + "UNIX-ACCEPT" + "UNIX-GETSOCKOPT" + "UNIX-SETSOCKOPT" + "UNIX-GETPEERNAME" + "UNIX-GETSOCKNAME" + "UNIX-RECV" + "UNIX-SEND" + "UNIX-RECVFROM" + "UNIX-SENDTO" + "UNIX-SHUTDOWN" + "UNIX-FCNTL" + + ;; serve-event.lisp + "FD-SETSIZE" + "FD-ISSET" + "FD-CLR" + + ;; Simple streams + "PROT_READ" + "UNIX-MMAP" + "UNIX-MUNMAP" + "UNIX-MSYNC" + + ;; Motif + "UNIX-GETUIO" + + ;; Hemlock + "UNIX-CFGETOSPEED" + "TERMIOS" + "UNIX-TCGETATTR" + "UNIX-TCSETATTR" + "UNIX-FCHMOD" + "UNIX-CREAT" + "UNIX-UTIMES" + + ;; Tests + "UNIX-SYMLINK" + + ;; Other symbols from structures, etc. + "C-CC" "C-CFLAG" "C-IFLAG" "C-ISPEED" "C-LFLAG" "C-OFLAG" "C-OSPEED" + "CHECK" "D-NAME" "D-RECLEN" "E2BIG" "EACCES" "EADDRINUSE" "EADDRNOTAVAIL" + "EAFNOSUPPORT" "EAGAIN" "EALREADY" "EBADF" "EBUSY" "ECHILD" + "ECONNABORTED" "ECONNREFUSED" "ECONNRESET" "EDEADLK" "EDESTADDRREQ" + "EDOM" "EDQUOT" "EEXIST" "EFAULT" "EFBIG" "EHOSTDOWN" "EHOSTUNREACH" + "EINPROGRESS" "EINTR" "EINVAL" "EIO" "EISCONN" "EISDIR" "ELOOP" "EMFILE" + "EMLINK" "EMSGSIZE" "ENAMETOOLONG" "ENETDOWN" "ENETRESET" "ENETUNREACH" + "ENFILE" "ENOBUFS" "ENODEV" "ENOENT" "ENOEXEC" "ENOMEM" "ENOPROTOOPT" + "ENOSPC" "ENOTBLK" "ENOTCONN" "ENOTDIR" "ENOTEMPTY" "ENOTSOCK" "ENOTTY" + "ENXIO" "EOPNOTSUPP" "EPERM" "EPFNOSUPPORT" "EPIPE" "EPROTONOSUPPORT" + "EPROTOTYPE" "ERANGE" "EREMOTE" "EROFS" "ESHUTDOWN" "ESOCKTNOSUPPORT" + "ESPIPE" "ESRCH" "ESUCCESS" "ETIMEDOUT" "ETOOMANYREFS" "ETXTBSY" "EUSERS" + "EWOULDBLOCK" "EXDEV" "F-GETFL" "F-GETOWN" "F-SETFL" "F-SETOWN" "FAPPEND" + "FASYNC" "FD-SET" "FD-ZERO" "FNDELAY" "F_OK" "GID-T" "IT-INTERVAL" + "IT-VALUE" "ITIMERVAL" "L_INCR" "L_SET" "L_XTND" "MAP_ANONYMOUS" + "MAP_FIXED" "MAP_PRIVATE" "MAP_SHARED" "MS_ASYNC" "MS_INVALIDATE" + "MS_SYNC" "O_APPEND" "O_CREAT" "O_EXCL" "O_NDELAY" "O_NONBLOCK" + "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PROT_EXEC" "PROT_NONE" + "PROT_WRITE" "RU-IDRSS" "RU-INBLOCK" "RU-ISRSS" "RU-IXRSS" "RU-MAJFLT" + "RU-MAXRSS" "RU-MINFLT" "RU-MSGRCV" "RU-MSGSND" "RU-NIVCSW" "RU-NSIGNALS" + "RU-NSWAP" "RU-NVCSW" "RU-OUBLOCK" "RU-STIME" "RU-UTIME" + "RUSAGE_CHILDREN" "RUSAGE_SELF" "R_OK" "S-IFBLK" "S-IFCHR" "S-IFDIR" + "S-IFLNK" "S-IFMT" "S-IFREG" "S-IFSOCK" "SIGABRT" "SIGALRM" "SIGBUS" + "SIGCHLD" "SIGCONT" "SIGCONTEXT" "SIGFPE" "SIGHUP" "SIGILL" "SIGINT" + "SIGIO" "SIGIOT" "SIGKILL" "SIGMASK" "SIGPIPE" "SIGPROF" "SIGQUIT" + "SIGSEGV" "SIGSTOP" "SIGTERM" "SIGTRAP" "SIGTSTP" "SIGTTIN" "SIGTTOU" + "SIGURG" "SIGUSR1" "SIGUSR2" "SIGVTALRM" "SIGWINCH" "SIGXCPU" "SIGXFSZ" + "ST-ATIME" "ST-BLKSIZE" "ST-BLOCKS" "ST-CTIME" "ST-DEV" "ST-GID" + "ST-MODE" "ST-MTIME" "ST-NLINK" "ST-RDEV" "ST-SIZE" "ST-UID" "STAT" + "TCSADRAIN" "TCSAFLUSH" "TCSANOW" "TIOCGPGRP" "TIOCGWINSZ" "TIOCNOTTY" + "TIOCSPGRP" "TIOCSWINSZ" "TTY-BRKINT" "TTY-ECHO" "TTY-ECHOCTL" + "TTY-ECHOE" "TTY-ECHOK" "TTY-ECHOKE" "TTY-ECHONL" "TTY-ECHOPRT" + "TTY-FLUSHO" "TTY-ICANON" "TTY-ICRNL" "TTY-IEXTEN" "TTY-IGNBRK" + "TTY-IGNCR" "TTY-IGNPAR" "TTY-IMAXBEL" "TTY-INLCR" "TTY-INPCK" "TTY-ISIG" + "TTY-ISTRIP" "TTY-IXANY" "TTY-IXOFF" "TTY-IXON" "TTY-NOFLSH" "TTY-ONLCR" + "TTY-OPOST" "TTY-PARMRK" "TTY-PENDIN" "TTY-TOSTOP" "TV-SEC" "TV-USEC" + "TZ-DSTTIME" "TZ-MINUTESWEST" "UID-T" "UNIX-FD" "UNIX-FILE-KIND" + "UNIX-FILE-MODE" "UNIX-GETUID" "UNIX-KILL" "UNIX-KILLPG" "UNIX-PATHNAME" + "UNIX-SIGBLOCK" "UNIX-SIGNAL-DESCRIPTION" "UNIX-SIGNAL-NAME" + "UNIX-SIGNAL-NUMBER" "UNIX-SIGPAUSE" "UNIX-SIGSETMASK" "USER-INFO" + "USER-INFO-DIR" "USER-INFO-GECOS" "USER-INFO-GID" "USER-INFO-PASSWORD" + "USER-INFO-SHELL" "USER-INFO-UID" "VDSUSP" "VEOF" "VEOL" "VEOL2" "VERASE" + "VINTR" "VKILL" "VMIN" "VQUIT" "VSTART" "VSTOP" "VSUSP" "VTIME" + "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL" "WS-YPIXEL" "W_OK" "X_OK" + "FIONREAD" + "TERMINAL-SPEEDS" + ) + #-(or linux solaris) + (:export "TCHARS" + "LTCHARS" + "D-NAMLEN" + + + ;; run-program.lisp + "SGTTYB" + + ;; Other symbols from structures, etc. + "DIRECT" "ELOCAL" "EPROCLIM" "EVICEERR" "EVICEOP" "EXECGRP" "EXECOTH" + "EXECOWN" "F-DUPFD" "F-GETFD" "F-SETFD" "FCREAT" "FEXCL" + "FTRUNC" "READGRP" "READOTH" "READOWN" "S-IEXEC" "S-IREAD" "S-ISGID" + "S-ISUID" "S-ISVTX" "S-IWRITE" "SAVETEXT" "SETGIDEXEC" "SETUIDEXEC" + "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL" "SG-OSPEED" "SIGEMT" "SIGSYS" + "T-BRKC" "T-DSUSPC" "T-EOFC" "T-FLUSHC" "T-INTRC" "T-LNEXTC" "T-QUITC" + "T-RPRNTC" "T-STARTC" "T-STOPC" "T-SUSPC" "T-WERASC" "TCIFLUSH" + "TCIOFLUSH" "TCOFLUSH" "TIOCFLUSH" "TIOCGETC" + "TIOCGETP" "TIOCGLTC" "TIOCSETC" "TIOCSETP" "TIOCSLTC" "TTY-CBREAK" + "TTY-CLOCAL" "TTY-CREAD" "TTY-CRMOD" "TTY-CS5" "TTY-CS6" "TTY-CS7" + "TTY-CS8" "TTY-CSIZE" "TTY-CSTOPB" "TTY-HUPCL" "TTY-LCASE" "TTY-PARENB" + "TTY-PARODD" "TTY-RAW" "TTY-TANDEM" "WRITEGRP" "WRITEOTH" + ) + #+linux + (:export "TCHARS" + "LTCHARS" + "D-NAMLEN" + + ;; Other symbols + "BLKCNT-T" "D-INO" "D-OFF" "EADV" "EBADE" "EBADFD" "EBADMSG" "EBADR" + "EBADRQC" "EBADSLT" "EBFONT" "ECHRNG" "ECOMM" "EDEADLOCK" "EDOTDOT" + "EIDRM" "EILSEQ" "EISNAM" "EL2HLT" "EL2NSYNC" "EL3HLT" "EL3RST" "ELIBACC" + "ELIBBAD" "ELIBEXEC" "ELIBMAX" "ELIBSCN" "ELNRNG" "EMULTIHOP" "ENAVAIL" + "ENOANO" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" "ENOPKG" + "ENOSR" "ENOSTR" "ENOSYS" "ENOTNAM" "ENOTUNIQ" "EOVERFLOW" "EPROTO" + "EREMCHG" "EREMOTEIO" "ERESTART" "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" + "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" "TTY-IUCLC" + "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" + "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" + "UTSNAME" + ) + #+solaris + (:export "D-INO" + "D-OFF" + "DIRECT" + "EADV" + "EBADE" + "EBADFD" + "EBADMSG" + "EBADR" + "EBADRQC" + "EBADSLT" + "EBFONT" + "ECANCELED" + "ECHRNG" + "ECOMM" + "EDEADLOCK" + "EIDRM" + "EILSEQ" + "EL2HLT" + "EL2NSYNC" + "EL3HLT" + "EL3RST" + "ELIBACC" + "ELIBBAD" + "ELIBEXEC" + "ELIBMAX" + "ELIBSCN" + "ELNRNG" + "EMULTIHOP" + "ENOANO" + "ENOCSI" + "ENODATA" + "ENOLCK" + "ENOLINK" + "ENOMSG" + "ENONET" + "ENOPKG" + "ENOSR" + "ENOSTR" + "ENOSYS" + "ENOTSUP" + "ENOTUNIQ" + "EOVERFLOW" + "EPROTO" + "EREMCHG" + "ERESTART" + "ESRMNT" + "ESTALE" + "ESTRPIPE" + "ETIME" + "EUNATCH" + "EXECGRP" + "EXECOTH" + "EXECOWN" + "EXFULL" + "F-DUPFD" + "F-GETFD" + "F-SETFD" + "FCREAT" + "FEXCL" + "FTRUNC" + "LTCHARS" + "O_NOCTTY" + "RCV1EN" + "READGRP" + "READOTH" + "READOWN" + "S-IEXEC" + "S-IREAD" + "S-ISGID" + "S-ISUID" + "S-ISVTX" + "S-IWRITE" + "SAVETEXT" + "SETGIDEXEC" + "SETUIDEXEC" + "SG-ERASE" + "SG-FLAGS" + "SG-ISPEED" + "SG-KILL" + "SG-OSPEED" + "SGTTYB" + "SIGEMT" + "SIGSYS" + "SIGWAITING" + "T-BRKC" + "T-DSUSPC" + "T-EOFC" + "T-FLUSHC" + "T-INTRC" + "T-LNEXTC" + "T-QUITC" + "T-RPRNTC" + "T-STARTC" + "T-STOPC" + "T-SUSPC" + "T-WERASC" + "TCHARS" + "TCIFLUSH" + "TCIOFLUSH" + "TCOFLUSH" + "TIOCFLUSH" + "TIOCGETC" + "TIOCGETP" + "TIOCGLTC" + "TIOCSETC" + "TIOCSETP" + "TIOCSLTC" + "TTY-CBAUD" + "TTY-CBREAK" + "TTY-CLOCAL" + "TTY-CREAD" + "TTY-CRMOD" + "TTY-CS5" + "TTY-CS6" + "TTY-CS7" + "TTY-CS8" + "TTY-CSIZE" + "TTY-CSTOPB" + "TTY-DEFECHO" + "TTY-HUPCL" + "TTY-IUCLC" + "TTY-LCASE" + "TTY-LOBLK" + "TTY-OCRNL" + "TTY-OFDEL" + "TTY-OFILL" + "TTY-OLCUC" + "TTY-ONLRET" + "TTY-ONOCR" + "TTY-PARENB" + "TTY-PARODD" + "TTY-RAW" + "TTY-TANDEM" + "TTY-XCASE" + "UNIX-TIMES" + "UTSNAME" + "WRITEGRP" + "WRITEOTH" + "XMT1EN" + )) (defpackage "FORMAT") ===================================== src/code/module.lisp ===================================== --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -161,3 +161,6 @@ (defmodule :cmu-contribs "modules:contrib") + +(defmodule :unix + "modules:load-unix") ===================================== src/code/unix-glibc2.lisp ===================================== --- a/src/code/unix-glibc2.lisp +++ b/src/code/unix-glibc2.lisp @@ -67,147 +67,11 @@ ;; Must be set to NIL initially to enable building Lisp! (defvar *filename-encoding* nil) -(export '( - daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t - blkcnt-t fsblkcnt-t fsfilcnt-t - unix-lockf f_ulock f_lock f_tlock f_test - timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime - itimerval it-interval it-value tchars t-intrc t-quitc t-startc - t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc - t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill - sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel - direct d-off d-ino d-reclen d-name - stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size - st-atime st-mtime st-ctime st-blksize st-blocks - s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock - s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec - ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss - ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock - ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw - rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc - unix-errno get-unix-error-msg - prot_read prot_write prot_exec prot_none - map_shared map_private map_fixed map_anonymous - ms_async ms_sync ms_invalidate - unix-mmap unix-munmap unix-msync unix-mprotect - unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid - unix-setitimer unix-getitimer - unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec - setgidexec savetext readown writeown execown readgrp writegrp - execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown - unix-getdtablesize unix-close unix-creat unix-dup unix-dup2 - unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown - fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek - l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr - o_ndelay - o_noctty - o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink - unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr - fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate - unix-ftruncate unix-symlink unix-unlink unix-write unix-ioctl - unix-uname utsname - tcsetpgrp tcgetpgrp tty-process-group - terminal-speeds tty-raw tty-crmod tty-echo tty-lcase - tty-cbreak - termios - c-lflag - c-iflag - c-oflag - tty-icrnl - tty-ocrnl - veof - vintr - vquit - vstart - vstop - vsusp - c-cflag - c-cc - tty-icanon - vmin - vtime - tty-ixon - tcsanow - tcsadrain - tciflush - tcoflush - tcioflush - tcsaflush - unix-tcgetattr - unix-tcsetattr - tty-ignbrk - tty-brkint - tty-ignpar - tty-parmrk - tty-inpck - tty-istrip - tty-inlcr - tty-igncr - tty-iuclc - tty-ixany - tty-ixoff - tty-imaxbel - tty-opost - tty-olcuc - tty-onlcr - tty-onocr - tty-onlret - tty-ofill - tty-ofdel - tty-isig - tty-xcase - tty-echoe - tty-echok - tty-echonl - tty-noflsh - tty-iexten - tty-tostop - tty-echoctl - tty-echoprt - tty-echoke - tty-pendin - tty-cstopb - tty-cread - tty-parenb - tty-parodd - tty-hupcl - tty-clocal - vintr - verase - vkill - veol - veol2 - TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC - TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ - TIOCSIGSEND - - KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK - KBDSCLICK FIONREAD unix-exit unix-stat unix-lstat unix-fstat - unix-getrusage unix-fast-getrusage rusage_self rusage_children - unix-gettimeofday - unix-utimes unix-sched-yield unix-setreuid - unix-setregid - unix-getpid unix-getppid - unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid - unix-getpagesize unix-gethostname unix-gethostid unix-fork - unix-getenv unix-setenv unix-putenv unix-unsetenv - unix-current-directory unix-isatty unix-ttyname unix-execve - unix-socket unix-connect unix-bind unix-listen unix-accept - unix-recv unix-send unix-getpeername unix-getsockname - unix-getsockopt unix-setsockopt unix-openpty - - unix-recvfrom unix-sendto unix-shutdown - - unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid - user-info user-info-name user-info-password user-info-uid - user-info-gid user-info-gecos user-info-dir user-info-shell - group-info group-info-name group-info-gid group-info-members)) - (pushnew :unix *features*) (pushnew :glibc2 *features*) ;; needed for bootstrap -(eval-when (:compile-toplevel) +(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro %name->file (string) `(if *filename-encoding* (string-encode ,string *filename-encoding*) @@ -217,8 +81,124 @@ (string-decode ,string *filename-encoding*) ,string))) +(defconstant +max-u-long+ 4294967295) + +(def-alien-type size-t #-alpha unsigned-int #+alpha long) +(def-alien-type time-t long) + +(def-alien-type uquad-t #+alpha unsigned-long + #-alpha (array unsigned-long 2)) +(def-alien-type u-int32-t unsigned-int) +(def-alien-type int64-t (signed 64)) +(def-alien-type u-int64-t (unsigned 64)) + +(def-alien-type dev-t #-amd64 uquad-t #+amd64 u-int64-t) +(def-alien-type uid-t unsigned-int) +(def-alien-type gid-t unsigned-int) +(def-alien-type ino-t #-amd64 u-int32-t #+amd64 u-int64-t) +(def-alien-type ino64-t u-int64-t) +(def-alien-type mode-t u-int32-t) +(def-alien-type nlink-t #-amd64 unsigned-int #+amd64 u-int64-t) +(def-alien-type off-t int64-t) +(def-alien-type blkcnt-t u-int64-t) + ;;;; Common machine independent structures. + +;; Needed early in bootstrap. +(defun unix-current-directory () + _N"Put the absolute pathname of the current working directory in BUF. + If successful, return BUF. If not, put an error message in + BUF and return NULL. BUF should be at least PATH_MAX bytes long." + ;; 5120 is some randomly selected maximum size for the buffer for getcwd. + (with-alien ((buf (array c-call:char 5120))) + (let ((result (alien-funcall + (extern-alien "getcwd" + (function (* c-call:char) + (* c-call:char) c-call:int)) + (cast buf (* c-call:char)) + 5120))) + + (values (not (zerop (sap-int (alien-sap result)))) + (%file->name (cast buf c-call:c-string)))))) + +;;; fcntlbits.h +(defconstant o_read o_rdonly _N"Open for reading") +(defconstant o_write o_wronly _N"Open for writing") + +(defconstant o_rdonly 0 _N"Read-only flag.") +(defconstant o_wronly 1 _N"Write-only flag.") +(defconstant o_rdwr 2 _N"Read-write flag.") +(defconstant o_accmode 3 _N"Access mode mask.") + +#-alpha +(progn + (defconstant o_creat #o100 _N"Create if nonexistant flag. (not fcntl)") + (defconstant o_excl #o200 _N"Error if already exists. (not fcntl)") + (defconstant o_noctty #o400 _N"Don't assign controlling tty. (not fcntl)") + (defconstant o_trunc #o1000 _N"Truncate flag. (not fcntl)") + (defconstant o_append #o2000 _N"Append flag.") + (defconstant o_ndelay #o4000 _N"Non-blocking I/O") + (defconstant o_nonblock #o4000 _N"Non-blocking I/O") + (defconstant o_ndelay o_nonblock) + (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)") + (defconstant o_fsync o_sync) + (defconstant o_async #o20000 _N"Asynchronous I/O")) +#+alpha +(progn + (defconstant o_creat #o1000 _N"Create if nonexistant flag. (not fcntl)") + (defconstant o_trunc #o2000 _N"Truncate flag. (not fcntl)") + (defconstant o_excl #o4000 _N"Error if already exists. (not fcntl)") + (defconstant o_noctty #o10000 _N"Don't assign controlling tty. (not fcntl)") + (defconstant o_nonblock #o4 _N"Non-blocking I/O") + (defconstant o_append #o10 _N"Append flag.") + (defconstant o_ndelay o_nonblock) + (defconstant o_sync #o40000 _N"Synchronous writes (on ext2)") + (defconstant o_fsync o_sync) + (defconstant o_async #o20000 _N"Asynchronous I/O")) + +#-alpha +(progn + (defconstant f-getlk 5 _N"Get lock") + (defconstant f-setlk 6 _N"Set lock") + (defconstant f-setlkw 7 _N"Set lock, wait for release") + (defconstant f-setown 8 _N"Set owner (for sockets)") + (defconstant f-getown 9 _N"Get owner (for sockets)")) +#+alpha +(progn + (defconstant f-getlk 7 _N"Get lock") + (defconstant f-setlk 8 _N"Set lock") + (defconstant f-setlkw 9 _N"Set lock, wait for release") + (defconstant f-setown 5 _N"Set owner (for sockets)") + (defconstant f-getown 6 _N"Get owner (for sockets)")) + +(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl") +(defun unix-open (path flags mode) + _N"Unix-open opens the file whose pathname is specified by PATH + for reading and/or writing as specified by the FLAGS argument. + Returns an integer file descriptor. + The flags argument can be: + + o_rdonly Read-only flag. + o_wronly Write-only flag. + o_rdwr Read-and-write flag. + o_append Append flag. + o_creat Create-if-nonexistant flag. + o_trunc Truncate-to-size-0 flag. + o_excl Error if the file already exists + o_noctty Don't assign controlling tty + o_ndelay Non-blocking I/O + o_sync Synchronous I/O + o_async Asynchronous I/O + + If the o_creat flag is specified, then the file is created with + a permission of argument MODE if the file doesn't exist." + (declare (type unix-pathname path) + (type fixnum flags) + (type unix-file-mode mode)) + (int-syscall ("open64" c-string int int) (%name->file path) flags mode)) + +;;; asm/errno.h (eval-when (compile eval) (defparameter *compiler-unix-errors* nil) @@ -241,97 +221,135 @@ ) -(defmacro def-enum (inc cur &rest names) - (flet ((defform (name) - (prog1 (when name `(defconstant ,name ,cur)) - (setf cur (funcall inc cur 1))))) - `(progn ,@(mapcar #'defform names)))) - -;;;; Memory-mapped files +(def-unix-error ESUCCESS 0 _N"Successful") +(def-unix-error EPERM 1 _N"Operation not permitted") +(def-unix-error ENOENT 2 _N"No such file or directory") +(def-unix-error ESRCH 3 _N"No such process") +(def-unix-error EINTR 4 _N"Interrupted system call") +(def-unix-error EIO 5 _N"I/O error") +(def-unix-error ENXIO 6 _N"No such device or address") +(def-unix-error E2BIG 7 _N"Arg list too long") +(def-unix-error ENOEXEC 8 _N"Exec format error") +(def-unix-error EBADF 9 _N"Bad file number") +(def-unix-error ECHILD 10 _N"No children") +(def-unix-error EAGAIN 11 _N"Try again") +(def-unix-error ENOMEM 12 _N"Out of memory") +(def-unix-error EACCES 13 _N"Permission denied") +(def-unix-error EFAULT 14 _N"Bad address") +(def-unix-error ENOTBLK 15 _N"Block device required") +(def-unix-error EBUSY 16 _N"Device or resource busy") +(def-unix-error EEXIST 17 _N"File exists") +(def-unix-error EXDEV 18 _N"Cross-device link") +(def-unix-error ENODEV 19 _N"No such device") +(def-unix-error ENOTDIR 20 _N"Not a director") +(def-unix-error EISDIR 21 _N"Is a directory") +(def-unix-error EINVAL 22 _N"Invalid argument") +(def-unix-error ENFILE 23 _N"File table overflow") +(def-unix-error EMFILE 24 _N"Too many open files") +(def-unix-error ENOTTY 25 _N"Not a typewriter") +(def-unix-error ETXTBSY 26 _N"Text file busy") +(def-unix-error EFBIG 27 _N"File too large") +(def-unix-error ENOSPC 28 _N"No space left on device") +(def-unix-error ESPIPE 29 _N"Illegal seek") +(def-unix-error EROFS 30 _N"Read-only file system") +(def-unix-error EMLINK 31 _N"Too many links") +(def-unix-error EPIPE 32 _N"Broken pipe") +;;; +;;; Math +(def-unix-error EDOM 33 _N"Math argument out of domain") +(def-unix-error ERANGE 34 _N"Math result not representable") +;;; +(def-unix-error EDEADLK 35 _N"Resource deadlock would occur") +(def-unix-error ENAMETOOLONG 36 _N"File name too long") +(def-unix-error ENOLCK 37 _N"No record locks available") +(def-unix-error ENOSYS 38 _N"Function not implemented") +(def-unix-error ENOTEMPTY 39 _N"Directory not empty") +(def-unix-error ELOOP 40 _N"Too many symbolic links encountered") +(def-unix-error EWOULDBLOCK 11 _N"Operation would block") +(def-unix-error ENOMSG 42 _N"No message of desired type") +(def-unix-error EIDRM 43 _N"Identifier removed") +(def-unix-error ECHRNG 44 _N"Channel number out of range") +(def-unix-error EL2NSYNC 45 _N"Level 2 not synchronized") +(def-unix-error EL3HLT 46 _N"Level 3 halted") +(def-unix-error EL3RST 47 _N"Level 3 reset") +(def-unix-error ELNRNG 48 _N"Link number out of range") +(def-unix-error EUNATCH 49 _N"Protocol driver not attached") +(def-unix-error ENOCSI 50 _N"No CSI structure available") +(def-unix-error EL2HLT 51 _N"Level 2 halted") +(def-unix-error EBADE 52 _N"Invalid exchange") +(def-unix-error EBADR 53 _N"Invalid request descriptor") +(def-unix-error EXFULL 54 _N"Exchange full") +(def-unix-error ENOANO 55 _N"No anode") +(def-unix-error EBADRQC 56 _N"Invalid request code") +(def-unix-error EBADSLT 57 _N"Invalid slot") +(def-unix-error EDEADLOCK EDEADLK _N"File locking deadlock error") +(def-unix-error EBFONT 59 _N"Bad font file format") +(def-unix-error ENOSTR 60 _N"Device not a stream") +(def-unix-error ENODATA 61 _N"No data available") +(def-unix-error ETIME 62 _N"Timer expired") +(def-unix-error ENOSR 63 _N"Out of streams resources") +(def-unix-error ENONET 64 _N"Machine is not on the network") +(def-unix-error ENOPKG 65 _N"Package not installed") +(def-unix-error EREMOTE 66 _N"Object is remote") +(def-unix-error ENOLINK 67 _N"Link has been severed") +(def-unix-error EADV 68 _N"Advertise error") +(def-unix-error ESRMNT 69 _N"Srmount error") +(def-unix-error ECOMM 70 _N"Communication error on send") +(def-unix-error EPROTO 71 _N"Protocol error") +(def-unix-error EMULTIHOP 72 _N"Multihop attempted") +(def-unix-error EDOTDOT 73 _N"RFS specific error") +(def-unix-error EBADMSG 74 _N"Not a data message") +(def-unix-error EOVERFLOW 75 _N"Value too large for defined data type") +(def-unix-error ENOTUNIQ 76 _N"Name not unique on network") +(def-unix-error EBADFD 77 _N"File descriptor in bad state") +(def-unix-error EREMCHG 78 _N"Remote address changed") +(def-unix-error ELIBACC 79 _N"Can not access a needed shared library") +(def-unix-error ELIBBAD 80 _N"Accessing a corrupted shared library") +(def-unix-error ELIBSCN 81 _N".lib section in a.out corrupted") +(def-unix-error ELIBMAX 82 _N"Attempting to link in too many shared libraries") +(def-unix-error ELIBEXEC 83 _N"Cannot exec a shared library directly") +(def-unix-error EILSEQ 84 _N"Illegal byte sequence") +(def-unix-error ERESTART 85 _N"Interrupted system call should be restarted _N") +(def-unix-error ESTRPIPE 86 _N"Streams pipe error") +(def-unix-error EUSERS 87 _N"Too many users") +(def-unix-error ENOTSOCK 88 _N"Socket operation on non-socket") +(def-unix-error EDESTADDRREQ 89 _N"Destination address required") +(def-unix-error EMSGSIZE 90 _N"Message too long") +(def-unix-error EPROTOTYPE 91 _N"Protocol wrong type for socket") +(def-unix-error ENOPROTOOPT 92 _N"Protocol not available") +(def-unix-error EPROTONOSUPPORT 93 _N"Protocol not supported") +(def-unix-error ESOCKTNOSUPPORT 94 _N"Socket type not supported") +(def-unix-error EOPNOTSUPP 95 _N"Operation not supported on transport endpoint") +(def-unix-error EPFNOSUPPORT 96 _N"Protocol family not supported") +(def-unix-error EAFNOSUPPORT 97 _N"Address family not supported by protocol") +(def-unix-error EADDRINUSE 98 _N"Address already in use") +(def-unix-error EADDRNOTAVAIL 99 _N"Cannot assign requested address") +(def-unix-error ENETDOWN 100 _N"Network is down") +(def-unix-error ENETUNREACH 101 _N"Network is unreachable") +(def-unix-error ENETRESET 102 _N"Network dropped connection because of reset") +(def-unix-error ECONNABORTED 103 _N"Software caused connection abort") +(def-unix-error ECONNRESET 104 _N"Connection reset by peer") +(def-unix-error ENOBUFS 105 _N"No buffer space available") +(def-unix-error EISCONN 106 _N"Transport endpoint is already connected") +(def-unix-error ENOTCONN 107 _N"Transport endpoint is not connected") +(def-unix-error ESHUTDOWN 108 _N"Cannot send after transport endpoint shutdown") +(def-unix-error ETOOMANYREFS 109 _N"Too many references: cannot splice") +(def-unix-error ETIMEDOUT 110 _N"Connection timed out") +(def-unix-error ECONNREFUSED 111 _N"Connection refused") +(def-unix-error EHOSTDOWN 112 _N"Host is down") +(def-unix-error EHOSTUNREACH 113 _N"No route to host") +(def-unix-error EALREADY 114 _N"Operation already in progress") +(def-unix-error EINPROGRESS 115 _N"Operation now in progress") +(def-unix-error ESTALE 116 _N"Stale NFS file handle") +(def-unix-error EUCLEAN 117 _N"Structure needs cleaning") +(def-unix-error ENOTNAM 118 _N"Not a XENIX named type file") +(def-unix-error ENAVAIL 119 _N"No XENIX semaphores available") +(def-unix-error EISNAM 120 _N"Is a named type file") +(def-unix-error EREMOTEIO 121 _N"Remote I/O error") +(def-unix-error EDQUOT 122 _N"Quota exceeded") -(defconstant +null+ (sys:int-sap 0)) - -(defconstant prot_read 1) -(defconstant prot_write 2) -(defconstant prot_exec 4) -(defconstant prot_none 0) - -(defconstant map_shared 1) -(defconstant map_private 2) -(defconstant map_fixed 16) -(defconstant map_anonymous 32) - -(defconstant ms_async 1) -(defconstant ms_sync 4) -(defconstant ms_invalidate 2) - -;; The return value from mmap that means mmap failed. -(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits)))) - -(defun unix-mmap (addr length prot flags fd offset) - (declare (type (or null system-area-pointer) addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot) - (type (unsigned-byte 32) flags) - (type (or null unix-fd) fd) - (type (signed-byte 32) offset)) - ;; Can't use syscall, because the address that is returned could be - ;; "negative". Hence we explicitly check for mmap returning - ;; MAP_FAILED. - (let ((result - (alien-funcall (extern-alien "mmap" (function system-area-pointer - system-area-pointer - size-t int int int off-t)) - (or addr +null+) length prot flags (or fd -1) offset))) - (if (sap= result map_failed) - (values nil (unix-errno)) - (values result 0)))) - -(defun unix-munmap (addr length) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length)) - (syscall ("munmap" system-area-pointer size-t) t addr length)) - -(defun unix-msync (addr length flags) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length) - (type (signed-byte 32) flags)) - (syscall ("msync" system-area-pointer size-t int) t addr length flags)) - -(defun unix-mprotect (addr length prot) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot)) - (syscall ("mprotect" system-area-pointer size-t int) - t addr length prot)) - -;;;; Lisp types used by syscalls. - -(deftype unix-pathname () 'simple-string) -(deftype unix-fd () `(integer 0 ,most-positive-fixnum)) - -(deftype unix-file-mode () '(unsigned-byte 32)) -(deftype unix-pid () '(unsigned-byte 32)) -(deftype unix-uid () '(unsigned-byte 32)) -(deftype unix-gid () '(unsigned-byte 32)) - - -;;;; User and group database structures: <pwd.h> and <grp.h> - -(defstruct user-info - (name "" :type string) - (password "" :type string) - (uid 0 :type unix-uid) - (gid 0 :type unix-gid) - (gecos "" :type string) - (dir "" :type string) - (shell "" :type string)) - -(defstruct group-info - (name "" :type string) - (password "" :type string) - (gid 0 :type unix-gid) - (members nil :type list)) ; list of logins as strings +;;; And now for something completely different ... +(emit-unix-errors) (def-alien-type nil (struct passwd @@ -343,14 +361,6 @@ (pw-dir (* char)) ; user's home directory (pw-shell (* char)))) ; user's login shell -(def-alien-type nil - (struct group - (gr-name (* char)) ; name of the group - (gr-passwd (* char)) ; encrypted group password - (gr-gid gid-t) ; numerical group ID - (gr-mem (* (* char))))) ; vector of pointers to member names - - ;;;; System calls. (def-alien-routine ("os_get_errno" unix-get-errno) int) @@ -393,213 +403,261 @@ (defmacro int-syscall ((name &rest arg-types) &rest args) `(syscall (,name ,@arg-types) (values result 0) ,@args)) -;;; From stdio.h - -;;; Unix-rename accepts two files names and renames the first to the second. - -(defun unix-rename (name1 name2) - _N"Unix-rename renames the file with string name1 to the string - name2. NIL and an error code is returned if an error occured." - (declare (type unix-pathname name1 name2)) - (void-syscall ("rename" c-string c-string) - (%name->file name1) (%name->file name2))) - -;;; From sys/types.h -;;; and -;;; gnu/types.h +;;; Unix-write accepts a file descriptor, a buffer, an offset, and the +;;; length to write. It attempts to write len bytes to the device +;;; associated with fd from the the buffer starting at offset. It returns +;;; the actual number of bytes written. -(defconstant +max-s-long+ 2147483647) -(defconstant +max-u-long+ 4294967295) +(defun unix-write (fd buf offset len) + _N"Unix-write attempts to write a character buffer (buf) of length + len to the file described by the file descriptor fd. NIL and an + error is returned if the call is unsuccessful." + (declare (type unix-fd fd) + (type (unsigned-byte 32) offset len)) + (int-syscall ("write" int (* char) int) + fd + (with-alien ((ptr (* char) (etypecase buf + ((simple-array * (*)) + (vector-sap buf)) + (system-area-pointer + buf)))) + (addr (deref ptr offset))) + len)) -(def-alien-type quad-t #+alpha long #-alpha (array long 2)) -(def-alien-type uquad-t #+alpha unsigned-long - #-alpha (array unsigned-long 2)) -(def-alien-type qaddr-t (* quad-t)) -(def-alien-type daddr-t int) -(def-alien-type caddr-t (* char)) -(def-alien-type swblk-t long) -(def-alien-type size-t #-alpha unsigned-int #+alpha long) -(def-alien-type time-t long) -(def-alien-type clock-t long) -(def-alien-type uid-t unsigned-int) -(def-alien-type ssize-t #-alpha int #+alpha long) -(def-alien-type key-t int) -(def-alien-type int8-t char) -(def-alien-type u-int8-t unsigned-char) -(def-alien-type int16-t short) -(def-alien-type u-int16-t unsigned-short) -(def-alien-type int32-t int) -(def-alien-type u-int32-t unsigned-int) -(def-alien-type int64-t (signed 64)) -(def-alien-type u-int64-t (unsigned 64)) -(def-alien-type register-t #-alpha int #+alpha long) +(defun unix-pipe () + _N"Unix-pipe sets up a unix-piping mechanism consisting of + an input pipe and an output pipe. Unix-Pipe returns two + values: if no error occurred the first value is the pipe + to be read from and the second is can be written to. If + an error occurred the first value is NIL and the second + the unix error code." + (with-alien ((fds (array int 2))) + (syscall ("pipe" (* int)) + (values (deref fds 0) (deref fds 1)) + (cast fds (* int))))) -(def-alien-type dev-t #-amd64 uquad-t #+amd64 u-int64-t) -(def-alien-type uid-t unsigned-int) -(def-alien-type gid-t unsigned-int) -(def-alien-type ino-t #-amd64 u-int32-t #+amd64 u-int64-t) -(def-alien-type ino64-t u-int64-t) -(def-alien-type mode-t u-int32-t) -(def-alien-type nlink-t #-amd64 unsigned-int #+amd64 u-int64-t) -(def-alien-type off-t int64-t) -(def-alien-type blkcnt-t u-int64-t) -(def-alien-type fsblkcnt-t u-int64-t) -(def-alien-type fsfilcnt-t u-int64-t) -(def-alien-type pid-t int) -;(def-alien-type ssize-t #-alpha int #+alpha long) +;;; UNIX-READ accepts a file descriptor, a buffer, and the length to read. +;;; It attempts to read len bytes from the device associated with fd +;;; and store them into the buffer. It returns the actual number of +;;; bytes read. -(def-alien-type fsid-t (array int 2)) +(defun unix-read (fd buf len) + _N"UNIX-READ attempts to read from the file described by fd into + the buffer buf until it is full. Len is the length of the buffer. + The number of bytes actually read is returned or NIL and an error + number if an error occured." + (declare (type unix-fd fd) + (type (unsigned-byte 32) len)) + #+gencgc + ;; With gencgc, the collector tries to keep raw objects like strings + ;; in separate pages that are not write-protected. However, this + ;; isn't always true. Thus, BUF will sometimes be write-protected + ;; and the kernel doesn't like writing to write-protected pages. So + ;; go through and touch each page to give the segv handler a chance + ;; to unprotect the pages. (This is taken from unix.lisp.) + (without-gcing + (let* ((page-size (get-page-size)) + (1-page-size (1- page-size)) + (sap (etypecase buf + (system-area-pointer buf) + (vector (vector-sap buf)))) + (end (sap+ sap len))) + (declare (type (and fixnum unsigned-byte) page-size 1-page-size) + (type system-area-pointer sap end) + (optimize (speed 3) (safety 0))) + ;; Touch the beginning of every page + (do ((sap (int-sap (logand (sap-int sap) + (logxor 1-page-size (ldb (byte 32 0) -1)))) + (sap+ sap page-size))) + ((sap>= sap end)) + (declare (type system-area-pointer sap)) + (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0))))) + (int-syscall ("read" int (* char) int) fd buf len)) -(def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int) +;;; Unix-getpagesize returns the number of bytes in the system page. -(defconstant fd-setsize 1024) -(defconstant nfdbits 32) - -(def-alien-type nil - (struct fd-set - (fds-bits (array fd-mask #.(/ fd-setsize nfdbits))))) +(defun unix-getpagesize () + _N"Unix-getpagesize returns the number of bytes in a system page." + (int-syscall ("getpagesize"))) -(def-alien-type key-t int) +;;; sys/stat.h -(def-alien-type ipc-pid-t unsigned-short) +(defmacro extract-stat-results (buf) + `(values T + #+(or alpha amd64) + (slot ,buf 'st-dev) + #-(or alpha amd64) + (+ (deref (slot ,buf 'st-dev) 0) + (* (+ +max-u-long+ 1) + (deref (slot ,buf 'st-dev) 1))) ;;; let's hope this works.. + (slot ,buf 'st-ino) + (slot ,buf 'st-mode) + (slot ,buf 'st-nlink) + (slot ,buf 'st-uid) + (slot ,buf 'st-gid) + #+(or alpha amd64) + (slot ,buf 'st-rdev) + #-(or alpha amd64) + (+ (deref (slot ,buf 'st-rdev) 0) + (* (+ +max-u-long+ 1) + (deref (slot ,buf 'st-rdev) 1))) ;;; let's hope this works.. + (slot ,buf 'st-size) + (slot ,buf 'st-atime) + (slot ,buf 'st-mtime) + (slot ,buf 'st-ctime) + (slot ,buf 'st-blksize) + (slot ,buf 'st-blocks))) -;;; direntry.h +;;; bits/stat.h (def-alien-type nil - (struct dirent - #+glibc2.1 - (d-ino ino-t) ; inode number of entry - #-glibc2.1 - (d-ino ino64-t) ; inode number of entry - (d-off off-t) ; offset of next disk directory entry - (d-reclen unsigned-short) ; length of this record - (d_type unsigned-char) - (d-name (array char 256)))) ; name must be no longer than this -;;; dirent.h - -;;; Operations on Unix Directories. - -(export '(open-dir read-dir close-dir)) + (struct stat + (st-dev dev-t) + #-(or alpha amd64) (st-pad1 unsigned-short) + (st-ino ino-t) + #+alpha (st-pad1 unsigned-int) + #-amd64 (st-mode mode-t) + (st-nlink nlink-t) + #+amd64 (st-mode mode-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + #-alpha (st-pad2 unsigned-short) + (st-size off-t) + #-alpha (st-blksize unsigned-long) + #-alpha (st-blocks blkcnt-t) + (st-atime time-t) + #-alpha (unused-1 unsigned-long) + (st-mtime time-t) + #-alpha (unused-2 unsigned-long) + (st-ctime time-t) + #+alpha (st-blocks int) + #+alpha (st-pad2 unsigned-int) + #+alpha (st-blksize unsigned-int) + #+alpha (st-flags unsigned-int) + #+alpha (st-gen unsigned-int) + #+alpha (st-pad3 unsigned-int) + #+alpha (unused-1 unsigned-long) + #+alpha (unused-2 unsigned-long) + (unused-3 unsigned-long) + (unused-4 unsigned-long) + #-alpha (unused-5 unsigned-long))) -(defstruct (%directory - (:constructor make-directory) - (:conc-name directory-) - (:print-function %print-directory)) - name - (dir-struct (required-argument) :type system-area-pointer)) - -(defun %print-directory (dir stream depth) - (declare (ignore depth)) - (format stream "#<Directory ~S>" (directory-name dir))) +(defun unix-stat (name) + _N"UNIX-STAT retrieves information about the specified + file returning them in the form of multiple values. + See the UNIX Programmer's Manual for a description + of the values returned. If the call fails, then NIL + and an error number is returned instead." + (declare (type unix-pathname name)) + (when (string= name "") + (setf name ".")) + (with-alien ((buf (struct stat))) + (syscall ("stat64" c-string (* (struct stat))) + (extract-stat-results buf) + (%name->file name) (addr buf)))) -(defun open-dir (pathname) - (declare (type unix-pathname pathname)) - (when (string= pathname "") - (setf pathname ".")) - (let ((kind (unix-file-kind pathname))) - (case kind - (:directory - (let ((dir-struct - (alien-funcall (extern-alien "opendir" - (function system-area-pointer - c-string)) - (%name->file pathname)))) - (if (zerop (sap-int dir-struct)) - (values nil (unix-errno)) - (make-directory :name pathname :dir-struct dir-struct)))) - ((nil) - (values nil enoent)) - (t - (values nil enotdir))))) +(defun unix-fstat (fd) + _N"UNIX-FSTAT is similar to UNIX-STAT except the file is specified + by the file descriptor FD." + (declare (type unix-fd fd)) + (with-alien ((buf (struct stat))) + (syscall ("fstat64" int (* (struct stat))) + (extract-stat-results buf) + fd (addr buf)))) -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir64" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((dirent (* (struct dirent)) daddr)) - (values (%file->name (cast (slot dirent 'd-name) c-string)) - (slot dirent 'd-ino)))))) +(defun unix-lstat (name) + _N"UNIX-LSTAT is similar to UNIX-STAT except the specified + file must be a symbolic link." + (declare (type unix-pathname name)) + (with-alien ((buf (struct stat))) + (syscall ("lstat64" c-string (* (struct stat))) + (extract-stat-results buf) + (%name->file name) (addr buf)))) -(defun close-dir (dir) - (declare (type %directory dir)) - (alien-funcall (extern-alien "closedir" - (function void system-area-pointer)) - (directory-dir-struct dir)) - nil) +;; Encoding of the file mode. -;;; dlfcn.h -> in foreign.lisp +(defconstant s-ifmt #o0170000 _N"These bits determine file type.") -;;; fcntl.h -;;; -;;; POSIX Standard: 6.5 File Control Operations <fcntl.h> +;; File types. -(defconstant r_ok 4 _N"Test for read permission") -(defconstant w_ok 2 _N"Test for write permission") -(defconstant x_ok 1 _N"Test for execute permission") -(defconstant f_ok 0 _N"Test for presence of file") +(defconstant s-ififo #o0010000 _N"FIFO") +(defconstant s-ifchr #o0020000 _N"Character device") +(defconstant s-ifdir #o0040000 _N"Directory") +(defconstant s-ifblk #o0060000 _N"Block device") +(defconstant s-ifreg #o0100000 _N"Regular file") -(defun unix-fcntl (fd cmd arg) - _N"Unix-fcntl manipulates file descriptors accoridng to the - argument CMD which can be one of the following: +;; These don't actually exist on System V, but having them doesn't hurt. - F-DUPFD Duplicate a file descriptor. - F-GETFD Get file descriptor flags. - F-SETFD Set file descriptor flags. - F-GETFL Get file flags. - F-SETFL Set file flags. - F-GETOWN Get owner. - F-SETOWN Set owner. +(defconstant s-iflnk #o0120000 _N"Symbolic link.") +(defconstant s-ifsock #o0140000 _N"Socket.") +(defun unix-file-kind (name &optional check-for-links) + _N"Returns either :file, :directory, :link, :special, or NIL." + (declare (simple-string name)) + (multiple-value-bind (res dev ino mode) + (if check-for-links + (unix-lstat name) + (unix-stat name)) + (declare (type (or fixnum null) mode) + (ignore dev ino)) + (when res + (let ((kind (logand mode s-ifmt))) + (cond ((eql kind s-ifdir) :directory) + ((eql kind s-ifreg) :file) + ((eql kind s-iflnk) :link) + (t :special)))))) - The flags that can be specified for F-SETFL are: +(defun unix-maybe-prepend-current-directory (name) + (declare (simple-string name)) + (if (and (> (length name) 0) (char= (schar name 0) #\/)) + name + (multiple-value-bind (win dir) (unix-current-directory) + (if win + (concatenate 'simple-string dir "/" name) + name)))) - FNDELAY Non-blocking reads. - FAPPEND Append on each write. - FASYNC Signal pgrp when data ready. - FCREAT Create if nonexistant. - FTRUNC Truncate to zero length. - FEXCL Error if already created. - " - (declare (type unix-fd fd) - (type (unsigned-byte 32) cmd) - (type (unsigned-byte 32) arg)) - (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg)) +;; Values for the second argument to access. -(defun unix-open (path flags mode) - _N"Unix-open opens the file whose pathname is specified by PATH - for reading and/or writing as specified by the FLAGS argument. - Returns an integer file descriptor. - The flags argument can be: +;;; Unix-access accepts a path and a mode. It returns two values the +;;; first is T if the file is accessible and NIL otherwise. The second +;;; only has meaning in the second case and is the unix errno value. - o_rdonly Read-only flag. - o_wronly Write-only flag. - o_rdwr Read-and-write flag. - o_append Append flag. - o_creat Create-if-nonexistant flag. - o_trunc Truncate-to-size-0 flag. - o_excl Error if the file already exists - o_noctty Don't assign controlling tty - o_ndelay Non-blocking I/O - o_sync Synchronous I/O - o_async Asynchronous I/O +(defun unix-access (path mode) + _N"Given a file path (a string) and one of four constant modes, + unix-access returns T if the file is accessible with that + mode and NIL if not. It also returns an errno value with + NIL which determines why the file was not accessible. - If the o_creat flag is specified, then the file is created with - a permission of argument MODE if the file doesn't exist." + The access modes are: + r_ok Read permission. + w_ok Write permission. + x_ok Execute permission. + f_ok Presence of file." (declare (type unix-pathname path) - (type fixnum flags) - (type unix-file-mode mode)) - (int-syscall ("open64" c-string int int) (%name->file path) flags mode)) + (type (mod 8) mode)) + (void-syscall ("access" c-string int) (%name->file path) mode)) -(defun unix-getdtablesize () - _N"Unix-getdtablesize returns the maximum size of the file descriptor - table. (i.e. the maximum number of descriptors that can exist at - one time.)" - (int-syscall ("getdtablesize"))) +(defconstant l_set 0 _N"set the file pointer") +(defconstant l_incr 1 _N"increment the file pointer") +(defconstant l_xtnd 2 _N"extend the file size") + +(defun unix-lseek (fd offset whence) + _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead + a certain OFFSET for that file. WHENCE can be any of the following: + l_set Set the file pointer. + l_incr Increment the file pointer. + l_xtnd Extend the file size. + " + (declare (type unix-fd fd) + (type (signed-byte 64) offset) + (type (integer 0 2) whence)) + (let ((result (alien-funcall + (extern-alien "lseek64" (function off-t int off-t int)) + fd offset whence))) + (if (minusp result) + (values nil (unix-errno)) + (values result 0)))) ;;; Unix-close accepts a file descriptor and attempts to close the file ;;; associated with it. @@ -625,1511 +683,912 @@ (type unix-file-mode mode)) (int-syscall ("creat64" c-string int) (%name->file name) mode)) -;;; fcntlbits.h - -(defconstant o_read o_rdonly _N"Open for reading") -(defconstant o_write o_wronly _N"Open for writing") - -(defconstant o_rdonly 0 _N"Read-only flag.") -(defconstant o_wronly 1 _N"Write-only flag.") -(defconstant o_rdwr 2 _N"Read-write flag.") -(defconstant o_accmode 3 _N"Access mode mask.") - -#-alpha -(progn - (defconstant o_creat #o100 _N"Create if nonexistant flag. (not fcntl)") - (defconstant o_excl #o200 _N"Error if already exists. (not fcntl)") - (defconstant o_noctty #o400 _N"Don't assign controlling tty. (not fcntl)") - (defconstant o_trunc #o1000 _N"Truncate flag. (not fcntl)") - (defconstant o_append #o2000 _N"Append flag.") - (defconstant o_ndelay #o4000 _N"Non-blocking I/O") - (defconstant o_nonblock #o4000 _N"Non-blocking I/O") - (defconstant o_ndelay o_nonblock) - (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)") - (defconstant o_fsync o_sync) - (defconstant o_async #o20000 _N"Asynchronous I/O")) -#+alpha -(progn - (defconstant o_creat #o1000 _N"Create if nonexistant flag. (not fcntl)") - (defconstant o_trunc #o2000 _N"Truncate flag. (not fcntl)") - (defconstant o_excl #o4000 _N"Error if already exists. (not fcntl)") - (defconstant o_noctty #o10000 _N"Don't assign controlling tty. (not fcntl)") - (defconstant o_nonblock #o4 _N"Non-blocking I/O") - (defconstant o_append #o10 _N"Append flag.") - (defconstant o_ndelay o_nonblock) - (defconstant o_sync #o40000 _N"Synchronous writes (on ext2)") - (defconstant o_fsync o_sync) - (defconstant o_async #o20000 _N"Asynchronous I/O")) - -(defconstant f-dupfd 0 _N"Duplicate a file descriptor") -(defconstant f-getfd 1 _N"Get file desc. flags") -(defconstant f-setfd 2 _N"Set file desc. flags") -(defconstant f-getfl 3 _N"Get file flags") -(defconstant f-setfl 4 _N"Set file flags") - -#-alpha -(progn - (defconstant f-getlk 5 _N"Get lock") - (defconstant f-setlk 6 _N"Set lock") - (defconstant f-setlkw 7 _N"Set lock, wait for release") - (defconstant f-setown 8 _N"Set owner (for sockets)") - (defconstant f-getown 9 _N"Get owner (for sockets)")) -#+alpha -(progn - (defconstant f-getlk 7 _N"Get lock") - (defconstant f-setlk 8 _N"Set lock") - (defconstant f-setlkw 9 _N"Set lock, wait for release") - (defconstant f-setown 5 _N"Set owner (for sockets)") - (defconstant f-getown 6 _N"Get owner (for sockets)")) - - - -(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl") - -#-alpha -(progn - (defconstant F-RDLCK 0 _N"for fcntl and lockf") - (defconstant F-WRLCK 1 _N"for fcntl and lockf") - (defconstant F-UNLCK 2 _N"for fcntl and lockf") - (defconstant F-EXLCK 4 _N"old bsd flock (depricated)") - (defconstant F-SHLCK 8 _N"old bsd flock (depricated)")) -#+alpha -(progn - (defconstant F-RDLCK 1 _N"for fcntl and lockf") - (defconstant F-WRLCK 2 _N"for fcntl and lockf") - (defconstant F-UNLCK 8 _N"for fcntl and lockf") - (defconstant F-EXLCK 16 _N"old bsd flock (depricated)") - (defconstant F-SHLCK 32 _N"old bsd flock (depricated)")) +(defun unix-resolve-links (pathname) + _N"Returns the pathname with all symbolic links resolved." + (declare (simple-string pathname)) + (let ((len (length pathname)) + (pending pathname)) + (declare (fixnum len) (simple-string pending)) + (if (zerop len) + pathname + (let ((result (make-string 100 :initial-element (code-char 0))) + (fill-ptr 0) + (name-start 0)) + (loop + (let* ((name-end (or (position #\/ pending :start name-start) len)) + (new-fill-ptr (+ fill-ptr (- name-end name-start)))) + ;; grow the result string, if necessary. the ">=" (instead of + ;; using ">") allows for the trailing "/" if we find this + ;; component is a directory. + (when (>= new-fill-ptr (length result)) + (let ((longer (make-string (* 3 (length result)) + :initial-element (code-char 0)))) + (replace longer result :end1 fill-ptr) + (setq result longer))) + (replace result pending + :start1 fill-ptr + :end1 new-fill-ptr + :start2 name-start + :end2 name-end) + (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t))) + (unless kind (return nil)) + (cond ((eq kind :link) + (multiple-value-bind (link err) (unix-readlink result) + (unless link + (error (intl:gettext "Error reading link ~S: ~S") + (subseq result 0 fill-ptr) + (get-unix-error-msg err))) + (cond ((or (zerop (length link)) + (char/= (schar link 0) #\/)) + ;; It's a relative link + (fill result (code-char 0) + :start fill-ptr + :end new-fill-ptr)) + ((string= result "/../" :end1 4) + ;; It's across the super-root. + (let ((slash (or (position #\/ result :start 4) + 0))) + (fill result (code-char 0) + :start slash + :end new-fill-ptr) + (setf fill-ptr slash))) + (t + ;; It's absolute. + (and (> (length link) 0) + (char= (schar link 0) #\/)) + (fill result (code-char 0) :end new-fill-ptr) + (setf fill-ptr 0))) + (setf pending + (if (= name-end len) + link + (concatenate 'simple-string + link + (subseq pending name-end)))) + (setf len (length pending)) + (setf name-start 0))) + ((= name-end len) + (when (eq kind :directory) + (setf (schar result new-fill-ptr) #\/) + (incf new-fill-ptr)) + (return (subseq result 0 new-fill-ptr))) + ((eq kind :directory) + (setf (schar result new-fill-ptr) #\/) + (setf fill-ptr (1+ new-fill-ptr)) + (setf name-start (1+ name-end))) + (t + (return nil)))))))))) -(defconstant F-LOCK-SH 1 _N"Shared lock for bsd flock") -(defconstant F-LOCK-EX 2 _N"Exclusive lock for bsd flock") -(defconstant F-LOCK-NB 4 _N"Don't block. Combine with F-LOCK-SH or F-LOCK-EX") -(defconstant F-LOCK-UN 8 _N"Remove lock for bsd flock") +(defun unix-simplify-pathname (src) + (declare (simple-string src)) + (let* ((src-len (length src)) + (dst (make-string src-len)) + (dst-len 0) + (dots 0) + (last-slash nil)) + (macrolet ((deposit (char) + `(progn + (setf (schar dst dst-len) ,char) + (incf dst-len)))) + (dotimes (src-index src-len) + (let ((char (schar src src-index))) + (cond ((char= char #\.) + (when dots + (incf dots)) + (deposit char)) + ((char= char #\/) + (case dots + (0 + ;; Either ``/...' or ``...//...' + (unless last-slash + (setf last-slash dst-len) + (deposit char))) + (1 + ;; Either ``./...'' or ``..././...'' + (decf dst-len)) + (2 + ;; We've found .. + (cond + ((and last-slash (not (zerop last-slash))) + ;; There is something before this .. + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (cond ((and (= (+ (or prev-prev-slash 0) 2) + last-slash) + (char= (schar dst (- last-slash 2)) #\.) + (char= (schar dst (1- last-slash)) #\.)) + ;; The something before this .. is another .. + (deposit char) + (setf last-slash dst-len)) + (t + ;; The something is some random dir. + (setf dst-len + (if prev-prev-slash + (1+ prev-prev-slash) + 0)) + (setf last-slash prev-prev-slash))))) + (t + ;; There is nothing before this .., so we need to keep it + (setf last-slash dst-len) + (deposit char)))) + (t + ;; Something other than a dot between slashes. + (setf last-slash dst-len) + (deposit char))) + (setf dots 0)) + (t + (setf dots nil) + (setf (schar dst dst-len) char) + (incf dst-len)))))) + (when (and last-slash (not (zerop last-slash))) + (case dots + (1 + ;; We've got ``foobar/.'' + (decf dst-len)) + (2 + ;; We've got ``foobar/..'' + (unless (and (>= last-slash 2) + (char= (schar dst (1- last-slash)) #\.) + (char= (schar dst (- last-slash 2)) #\.) + (or (= last-slash 2) + (char= (schar dst (- last-slash 3)) #\/))) + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (if prev-prev-slash + (setf dst-len (1+ prev-prev-slash)) + (return-from unix-simplify-pathname "./"))))))) + (cond ((zerop dst-len) + "./") + ((= dst-len src-len) + dst) + (t + (subseq dst 0 dst-len))))) -(def-alien-type nil - (struct flock - (l-type short) - (l-whence short) - (l-start off-t) - (l-len off-t) - (l-pid pid-t))) +(defun unix-gethostname () + _N"Unix-gethostname returns the name of the host machine as a string." + (with-alien ((buf (array char 256))) + (syscall* ("gethostname" (* char) int) + (cast buf c-string) + (cast buf (* char)) 256))) -;;; Define some more compatibility macros to be backward compatible with -;;; BSD systems which did not managed to hide these kernel macros. +;;; Unix-dup returns a duplicate copy of the existing file-descriptor +;;; passed as an argument. -(defconstant FAPPEND o_append _N"depricated stuff") -(defconstant FFSYNC o_fsync _N"depricated stuff") -(defconstant FASYNC o_async _N"depricated stuff") -(defconstant FNONBLOCK o_nonblock _N"depricated stuff") -(defconstant FNDELAY o_ndelay _N"depricated stuff") +(defun unix-dup (fd) + _N"Unix-dup duplicates an existing file descriptor (given as the + argument) and return it. If FD is not a valid file descriptor, NIL + and an error number are returned." + (declare (type unix-fd fd)) + (int-syscall ("dup" int) fd)) +;;; Unix-dup2 makes the second file-descriptor describe the same file +;;; as the first. If the second file-descriptor points to an open +;;; file, it is first closed. In any case, the second should have a +;;; value which is a valid file-descriptor. -;;; grp.h +(defun unix-dup2 (fd1 fd2) + _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup + does only the new value of the duplicate descriptor may be requested + through the second argument. If a file already exists with the + requested descriptor number, it will be closed and the number + assigned to the duplicate." + (declare (type unix-fd fd1 fd2)) + (void-syscall ("dup2" int int) fd1 fd2)) -;;; POSIX Standard: 9.2.1 Group Database Access <grp.h> +;;; Unix-exit terminates a program. -#+(or) -(defun unix-setgrend () - _N"Rewind the group-file stream." - (void-syscall ("setgrend"))) +(defun unix-exit (&optional (code 0)) + _N"Unix-exit terminates the current process with an optional + error code. If successful, the call doesn't return. If + unsuccessful, the call returns NIL and an error number." + (declare (type (signed-byte 32) code)) + (void-syscall ("exit" int) code)) -#+(or) -(defun unix-endgrent () - _N"Close the group-file stream." - (void-syscall ("endgrent"))) +(def-alien-routine ("getuid" unix-getuid) int + _N"Unix-getuid returns the real user-id associated with the + current process.") -#+(or) -(defun unix-getgrent () - _N"Read an entry from the group-file stream, opening it if necessary." - - (let ((result (alien-funcall (extern-alien "getgrent" - (function (* (struct group))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) +;;; Unix-chdir accepts a directory name and makes that the +;;; current working directory. -;;; ioctl-types.h +(defun unix-chdir (path) + _N"Given a file path string, unix-chdir changes the current working + directory to the one specified." + (declare (type unix-pathname path)) + (void-syscall ("chdir" c-string) (%name->file path))) -(def-alien-type nil - (struct winsize - (ws-row unsigned-short) ; rows, in characters - (ws-col unsigned-short) ; columns, in characters - (ws-xpixel unsigned-short) ; horizontal size, pixels - (ws-ypixel unsigned-short))) ; veritical size, pixels +;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. -(defconstant +NCC+ 8 - _N"Size of control character vector.") +(defun unix-chmod (path mode) + _N"Given a file path string and a constant mode, unix-chmod changes the + permission mode for that file to the one specified. The new mode + can be created by logically OR'ing the following: -(def-alien-type nil - (struct termio - (c-iflag unsigned-int) ; input mode flags - (c-oflag unsigned-int) ; output mode flags - (c-cflag unsigned-int) ; control mode flags - (c-lflag unsigned-int) ; local mode flags - (c-line unsigned-char) ; line discipline - (c-cc (array unsigned-char #.+NCC+)))) ; control characters - -;;; modem lines -(defconstant tiocm-le 1) -(defconstant tiocm-dtr 2) -(defconstant tiocm-rts 4) -(defconstant tiocm-st 8) -(defconstant tiocm-sr #x10) -(defconstant tiocm-cts #x20) -(defconstant tiocm-car #x40) -(defconstant tiocm-rng #x80) -(defconstant tiocm-dsr #x100) -(defconstant tiocm-cd tiocm-car) -(defconstant tiocm-ri #x80) - -;;; ioctl (fd, TIOCSERGETLSR, &result) where result may be as below - -;;; line disciplines -(defconstant N-TTY 0) -(defconstant N-SLIP 1) -(defconstant N-MOUSE 2) -(defconstant N-PPP 3) -(defconstant N-STRIP 4) -(defconstant N-AX25 5) - - -;;; ioctls.h - -;;; Routing table calls. -(defconstant siocaddrt #x890B) ;; add routing table entry -(defconstant siocdelrt #x890C) ;; delete routing table entry -(defconstant siocrtmsg #x890D) ;; call to routing system - -;;; Socket configuration controls. -(defconstant siocgifname #x8910) ;; get iface name -(defconstant siocsiflink #x8911) ;; set iface channel -(defconstant siocgifconf #x8912) ;; get iface list -(defconstant siocgifflags #x8913) ;; get flags -(defconstant siocsifflags #x8914) ;; set flags -(defconstant siocgifaddr #x8915) ;; get PA address -(defconstant siocsifaddr #x8916) ;; set PA address -(defconstant siocgifdstaddr #x8917 ) ;; get remote PA address -(defconstant siocsifdstaddr #x8918 ) ;; set remote PA address -(defconstant siocgifbrdaddr #x8919 ) ;; get broadcast PA address -(defconstant siocsifbrdaddr #x891a ) ;; set broadcast PA address -(defconstant siocgifnetmask #x891b ) ;; get network PA mask -(defconstant siocsifnetmask #x891c ) ;; set network PA mask -(defconstant siocgifmetric #x891d ) ;; get metric -(defconstant siocsifmetric #x891e ) ;; set metric -(defconstant siocgifmem #x891f ) ;; get memory address (BSD) -(defconstant siocsifmem #x8920 ) ;; set memory address (BSD) -(defconstant siocgifmtu #x8921 ) ;; get MTU size -(defconstant siocsifmtu #x8922 ) ;; set MTU size -(defconstant siocsifhwaddr #x8924 ) ;; set hardware address -(defconstant siocgifencap #x8925 ) ;; get/set encapsulations -(defconstant siocsifencap #x8926) -(defconstant siocgifhwaddr #x8927 ) ;; Get hardware address -(defconstant siocgifslave #x8929 ) ;; Driver slaving support -(defconstant siocsifslave #x8930) -(defconstant siocaddmulti #x8931 ) ;; Multicast address lists -(defconstant siocdelmulti #x8932) -(defconstant siocgifindex #x8933 ) ;; name -> if_index mapping -(defconstant siogifindex SIOCGIFINDEX ) ;; misprint compatibility :-) -(defconstant siocsifpflags #x8934 ) ;; set/get extended flags set -(defconstant siocgifpflags #x8935) -(defconstant siocdifaddr #x8936 ) ;; delete PA address -(defconstant siocsifhwbroadcast #x8937 ) ;; set hardware broadcast addr -(defconstant siocgifcount #x8938 ) ;; get number of devices - -(defconstant siocgifbr #x8940 ) ;; Bridging support -(defconstant siocsifbr #x8941 ) ;; Set bridging options - -(defconstant siocgiftxqlen #x8942 ) ;; Get the tx queue length -(defconstant siocsiftxqlen #x8943 ) ;; Set the tx queue length - - -;;; ARP cache control calls. -;; 0x8950 - 0x8952 * obsolete calls, don't re-use -(defconstant siocdarp #x8953 ) ;; delete ARP table entry -(defconstant siocgarp #x8954 ) ;; get ARP table entry -(defconstant siocsarp #x8955 ) ;; set ARP table entry - -;;; RARP cache control calls. -(defconstant siocdrarp #x8960 ) ;; delete RARP table entry -(defconstant siocgrarp #x8961 ) ;; get RARP table entry -(defconstant siocsrarp #x8962 ) ;; set RARP table entry - -;;; Driver configuration calls - -(defconstant siocgifmap #x8970 ) ;; Get device parameters -(defconstant siocsifmap #x8971 ) ;; Set device parameters - -;;; DLCI configuration calls - -(defconstant siocadddlci #x8980 ) ;; Create new DLCI device -(defconstant siocdeldlci #x8981 ) ;; Delete DLCI device - -;;; Device private ioctl calls. - -;; These 16 ioctls are available to devices via the do_ioctl() device -;; vector. Each device should include this file and redefine these -;; names as their own. Because these are device dependent it is a good -;; idea _NOT_ to issue them to random objects and hope. - -(defconstant siocdevprivate #x89F0 ) ;; to 89FF - - -;;; netdb.h - -;; All data returned by the network data base library are supplied in -;; host order and returned in network order (suitable for use in -;; system calls). - -;;; Absolute file name for network data base files. -(defconstant path-hequiv "/etc/hosts.equiv") -(defconstant path-hosts "/etc/hosts") -(defconstant path-networks "/etc/networks") -(defconstant path-nsswitch_conf "/etc/nsswitch.conf") -(defconstant path-protocols "/etc/protocols") -(defconstant path-services "/etc/services") - - -;;; Possible values left in `h_errno'. -(defconstant netdb-internal -1 _N"See errno.") -(defconstant netdb-success 0 _N"No problem.") -(defconstant host-not-found 1 _N"Authoritative Answer Host not found.") -(defconstant try-again 2 _N"Non-Authoritative Host not found,or SERVERFAIL.") -(defconstant no-recovery 3 _N"Non recoverable errors, FORMERR, REFUSED, NOTIMP.") -(defconstant no-data 4 "Valid name, no data record of requested type.") -(defconstant no-address no-data "No address, look for MX record.") - -;;; Description of data base entry for a single host. + setuidexec Set user ID on execution. + setgidexec Set group ID on execution. + savetext Save text image after execution. + readown Read by owner. + writeown Write by owner. + execown Execute (search directory) by owner. + readgrp Read by group. + writegrp Write by group. + execgrp Execute (search directory) by group. + readoth Read by others. + writeoth Write by others. + execoth Execute (search directory) by others. -(def-alien-type nil - (struct hostent - (h-name c-string) ; Official name of host. - (h-aliases (* c-string)) ; Alias list. - (h-addrtype int) ; Host address type. - (h_length int) ; Length of address. - (h-addr-list (* c-string)))) ; List of addresses from name server. - -#+(or) -(defun unix-sethostent (stay-open) - _N"Open host data base files and mark them as staying open even after -a later search if STAY_OPEN is non-zero." - (void-syscall ("sethostent" int) stay-open)) - -#+(or) -(defun unix-endhostent () - _N"Close host data base files and clear `stay open' flag." - (void-syscall ("endhostent"))) - -#+(or) -(defun unix-gethostent () - _N"Get next entry from host data base file. Open data base if -necessary." - (let ((result (alien-funcall (extern-alien "gethostent" - (function (* (struct hostent))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-gethostbyaddr(addr length type) - _N"Return entry from host data base which address match ADDR with -length LEN and type TYPE." - (let ((result (alien-funcall (extern-alien "gethostbyaddr" - (function (* (struct hostent)) - c-string int int)) - addr len type))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-gethostbyname (name) - _N"Return entry from host data base for host with NAME." - (let ((result (alien-funcall (extern-alien "gethostbyname" - (function (* (struct hostent)) - c-string)) - name))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-gethostbyname2 (name af) - _N"Return entry from host data base for host with NAME. AF must be - set to the address type which as `AF_INET' for IPv4 or `AF_INET6' - for IPv6." - (let ((result (alien-funcall (extern-alien "gethostbyname2" - (function (* (struct hostent)) - c-string int)) - name af))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) + Thus #o444 and (logior unix:readown unix:readgrp unix:readoth) + are equivalent for 'mode. The octal-base is familar to Unix users. + + It returns T on successfully completion; NIL and an error number + otherwise." + (declare (type unix-pathname path) + (type unix-file-mode mode)) + (void-syscall ("chmod" c-string int) (%name->file path) mode)) -;; Description of data base entry for a single network. NOTE: here a -;; poor assumption is made. The network number is expected to fit -;; into an unsigned long int variable. +;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode +;;; ("mode") and changes the protection of the file described by "fd" to +;;; "mode". -(def-alien-type nil - (struct netent - (n-name c-string) ; Official name of network. - (n-aliases (* c-string)) ; Alias list. - (n-addrtype int) ; Net address type. - (n-net unsigned-long))) ; Network number. - -#+(or) -(defun unix-setnetent (stay-open) - _N"Open network data base files and mark them as staying open even - after a later search if STAY_OPEN is non-zero." - (void-syscall ("setnetent" int) stay-open)) - - -#+(or) -(defun unix-endnetent () - _N"Close network data base files and clear `stay open' flag." - (void-syscall ("endnetent"))) - - -#+(or) -(defun unix-getnetent () - _N"Get next entry from network data base file. Open data base if - necessary." - (let ((result (alien-funcall (extern-alien "getnetent" - (function (* (struct netent))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - - -#+(or) -(defun unix-getnetbyaddr (net type) - _N"Return entry from network data base which address match NET and - type TYPE." - (let ((result (alien-funcall (extern-alien "getnetbyaddr" - (function (* (struct netent)) - unsigned-long int)) - net type))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getnetbyname (name) - _N"Return entry from network data base for network with NAME." - (let ((result (alien-funcall (extern-alien "getnetbyname" - (function (* (struct netent)) - c-string)) - name))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -;; Description of data base entry for a single service. -(def-alien-type nil - (struct servent - (s-name c-string) ; Official service name. - (s-aliases (* c-string)) ; Alias list. - (s-port int) ; Port number. - (s-proto c-string))) ; Protocol to use. - -#+(or) -(defun unix-setservent (stay-open) - _N"Open service data base files and mark them as staying open even - after a later search if STAY_OPEN is non-zero." - (void-syscall ("setservent" int) stay-open)) - -#+(or) -(defun unix-endservent (stay-open) - _N"Close service data base files and clear `stay open' flag." - (void-syscall ("endservent"))) - - -#+(or) -(defun unix-getservent () - _N"Get next entry from service data base file. Open data base if - necessary." - (let ((result (alien-funcall (extern-alien "getservent" - (function (* (struct servent))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getservbyname (name proto) - _N"Return entry from network data base for network with NAME and - protocol PROTO." - (let ((result (alien-funcall (extern-alien "getservbyname" - (function (* (struct netent)) - c-string (* char))) - name proto))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getservbyport (port proto) - _N"Return entry from service data base which matches port PORT and - protocol PROTO." - (let ((result (alien-funcall (extern-alien "getservbyport" - (function (* (struct netent)) - int (* char))) - port proto))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -;; Description of data base entry for a single service. +(defun unix-fchmod (fd mode) + _N"Given an integer file descriptor and a mode (the same as those + used for unix-chmod), unix-fchmod changes the permission mode + for that file to the one specified. T is returned if the call + was successful." + (declare (type unix-fd fd) + (type unix-file-mode mode)) + (void-syscall ("fchmod" int int) fd mode)) -(def-alien-type nil - (struct protoent - (p-name c-string) ; Official protocol name. - (p-aliases (* c-string)) ; Alias list. - (p-proto int))) ; Protocol number. - -#+(or) -(defun unix-setprotoent (stay-open) - _N"Open protocol data base files and mark them as staying open even - after a later search if STAY_OPEN is non-zero." - (void-syscall ("setprotoent" int) stay-open)) - -#+(or) -(defun unix-endprotoent () - _N"Close protocol data base files and clear `stay open' flag." - (void-syscall ("endprotoent"))) - -#+(or) -(defun unix-getprotoent () - _N"Get next entry from protocol data base file. Open data base if - necessary." - (let ((result (alien-funcall (extern-alien "getprotoent" - (function (* (struct protoent))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getprotobyname (name) - _N"Return entry from protocol data base for network with NAME." - (let ((result (alien-funcall (extern-alien "getprotobyname" - (function (* (struct protoent)) - c-string)) - name))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getprotobynumber (proto) - _N"Return entry from protocol data base which number is PROTO." - (let ((result (alien-funcall (extern-alien "getprotobynumber" - (function (* (struct protoent)) - int)) - proto))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-setnetgrent (netgroup) - _N"Establish network group NETGROUP for enumeration." - (int-syscall ("setservent" c-string) netgroup)) - -#+(or) -(defun unix-endnetgrent () - _N"Free all space allocated by previous `setnetgrent' call." - (void-syscall ("endnetgrent"))) - -#+(or) -(defun unix-getnetgrent (hostp userp domainp) - _N"Get next member of netgroup established by last `setnetgrent' call - and return pointers to elements in HOSTP, USERP, and DOMAINP." - (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string)) - hostp userp domainp)) - -#+(or) -(defun unix-innetgr (netgroup host user domain) - _N"Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)." - (int-syscall ("innetgr" c-string c-string c-string c-string) - netgroup host user domain)) +(defun unix-readlink (path) + _N"Unix-readlink invokes the readlink system call on the file name + specified by the simple string path. It returns up to two values: + the contents of the symbolic link if the call is successful, or + NIL and the Unix error number." + (declare (type unix-pathname path)) + (with-alien ((buf (array char 1024))) + (syscall ("readlink" c-string (* char) int) + (let ((string (make-string result))) + #-unicode + (kernel:copy-from-system-area + (alien-sap buf) 0 + string (* vm:vector-data-offset vm:word-bits) + (* result vm:byte-bits)) + #+unicode + (let ((sap (alien-sap buf))) + (dotimes (k result) + (setf (aref string k) (code-char (sap-ref-8 sap k))))) + (%file->name string)) + (%name->file path) (cast buf (* char)) 1024))) -(def-alien-type nil - (struct addrinfo - (ai-flags int) ; Input flags. - (ai-family int) ; Protocol family for socket. - (ai-socktype int) ; Socket type. - (ai-protocol int) ; Protocol for socket. - (ai-addrlen int) ; Length of socket address. - (ai-addr (* (struct sockaddr))) - ; Socket address for socket. - (ai-cononname c-string) - ; Canonical name for service location. - (ai-net (* (struct addrinfo))))) ; Pointer to next in list. - -;; Possible values for `ai_flags' field in `addrinfo' structure. - -(defconstant ai_passive 1 _N"Socket address is intended for `bind'.") -(defconstant ai_canonname 2 _N"Request for canonical name.") - -;; Error values for `getaddrinfo' function. -(defconstant eai_badflags -1 _N"Invalid value for `ai_flags' field.") -(defconstant eai_noname -2 _N"NAME or SERVICE is unknown.") -(defconstant eai_again -3 _N"Temporary failure in name resolution.") -(defconstant eai_fail -4 _N"Non-recoverable failure in name res.") -(defconstant eai_nodata -5 _N"No address associated with NAME.") -(defconstant eai_family -6 _N"ai_family not supported.") -(defconstant eai_socktype -7 _N"ai_socktype not supported.") -(defconstant eai_service -8 _N"SERVICE not supported for ai_socktype.") -(defconstant eai_addrfamily -9 _N"Address family for NAME not supported.") -(defconstant eai_memory -10 _N"Memory allocation failure.") -(defconstant eai_system -11 _N"System error returned in errno.") - - -#+(or) -(defun unix-getaddrinfo (name service req pai) - _N"Translate name of a service location and/or a service name to set of - socket addresses." - (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo)) - (* (* struct addrinfo))) - name service req pai)) - - -#+(or) -(defun unix-freeaddrinfo (ai) - _N"Free `addrinfo' structure AI including associated storage." - (void-syscall ("freeaddrinfo" (* struct addrinfo)) - ai)) +;;; Unix-unlink accepts a name and deletes the directory entry for that +;;; name and the file if this is the last link. +(defun unix-unlink (name) + _N"Unix-unlink removes the directory entry for the named file. + NIL and an error code is returned if the call fails." + (declare (type unix-pathname name)) + (void-syscall ("unlink" c-string) (%name->file name))) -;;; pty.h +;;; fcntl.h +;;; +;;; POSIX Standard: 6.5 File Control Operations <fcntl.h> -(defun unix-openpty (name termp winp) - _N"Create pseudo tty master slave pair with NAME and set terminal - attributes according to TERMP and WINP and return handles for both - ends in AMASTER and ASLAVE." - (with-alien ((amaster int) - (aslave int)) - (values - (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios)) - (* (struct winsize))) - (addr amaster) (addr aslave) name termp winp) - amaster aslave))) +(defconstant r_ok 4 _N"Test for read permission") +(defconstant w_ok 2 _N"Test for write permission") +(defconstant x_ok 1 _N"Test for execute permission") +(defconstant f_ok 0 _N"Test for presence of file") -#+(or) -(defun unix-forkpty (amaster name termp winp) - _N"Create child process and establish the slave pseudo terminal as the - child's controlling terminal." - (int-syscall ("forkpty" (* int) c-string (* (struct termios)) - (* (struct winsize))) - amaster name termp winp)) - - -;; POSIX Standard: 9.2.2 User Database Access <pwd.h> - -#+(or) -(defun unix-setpwent () - _N"Rewind the password-file stream." - (void-syscall ("setpwent"))) - -#+(or) -(defun unix-endpwent () - _N"Close the password-file stream." - (void-syscall ("endpwent"))) - -#+(or) -(defun unix-getpwent () - _N"Read an entry from the password-file stream, opening it if necessary." - (let ((result (alien-funcall (extern-alien "getpwent" - (function (* (struct passwd))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) +(defun unix-fcntl (fd cmd arg) + _N"Unix-fcntl manipulates file descriptors accoridng to the + argument CMD which can be one of the following: -;;; resourcebits.h + F-DUPFD Duplicate a file descriptor. + F-GETFD Get file descriptor flags. + F-SETFD Set file descriptor flags. + F-GETFL Get file flags. + F-SETFL Set file flags. + F-GETOWN Get owner. + F-SETOWN Set owner. -(def-alien-type nil - (struct rlimit - (rlim-cur long) ; current (soft) limit - (rlim-max long))); maximum value for rlim-cur + The flags that can be specified for F-SETFL are: -(defconstant rusage_self 0 _N"The calling process.") -(defconstant rusage_children -1 _N"Terminated child processes.") -(defconstant rusage_both -2) + FNDELAY Non-blocking reads. + FAPPEND Append on each write. + FASYNC Signal pgrp when data ready. + FCREAT Create if nonexistant. + FTRUNC Truncate to zero length. + FEXCL Error if already created. + " + (declare (type unix-fd fd) + (type (unsigned-byte 32) cmd) + (type (unsigned-byte 32) arg)) + (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg)) -(def-alien-type nil - (struct rusage - (ru-utime (struct timeval)) ; user time used - (ru-stime (struct timeval)) ; system time used. - (ru-maxrss long) ; Maximum resident set size (in kilobytes) - (ru-ixrss long) ; integral shared memory size - (ru-idrss long) ; integral unshared data " - (ru-isrss long) ; integral unshared stack " - (ru-minflt long) ; page reclaims - (ru-majflt long) ; page faults - (ru-nswap long) ; swaps - (ru-inblock long) ; block input operations - (ru-oublock long) ; block output operations - (ru-msgsnd long) ; messages sent - (ru-msgrcv long) ; messages received - (ru-nsignals long) ; signals received - (ru-nvcsw long) ; voluntary context switches - (ru-nivcsw long))) ; involuntary " +;;;; Memory-mapped files -;; Priority limits. +(defconstant +null+ (sys:int-sap 0)) -(defconstant prio-min -20 _N"Minimum priority a process can have") -(defconstant prio-max 20 _N"Maximum priority a process can have") +(defconstant prot_read 1) +(defconstant prot_write 2) +(defconstant prot_exec 4) +(defconstant prot_none 0) +(defconstant map_shared 1) +(defconstant map_private 2) +(defconstant map_fixed 16) +(defconstant map_anonymous 32) -;;; The type of the WHICH argument to `getpriority' and `setpriority', -;;; indicating what flavor of entity the WHO argument specifies. +(defconstant ms_async 1) +(defconstant ms_sync 4) +(defconstant ms_invalidate 2) -(defconstant priority-process 0 _N"WHO is a process ID") -(defconstant priority-pgrp 1 _N"WHO is a process group ID") -(defconstant priority-user 2 _N"WHO is a user ID") +;; The return value from mmap that means mmap failed. +(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits)))) -;;; sched.h +(defun unix-mmap (addr length prot flags fd offset) + (declare (type (or null system-area-pointer) addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot) + (type (unsigned-byte 32) flags) + (type (or null unix-fd) fd) + (type (signed-byte 32) offset)) + ;; Can't use syscall, because the address that is returned could be + ;; "negative". Hence we explicitly check for mmap returning + ;; MAP_FAILED. + (let ((result + (alien-funcall (extern-alien "mmap" (function system-area-pointer + system-area-pointer + size-t int int int off-t)) + (or addr +null+) length prot flags (or fd -1) offset))) + (if (sap= result map_failed) + (values nil (unix-errno)) + (values result 0)))) -#+(or) -(defun unix-sched_setparam (pid param) - _N"Rewind the password-file stream." - (int-syscall ("sched_setparam" pid-t (struct psched-param)) - pid param)) +(defun unix-munmap (addr length) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length)) + (syscall ("munmap" system-area-pointer size-t) t addr length)) -#+(or) -(defun unix-sched_getparam (pid param) - _N"Rewind the password-file stream." - (int-syscall ("sched_getparam" pid-t (struct psched-param)) - pid param)) +(defun unix-msync (addr length flags) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (signed-byte 32) flags)) + (syscall ("msync" system-area-pointer size-t int) t addr length flags)) +;;; Unix-rename accepts two files names and renames the first to the second. -#+(or) -(defun unix-sched_setscheduler (pid policy param) - _N"Set scheduling algorithm and/or parameters for a process." - (int-syscall ("sched_setscheduler" pid-t int (struct psched-param)) - pid policy param)) +(defun unix-rename (name1 name2) + _N"Unix-rename renames the file with string name1 to the string + name2. NIL and an error code is returned if an error occured." + (declare (type unix-pathname name1 name2)) + (void-syscall ("rename" c-string c-string) + (%name->file name1) (%name->file name2))) -#+(or) -(defun unix-sched_getscheduler (pid) - _N"Retrieve scheduling algorithm for a particular purpose." - (int-syscall ("sched_getscheduler" pid-t) - pid)) +;;; Unix-rmdir accepts a name and removes the associated directory. -(defun unix-sched-yield () - _N"Retrieve scheduling algorithm for a particular purpose." - (int-syscall ("sched_yield"))) +(defun unix-rmdir (name) + _N"Unix-rmdir attempts to remove the directory name. NIL and + an error number is returned if an error occured." + (declare (type unix-pathname name)) + (void-syscall ("rmdir" c-string) (%name->file name))) -#+(or) -(defun unix-sched_get_priority_max (algorithm) - _N"Get maximum priority value for a scheduler." - (int-syscall ("sched_get_priority_max" int) - algorithm)) +(def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int) -#+(or) -(defun unix-sched_get_priority_min (algorithm) - _N"Get minimum priority value for a scheduler." - (int-syscall ("sched_get_priority_min" int) - algorithm)) +(defconstant fd-setsize 1024) +(defconstant nfdbits 32) + +(def-alien-type nil + (struct fd-set + (fds-bits (array fd-mask #.(/ fd-setsize nfdbits))))) +;; not checked for linux... +(defmacro fd-clr (offset fd-set) + (let ((word (gensym)) + (bit (gensym))) + `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) + (setf (deref (slot ,fd-set 'fds-bits) ,word) + (logand (deref (slot ,fd-set 'fds-bits) ,word) + (32bit-logical-not + (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) +;; not checked for linux... +(defmacro fd-isset (offset fd-set) + (let ((word (gensym)) + (bit (gensym))) + `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) + (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) -#+(or) -(defun unix-sched_rr_get_interval (pid t) - _N"Get the SCHED_RR interval for the named process." - (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec))) - pid t)) +;; not checked for linux... +(defmacro fd-set (offset fd-set) + (let ((word (gensym)) + (bit (gensym))) + `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) + (setf (deref (slot ,fd-set 'fds-bits) ,word) + (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) + (deref (slot ,fd-set 'fds-bits) ,word)))))) -;;; schedbits.h +;; not checked for linux... +(defmacro fd-zero (fd-set) + `(progn + ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) + collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) -(defconstant scheduler-other 0) -(defconstant scheduler-fifo 1) -(defconstant scheduler-rr 2) +;;; TTY ioctl commands. +(eval-when (compile load eval) -;; Data structure to describe a process' schedulability. +(defconstant iocparm-mask #x3fff) +(defconstant ioc_void #x00000000) +(defconstant ioc_out #x40000000) +(defconstant ioc_in #x80000000) +(defconstant ioc_inout (logior ioc_in ioc_out)) -(def-alien-type nil - (struct sched_param - (sched-priority int))) +(defmacro define-ioctl-command (name dev cmd &optional arg parm-type) + _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given + then ioctl argument size and direction are included as for ioctls defined + by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type + is the characters code, else DEV may be an integer giving the type." + (let* ((type (if (characterp dev) + (char-code dev) + dev)) + (code (logior (ash type 8) cmd))) + (when arg + (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask) + 16) + ,code))) + (when parm-type + (let ((dir (ecase parm-type + (:void ioc_void) + (:in ioc_in) + (:out ioc_out) + (:inout ioc_inout)))) + (setf code `(logior ,dir ,code)))) + `(eval-when (eval load compile) + (defconstant ,name ,code)))) +) -;; Cloning flags. -(defconstant csignal #x000000ff _N"Signal mask to be sent at exit.") -(defconstant clone_vm #x00000100 _N"Set if VM shared between processes.") -(defconstant clone_fs #x00000200 _N"Set if fs info shared between processes") -(defconstant clone_files #x00000400 _N"Set if open files shared between processe") -(defconstant clone_sighand #x00000800 _N"Set if signal handlers shared.") -(defconstant clone_pid #x00001000 _N"Set if pid shared.") +;;; TTY ioctl commands. +(define-ioctl-command TIOCGWINSZ #\T #x13) +(define-ioctl-command TIOCSWINSZ #\T #x14) +(define-ioctl-command TIOCNOTTY #\T #x22) +(define-ioctl-command TIOCSPGRP #\T #x10) +(define-ioctl-command TIOCGPGRP #\T #x0F) -;;; shadow.h +;;; File ioctl commands. +(define-ioctl-command FIONREAD #\T #x1B) -;; Structure of the password file. +;;; ioctl-types.h (def-alien-type nil - (struct spwd - (sp-namp c-string) ; Login name. - (sp-pwdp c-string) ; Encrypted password. - (sp-lstchg long) ; Date of last change. - (sp-min long) ; Minimum number of days between changes. - (sp-max long) ; Maximum number of days between changes. - (sp-warn long) ; Number of days to warn user to change the password. - (sp-inact long) ; Number of days the account may be inactive. - (sp-expire long) ; Number of days since 1970-01-01 until account expires. - (sp-flags long))) ; Reserved. - -#+(or) -(defun unix-setspent () - _N"Open database for reading." - (void-syscall ("setspent"))) - -#+(or) -(defun unix-endspent () - _N"Close database." - (void-syscall ("endspent"))) - -#+(or) -(defun unix-getspent () - _N"Get next entry from database, perhaps after opening the file." - (let ((result (alien-funcall (extern-alien "getspent" - (function (* (struct spwd))))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-getspnam (name) - _N"Get shadow entry matching NAME." - (let ((result (alien-funcall (extern-alien "getspnam" - (function (* (struct spwd)) - c-string)) - name))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -#+(or) -(defun unix-sgetspent (string) - _N"Read shadow entry from STRING." - (let ((result (alien-funcall (extern-alien "sgetspent" - (function (* (struct spwd)) - c-string)) - string))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) - -;; - -#+(or) -(defun unix-lckpwdf () - _N"Protect password file against multi writers." - (void-syscall ("lckpwdf"))) + (struct winsize + (ws-row unsigned-short) ; rows, in characters + (ws-col unsigned-short) ; columns, in characters + (ws-xpixel unsigned-short) ; horizontal size, pixels + (ws-ypixel unsigned-short))) ; veritical size, pixels +(defconstant f-getfl 3 _N"Get file flags") +(defconstant f-setfl 4 _N"Set file flags") -#+(or) -(defun unix-ulckpwdf () - _N"Unlock password file." - (void-syscall ("ulckpwdf"))) +;;; Define some more compatibility macros to be backward compatible with +;;; BSD systems which did not managed to hide these kernel macros. -;;; bits/stat.h - -(def-alien-type nil - (struct stat - (st-dev dev-t) - #-(or alpha amd64) (st-pad1 unsigned-short) - (st-ino ino-t) - #+alpha (st-pad1 unsigned-int) - #-amd64 (st-mode mode-t) - (st-nlink nlink-t) - #+amd64 (st-mode mode-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - #-alpha (st-pad2 unsigned-short) - (st-size off-t) - #-alpha (st-blksize unsigned-long) - #-alpha (st-blocks blkcnt-t) - (st-atime time-t) - #-alpha (unused-1 unsigned-long) - (st-mtime time-t) - #-alpha (unused-2 unsigned-long) - (st-ctime time-t) - #+alpha (st-blocks int) - #+alpha (st-pad2 unsigned-int) - #+alpha (st-blksize unsigned-int) - #+alpha (st-flags unsigned-int) - #+alpha (st-gen unsigned-int) - #+alpha (st-pad3 unsigned-int) - #+alpha (unused-1 unsigned-long) - #+alpha (unused-2 unsigned-long) - (unused-3 unsigned-long) - (unused-4 unsigned-long) - #-alpha (unused-5 unsigned-long))) - -;; Encoding of the file mode. +(defconstant FAPPEND o_append _N"depricated stuff") +(defconstant FFSYNC o_fsync _N"depricated stuff") +(defconstant FASYNC o_async _N"depricated stuff") +(defconstant FNONBLOCK o_nonblock _N"depricated stuff") +(defconstant FNDELAY o_ndelay _N"depricated stuff") -(defconstant s-ifmt #o0170000 _N"These bits determine file type.") +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + +;;;; Lisp types used by syscalls. -;; File types. +(deftype unix-pathname () 'simple-string) +(deftype unix-fd () `(integer 0 ,most-positive-fixnum)) -(defconstant s-ififo #o0010000 _N"FIFO") -(defconstant s-ifchr #o0020000 _N"Character device") -(defconstant s-ifdir #o0040000 _N"Directory") -(defconstant s-ifblk #o0060000 _N"Block device") -(defconstant s-ifreg #o0100000 _N"Regular file") +(deftype unix-file-mode () '(unsigned-byte 32)) +(deftype unix-pid () '(unsigned-byte 32)) +(deftype unix-uid () '(unsigned-byte 32)) +(deftype unix-gid () '(unsigned-byte 32)) -;; These don't actually exist on System V, but having them doesn't hurt. +;;; Operations on Unix Directories. -(defconstant s-iflnk #o0120000 _N"Symbolic link.") -(defconstant s-ifsock #o0140000 _N"Socket.") +;;; direntry.h -;; Protection bits. +(def-alien-type nil + (struct dirent + #+glibc2.1 + (d-ino ino-t) ; inode number of entry + #-glibc2.1 + (d-ino ino64-t) ; inode number of entry + (d-off off-t) ; offset of next disk directory entry + (d-reclen unsigned-short) ; length of this record + (d_type unsigned-char) + (d-name (array char 256)))) ; name must be no longer than this -(defconstant s-isuid #o0004000 _N"Set user ID on execution.") -(defconstant s-isgid #o0002000 _N"Set group ID on execution.") -(defconstant s-isvtx #o0001000 _N"Save swapped text after use (sticky).") -(defconstant s-iread #o0000400 _N"Read by owner") -(defconstant s-iwrite #o0000200 _N"Write by owner.") -(defconstant s-iexec #o0000100 _N"Execute by owner.") +(export '(open-dir read-dir close-dir)) -;;; statfsbuf.h +(defstruct (%directory + (:constructor make-directory) + (:conc-name directory-) + (:print-function %print-directory)) + name + (dir-struct (required-argument) :type system-area-pointer)) -(def-alien-type nil - (struct statfs - (f-type int) - (f-bsize int) - (f-blocks fsblkcnt-t) - (f-bfree fsblkcnt-t) - (f-bavail fsblkcnt-t) - (f-files fsfilcnt-t) - (f-ffree fsfilcnt-t) - (f-fsid fsid-t) - (f-namelen int) - (f-spare (array int 6)))) +(defun %print-directory (dir stream depth) + (declare (ignore depth)) + (format stream "#<Directory ~S>" (directory-name dir))) +(defun open-dir (pathname) + (declare (type unix-pathname pathname)) + (when (string= pathname "") + (setf pathname ".")) + (let ((kind (unix-file-kind pathname))) + (case kind + (:directory + (let ((dir-struct + (alien-funcall (extern-alien "opendir" + (function system-area-pointer + c-string)) + (%name->file pathname)))) + (if (zerop (sap-int dir-struct)) + (values nil (unix-errno)) + (make-directory :name pathname :dir-struct dir-struct)))) + ((nil) + (values nil enoent)) + (t + (values nil enotdir))))) -;;; termbits.h +(defun read-dir (dir) + (declare (type %directory dir)) + (let ((daddr (alien-funcall (extern-alien "readdir64" + (function system-area-pointer + system-area-pointer)) + (directory-dir-struct dir)))) + (declare (type system-area-pointer daddr)) + (if (zerop (sap-int daddr)) + nil + (with-alien ((dirent (* (struct dirent)) daddr)) + (values (%file->name (cast (slot dirent 'd-name) c-string)) + (slot dirent 'd-ino)))))) -(def-alien-type cc-t unsigned-char) -(def-alien-type speed-t unsigned-int) -(def-alien-type tcflag-t unsigned-int) +(defun close-dir (dir) + (declare (type %directory dir)) + (alien-funcall (extern-alien "closedir" + (function void system-area-pointer)) + (directory-dir-struct dir)) + nil) -(defconstant +NCCS+ 32 - _N"Size of control character vector.") +(defconstant rusage_self 0 _N"The calling process.") +(defconstant rusage_children -1 _N"Terminated child processes.") +(defconstant rusage_both -2) (def-alien-type nil - (struct termios - (c-iflag tcflag-t) - (c-oflag tcflag-t) - (c-cflag tcflag-t) - (c-lflag tcflag-t) - (c-line cc-t) - (c-cc (array cc-t #.+NCCS+)) - (c-ispeed speed-t) - (c-ospeed speed-t))) + (struct rusage + (ru-utime (struct timeval)) ; user time used + (ru-stime (struct timeval)) ; system time used. + (ru-maxrss long) ; Maximum resident set size (in kilobytes) + (ru-ixrss long) ; integral shared memory size + (ru-idrss long) ; integral unshared data " + (ru-isrss long) ; integral unshared stack " + (ru-minflt long) ; page reclaims + (ru-majflt long) ; page faults + (ru-nswap long) ; swaps + (ru-inblock long) ; block input operations + (ru-oublock long) ; block output operations + (ru-msgsnd long) ; messages sent + (ru-msgrcv long) ; messages received + (ru-nsignals long) ; signals received + (ru-nvcsw long) ; voluntary context switches + (ru-nivcsw long))) -;; c_cc characters +(declaim (inline unix-fast-getrusage)) +(defun unix-fast-getrusage (who) + _N"Like call getrusage, but return only the system and user time, and returns + the seconds and microseconds as separate values." + (declare (values (member t) + (unsigned-byte 31) (mod 1000000) + (unsigned-byte 31) (mod 1000000))) + (with-alien ((usage (struct rusage))) + (syscall* ("getrusage" int (* (struct rusage))) + (values t + (slot (slot usage 'ru-utime) 'tv-sec) + (slot (slot usage 'ru-utime) 'tv-usec) + (slot (slot usage 'ru-stime) 'tv-sec) + (slot (slot usage 'ru-stime) 'tv-usec)) + who (addr usage)))) -(def-enum + 0 vintr vquit verase - vkill veof vtime - vmin vswtc vstart - vstop vsusp veol - vreprint vdiscard vwerase - vlnext veol2) -(defvar vdsusp vsusp) +(defun unix-getrusage (who) + _N"Unix-getrusage returns information about the resource usage + of the process specified by who. Who can be either the + current process (rusage_self) or all of the terminated + child processes (rusage_children). NIL and an error number + is returned if the call fails." + (with-alien ((usage (struct rusage))) + (syscall ("getrusage" int (* (struct rusage))) + (values t + (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000) + (slot (slot usage 'ru-utime) 'tv-usec)) + (+ (* (slot (slot usage 'ru-stime) 'tv-sec) 1000000) + (slot (slot usage 'ru-stime) 'tv-usec)) + (slot usage 'ru-maxrss) + (slot usage 'ru-ixrss) + (slot usage 'ru-idrss) + (slot usage 'ru-isrss) + (slot usage 'ru-minflt) + (slot usage 'ru-majflt) + (slot usage 'ru-nswap) + (slot usage 'ru-inblock) + (slot usage 'ru-oublock) + (slot usage 'ru-msgsnd) + (slot usage 'ru-msgrcv) + (slot usage 'ru-nsignals) + (slot usage 'ru-nvcsw) + (slot usage 'ru-nivcsw)) + who (addr usage)))) -(def-enum + 0 tciflush tcoflush tcioflush) +;;;; Socket support. -(def-enum + 0 tcsanow tcsadrain tcsaflush) +;;; Looks a bit naked. -;; c_iflag bits -(def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck - tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc - tty-ixon tty-ixany tty-ixoff - tty-imaxbel) +(def-alien-routine ("socket" unix-socket) int + (domain int) + (type int) + (protocol int)) -;; c_oflag bits -(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr - tty-onlret tty-ofill tty-ofdel tty-nldly) +(def-alien-routine ("connect" unix-connect) int + (socket int) + (sockaddr (* t)) + (len int)) -(defconstant tty-nl0 0) -(defconstant tty-nl1 #o400) - -(defconstant tty-crdly #o0003000) -(defconstant tty-cr0 #o0000000) -(defconstant tty-cr1 #o0001000) -(defconstant tty-cr2 #o0002000) -(defconstant tty-cr3 #o0003000) -(defconstant tty-tabdly #o0014000) -(defconstant tty-tab0 #o0000000) -(defconstant tty-tab1 #o0004000) -(defconstant tty-tab2 #o0010000) -(defconstant tty-tab3 #o0014000) -(defconstant tty-xtabs #o0014000) -(defconstant tty-bsdly #o0020000) -(defconstant tty-bs0 #o0000000) -(defconstant tty-bs1 #o0020000) -(defconstant tty-vtdly #o0040000) -(defconstant tty-vt0 #o0000000) -(defconstant tty-vt1 #o0040000) -(defconstant tty-ffdly #o0100000) -(defconstant tty-ff0 #o0000000) -(defconstant tty-ff1 #o0100000) - -;; c-cflag bit meaning -(defconstant tty-cbaud #o0010017) -(defconstant tty-b0 #o0000000) ;; hang up -(defconstant tty-b50 #o0000001) -(defconstant tty-b75 #o0000002) -(defconstant tty-b110 #o0000003) -(defconstant tty-b134 #o0000004) -(defconstant tty-b150 #o0000005) -(defconstant tty-b200 #o0000006) -(defconstant tty-b300 #o0000007) -(defconstant tty-b600 #o0000010) -(defconstant tty-b1200 #o0000011) -(defconstant tty-b1800 #o0000012) -(defconstant tty-b2400 #o0000013) -(defconstant tty-b4800 #o0000014) -(defconstant tty-b9600 #o0000015) -(defconstant tty-b19200 #o0000016) -(defconstant tty-b38400 #o0000017) -(defconstant tty-exta tty-b19200) -(defconstant tty-extb tty-b38400) -(defconstant tty-csize #o0000060) -(defconstant tty-cs5 #o0000000) -(defconstant tty-cs6 #o0000020) -(defconstant tty-cs7 #o0000040) -(defconstant tty-cs8 #o0000060) -(defconstant tty-cstopb #o0000100) -(defconstant tty-cread #o0000200) -(defconstant tty-parenb #o0000400) -(defconstant tty-parodd #o0001000) -(defconstant tty-hupcl #o0002000) -(defconstant tty-clocal #o0004000) -(defconstant tty-cbaudex #o0010000) -(defconstant tty-b57600 #o0010001) -(defconstant tty-b115200 #o0010002) -(defconstant tty-b230400 #o0010003) -(defconstant tty-b460800 #o0010004) -(defconstant tty-cibaud #o002003600000) ; input baud rate (not used) -(defconstant tty-crtscts #o020000000000) ;flow control +(def-alien-routine ("bind" unix-bind) int + (socket int) + (sockaddr (* t)) + (len int)) -;; c_lflag bits -(def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe - tty-echok tty-echonl tty-noflsh - tty-tostop tty-echoctl tty-echoprt - tty-echoke tty-flusho - tty-pendin tty-iexten) +(def-alien-routine ("listen" unix-listen) int + (socket int) + (backlog int)) -;;; tcflow() and TCXONC use these -(def-enum + 0 tty-tcooff tty-tcoon tty-tcioff tty-tcion) +(def-alien-routine ("accept" unix-accept) int + (socket int) + (sockaddr (* t)) + (len int :in-out)) -;; tcflush() and TCFLSH use these */ -(def-enum + 0 tty-tciflush tty-tcoflush tty-tcioflush) +(def-alien-routine ("recv" unix-recv) int + (fd int) + (buffer c-string) + (length int) + (flags int)) -;; tcsetattr uses these -(def-enum + 0 tty-tcsanow tty-tcsadrain tty-tcsaflush) +(def-alien-routine ("send" unix-send) int + (fd int) + (buffer c-string) + (length int) + (flags int)) -;;; termios.h - -(defun unix-cfgetospeed (termios) - _N"Get terminal output speed." - (multiple-value-bind (speed errno) - (int-syscall ("cfgetospeed" (* (struct termios))) termios) - (if speed - (values (svref terminal-speeds speed) 0) - (values speed errno)))) +(def-alien-routine ("getpeername" unix-getpeername) int + (socket int) + (sockaddr (* t)) + (len (* unsigned))) -(defun unix-cfsetospeed (termios speed) - _N"Set terminal output speed." - (let ((baud (or (position speed terminal-speeds) - (error _"Bogus baud rate ~S" speed)))) - (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud))) +(def-alien-routine ("getsockname" unix-getsockname) int + (socket int) + (sockaddr (* t)) + (len (* unsigned))) -(defun unix-cfgetispeed (termios) - _N"Get terminal input speed." - (multiple-value-bind (speed errno) - (int-syscall ("cfgetispeed" (* (struct termios))) termios) - (if speed - (values (svref terminal-speeds speed) 0) - (values speed errno)))) +(def-alien-routine ("getsockopt" unix-getsockopt) int + (socket int) + (level int) + (optname int) + (optval (* t)) + (optlen unsigned :in-out)) -(defun unix-cfsetispeed (termios speed) - _N"Set terminal input speed." - (let ((baud (or (position speed terminal-speeds) - (error _"Bogus baud rate ~S" speed)))) - (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud))) +(def-alien-routine ("setsockopt" unix-setsockopt) int + (socket int) + (level int) + (optname int) + (optval (* t)) + (optlen unsigned)) -(defun unix-tcgetattr (fd termios) - _N"Get terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) +;; Datagram support -(defun unix-tcsetattr (fd opt termios) - _N"Set terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios)) +(def-alien-routine ("recvfrom" unix-recvfrom) int + (fd int) + (buffer c-string) + (length int) + (flags int) + (sockaddr (* t)) + (len int :in-out)) -(defun unix-tcsendbreak (fd duration) - _N"Send break" - (declare (type unix-fd fd)) - (void-syscall ("tcsendbreak" int int) fd duration)) +(def-alien-routine ("sendto" unix-sendto) int + (fd int) + (buffer c-string) + (length int) + (flags int) + (sockaddr (* t)) + (len int)) -(defun unix-tcdrain (fd) - _N"Wait for output for finish" - (declare (type unix-fd fd)) - (void-syscall ("tcdrain" int) fd)) +(def-alien-routine ("shutdown" unix-shutdown) int + (socket int) + (level int)) -(defun unix-tcflush (fd selector) - _N"See tcflush(3)" - (declare (type unix-fd fd)) - (void-syscall ("tcflush" int int) fd selector)) +;;; sys/select.h -(defun unix-tcflow (fd action) - _N"Flow control" - (declare (type unix-fd fd)) - (void-syscall ("tcflow" int int) fd action)) +;;; UNIX-FAST-SELECT -- public. +;;; +(defmacro unix-fast-select (num-descriptors + read-fds write-fds exception-fds + timeout-secs &optional (timeout-usecs 0)) + _N"Perform the UNIX select(2) system call." + (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) + (type (or (alien (* (struct fd-set))) null) + read-fds write-fds exception-fds) + (type (or null (unsigned-byte 31)) timeout-secs) + (type (unsigned-byte 31) timeout-usecs) + (optimize (speed 3) (safety 0) (inhibit-warnings 3))) + `(let ((timeout-secs ,timeout-secs)) + (with-alien ((tv (struct timeval))) + (when timeout-secs + (setf (slot tv 'tv-sec) timeout-secs) + (setf (slot tv 'tv-usec) ,timeout-usecs)) + (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) + (* (struct fd-set)) (* (struct timeval))) + ,num-descriptors ,read-fds ,write-fds ,exception-fds + (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) -;;; timebits.h -;; A time value that is accurate to the nearest -;; microsecond but also has a range of years. -(def-alien-type nil - (struct timeval - (tv-sec time-t) ; seconds - (tv-usec time-t))) ; and microseconds +;;; Unix-select accepts sets of file descriptors and waits for an event +;;; to happen on one of them or to time out. -;;; unistd.h - -(defun sub-unix-execve (program arg-list env-list) - (let ((argv nil) - (argv-bytes 0) - (envp nil) - (envp-bytes 0) - result error-code) - (unwind-protect - (progn - ;; Blast the stuff into the proper format - (multiple-value-setq - (argv argv-bytes) - (string-list-to-c-strvec arg-list)) - (multiple-value-setq - (envp envp-bytes) - (string-list-to-c-strvec env-list)) - ;; - ;; Now do the system call - (multiple-value-setq - (result error-code) - (int-syscall ("execve" - c-string system-area-pointer system-area-pointer) - program argv envp))) - ;; - ;; Deallocate memory - (when argv - (system:deallocate-system-memory argv argv-bytes)) - (when envp - (system:deallocate-system-memory envp envp-bytes))) - (values result error-code))) - -;;;; UNIX-EXECVE - -(defun unix-execve (program &optional arg-list - (environment *environment-list*)) - _N"Executes the Unix execve system call. If the system call suceeds, lisp - will no longer be running in this process. If the system call fails this - function returns two values: NIL and an error code. Arg-list should be a - list of simple-strings which are passed as arguments to the exec'ed program. - Environment should be an a-list mapping symbols to simple-strings which this - function bashes together to form the environment for the exec'ed program." - (check-type program simple-string) - (let ((env-list (let ((envlist nil)) - (dolist (cons environment) - (push (if (cdr cons) - (concatenate 'simple-string - (string (car cons)) "=" - (cdr cons)) - (car cons)) - envlist)) - envlist))) - (sub-unix-execve (%name->file program) arg-list env-list))) - - -(defmacro round-bytes-to-words (n) - `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3))) +(defmacro num-to-fd-set (fdset num) + `(if (fixnump ,num) + (progn + (setf (deref (slot ,fdset 'fds-bits) 0) ,num) + ,@(loop for index upfrom 1 below (/ fd-setsize nfdbits) + collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) + (progn + ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) + collect `(setf (deref (slot ,fdset 'fds-bits) ,index) + (ldb (byte nfdbits ,(* index nfdbits)) ,num)))))) -;; Values for the second argument to access. +(defmacro fd-set-to-num (nfds fdset) + `(if (<= ,nfds nfdbits) + (deref (slot ,fdset 'fds-bits) 0) + (+ ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) + collect `(ash (deref (slot ,fdset 'fds-bits) ,index) + ,(* index nfdbits)))))) -;;; Unix-access accepts a path and a mode. It returns two values the -;;; first is T if the file is accessible and NIL otherwise. The second -;;; only has meaning in the second case and is the unix errno value. +(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) + _N"Unix-select examines the sets of descriptors passed as arguments + to see if they are ready for reading and writing. See the UNIX + Programmers Manual for more information." + (declare (type (integer 0 #.FD-SETSIZE) nfds) + (type unsigned-byte rdfds wrfds xpfds) + (type (or (unsigned-byte 31) null) to-secs) + (type (unsigned-byte 31) to-usecs) + (optimize (speed 3) (safety 0) (inhibit-warnings 3))) + (with-alien ((tv (struct timeval)) + (rdf (struct fd-set)) + (wrf (struct fd-set)) + (xpf (struct fd-set))) + (when to-secs + (setf (slot tv 'tv-sec) to-secs) + (setf (slot tv 'tv-usec) to-usecs)) + (num-to-fd-set rdf rdfds) + (num-to-fd-set wrf wrfds) + (num-to-fd-set xpf xpfds) + (macrolet ((frob (lispvar alienvar) + `(if (zerop ,lispvar) + (int-sap 0) + (alien-sap (addr ,alienvar))))) + (syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) + (* (struct fd-set)) (* (struct timeval))) + (values result + (fd-set-to-num nfds rdf) + (fd-set-to-num nfds wrf) + (fd-set-to-num nfds xpf)) + nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) + (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) -(defun unix-access (path mode) - _N"Given a file path (a string) and one of four constant modes, - unix-access returns T if the file is accessible with that - mode and NIL if not. It also returns an errno value with - NIL which determines why the file was not accessible. +(defun unix-symlink (name1 name2) + _N"Unix-symlink creates a symbolic link named name2 to the file + named name1. NIL and an error number is returned if the call + is unsuccessful." + (declare (type unix-pathname name1 name2)) + (void-syscall ("symlink" c-string c-string) + (%name->file name1) (%name->file name2))) - The access modes are: - r_ok Read permission. - w_ok Write permission. - x_ok Execute permission. - f_ok Presence of file." - (declare (type unix-pathname path) - (type (mod 8) mode)) - (void-syscall ("access" c-string int) (%name->file path) mode)) +(def-alien-routine ("gethostid" unix-gethostid) unsigned-long + _N"Unix-gethostid returns a 32-bit integer which provides unique + identification for the host machine.") -(defconstant l_set 0 _N"set the file pointer") -(defconstant l_incr 1 _N"increment the file pointer") -(defconstant l_xtnd 2 _N"extend the file size") +(def-alien-routine ("getpid" unix-getpid) int + _N"Unix-getpid returns the process-id of the current process.") -(defun unix-lseek (fd offset whence) - _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead - a certain OFFSET for that file. WHENCE can be any of the following: +;;;; User and group database structures: <pwd.h> and <grp.h> +(defstruct user-info + (name "" :type string) + (password "" :type string) + (uid 0 :type unix-uid) + (gid 0 :type unix-gid) + (gecos "" :type string) + (dir "" :type string) + (shell "" :type string)) - l_set Set the file pointer. - l_incr Increment the file pointer. - l_xtnd Extend the file size. - " - (declare (type unix-fd fd) - (type (signed-byte 64) offset) - (type (integer 0 2) whence)) - (let ((result (alien-funcall - (extern-alien "lseek64" (function off-t int off-t int)) - fd offset whence))) - (if (minusp result) - (values nil (unix-errno)) - (values result 0)))) +(defun unix-getpwuid (uid) + _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." + (declare (type unix-uid uid)) + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd)) + (result (* (struct passwd)))) + (let ((returned + (alien-funcall + (extern-alien "getpwuid_r" + (function c-call:int + c-call:unsigned-int + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct passwd))))) + uid + (addr user-info) + (cast buf (* c-call:char)) + 1024 + (addr result)))) + (when (zerop returned) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) +(declaim (inline unix-gettimeofday)) +(defun unix-gettimeofday () + _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and + microseconds of the current time of day, the timezone (in minutes west + of Greenwich), and a daylight-savings flag. If it doesn't work, it + returns NIL and the errno." + (with-alien ((tv (struct timeval)) + (tz (struct timezone))) + (syscall* ("gettimeofday" (* (struct timeval)) + (* (struct timezone))) + (values T + (slot tv 'tv-sec) + (slot tv 'tv-usec) + (slot tz 'tz-minuteswest) + (slot tz 'tz-dsttime)) + (addr tv) + (addr tz)))) -;;; UNIX-READ accepts a file descriptor, a buffer, and the length to read. -;;; It attempts to read len bytes from the device associated with fd -;;; and store them into the buffer. It returns the actual number of -;;; bytes read. +;;; Unix-utimes changes the accessed and updated times on UNIX +;;; files. The first argument is the filename (a string) and +;;; the second argument is a list of the 4 times- accessed and +;;; updated seconds and microseconds. -(defun unix-read (fd buf len) - _N"UNIX-READ attempts to read from the file described by fd into - the buffer buf until it is full. Len is the length of the buffer. - The number of bytes actually read is returned or NIL and an error - number if an error occured." - (declare (type unix-fd fd) - (type (unsigned-byte 32) len)) - #+gencgc - ;; With gencgc, the collector tries to keep raw objects like strings - ;; in separate pages that are not write-protected. However, this - ;; isn't always true. Thus, BUF will sometimes be write-protected - ;; and the kernel doesn't like writing to write-protected pages. So - ;; go through and touch each page to give the segv handler a chance - ;; to unprotect the pages. (This is taken from unix.lisp.) - (without-gcing - (let* ((page-size (get-page-size)) - (1-page-size (1- page-size)) - (sap (etypecase buf - (system-area-pointer buf) - (vector (vector-sap buf)))) - (end (sap+ sap len))) - (declare (type (and fixnum unsigned-byte) page-size 1-page-size) - (type system-area-pointer sap end) - (optimize (speed 3) (safety 0))) - ;; Touch the beginning of every page - (do ((sap (int-sap (logand (sap-int sap) - (logxor 1-page-size (ldb (byte 32 0) -1)))) - (sap+ sap page-size))) - ((sap>= sap end)) - (declare (type system-area-pointer sap)) - (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0))))) - (int-syscall ("read" int (* char) int) fd buf len)) - - -;;; Unix-write accepts a file descriptor, a buffer, an offset, and the -;;; length to write. It attempts to write len bytes to the device -;;; associated with fd from the the buffer starting at offset. It returns -;;; the actual number of bytes written. - -(defun unix-write (fd buf offset len) - _N"Unix-write attempts to write a character buffer (buf) of length - len to the file described by the file descriptor fd. NIL and an - error is returned if the call is unsuccessful." - (declare (type unix-fd fd) - (type (unsigned-byte 32) offset len)) - (int-syscall ("write" int (* char) int) - fd - (with-alien ((ptr (* char) (etypecase buf - ((simple-array * (*)) - (vector-sap buf)) - (system-area-pointer - buf)))) - (addr (deref ptr offset))) - len)) - -(defun unix-pipe () - _N"Unix-pipe sets up a unix-piping mechanism consisting of - an input pipe and an output pipe. Unix-Pipe returns two - values: if no error occurred the first value is the pipe - to be read from and the second is can be written to. If - an error occurred the first value is NIL and the second - the unix error code." - (with-alien ((fds (array int 2))) - (syscall ("pipe" (* int)) - (values (deref fds 0) (deref fds 1)) - (cast fds (* int))))) - - -(defun unix-chown (path uid gid) - _N"Given a file path, an integer user-id, and an integer group-id, - unix-chown changes the owner of the file and the group of the - file to those specified. Either the owner or the group may be - left unchanged by specifying them as -1. Note: Permission will - fail if the caller is not the superuser." - (declare (type unix-pathname path) - (type (or unix-uid (integer -1 -1)) uid) - (type (or unix-gid (integer -1 -1)) gid)) - (void-syscall ("chown" c-string int int) (%name->file path) uid gid)) - -;;; Unix-fchown is exactly the same as unix-chown except that the file -;;; is specified by a file-descriptor ("fd") instead of a pathname. - -(defun unix-fchown (fd uid gid) - _N"Unix-fchown is like unix-chown, except that it accepts an integer - file descriptor instead of a file path name." - (declare (type unix-fd fd) - (type (or unix-uid (integer -1 -1)) uid) - (type (or unix-gid (integer -1 -1)) gid)) - (void-syscall ("fchown" int int int) fd uid gid)) - -;;; Unix-chdir accepts a directory name and makes that the -;;; current working directory. - -(defun unix-chdir (path) - _N"Given a file path string, unix-chdir changes the current working - directory to the one specified." - (declare (type unix-pathname path)) - (void-syscall ("chdir" c-string) (%name->file path))) - -(defun unix-current-directory () - _N"Put the absolute pathname of the current working directory in BUF. - If successful, return BUF. If not, put an error message in - BUF and return NULL. BUF should be at least PATH_MAX bytes long." - ;; 5120 is some randomly selected maximum size for the buffer for getcwd. - (with-alien ((buf (array c-call:char 5120))) - (let ((result (alien-funcall - (extern-alien "getcwd" - (function (* c-call:char) - (* c-call:char) c-call:int)) - (cast buf (* c-call:char)) - 5120))) - - (values (not (zerop (sap-int (alien-sap result)))) - (%file->name (cast buf c-call:c-string)))))) - - -;;; Unix-dup returns a duplicate copy of the existing file-descriptor -;;; passed as an argument. - -(defun unix-dup (fd) - _N"Unix-dup duplicates an existing file descriptor (given as the - argument) and return it. If FD is not a valid file descriptor, NIL - and an error number are returned." - (declare (type unix-fd fd)) - (int-syscall ("dup" int) fd)) - -;;; Unix-dup2 makes the second file-descriptor describe the same file -;;; as the first. If the second file-descriptor points to an open -;;; file, it is first closed. In any case, the second should have a -;;; value which is a valid file-descriptor. - -(defun unix-dup2 (fd1 fd2) - _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup - does only the new value of the duplicate descriptor may be requested - through the second argument. If a file already exists with the - requested descriptor number, it will be closed and the number - assigned to the duplicate." - (declare (type unix-fd fd1 fd2)) - (void-syscall ("dup2" int int) fd1 fd2)) - -;;; Unix-exit terminates a program. - -(defun unix-exit (&optional (code 0)) - _N"Unix-exit terminates the current process with an optional - error code. If successful, the call doesn't return. If - unsuccessful, the call returns NIL and an error number." - (declare (type (signed-byte 32) code)) - (void-syscall ("exit" int) code)) - -#+(or) -(defun unix-pathconf (path name) - _N"Get file-specific configuration information about PATH." - (int-syscall ("pathconf" c-string int) (%name->file path) name)) - -#+(or) -(defun unix-sysconf (name) - _N"Get the value of the system variable NAME." - (int-syscall ("sysconf" int) name)) - -#+(or) -(defun unix-confstr (name) - _N"Get the value of the string-valued system variable NAME." - (with-alien ((buf (array char 1024))) - (values (not (zerop (alien-funcall (extern-alien "confstr" - (function int - c-string - size-t)) - name buf 1024))) - (cast buf c-string)))) - - -(def-alien-routine ("getpid" unix-getpid) int - _N"Unix-getpid returns the process-id of the current process.") - -(def-alien-routine ("getppid" unix-getppid) int - _N"Unix-getppid returns the process-id of the parent of the current process.") - -;;; Unix-getpgrp returns the group-id associated with the -;;; current process. - -(defun unix-getpgrp () - _N"Unix-getpgrp returns the group-id of the calling process." - (int-syscall ("getpgrp"))) - -;;; Unix-setpgid sets the group-id of the process specified by -;;; "pid" to the value of "pgrp". The process must either have -;;; the same effective user-id or be a super-user process. - -;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained -;;; for backward compatibility. setpgrp(void)[solaris] is being phased -;;; out in favor of setsid(). - -(defun unix-setpgrp (pid pgrp) - _N"Unix-setpgrp sets the process group on the process pid to - pgrp. NIL and an error number are returned upon failure." - (void-syscall ("setpgid" int int) pid pgrp)) - -(defun unix-setpgid (pid pgrp) - _N"Unix-setpgid sets the process group of the process pid to - pgrp. If pgid is equal to pid, the process becomes a process - group leader. NIL and an error number are returned upon failure." - (void-syscall ("setpgid" int int) pid pgrp)) - -#+(or) -(defun unix-setsid () - _N"Create a new session with the calling process as its leader. - The process group IDs of the session and the calling process - are set to the process ID of the calling process, which is returned." - (void-syscall ( "setsid"))) - -#+(or) -(defun unix-getsid () - _N"Return the session ID of the given process." - (int-syscall ( "getsid"))) - -(def-alien-routine ("getuid" unix-getuid) int - _N"Unix-getuid returns the real user-id associated with the - current process.") - -#+(or) -(def-alien-routine ("geteuid" unix-getuid) int - _N"Get the effective user ID of the calling process.") - -(def-alien-routine ("getgid" unix-getgid) int - _N"Unix-getgid returns the real group-id of the current process.") - -(def-alien-routine ("getegid" unix-getegid) int - _N"Unix-getegid returns the effective group-id of the current process.") - -;/* If SIZE is zero, return the number of supplementary groups -; the calling process is in. Otherwise, fill in the group IDs -; of its supplementary groups in LIST and return the number written. */ -;extern int getgroups __P ((int __size, __gid_t __list[])); - -#+(or) -(defun unix-group-member (gid) - _N"Return nonzero iff the calling process is in group GID." - (int-syscall ( "group-member" gid-t) gid)) - - -(defun unix-setuid (uid) - _N"Set the user ID of the calling process to UID. - If the calling process is the super-user, set the real - and effective user IDs, and the saved set-user-ID to UID; - if not, the effective user ID is set to UID." - (int-syscall ("setuid" uid-t) uid)) - -;;; Unix-setreuid sets the real and effective user-id's of the current -;;; process to the arguments "ruid" and "euid", respectively. Usage is -;;; restricted for anyone but the super-user. Setting either "ruid" or -;;; "euid" to -1 makes the system use the current id instead. - -(defun unix-setreuid (ruid euid) - _N"Unix-setreuid sets the real and effective user-id's of the current - process to the specified ones. NIL and an error number is returned - if the call fails." - (void-syscall ("setreuid" int int) ruid euid)) - -(defun unix-setgid (gid) - _N"Set the group ID of the calling process to GID. - If the calling process is the super-user, set the real - and effective group IDs, and the saved set-group-ID to GID; - if not, the effective group ID is set to GID." - (int-syscall ("setgid" gid-t) gid)) - - -;;; Unix-setregid sets the real and effective group-id's of the current -;;; process to the arguments "rgid" and "egid", respectively. Usage is -;;; restricted for anyone but the super-user. Setting either "rgid" or -;;; "egid" to -1 makes the system use the current id instead. - -(defun unix-setregid (rgid egid) - _N"Unix-setregid sets the real and effective group-id's of the current - process process to the specified ones. NIL and an error number is - returned if the call fails." - (void-syscall ("setregid" int int) rgid egid)) - -(defun unix-fork () - _N"Executes the unix fork system call. Returns 0 in the child and the pid - of the child in the parent if it works, or NIL and an error number if it - doesn't work." - (int-syscall ("fork"))) - -;; Environment maninpulation; man getenv(3) -(def-alien-routine ("getenv" unix-getenv) c-call:c-string - (name c-call:c-string) - _N"Get the value of the environment variable named Name. If no such - variable exists, Nil is returned.") - -(def-alien-routine ("setenv" unix-setenv) c-call:int - (name c-call:c-string) - (value c-call:c-string) - (overwrite c-call:int) - _N"Adds the environment variable named Name to the environment with - the given Value if Name does not already exist. If Name does exist, - the value is changed to Value if Overwrite is non-zero. Otherwise, - the value is not changed.") - -(def-alien-routine ("putenv" unix-putenv) c-call:int - (name c-call:c-string) - _N"Adds or changes the environment. Name-value must be a string of - the form \"name=value\". If the name does not exist, it is added. - If name does exist, the value is updated to the given value.") - -(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int - (name c-call:c-string) - _N"Removes the variable Name from the environment") +(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec) + _N"Unix-utimes sets the 'last-accessed' and 'last-updated' + times on a specified file. NIL and an error number is + returned if the call is unsuccessful." + (declare (type unix-pathname file) + (type (alien unsigned-long) + atime-sec atime-usec + mtime-sec mtime-usec)) + (with-alien ((tvp (array (struct timeval) 2))) + (setf (slot (deref tvp 0) 'tv-sec) atime-sec) + (setf (slot (deref tvp 0) 'tv-usec) atime-usec) + (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) + (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) + (void-syscall ("utimes" c-string (* (struct timeval))) + file + (cast tvp (* (struct timeval)))))) (def-alien-routine ("ttyname" unix-ttyname) c-string (fd int)) @@ -2139,127 +1598,19 @@ length LEN and type TYPE." associated with it is a terminal." (fd int)) -;;; Unix-link creates a hard link from name2 to name1. - -(defun unix-link (name1 name2) - _N"Unix-link creates a hard link from the file with name1 to the - file with name2." - (declare (type unix-pathname name1 name2)) - (void-syscall ("link" c-string c-string) - (%name->file name1) (%name->file name2))) - -(defun unix-symlink (name1 name2) - _N"Unix-symlink creates a symbolic link named name2 to the file - named name1. NIL and an error number is returned if the call - is unsuccessful." - (declare (type unix-pathname name1 name2)) - (void-syscall ("symlink" c-string c-string) - (%name->file name1) (%name->file name2))) - -(defun unix-readlink (path) - _N"Unix-readlink invokes the readlink system call on the file name - specified by the simple string path. It returns up to two values: - the contents of the symbolic link if the call is successful, or - NIL and the Unix error number." - (declare (type unix-pathname path)) - (with-alien ((buf (array char 1024))) - (syscall ("readlink" c-string (* char) int) - (let ((string (make-string result))) - #-unicode - (kernel:copy-from-system-area - (alien-sap buf) 0 - string (* vm:vector-data-offset vm:word-bits) - (* result vm:byte-bits)) - #+unicode - (let ((sap (alien-sap buf))) - (dotimes (k result) - (setf (aref string k) (code-char (sap-ref-8 sap k))))) - (%file->name string)) - (%name->file path) (cast buf (* char)) 1024))) - -;;; Unix-unlink accepts a name and deletes the directory entry for that -;;; name and the file if this is the last link. - -(defun unix-unlink (name) - _N"Unix-unlink removes the directory entry for the named file. - NIL and an error code is returned if the call fails." - (declare (type unix-pathname name)) - (void-syscall ("unlink" c-string) (%name->file name))) - -;;; Unix-rmdir accepts a name and removes the associated directory. - -(defun unix-rmdir (name) - _N"Unix-rmdir attempts to remove the directory name. NIL and - an error number is returned if an error occured." - (declare (type unix-pathname name)) - (void-syscall ("rmdir" c-string) (%name->file name))) +;;; pty.h -(defun tcgetpgrp (fd) - _N"Get the tty-process-group for the unix file-descriptor FD." - (alien:with-alien ((alien-pgrp c-call:int)) - (multiple-value-bind (ok err) - (unix-ioctl fd - tiocgpgrp - (alien:alien-sap (alien:addr alien-pgrp))) - (if ok - (values alien-pgrp nil) - (values nil err))))) - -(defun tty-process-group (&optional fd) - _N"Get the tty-process-group for the unix file-descriptor FD. If not supplied, - FD defaults to /dev/tty." - (if fd - (tcgetpgrp fd) - (multiple-value-bind (tty-fd errno) - (unix-open "/dev/tty" o_rdwr 0) - (cond (tty-fd - (multiple-value-prog1 - (tcgetpgrp tty-fd) - (unix-close tty-fd))) - (t - (values nil errno)))))) - -(defun tcsetpgrp (fd pgrp) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP." - (alien:with-alien ((alien-pgrp c-call:int pgrp)) - (unix-ioctl fd - tiocspgrp - (alien:alien-sap (alien:addr alien-pgrp))))) - -(defun %set-tty-process-group (pgrp &optional fd) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not - supplied, FD defaults to /dev/tty." - (let ((old-sigs - (unix-sigblock - (sigmask :sigttou :sigttin :sigtstp :sigchld)))) - (declare (type (unsigned-byte 32) old-sigs)) - (unwind-protect - (if fd - (tcsetpgrp fd pgrp) - (multiple-value-bind (tty-fd errno) - (unix-open "/dev/tty" o_rdwr 0) - (cond (tty-fd - (multiple-value-prog1 - (tcsetpgrp tty-fd pgrp) - (unix-close tty-fd))) - (t - (values nil errno))))) - (unix-sigsetmask old-sigs)))) - -(defsetf tty-process-group (&optional fd) (pgrp) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not - supplied, FD defaults to /dev/tty." - `(%set-tty-process-group ,pgrp ,fd)) - -#+(or) -(defun unix-getlogin () - _N"Return the login name of the user." - (let ((result (alien-funcall (extern-alien "getlogin" - (function c-string))))) - (declare (type system-area-pointer result)) - (if (zerop (sap-int result)) - nil - result))) +(defun unix-openpty (name termp winp) + _N"Create pseudo tty master slave pair with NAME and set terminal + attributes according to TERMP and WINP and return handles for both + ends in AMASTER and ASLAVE." + (with-alien ((amaster int) + (aslave int)) + (values + (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios)) + (* (struct winsize))) + (addr amaster) (addr aslave) name termp winp) + amaster aslave))) (def-alien-type nil (struct utsname @@ -2284,1516 +1635,190 @@ length LEN and type TYPE." (cast (slot utsname 'domainname) c-string)) (addr utsname)))) -(defun unix-gethostname () - _N"Unix-gethostname returns the name of the host machine as a string." - (with-alien ((buf (array char 256))) - (syscall* ("gethostname" (* char) int) - (cast buf c-string) - (cast buf (* char)) 256))) - -#+(or) -(defun unix-sethostname (name len) - (int-syscall ("sethostname" c-string size-t) name len)) - -#+(or) -(defun unix-sethostid (id) - (int-syscall ("sethostid" long) id)) - -#+(or) -(defun unix-getdomainname (name len) - (int-syscall ("getdomainname" c-string size-t) name len)) +;;; sys/ioctl.h -#+(or) -(defun unix-setdomainname (name len) - (int-syscall ("setdomainname" c-string size-t) name len)) +(defun unix-ioctl (fd cmd arg) + _N"Unix-ioctl performs a variety of operations on open i/o + descriptors. See the UNIX Programmer's Manual for more + information." + (declare (type unix-fd fd) + (type (unsigned-byte 32) cmd)) + (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) -;;; Unix-fsync writes the core-image of the file described by "fd" to -;;; permanent storage (i.e. disk). -(defun unix-fsync (fd) - _N"Unix-fsync writes the core image of the file described by - fd to disk." - (declare (type unix-fd fd)) - (void-syscall ("fsync" int) fd)) +;;; Unix-mkdir accepts a name and a mode and attempts to create the +;;; corresponding directory with mode mode. +(defun unix-mkdir (name mode) + _N"Unix-mkdir creates a new directory with the specified name and mode. + (Same as those for unix-chmod.) It returns T upon success, otherwise + NIL and an error number." + (declare (type unix-pathname name) + (type unix-file-mode mode)) + (void-syscall ("mkdir" c-string int) (%name->file name) mode)) -#+(or) -(defun unix-vhangup () - _N"Revoke access permissions to all processes currently communicating - with the control terminal, and then send a SIGHUP signal to the process - group of the control terminal." - (int-syscall ("vhangup"))) - -#+(or) -(defun unix-revoke (file) - _N"Revoke the access of all descriptors currently open on FILE." - (int-syscall ("revoke" c-string) (%name->file file))) - - -#+(or) -(defun unix-chroot (path) - _N"Make PATH be the root directory (the starting point for absolute paths). - This call is restricted to the super-user." - (int-syscall ("chroot" c-string) (%name->file path))) - -(def-alien-routine ("gethostid" unix-gethostid) unsigned-long - _N"Unix-gethostid returns a 32-bit integer which provides unique - identification for the host machine.") - -;;; Unix-sync writes all information in core memory which has been modified -;;; to permanent storage (i.e. disk). - -(defun unix-sync () - _N"Unix-sync writes all information in core memory which has been - modified to disk. It returns NIL and an error code if an error - occured." - (void-syscall ("sync"))) - -;;; Unix-getpagesize returns the number of bytes in the system page. - -(defun unix-getpagesize () - _N"Unix-getpagesize returns the number of bytes in a system page." - (int-syscall ("getpagesize"))) - -;;; Unix-truncate accepts a file name and a new length. The file is -;;; truncated to the new length. - -(defun unix-truncate (name length) - _N"Unix-truncate truncates the named file to the length (in - bytes) specified by LENGTH. NIL and an error number is returned - if the call is unsuccessful." - (declare (type unix-pathname name) - (type (unsigned-byte 64) length)) - (void-syscall ("truncate64" c-string off-t) (%name->file name) length)) - -(defun unix-ftruncate (fd length) - _N"Unix-ftruncate is similar to unix-truncate except that the first - argument is a file descriptor rather than a file name." - (declare (type unix-fd fd) - (type (unsigned-byte 64) length)) - (void-syscall ("ftruncate64" int off-t) fd length)) - -#+(or) -(defun unix-getdtablesize () - _N"Return the maximum number of file descriptors - the current process could possibly have." - (int-syscall ("getdtablesize"))) - -(defconstant f_ulock 0 _N"Unlock a locked region") -(defconstant f_lock 1 _N"Lock a region for exclusive use") -(defconstant f_tlock 2 _N"Test and lock a region for exclusive use") -(defconstant f_test 3 _N"Test a region for othwer processes locks") - -(defun unix-lockf (fd cmd length) - _N"Unix-locks can lock, unlock and test files according to the cmd - which can be one of the following: - - f_ulock Unlock a locked region - f_lock Lock a region for exclusive use - f_tlock Test and lock a region for exclusive use - f_test Test a region for othwer processes locks - - The lock is for a region from the current location for a length - of length. - - This is a simpler version of the interface provided by unix-fcntl. - " - (declare (type unix-fd fd) - (type (unsigned-byte 64) length) - (type (integer 0 3) cmd)) - (int-syscall ("lockf64" int int off-t) fd cmd length)) - -;;; utime.h - -;; Structure describing file times. +;;; timebits.h +;; A time value that is accurate to the nearest +;; microsecond but also has a range of years. (def-alien-type nil - (struct utimbuf - (actime time-t) ; Access time. - (modtime time-t))) ; Modification time. - -;;; Unix-utimes changes the accessed and updated times on UNIX -;;; files. The first argument is the filename (a string) and -;;; the second argument is a list of the 4 times- accessed and -;;; updated seconds and microseconds. + (struct timeval + (tv-sec time-t) ; seconds + (tv-usec time-t))) ; and microseconds -(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec) - _N"Unix-utimes sets the 'last-accessed' and 'last-updated' - times on a specified file. NIL and an error number is - returned if the call is unsuccessful." - (declare (type unix-pathname file) - (type (alien unsigned-long) - atime-sec atime-usec - mtime-sec mtime-usec)) - (with-alien ((tvp (array (struct timeval) 2))) - (setf (slot (deref tvp 0) 'tv-sec) atime-sec) - (setf (slot (deref tvp 0) 'tv-usec) atime-usec) - (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) - (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) - (void-syscall ("utimes" c-string (* (struct timeval))) - file - (cast tvp (* (struct timeval)))))) -;;; waitflags.h +;;; sys/time.h -;; Bits in the third argument to `waitpid'. +;; Structure crudely representing a timezone. +;; This is obsolete and should never be used. +(def-alien-type nil + (struct timezone + (tz-minuteswest int) ; minutes west of Greenwich + (tz-dsttime int))) ; type of dst correction -(defconstant waitpid-wnohang 1 _N"Don't block waiting.") -(defconstant waitpid-wuntranced 2 _N"Report status of stopped children.") +;; Type of the second argument to `getitimer' and +;; the second and third arguments `setitimer'. +(def-alien-type nil + (struct itimerval + (it-interval (struct timeval)) ; timer interval + (it-value (struct timeval)))) ; current value -(defconstant waitpid-wclone #x80000000 _N"Wait for cloned process.") +(defconstant ITIMER-REAL 0) +(defconstant ITIMER-VIRTUAL 1) +(defconstant ITIMER-PROF 2) -;;; sys/ioctl.h +(defun unix-getitimer (which) + _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). On success, + unix-getitimer returns 5 values, + T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." + (declare (type (member :real :virtual :profile) which) + (values t + (unsigned-byte 29)(mod 1000000) + (unsigned-byte 29)(mod 1000000))) + (let ((which (ecase which + (:real ITIMER-REAL) + (:virtual ITIMER-VIRTUAL) + (:profile ITIMER-PROF)))) + (with-alien ((itv (struct itimerval))) + (syscall* ("getitimer" int (* (struct itimerval))) + (values T + (slot (slot itv 'it-interval) 'tv-sec) + (slot (slot itv 'it-interval) 'tv-usec) + (slot (slot itv 'it-value) 'tv-sec) + (slot (slot itv 'it-value) 'tv-usec)) + which (alien-sap (addr itv)))))) -(defun unix-ioctl (fd cmd arg) - _N"Unix-ioctl performs a variety of operations on open i/o - descriptors. See the UNIX Programmer's Manual for more - information." - (declare (type unix-fd fd) - (type (unsigned-byte 32) cmd)) - (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) +(defun unix-setitimer (which int-secs int-usec val-secs val-usec) + _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). A SIGALRM signal + will be delivered VALUE <seconds+microseconds> from now. INTERVAL, + when non-zero, is <seconds+microseconds> to be loaded each time + the timer expires. Setting INTERVAL and VALUE to zero disables + the timer. See the Unix man page for more details. On success, + unix-setitimer returns the old contents of the INTERVAL and VALUE + slots as in unix-getitimer." + (declare (type (member :real :virtual :profile) which) + (type (unsigned-byte 29) int-secs val-secs) + (type (integer 0 (1000000)) int-usec val-usec) + (values t + (unsigned-byte 29)(mod 1000000) + (unsigned-byte 29)(mod 1000000))) + (let ((which (ecase which + (:real ITIMER-REAL) + (:virtual ITIMER-VIRTUAL) + (:profile ITIMER-PROF)))) + (with-alien ((itvn (struct itimerval)) + (itvo (struct itimerval))) + (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs + (slot (slot itvn 'it-interval) 'tv-usec) int-usec + (slot (slot itvn 'it-value ) 'tv-sec ) val-secs + (slot (slot itvn 'it-value ) 'tv-usec) val-usec) + (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval))) + (values T + (slot (slot itvo 'it-interval) 'tv-sec) + (slot (slot itvo 'it-interval) 'tv-usec) + (slot (slot itvo 'it-value) 'tv-sec) + (slot (slot itvo 'it-value) 'tv-usec)) + which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) + +;;; termbits.h -;;; sys/fsuid.h +(def-alien-type cc-t unsigned-char) +(def-alien-type speed-t unsigned-int) +(def-alien-type tcflag-t unsigned-int) -#+(or) -(defun unix-setfsuid (uid) - _N"Change uid used for file access control to UID, without affecting - other priveledges (such as who can send signals at the process)." - (int-syscall ("setfsuid" uid-t) uid)) +(defconstant +NCCS+ 32 + _N"Size of control character vector.") -#+(or) -(defun unix-setfsgid (gid) - _N"Change gid used for file access control to GID, without affecting - other priveledges (such as who can send signals at the process)." - (int-syscall ("setfsgid" gid-t) gid)) +(def-alien-type nil + (struct termios + (c-iflag tcflag-t) + (c-oflag tcflag-t) + (c-cflag tcflag-t) + (c-lflag tcflag-t) + (c-line cc-t) + (c-cc (array cc-t #.+NCCS+)) + (c-ispeed speed-t) + (c-ospeed speed-t))) -;;; sys/poll.h +;; c_cc characters -;; Data structure describing a polling request. +(defmacro def-enum (inc cur &rest names) + (flet ((defform (name) + (prog1 (when name `(defconstant ,name ,cur)) + (setf cur (funcall inc cur 1))))) + `(progn ,@(mapcar #'defform names)))) -(def-alien-type nil - (struct pollfd - (fd int) ; File descriptor to poll. - (events short) ; Types of events poller cares about. - (revents short))) ; Types of events that actually occurred. - -;; Event types that can be polled for. These bits may be set in `events' -;; to indicate the interesting event types; they will appear in `revents' -;; to indicate the status of the file descriptor. - -(defconstant POLLIN #o1 _N"There is data to read.") -(defconstant POLLPRI #o2 _N"There is urgent data to read.") -(defconstant POLLOUT #o4 _N"Writing now will not block.") - -;; Event types always implicitly polled for. These bits need not be set in -;;`events', but they will appear in `revents' to indicate the status of -;; the file descriptor. */ - - -(defconstant POLLERR #o10 _N"Error condition.") -(defconstant POLLHUP #o20 _N"Hung up.") -(defconstant POLLNVAL #o40 _N"Invalid polling request.") - - -(defconstant +npollfile+ 30 _N"Canonical number of polling requests to read -in at a time in poll.") - -#+(or) -(defun unix-poll (fds nfds timeout) - _N" Poll the file descriptors described by the NFDS structures starting at - FDS. If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for - an event to occur; if TIMEOUT is -1, block until an event occurs. - Returns the number of file descriptors with events, zero if timed out, - or -1 for errors." - (int-syscall ("poll" (* (struct pollfd)) long int) - fds nfds timeout)) - -;;; sys/resource.h - -(defun unix-getrlimit (resource) - _N"Get the soft and hard limits for RESOURCE." - (with-alien ((rlimits (struct rlimit))) - (syscall ("getrlimit" int (* (struct rlimit))) - (values t - (slot rlimits 'rlim-cur) - (slot rlimits 'rlim-max)) - resource (addr rlimits)))) - -(defun unix-setrlimit (resource current maximum) - _N"Set the current soft and hard maximum limits for RESOURCE. - Only the super-user can increase hard limits." - (with-alien ((rlimits (struct rlimit))) - (setf (slot rlimits 'rlim-cur) current) - (setf (slot rlimits 'rlim-max) maximum) - (void-syscall ("setrlimit" int (* (struct rlimit))) - resource (addr rlimits)))) +(def-enum + 0 vintr vquit verase + vkill veof vtime + vmin vswtc vstart + vstop vsusp veol + vreprint vdiscard vwerase + vlnext veol2) +(defvar vdsusp vsusp) -(declaim (inline unix-fast-getrusage)) -(defun unix-fast-getrusage (who) - _N"Like call getrusage, but return only the system and user time, and returns - the seconds and microseconds as separate values." - (declare (values (member t) - (unsigned-byte 31) (mod 1000000) - (unsigned-byte 31) (mod 1000000))) - (with-alien ((usage (struct rusage))) - (syscall* ("getrusage" int (* (struct rusage))) - (values t - (slot (slot usage 'ru-utime) 'tv-sec) - (slot (slot usage 'ru-utime) 'tv-usec) - (slot (slot usage 'ru-stime) 'tv-sec) - (slot (slot usage 'ru-stime) 'tv-usec)) - who (addr usage)))) +(def-enum + 0 tcsanow tcsadrain tcsaflush) -(defun unix-getrusage (who) - _N"Unix-getrusage returns information about the resource usage - of the process specified by who. Who can be either the - current process (rusage_self) or all of the terminated - child processes (rusage_children). NIL and an error number - is returned if the call fails." - (with-alien ((usage (struct rusage))) - (syscall ("getrusage" int (* (struct rusage))) - (values t - (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000) - (slot (slot usage 'ru-utime) 'tv-usec)) - (+ (* (slot (slot usage 'ru-stime) 'tv-sec) 1000000) - (slot (slot usage 'ru-stime) 'tv-usec)) - (slot usage 'ru-maxrss) - (slot usage 'ru-ixrss) - (slot usage 'ru-idrss) - (slot usage 'ru-isrss) - (slot usage 'ru-minflt) - (slot usage 'ru-majflt) - (slot usage 'ru-nswap) - (slot usage 'ru-inblock) - (slot usage 'ru-oublock) - (slot usage 'ru-msgsnd) - (slot usage 'ru-msgrcv) - (slot usage 'ru-nsignals) - (slot usage 'ru-nvcsw) - (slot usage 'ru-nivcsw)) - who (addr usage)))) +;; c_iflag bits +(def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck + tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc + tty-ixon tty-ixany tty-ixoff + tty-imaxbel) -#+(or) -(defun unix-ulimit (cmd newlimit) - _N"Function depends on CMD: - 1 = Return the limit on the size of a file, in units of 512 bytes. - 2 = Set the limit on the size of a file to NEWLIMIT. Only the - super-user can increase the limit. - 3 = Return the maximum possible address of the data segment. - 4 = Return the maximum number of files that the calling process can open. - Returns -1 on errors." - (int-syscall ("ulimit" int long) cmd newlimit)) - -#+(or) -(defun unix-getpriority (which who) - _N"Return the highest priority of any process specified by WHICH and WHO - (see above); if WHO is zero, the current process, process group, or user - (as specified by WHO) is used. A lower priority number means higher - priority. Priorities range from PRIO_MIN to PRIO_MAX (above)." - (int-syscall ("getpriority" int int) - which who)) - -#+(or) -(defun unix-setpriority (which who) - _N"Set the priority of all processes specified by WHICH and WHO (see above) - to PRIO. Returns 0 on success, -1 on errors." - (int-syscall ("setpriority" int int) - which who)) - -;;; sys/socket.h +;; c_oflag bits +(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr + tty-onlret tty-ofill tty-ofdel tty-nldly) -;;;; Socket support. +;; c_lflag bits +(def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe + tty-echok tty-echonl tty-noflsh + tty-tostop tty-echoctl tty-echoprt + tty-echoke tty-flusho + tty-pendin tty-iexten) -;;; Looks a bit naked. +(defun unix-tcgetattr (fd termios) + _N"Get terminal attributes." + (declare (type unix-fd fd)) + (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) -(def-alien-routine ("socket" unix-socket) int - (domain int) - (type int) - (protocol int)) +(defun unix-tcsetattr (fd opt termios) + _N"Set terminal attributes." + (declare (type unix-fd fd)) + (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios)) -(def-alien-routine ("connect" unix-connect) int - (socket int) - (sockaddr (* t)) - (len int)) +(defconstant writeown #o200 _N"Write by owner") -(def-alien-routine ("bind" unix-bind) int - (socket int) - (sockaddr (* t)) - (len int)) +;;; termios.h -(def-alien-routine ("listen" unix-listen) int - (socket int) - (backlog int)) +(defconstant terminal-speeds + '#(0 50 75 110 134 150 200 300 600 1200 1800 2400 + 4800 9600 19200 38400 57600 115200 230400)) -(def-alien-routine ("accept" unix-accept) int - (socket int) - (sockaddr (* t)) - (len int :in-out)) - -(def-alien-routine ("recv" unix-recv) int - (fd int) - (buffer c-string) - (length int) - (flags int)) - -(def-alien-routine ("send" unix-send) int - (fd int) - (buffer c-string) - (length int) - (flags int)) - -(def-alien-routine ("getpeername" unix-getpeername) int - (socket int) - (sockaddr (* t)) - (len (* unsigned))) - -(def-alien-routine ("getsockname" unix-getsockname) int - (socket int) - (sockaddr (* t)) - (len (* unsigned))) - -(def-alien-routine ("getsockopt" unix-getsockopt) int - (socket int) - (level int) - (optname int) - (optval (* t)) - (optlen unsigned :in-out)) - -(def-alien-routine ("setsockopt" unix-setsockopt) int - (socket int) - (level int) - (optname int) - (optval (* t)) - (optlen unsigned)) - -;; Datagram support - -(def-alien-routine ("recvfrom" unix-recvfrom) int - (fd int) - (buffer c-string) - (length int) - (flags int) - (sockaddr (* t)) - (len int :in-out)) - -(def-alien-routine ("sendto" unix-sendto) int - (fd int) - (buffer c-string) - (length int) - (flags int) - (sockaddr (* t)) - (len int)) - -(def-alien-routine ("shutdown" unix-shutdown) int - (socket int) - (level int)) - -;;; sys/select.h - -;;; UNIX-FAST-SELECT -- public. -;;; -(defmacro unix-fast-select (num-descriptors - read-fds write-fds exception-fds - timeout-secs &optional (timeout-usecs 0)) - _N"Perform the UNIX select(2) system call." - (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) - (type (or (alien (* (struct fd-set))) null) - read-fds write-fds exception-fds) - (type (or null (unsigned-byte 31)) timeout-secs) - (type (unsigned-byte 31) timeout-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - `(let ((timeout-secs ,timeout-secs)) - (with-alien ((tv (struct timeval))) - (when timeout-secs - (setf (slot tv 'tv-sec) timeout-secs) - (setf (slot tv 'tv-usec) ,timeout-usecs)) - (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - ,num-descriptors ,read-fds ,write-fds ,exception-fds - (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) - - -;;; Unix-select accepts sets of file descriptors and waits for an event -;;; to happen on one of them or to time out. - -(defmacro num-to-fd-set (fdset num) - `(if (fixnump ,num) - (progn - (setf (deref (slot ,fdset 'fds-bits) 0) ,num) - ,@(loop for index upfrom 1 below (/ fd-setsize nfdbits) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) - (progn - ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) - (ldb (byte nfdbits ,(* index nfdbits)) ,num)))))) - -(defmacro fd-set-to-num (nfds fdset) - `(if (<= ,nfds nfdbits) - (deref (slot ,fdset 'fds-bits) 0) - (+ ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) - collect `(ash (deref (slot ,fdset 'fds-bits) ,index) - ,(* index nfdbits)))))) - -(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) - _N"Unix-select examines the sets of descriptors passed as arguments - to see if they are ready for reading and writing. See the UNIX - Programmers Manual for more information." - (declare (type (integer 0 #.FD-SETSIZE) nfds) - (type unsigned-byte rdfds wrfds xpfds) - (type (or (unsigned-byte 31) null) to-secs) - (type (unsigned-byte 31) to-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (with-alien ((tv (struct timeval)) - (rdf (struct fd-set)) - (wrf (struct fd-set)) - (xpf (struct fd-set))) - (when to-secs - (setf (slot tv 'tv-sec) to-secs) - (setf (slot tv 'tv-usec) to-usecs)) - (num-to-fd-set rdf rdfds) - (num-to-fd-set wrf wrfds) - (num-to-fd-set xpf xpfds) - (macrolet ((frob (lispvar alienvar) - `(if (zerop ,lispvar) - (int-sap 0) - (alien-sap (addr ,alienvar))))) - (syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - (values result - (fd-set-to-num nfds rdf) - (fd-set-to-num nfds wrf) - (fd-set-to-num nfds xpf)) - nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) - (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) - -;;; sys/stat.h - -(defmacro extract-stat-results (buf) - `(values T - #+(or alpha amd64) - (slot ,buf 'st-dev) - #-(or alpha amd64) - (+ (deref (slot ,buf 'st-dev) 0) - (* (+ +max-u-long+ 1) - (deref (slot ,buf 'st-dev) 1))) ;;; let's hope this works.. - (slot ,buf 'st-ino) - (slot ,buf 'st-mode) - (slot ,buf 'st-nlink) - (slot ,buf 'st-uid) - (slot ,buf 'st-gid) - #+(or alpha amd64) - (slot ,buf 'st-rdev) - #-(or alpha amd64) - (+ (deref (slot ,buf 'st-rdev) 0) - (* (+ +max-u-long+ 1) - (deref (slot ,buf 'st-rdev) 1))) ;;; let's hope this works.. - (slot ,buf 'st-size) - (slot ,buf 'st-atime) - (slot ,buf 'st-mtime) - (slot ,buf 'st-ctime) - (slot ,buf 'st-blksize) - (slot ,buf 'st-blocks))) - -(defun unix-stat (name) - _N"UNIX-STAT retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat))) - (syscall ("stat64" c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"UNIX-FSTAT is similar to UNIX-STAT except the file is specified - by the file descriptor FD." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat))) - (syscall ("fstat64" int (* (struct stat))) - (extract-stat-results buf) - fd (addr buf)))) - -(defun unix-lstat (name) - _N"UNIX-LSTAT is similar to UNIX-STAT except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat))) - (syscall ("lstat64" c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. - -(defun unix-chmod (path mode) - _N"Given a file path string and a constant mode, unix-chmod changes the - permission mode for that file to the one specified. The new mode - can be created by logically OR'ing the following: - - setuidexec Set user ID on execution. - setgidexec Set group ID on execution. - savetext Save text image after execution. - readown Read by owner. - writeown Write by owner. - execown Execute (search directory) by owner. - readgrp Read by group. - writegrp Write by group. - execgrp Execute (search directory) by group. - readoth Read by others. - writeoth Write by others. - execoth Execute (search directory) by others. - - Thus #o444 and (logior unix:readown unix:readgrp unix:readoth) - are equivalent for 'mode. The octal-base is familar to Unix users. - - It returns T on successfully completion; NIL and an error number - otherwise." - (declare (type unix-pathname path) - (type unix-file-mode mode)) - (void-syscall ("chmod" c-string int) (%name->file path) mode)) - -;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode -;;; ("mode") and changes the protection of the file described by "fd" to -;;; "mode". - -(defun unix-fchmod (fd mode) - _N"Given an integer file descriptor and a mode (the same as those - used for unix-chmod), unix-fchmod changes the permission mode - for that file to the one specified. T is returned if the call - was successful." - (declare (type unix-fd fd) - (type unix-file-mode mode)) - (void-syscall ("fchmod" int int) fd mode)) - - -(defun unix-umask (mask) - _N"Set the file creation mask of the current process to MASK, - and return the old creation mask." - (int-syscall ("umask" mode-t) mask)) - -;;; Unix-mkdir accepts a name and a mode and attempts to create the -;;; corresponding directory with mode mode. - -(defun unix-mkdir (name mode) - _N"Unix-mkdir creates a new directory with the specified name and mode. - (Same as those for unix-chmod.) It returns T upon success, otherwise - NIL and an error number." - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (void-syscall ("mkdir" c-string int) (%name->file name) mode)) - -#+(or) -(defun unix-makedev (path mode dev) - _N"Create a device file named PATH, with permission and special bits MODE - and device number DEV (which can be constructed from major and minor - device numbers with the `makedev' macro above)." - (declare (type unix-pathname path) - (type unix-file-mode mode)) - (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev)) - - -#+(or) -(defun unix-fifo (name mode) - _N"Create a new FIFO named PATH, with permission bits MODE." - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (void-syscall ("mkfifo" c-string int) (%name->file name) mode)) - -;;; sys/statfs.h - -#+(or) -(defun unix-statfs (file buf) - _N"Return information about the filesystem on which FILE resides." - (int-syscall ("statfs64" c-string (* (struct statfs))) - (%name->file file) buf)) - -;;; sys/swap.h - -#+(or) -(defun unix-swapon (path flags) - _N"Make the block special device PATH available to the system for swapping. - This call is restricted to the super-user." - (int-syscall ("swapon" c-string int) (%name->file path) flags)) - -#+(or) -(defun unix-swapoff (path) - _N"Make the block special device PATH unavailable to the system for swapping. - This call is restricted to the super-user." - (int-syscall ("swapoff" c-string) (%name->file path))) - -;;; sys/sysctl.h - -#+(or) -(defun unix-sysctl (name nlen oldval oldlenp newval newlen) - _N"Read or write system parameters." - (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t) - name nlen oldval oldlenp newval newlen)) - -;;; time.h - -;; POSIX.4 structure for a time value. This is like a `struct timeval' but -;; has nanoseconds instead of microseconds. - -(def-alien-type nil - (struct timespec - (tv-sec long) ;Seconds - (tv-nsec long))) ;Nanoseconds - -;; Used by other time functions. - -(def-alien-type nil - (struct tm - (tm-sec int) ; Seconds. [0-60] (1 leap second) - (tm-min int) ; Minutes. [0-59] - (tm-hour int) ; Hours. [0-23] - (tm-mday int) ; Day. [1-31] - (tm-mon int) ; Month. [0-11] - (tm-year int) ; Year - 1900. - (tm-wday int) ; Day of week. [0-6] - (tm-yday int) ; Days in year.[0-365] - (tm-isdst int) ; DST. [-1/0/1] - (tm-gmtoff long) ; Seconds east of UTC. - (tm-zone c-string))) ; Timezone abbreviation. - -#+(or) -(defun unix-clock () - _N"Time used by the program so far (user time + system time). - The result / CLOCKS_PER_SECOND is program time in seconds." - (int-syscall ("clock"))) - -#+(or) -(defun unix-time (timer) - _N"Return the current time and put it in *TIMER if TIMER is not NULL." - (int-syscall ("time" time-t) timer)) - -;; Requires call to tzset() in main. - -(def-alien-variable ("daylight" unix-daylight) int) -(def-alien-variable ("timezone" unix-timezone) time-t) -;(def-alien-variable ("altzone" unix-altzone) time-t) doesn't exist -(def-alien-variable ("tzname" unix-tzname) (array c-string 2)) - -(def-alien-routine get-timezone c-call:void - (when c-call:long :in) - (minutes-west c-call:int :out) - (daylight-savings-p alien:boolean :out)) - -(defun unix-get-minutes-west (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore dst)) - (values minutes))) - -(defun unix-get-timezone (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore minutes)) - (values (deref unix-tzname (if dst 1 0))))) - -;;; sys/time.h - -;; Structure crudely representing a timezone. -;; This is obsolete and should never be used. -(def-alien-type nil - (struct timezone - (tz-minuteswest int) ; minutes west of Greenwich - (tz-dsttime int))) ; type of dst correction - - -(declaim (inline unix-gettimeofday)) -(defun unix-gettimeofday () - _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and - microseconds of the current time of day, the timezone (in minutes west - of Greenwich), and a daylight-savings flag. If it doesn't work, it - returns NIL and the errno." - (with-alien ((tv (struct timeval)) - (tz (struct timezone))) - (syscall* ("gettimeofday" (* (struct timeval)) - (* (struct timezone))) - (values T - (slot tv 'tv-sec) - (slot tv 'tv-usec) - (slot tz 'tz-minuteswest) - (slot tz 'tz-dsttime)) - (addr tv) - (addr tz)))) - - -;/* Set the current time of day and timezone information. -; This call is restricted to the super-user. */ -;extern int __settimeofday __P ((__const struct timeval *__tv, -; __const struct timezone *__tz)); -;extern int settimeofday __P ((__const struct timeval *__tv, -; __const struct timezone *__tz)); - -;/* Adjust the current time of day by the amount in DELTA. -; If OLDDELTA is not NULL, it is filled in with the amount -; of time adjustment remaining to be done from the last `adjtime' call. -; This call is restricted to the super-user. */ -;extern int __adjtime __P ((__const struct timeval *__delta, -; struct timeval *__olddelta)); -;extern int adjtime __P ((__const struct timeval *__delta, -; struct timeval *__olddelta)); - - -;; Type of the second argument to `getitimer' and -;; the second and third arguments `setitimer'. -(def-alien-type nil - (struct itimerval - (it-interval (struct timeval)) ; timer interval - (it-value (struct timeval)))) ; current value - -(defconstant ITIMER-REAL 0) -(defconstant ITIMER-VIRTUAL 1) -(defconstant ITIMER-PROF 2) - -(defun unix-getitimer (which) - _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of - three system timers (:real :virtual or :profile). On success, - unix-getitimer returns 5 values, - T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." - (declare (type (member :real :virtual :profile) which) - (values t - (unsigned-byte 29)(mod 1000000) - (unsigned-byte 29)(mod 1000000))) - (let ((which (ecase which - (:real ITIMER-REAL) - (:virtual ITIMER-VIRTUAL) - (:profile ITIMER-PROF)))) - (with-alien ((itv (struct itimerval))) - (syscall* ("getitimer" int (* (struct itimerval))) - (values T - (slot (slot itv 'it-interval) 'tv-sec) - (slot (slot itv 'it-interval) 'tv-usec) - (slot (slot itv 'it-value) 'tv-sec) - (slot (slot itv 'it-value) 'tv-usec)) - which (alien-sap (addr itv)))))) - -(defun unix-setitimer (which int-secs int-usec val-secs val-usec) - _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of - three system timers (:real :virtual or :profile). A SIGALRM signal - will be delivered VALUE <seconds+microseconds> from now. INTERVAL, - when non-zero, is <seconds+microseconds> to be loaded each time - the timer expires. Setting INTERVAL and VALUE to zero disables - the timer. See the Unix man page for more details. On success, - unix-setitimer returns the old contents of the INTERVAL and VALUE - slots as in unix-getitimer." - (declare (type (member :real :virtual :profile) which) - (type (unsigned-byte 29) int-secs val-secs) - (type (integer 0 (1000000)) int-usec val-usec) - (values t - (unsigned-byte 29)(mod 1000000) - (unsigned-byte 29)(mod 1000000))) - (let ((which (ecase which - (:real ITIMER-REAL) - (:virtual ITIMER-VIRTUAL) - (:profile ITIMER-PROF)))) - (with-alien ((itvn (struct itimerval)) - (itvo (struct itimerval))) - (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs - (slot (slot itvn 'it-interval) 'tv-usec) int-usec - (slot (slot itvn 'it-value ) 'tv-sec ) val-secs - (slot (slot itvn 'it-value ) 'tv-usec) val-usec) - (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval))) - (values T - (slot (slot itvo 'it-interval) 'tv-sec) - (slot (slot itvo 'it-interval) 'tv-usec) - (slot (slot itvo 'it-value) 'tv-sec) - (slot (slot itvo 'it-value) 'tv-usec)) - which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) - -;;; sys/timeb.h - -;; Structure returned by the `ftime' function. - -(def-alien-type nil - (struct timeb - (time time-t) ; Seconds since epoch, as from `time'. - (millitm short) ; Additional milliseconds. - (timezone int) ; Minutes west of GMT. - (dstflag short))) ; Nonzero if Daylight Savings Time used. - -#+(or) -(defun unix-fstime (timebuf) - _N"Fill in TIMEBUF with information about the current time." - (int-syscall ("ftime" (* (struct timeb))) timebuf)) - - -;;; sys/times.h - -;; Structure describing CPU time used by a process and its children. - -(def-alien-type nil - (struct tms - (tms-utime clock-t) ; User CPU time. - (tms-stime clock-t) ; System CPU time. - (tms-cutime clock-t) ; User CPU time of dead children. - (tms-cstime clock-t))) ; System CPU time of dead children. - -#+(or) -(defun unix-times (buffer) - _N"Store the CPU time used by this process and all its - dead children (and their dead children) in BUFFER. - Return the elapsed real time, or (clock_t) -1 for errors. - All times are in CLK_TCKths of a second." - (int-syscall ("times" (* (struct tms))) buffer)) - -;;; sys/wait.h - -#+(or) -(defun unix-wait (status) - _N"Wait for a child to die. When one does, put its status in *STAT_LOC - and return its process ID. For errors, return (pid_t) -1." - (int-syscall ("wait" (* int)) status)) - -#+(or) -(defun unix-waitpid (pid status options) - _N"Wait for a child matching PID to die. - If PID is greater than 0, match any process whose process ID is PID. - If PID is (pid_t) -1, match any process. - If PID is (pid_t) 0, match any process with the - same process group as the current process. - If PID is less than -1, match any process whose - process group is the absolute value of PID. - If the WNOHANG bit is set in OPTIONS, and that child - is not already dead, return (pid_t) 0. If successful, - return PID and store the dead child's status in STAT_LOC. - Return (pid_t) -1 for errors. If the WUNTRACED bit is - set in OPTIONS, return status for stopped children; otherwise don't." - (int-syscall ("waitpit" pid-t (* int) int) - pid status options)) - -;;; asm/errno.h - -(def-unix-error ESUCCESS 0 _N"Successful") -(def-unix-error EPERM 1 _N"Operation not permitted") -(def-unix-error ENOENT 2 _N"No such file or directory") -(def-unix-error ESRCH 3 _N"No such process") -(def-unix-error EINTR 4 _N"Interrupted system call") -(def-unix-error EIO 5 _N"I/O error") -(def-unix-error ENXIO 6 _N"No such device or address") -(def-unix-error E2BIG 7 _N"Arg list too long") -(def-unix-error ENOEXEC 8 _N"Exec format error") -(def-unix-error EBADF 9 _N"Bad file number") -(def-unix-error ECHILD 10 _N"No children") -(def-unix-error EAGAIN 11 _N"Try again") -(def-unix-error ENOMEM 12 _N"Out of memory") -(def-unix-error EACCES 13 _N"Permission denied") -(def-unix-error EFAULT 14 _N"Bad address") -(def-unix-error ENOTBLK 15 _N"Block device required") -(def-unix-error EBUSY 16 _N"Device or resource busy") -(def-unix-error EEXIST 17 _N"File exists") -(def-unix-error EXDEV 18 _N"Cross-device link") -(def-unix-error ENODEV 19 _N"No such device") -(def-unix-error ENOTDIR 20 _N"Not a director") -(def-unix-error EISDIR 21 _N"Is a directory") -(def-unix-error EINVAL 22 _N"Invalid argument") -(def-unix-error ENFILE 23 _N"File table overflow") -(def-unix-error EMFILE 24 _N"Too many open files") -(def-unix-error ENOTTY 25 _N"Not a typewriter") -(def-unix-error ETXTBSY 26 _N"Text file busy") -(def-unix-error EFBIG 27 _N"File too large") -(def-unix-error ENOSPC 28 _N"No space left on device") -(def-unix-error ESPIPE 29 _N"Illegal seek") -(def-unix-error EROFS 30 _N"Read-only file system") -(def-unix-error EMLINK 31 _N"Too many links") -(def-unix-error EPIPE 32 _N"Broken pipe") -;;; -;;; Math -(def-unix-error EDOM 33 _N"Math argument out of domain") -(def-unix-error ERANGE 34 _N"Math result not representable") -;;; -(def-unix-error EDEADLK 35 _N"Resource deadlock would occur") -(def-unix-error ENAMETOOLONG 36 _N"File name too long") -(def-unix-error ENOLCK 37 _N"No record locks available") -(def-unix-error ENOSYS 38 _N"Function not implemented") -(def-unix-error ENOTEMPTY 39 _N"Directory not empty") -(def-unix-error ELOOP 40 _N"Too many symbolic links encountered") -(def-unix-error EWOULDBLOCK 11 _N"Operation would block") -(def-unix-error ENOMSG 42 _N"No message of desired type") -(def-unix-error EIDRM 43 _N"Identifier removed") -(def-unix-error ECHRNG 44 _N"Channel number out of range") -(def-unix-error EL2NSYNC 45 _N"Level 2 not synchronized") -(def-unix-error EL3HLT 46 _N"Level 3 halted") -(def-unix-error EL3RST 47 _N"Level 3 reset") -(def-unix-error ELNRNG 48 _N"Link number out of range") -(def-unix-error EUNATCH 49 _N"Protocol driver not attached") -(def-unix-error ENOCSI 50 _N"No CSI structure available") -(def-unix-error EL2HLT 51 _N"Level 2 halted") -(def-unix-error EBADE 52 _N"Invalid exchange") -(def-unix-error EBADR 53 _N"Invalid request descriptor") -(def-unix-error EXFULL 54 _N"Exchange full") -(def-unix-error ENOANO 55 _N"No anode") -(def-unix-error EBADRQC 56 _N"Invalid request code") -(def-unix-error EBADSLT 57 _N"Invalid slot") -(def-unix-error EDEADLOCK EDEADLK _N"File locking deadlock error") -(def-unix-error EBFONT 59 _N"Bad font file format") -(def-unix-error ENOSTR 60 _N"Device not a stream") -(def-unix-error ENODATA 61 _N"No data available") -(def-unix-error ETIME 62 _N"Timer expired") -(def-unix-error ENOSR 63 _N"Out of streams resources") -(def-unix-error ENONET 64 _N"Machine is not on the network") -(def-unix-error ENOPKG 65 _N"Package not installed") -(def-unix-error EREMOTE 66 _N"Object is remote") -(def-unix-error ENOLINK 67 _N"Link has been severed") -(def-unix-error EADV 68 _N"Advertise error") -(def-unix-error ESRMNT 69 _N"Srmount error") -(def-unix-error ECOMM 70 _N"Communication error on send") -(def-unix-error EPROTO 71 _N"Protocol error") -(def-unix-error EMULTIHOP 72 _N"Multihop attempted") -(def-unix-error EDOTDOT 73 _N"RFS specific error") -(def-unix-error EBADMSG 74 _N"Not a data message") -(def-unix-error EOVERFLOW 75 _N"Value too large for defined data type") -(def-unix-error ENOTUNIQ 76 _N"Name not unique on network") -(def-unix-error EBADFD 77 _N"File descriptor in bad state") -(def-unix-error EREMCHG 78 _N"Remote address changed") -(def-unix-error ELIBACC 79 _N"Can not access a needed shared library") -(def-unix-error ELIBBAD 80 _N"Accessing a corrupted shared library") -(def-unix-error ELIBSCN 81 _N".lib section in a.out corrupted") -(def-unix-error ELIBMAX 82 _N"Attempting to link in too many shared libraries") -(def-unix-error ELIBEXEC 83 _N"Cannot exec a shared library directly") -(def-unix-error EILSEQ 84 _N"Illegal byte sequence") -(def-unix-error ERESTART 85 _N"Interrupted system call should be restarted _N") -(def-unix-error ESTRPIPE 86 _N"Streams pipe error") -(def-unix-error EUSERS 87 _N"Too many users") -(def-unix-error ENOTSOCK 88 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 89 _N"Destination address required") -(def-unix-error EMSGSIZE 90 _N"Message too long") -(def-unix-error EPROTOTYPE 91 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 92 _N"Protocol not available") -(def-unix-error EPROTONOSUPPORT 93 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 94 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 95 _N"Operation not supported on transport endpoint") -(def-unix-error EPFNOSUPPORT 96 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 97 _N"Address family not supported by protocol") -(def-unix-error EADDRINUSE 98 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 99 _N"Cannot assign requested address") -(def-unix-error ENETDOWN 100 _N"Network is down") -(def-unix-error ENETUNREACH 101 _N"Network is unreachable") -(def-unix-error ENETRESET 102 _N"Network dropped connection because of reset") -(def-unix-error ECONNABORTED 103 _N"Software caused connection abort") -(def-unix-error ECONNRESET 104 _N"Connection reset by peer") -(def-unix-error ENOBUFS 105 _N"No buffer space available") -(def-unix-error EISCONN 106 _N"Transport endpoint is already connected") -(def-unix-error ENOTCONN 107 _N"Transport endpoint is not connected") -(def-unix-error ESHUTDOWN 108 _N"Cannot send after transport endpoint shutdown") -(def-unix-error ETOOMANYREFS 109 _N"Too many references: cannot splice") -(def-unix-error ETIMEDOUT 110 _N"Connection timed out") -(def-unix-error ECONNREFUSED 111 _N"Connection refused") -(def-unix-error EHOSTDOWN 112 _N"Host is down") -(def-unix-error EHOSTUNREACH 113 _N"No route to host") -(def-unix-error EALREADY 114 _N"Operation already in progress") -(def-unix-error EINPROGRESS 115 _N"Operation now in progress") -(def-unix-error ESTALE 116 _N"Stale NFS file handle") -(def-unix-error EUCLEAN 117 _N"Structure needs cleaning") -(def-unix-error ENOTNAM 118 _N"Not a XENIX named type file") -(def-unix-error ENAVAIL 119 _N"No XENIX semaphores available") -(def-unix-error EISNAM 120 _N"Is a named type file") -(def-unix-error EREMOTEIO 121 _N"Remote I/O error") -(def-unix-error EDQUOT 122 _N"Quota exceeded") - -;;; And now for something completely different ... -(emit-unix-errors) - -;;; the ioctl's. -;;; -;;; I've deleted all the stuff that wasn't in the header files. -;;; This is what survived. - -;; 0x54 is just a magic number to make these relatively unique ('T') - -(eval-when (compile load eval) - -(defconstant iocparm-mask #x3fff) -(defconstant ioc_void #x00000000) -(defconstant ioc_out #x40000000) -(defconstant ioc_in #x80000000) -(defconstant ioc_inout (logior ioc_in ioc_out)) - -(defmacro define-ioctl-command (name dev cmd &optional arg parm-type) - _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given - then ioctl argument size and direction are included as for ioctls defined - by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type - is the characters code, else DEV may be an integer giving the type." - (let* ((type (if (characterp dev) - (char-code dev) - dev)) - (code (logior (ash type 8) cmd))) - (when arg - (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask) - 16) - ,code))) - (when parm-type - (let ((dir (ecase parm-type - (:void ioc_void) - (:in ioc_in) - (:out ioc_out) - (:inout ioc_inout)))) - (setf code `(logior ,dir ,code)))) - `(eval-when (eval load compile) - (defconstant ,name ,code)))) - -) - -;;; TTY ioctl commands. - -(define-ioctl-command TIOCGWINSZ #\T #x13) -(define-ioctl-command TIOCSWINSZ #\T #x14) -(define-ioctl-command TIOCNOTTY #\T #x22) -(define-ioctl-command TIOCSPGRP #\T #x10) -(define-ioctl-command TIOCGPGRP #\T #x0F) - -;;; File ioctl commands. -(define-ioctl-command FIONREAD #\T #x1B) - -;;; asm/sockios.h - -;;; Socket options. - -(define-ioctl-command SIOCSPGRP #x89 #x02) - -(defun siocspgrp (fd pgrp) - _N"Set the socket process-group for the unix file-descriptor FD to PGRP." - (alien:with-alien ((alien-pgrp c-call:int pgrp)) - (unix-ioctl fd - siocspgrp - (alien:alien-sap (alien:addr alien-pgrp))))) - -;;; A few random constants and functions - -(defconstant setuidexec #o4000 _N"Set user ID on execution") -(defconstant setgidexec #o2000 _N"Set group ID on execution") -(defconstant savetext #o1000 _N"Save text image after execution") -(defconstant readown #o400 _N"Read by owner") -(defconstant writeown #o200 _N"Write by owner") -(defconstant execown #o100 _N"Execute (search directory) by owner") -(defconstant readgrp #o40 _N"Read by group") -(defconstant writegrp #o20 _N"Write by group") -(defconstant execgrp #o10 _N"Execute (search directory) by group") -(defconstant readoth #o4 _N"Read by others") -(defconstant writeoth #o2 _N"Write by others") -(defconstant execoth #o1 _N"Execute (search directory) by others") - -(defconstant terminal-speeds - '#(0 50 75 110 134 150 200 300 600 1200 1800 2400 - 4800 9600 19200 38400 57600 115200 230400)) - -;;;; Support routines for dealing with unix pathnames. - -(export '(unix-file-kind unix-maybe-prepend-current-directory - unix-resolve-links unix-simplify-pathname)) - -(defun unix-file-kind (name &optional check-for-links) - _N"Returns either :file, :directory, :link, :special, or NIL." - (declare (simple-string name)) - (multiple-value-bind (res dev ino mode) - (if check-for-links - (unix-lstat name) - (unix-stat name)) - (declare (type (or fixnum null) mode) - (ignore dev ino)) - (when res - (let ((kind (logand mode s-ifmt))) - (cond ((eql kind s-ifdir) :directory) - ((eql kind s-ifreg) :file) - ((eql kind s-iflnk) :link) - (t :special)))))) - -(defun unix-maybe-prepend-current-directory (name) - (declare (simple-string name)) - (if (and (> (length name) 0) (char= (schar name 0) #\/)) - name - (multiple-value-bind (win dir) (unix-current-directory) - (if win - (concatenate 'simple-string dir "/" name) - name)))) - -(defun unix-resolve-links (pathname) - _N"Returns the pathname with all symbolic links resolved." - (declare (simple-string pathname)) - (let ((len (length pathname)) - (pending pathname)) - (declare (fixnum len) (simple-string pending)) - (if (zerop len) - pathname - (let ((result (make-string 100 :initial-element (code-char 0))) - (fill-ptr 0) - (name-start 0)) - (loop - (let* ((name-end (or (position #\/ pending :start name-start) len)) - (new-fill-ptr (+ fill-ptr (- name-end name-start)))) - ;; grow the result string, if necessary. the ">=" (instead of - ;; using ">") allows for the trailing "/" if we find this - ;; component is a directory. - (when (>= new-fill-ptr (length result)) - (let ((longer (make-string (* 3 (length result)) - :initial-element (code-char 0)))) - (replace longer result :end1 fill-ptr) - (setq result longer))) - (replace result pending - :start1 fill-ptr - :end1 new-fill-ptr - :start2 name-start - :end2 name-end) - (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t))) - (unless kind (return nil)) - (cond ((eq kind :link) - (multiple-value-bind (link err) (unix-readlink result) - (unless link - (error (intl:gettext "Error reading link ~S: ~S") - (subseq result 0 fill-ptr) - (get-unix-error-msg err))) - (cond ((or (zerop (length link)) - (char/= (schar link 0) #\/)) - ;; It's a relative link - (fill result (code-char 0) - :start fill-ptr - :end new-fill-ptr)) - ((string= result "/../" :end1 4) - ;; It's across the super-root. - (let ((slash (or (position #\/ result :start 4) - 0))) - (fill result (code-char 0) - :start slash - :end new-fill-ptr) - (setf fill-ptr slash))) - (t - ;; It's absolute. - (and (> (length link) 0) - (char= (schar link 0) #\/)) - (fill result (code-char 0) :end new-fill-ptr) - (setf fill-ptr 0))) - (setf pending - (if (= name-end len) - link - (concatenate 'simple-string - link - (subseq pending name-end)))) - (setf len (length pending)) - (setf name-start 0))) - ((= name-end len) - (when (eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (incf new-fill-ptr)) - (return (subseq result 0 new-fill-ptr))) - ((eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (setf fill-ptr (1+ new-fill-ptr)) - (setf name-start (1+ name-end))) - (t - (return nil)))))))))) - -(defun unix-simplify-pathname (src) - (declare (simple-string src)) - (let* ((src-len (length src)) - (dst (make-string src-len)) - (dst-len 0) - (dots 0) - (last-slash nil)) - (macrolet ((deposit (char) - `(progn - (setf (schar dst dst-len) ,char) - (incf dst-len)))) - (dotimes (src-index src-len) - (let ((char (schar src src-index))) - (cond ((char= char #\.) - (when dots - (incf dots)) - (deposit char)) - ((char= char #\/) - (case dots - (0 - ;; Either ``/...' or ``...//...' - (unless last-slash - (setf last-slash dst-len) - (deposit char))) - (1 - ;; Either ``./...'' or ``..././...'' - (decf dst-len)) - (2 - ;; We've found .. - (cond - ((and last-slash (not (zerop last-slash))) - ;; There is something before this .. - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (cond ((and (= (+ (or prev-prev-slash 0) 2) - last-slash) - (char= (schar dst (- last-slash 2)) #\.) - (char= (schar dst (1- last-slash)) #\.)) - ;; The something before this .. is another .. - (deposit char) - (setf last-slash dst-len)) - (t - ;; The something is some random dir. - (setf dst-len - (if prev-prev-slash - (1+ prev-prev-slash) - 0)) - (setf last-slash prev-prev-slash))))) - (t - ;; There is nothing before this .., so we need to keep it - (setf last-slash dst-len) - (deposit char)))) - (t - ;; Something other than a dot between slashes. - (setf last-slash dst-len) - (deposit char))) - (setf dots 0)) - (t - (setf dots nil) - (setf (schar dst dst-len) char) - (incf dst-len)))))) - (when (and last-slash (not (zerop last-slash))) - (case dots - (1 - ;; We've got ``foobar/.'' - (decf dst-len)) - (2 - ;; We've got ``foobar/..'' - (unless (and (>= last-slash 2) - (char= (schar dst (1- last-slash)) #\.) - (char= (schar dst (- last-slash 2)) #\.) - (or (= last-slash 2) - (char= (schar dst (- last-slash 3)) #\/))) - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (if prev-prev-slash - (setf dst-len (1+ prev-prev-slash)) - (return-from unix-simplify-pathname "./"))))))) - (cond ((zerop dst-len) - "./") - ((= dst-len src-len) - dst) - (t - (subseq dst 0 dst-len))))) - -;;; -;;; STRING-LIST-TO-C-STRVEC -- Internal -;;; -;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of -;;; simple-strings and constructs a C-style string vector (strvec) -- -;;; a null-terminated array of pointers to null-terminated strings. -;;; This function returns two values: a sap and a byte count. When the -;;; memory is no longer needed it should be deallocated with -;;; vm_deallocate. -;;; -(defun string-list-to-c-strvec (string-list) - ;; - ;; Make a pass over string-list to calculate the amount of memory - ;; needed to hold the strvec. - (let ((string-bytes 0) - (vec-bytes (* 4 (1+ (length string-list))))) - (declare (fixnum string-bytes vec-bytes)) - (dolist (s string-list) - (check-type s simple-string) - (incf string-bytes (round-bytes-to-words (1+ (length s))))) - ;; - ;; Now allocate the memory and fill it in. - (let* ((total-bytes (+ string-bytes vec-bytes)) - (vec-sap (system:allocate-system-memory total-bytes)) - (string-sap (sap+ vec-sap vec-bytes)) - (i 0)) - (declare (type (and unsigned-byte fixnum) total-bytes i) - (type system:system-area-pointer vec-sap string-sap)) - (dolist (s string-list) - (declare (simple-string s)) - (let ((n (length s))) - ;; - ;; Blast the string into place - #-unicode - (kernel:copy-to-system-area (the simple-string s) - (* vm:vector-data-offset vm:word-bits) - string-sap 0 - (* (1+ n) vm:byte-bits)) - #+unicode - (progn - ;; FIXME: Do we need to apply some kind of transformation - ;; to convert Lisp unicode strings to C strings? Utf-8? - (dotimes (k n) - (setf (sap-ref-8 string-sap k) - (logand #xff (char-code (aref s k))))) - (setf (sap-ref-8 string-sap n) 0)) - ;; - ;; Blast the pointer to the string into place - (setf (sap-ref-sap vec-sap i) string-sap) - (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n)))) - (incf i 4))) - ;; Blast in last null pointer - (setf (sap-ref-sap vec-sap i) (int-sap 0)) - (values vec-sap total-bytes)))) - -;;; Stuff not yet found in the header files... -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Abandon all hope who enters here... - - -;; not checked for linux... -(defmacro fd-set (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) - (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) - (deref (slot ,fd-set 'fds-bits) ,word)))))) - -;; not checked for linux... -(defmacro fd-clr (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) - (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logand (deref (slot ,fd-set 'fds-bits) ,word) - (32bit-logical-not - (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) - -;; not checked for linux... -(defmacro fd-isset (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits) - (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) - -;; not checked for linux... -(defmacro fd-zero (fd-set) - `(progn - ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits) - collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) - - - - -;;;; User and group database access, POSIX Standard 9.2.2 - -(defun unix-getpwnam (login) - _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." - (declare (type simple-string login)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd)) - (result (* (struct passwd)))) - (let ((returned - (alien-funcall - (extern-alien "getpwnam_r" - (function c-call:int - c-call:c-string - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct passwd))))) - login - (addr user-info) - (cast buf (* c-call:char)) - 1024 - (addr result)))) - (when (zerop returned) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - -(defun unix-getpwuid (uid) - _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." - (declare (type unix-uid uid)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd)) - (result (* (struct passwd)))) - (let ((returned - (alien-funcall - (extern-alien "getpwuid_r" - (function c-call:int - c-call:unsigned-int - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct passwd))))) - uid - (addr user-info) - (cast buf (* c-call:char)) - 1024 - (addr result)))) - (when (zerop returned) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - -(defun unix-getgrnam (name) - _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." - (declare (type simple-string name)) - (with-alien ((buf (array c-call:char 2048)) - (group-info (struct group)) - (result (* (struct group)))) - (let ((returned - (alien-funcall - (extern-alien "getgrnam_r" - (function c-call:int - c-call:c-string - (* (struct group)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct group))))) - name - (addr group-info) - (cast buf (* c-call:char)) - 2048 - (addr result)))) - (when (zerop returned) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string)))))))) - -(defun unix-getgrgid (gid) - _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." - (declare (type unix-gid gid)) - (with-alien ((buf (array c-call:char 2048)) - (group-info (struct group)) - (result (* (struct group)))) - (let ((returned - (alien-funcall - (extern-alien "getgrgid_r" - (function c-call:int - c-call:unsigned-int - (* (struct group)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct group))))) - gid - (addr group-info) - (cast buf (* c-call:char)) - 2048 - (addr result)))) - (when (zerop returned) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string)))))))) - - -;; EOF +(defun unix-cfgetospeed (termios) + _N"Get terminal output speed." + (multiple-value-bind (speed errno) + (int-syscall ("cfgetospeed" (* (struct termios))) termios) + (if speed + (values (svref terminal-speeds speed) 0) + (values speed errno)))) ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -9,15 +9,15 @@ ;;; ;;; ********************************************************************** ;;; -;;; This file contains the UNIX low-level support. +;;; This file contains the UNIX low-level support, just enough to run +;;; CMUCL. ;;; (in-package "UNIX") -(use-package "ALIEN") -(use-package "C-CALL") -(use-package "SYSTEM") -(use-package "EXT") + (intl:textdomain "cmucl-unix") +(pushnew :unix *features*) + ;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding ;; is locale-dependent...else use :utf-8 on Unicode Lisps. On 8 bit Lisps ;; it must be set to :iso8859-1 (or left as NIL), making files with @@ -25,172 +25,7 @@ ;; Must be set to NIL initially to enable building Lisp! (defvar *filename-encoding* nil) -(export '(daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t - timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime - itimerval it-interval it-value tchars t-intrc t-quitc t-startc - t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc - t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill - sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel - direct d-off d-ino d-reclen #-(or linux svr4) d-namlen d-name - stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size - st-atime st-mtime st-ctime st-blksize st-blocks - s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock - s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec - ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss - ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock - ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw - rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc - - unix-errno get-unix-error-msg - - prot_read prot_write prot_exec prot_none - map_shared map_private map_fixed map_anonymous - ms_async ms_sync ms_invalidate - unix-mmap unix-munmap unix-msync - unix-mprotect - - unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid - unix-setitimer unix-getitimer - unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec - setgidexec savetext readown writeown execown readgrp writegrp - execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown - unix-getdtablesize unix-close unix-creat unix-dup unix-dup2 - unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown - fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek - l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr - #+(or hpux svr4 bsd linux) o_ndelay - #+(or hpux svr4 bsd linux) o_noctty #+(or hpux svr4 bsd) o_nonblock - o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink - unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr - fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate - unix-ftruncate unix-symlink - #+(and sparc svr4) unix-times - unix-unlink unix-write unix-ioctl - tcsetpgrp tcgetpgrp tty-process-group - terminal-speeds tty-raw tty-crmod tty-echo tty-lcase - #-hpux tty-cbreak #-(or hpux linux) tty-tandem - #+(or hpux svr4 linux bsd) termios - #+(or hpux svr4 linux bsd) c-lflag - #+(or hpux svr4 linux bsd) c-iflag - #+(or hpux svr4 linux bsd) c-oflag - #+(or hpux svr4 linux bsd) tty-icrnl - #+(or hpux svr4 linux) tty-ocrnl - #+(or hpux svr4 bsd) vdsusp #+(or hpux svr4 linux bsd) veof - #+(or hpux svr4 linux bsd) vintr - #+(or hpux svr4 linux bsd) vquit - #+(or hpux svr4 linux bsd) vstart - #+(or hpux svr4 linux bsd) vstop - #+(or hpux svr4 linux bsd) vsusp - #+(or hpux svr4 linux bsd) c-cflag - #+(or hpux svr4 linux bsd) c-cc - #+(or bsd osf1) c-ispeed - #+(or bsd osf1) c-ospeed - #+(or hpux svr4 linux bsd) tty-icanon - #+(or hpux svr4 linux bsd) vmin - #+(or hpux svr4 linux bsd) vtime - #+(or hpux svr4 linux bsd) tty-ixon - #+(or hpux svr4 linux bsd) tcsanow - #+(or hpux svr4 linux bsd) tcsadrain - #+(or hpux svr4 linux bsd) tciflush - #+(or hpux svr4 linux bsd) tcoflush - #+(or hpux svr4 linux bsd) tcioflush - #+(or hpux svr4 linux bsd) tcsaflush - #+(or hpux svr4 linux bsd) unix-tcgetattr - #+(or hpux svr4 linux bsd) unix-tcsetattr - #+(or hpux svr4 bsd) unix-cfgetospeed - #+(or hpux svr4 bsd) unix-cfsetospeed - #+(or hpux svr4 bsd) unix-cfgetispeed - #+(or hpux svr4 bsd) unix-cfsetispeed - #+(or hpux svr4 linux bsd) tty-ignbrk - #+(or hpux svr4 linux bsd) tty-brkint - #+(or hpux svr4 linux bsd) tty-ignpar - #+(or hpux svr4 linux bsd) tty-parmrk - #+(or hpux svr4 linux bsd) tty-inpck - #+(or hpux svr4 linux bsd) tty-istrip - #+(or hpux svr4 linux bsd) tty-inlcr - #+(or hpux svr4 linux bsd) tty-igncr - #+(or hpux svr4 linux) tty-iuclc - #+(or hpux svr4 linux bsd) tty-ixany - #+(or hpux svr4 linux bsd) tty-ixoff - #+hpux tty-ienqak - #+(or hpux irix solaris linux bsd) tty-imaxbel - #+(or hpux svr4 linux bsd) tty-opost - #+(or hpux svr4 linux) tty-olcuc - #+(or hpux svr4 linux bsd) tty-onlcr - #+(or hpux svr4 linux) tty-onocr - #+(or hpux svr4 linux) tty-onlret - #+(or hpux svr4 linux) tty-ofill - #+(or hpux svr4 linux) tty-ofdel - #+(or hpux svr4 linux bsd) tty-isig - #+(or hpux svr4 linux) tty-xcase - #+(or hpux svr4 linux bsd) tty-echoe - #+(or hpux svr4 linux bsd) tty-echok - #+(or hpux svr4 linux bsd) tty-echonl - #+(or hpux svr4 linux bsd) tty-noflsh - #+(or hpux svr4 linux bsd) tty-iexten - #+(or hpux svr4 linux bsd) tty-tostop - #+(or hpux irix solaris linux bsd) tty-echoctl - #+(or hpux irix solaris linux bsd) tty-echoprt - #+(or hpux irix solaris linux bsd) tty-echoke - #+(or hpux irix solaris) tty-defecho - #+(or hpux irix solaris bsd) tty-flusho - #+(or hpux irix solaris linux bsd) tty-pendin - #+(or hpux svr4 linux bsd) tty-cstopb - #+(or hpux svr4 linux bsd) tty-cread - #+(or hpux svr4 linux bsd) tty-parenb - #+(or hpux svr4 linux bsd) tty-parodd - #+(or hpux svr4 linux bsd) tty-hupcl - #+(or hpux svr4 linux bsd) tty-clocal - #+(or irix solaris) rcv1en - #+(or irix solaris) xmt1en - #+(or hpux irix solaris) tty-loblk - #+(or hpux svr4 linux bsd) vintr - #+(or hpux svr4 linux bsd) verase - #+(or hpux svr4 linux bsd) vkill - #+(or hpux svr4 linux bsd) veol - #+(or hpux irix solaris linux bsd) veol2 - #+(or hpux irix solaris) tty-cbaud - #+(or hpux svr4 bsd) tty-csize #+(or hpux svr4 bsd) tty-cs5 - #+(or hpux svr4 bsd) tty-cs6 #+(or hpux svr4 bsd) tty-cs7 - #+(or hpux svr4 bsd) tty-cs8 - #+(or hpux svr4 bsd) unix-tcsendbreak - #+(or hpux svr4 bsd) unix-tcdrain - #+(or hpux svr4 bsd) unix-tcflush - #+(or hpux svr4 bsd) unix-tcflow - - TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC - TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ - TIOCSIGSEND - - KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK - KBDSCLICK FIONREAD #+(or hpux bsd) siocspgrp - unix-exit unix-stat unix-lstat unix-fstat - unix-getrusage unix-fast-getrusage rusage_self rusage_children - unix-gettimeofday - #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid - #-(or svr4 hpux) unix-setregid - unix-getpid unix-getppid - #+(or svr4 bsd)unix-setpgid - unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid - unix-getpagesize unix-gethostname unix-gethostid unix-fork - unix-getenv unix-setenv unix-putenv unix-unsetenv - unix-current-directory unix-isatty unix-ttyname unix-execve - unix-socket unix-connect unix-bind unix-listen unix-accept - unix-recv unix-send unix-getpeername unix-getsockname - unix-getsockopt unix-setsockopt unix-openpty - - unix-recvfrom unix-sendto unix-shutdown - - unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid - user-info user-info-name user-info-password user-info-uid - user-info-gid user-info-gecos user-info-dir user-info-shell - group-info group-info-name group-info-gid group-info-members - - unix-uname)) - -(pushnew :unix *features*) - -(eval-when (:compile-toplevel) +(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro %name->file (string) `(if *filename-encoding* (string-encode ,string *filename-encoding*) @@ -203,24 +38,15 @@ ;;;; Common machine independent structures. -;;; From sys/types.h - (def-alien-type int64-t (signed 64)) -(def-alien-type u-int64-t (unsigned 64)) - -(def-alien-type daddr-t - #-(or linux alpha) long - #+(or linux alpha) int) -(def-alien-type caddr-t (* char)) +(def-alien-type u-int64-t (unsigned 64)) (def-alien-type ino-t #+netbsd u-int64-t #+alpha unsigned-int #-(or alpha netbsd) unsigned-long) -(def-alien-type swblk-t long) - (def-alien-type size-t #-(or linux alpha) long #+linux unsigned-int @@ -262,55 +88,11 @@ (def-alien-type uid-t unsigned-long) (def-alien-type gid-t unsigned-long)) -;;; Large file support for Solaris. Define some of the 64-bit types -;;; we need. Unlike unix-glibc's large file support, Solaris's -;;; version is a little simpler because all of the 64-bit versions of -;;; the functions actually exist as functions. So instead of calling -;;; the 32-bit versions of the functions, we call the 64-bit versions. -;;; -;;; These functions are: creat64, open64, truncate64, ftruncate64, -;;; stat64, lstat64, fstat64, readdir64. -;;; -;;; There are also some new structures for large file support: -;;; dirent64, stat64. -;;; -;;; FIXME: We should abstract this better, but I (rtoy) don't have any -;;; other system to test this out on, so it's a Solaris hack for now. -#+solaris -(progn - (deftype file-offset64 () '(signed-byte 64)) - (def-alien-type off64-t int64-t) - (def-alien-type ino64-t u-int64-t) - (def-alien-type blkcnt64-t u-int64-t)) - (def-alien-type mode-t #-(or alpha svr4) unsigned-short #+alpha unsigned-int #+svr4 unsigned-long) -(def-alien-type nlink-t - #-(or svr4 netbsd) unsigned-short - #+netbsd unsigned-long - #+svr4 unsigned-long) - -(defconstant FD-SETSIZE - #-(or hpux alpha linux FreeBSD) 256 - #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024) - -;; not checked for linux... -(def-alien-type nil - (struct fd-set - (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32))))) - -;; not checked for linux... -(defmacro fd-set (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) - (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) - (deref (slot ,fd-set 'fds-bits) ,word)))))) - ;; not checked for linux... (defmacro fd-clr (offset fd-set) (let ((word (gensym)) @@ -328,38 +110,25 @@ `(multiple-value-bind (,word ,bit) (floor ,offset 32) (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) -;; not checked for linux... -(defmacro fd-zero (fd-set) - `(progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) +(def-alien-type nlink-t + #-(or svr4 netbsd) unsigned-short + #+netbsd unsigned-long + #+svr4 unsigned-long) + +(defconstant fd-setsize + #-(or hpux alpha linux FreeBSD) 256 + #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024) -;;; From sys/time.h +;; not checked for linux... +(def-alien-type nil + (struct fd-set + (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32))))) (def-alien-type nil (struct timeval (tv-sec #-linux time-t #+linux int) ; seconds (tv-usec int))) ; and microseconds -(def-alien-type nil - (struct timezone - (tz-minuteswest int) ; minutes west of Greenwich - (tz-dsttime ; type of dst correction - #-linux (enum nil :none :usa :aust :wet :met :eet :can) - #+linux int))) - -(def-alien-type nil - (struct itimerval - (it-interval (struct timeval)) ; timer interval - (it-value (struct timeval)))) ; current value - -#+(or linux svr4) -; High-res time. Actually posix definition under svr4 name. -(def-alien-type nil - (struct timestruc-t - (tv-sec time-t) - (tv-nsec long))) - #+(or linux BSD) (def-alien-type nil (struct timespec-t @@ -388,7 +157,6 @@ #-linux (t-werasc char) ; word erase (t-lnextc char))) ; literal next character - (def-alien-type nil (struct sgttyb #+linux (sg-flags #+mach short #-mach int) ; mode flags @@ -408,932 +176,413 @@ (ws-xpixel unsigned-short) ; horizontal size, pixels (ws-ypixel unsigned-short))) ; veritical size, pixels + +;;;; System calls. -;;; From sys/termios.h - -;;; NOTE: There is both a termio (SYSV) and termios (POSIX) -;;; structure with similar but incompatible definitions. It may be that -;;; the non-BSD variant of termios below is really a termio but I (pw) -;;; can't verify. The BSD variant uses the Posix termios def. Some systems -;;; (Ultrix and OSF1) seem to support both if used independently. -;;; The 17f version of this seems a bit confused wrt the conditionals. -;;; Please check these defs for your system. - -;;; TSM: from what I can tell looking at the 17f definition, my guess is that it -;;; was originally a termio for sunos (nonsolaris) (because it had the c-line -;;; member for sunos only), and then was mutated into the termios definition for -;;; later systems. The definition here is definitely not an IRIX termio because -;;; it doesn't have c-line. In any case, the functions tcgetattr, etc., -;;; definitely take a termios, and termios seems to be the more standard -;;; standard now, so my suggestion is to just go with termios and forget about -;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've -;;; changed it (which means you need to bootstrap it to avoid a reader error). - -;;; On top of all that, SGI decided to change the termios structure on irix -;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library, -;;; but introduced static functions in termios.h to redirect new calls to the -;;; new library--which means it's important not to #include termios.h before -;;; undefineds.h when building lisp. - -(defconstant +NCCS+ - #+hpux 16 - #+irix 23 - #+(or linux solaris) 19 - #+(or bsd osf1) 20 - #+(and sunos (not svr4)) 17 - _N"Size of control character vector.") +(defmacro %syscall ((name (&rest arg-types) result-type) + success-form &rest args) + `(let* ((fn (extern-alien ,name (function ,result-type ,@arg-types))) + (result (alien-funcall fn ,@args))) + (if (eql -1 result) + (values nil (unix-errno)) + ,success-form))) -(def-alien-type nil - (struct termios - (c-iflag unsigned-int) - (c-oflag unsigned-int) - (c-cflag unsigned-int) - (c-lflag unsigned-int) - #+(or linux hpux (and sunos (not svr4))) - (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int - #+(or linux (and sunos (not svr4))) unsigned-char) - (c-cc (array unsigned-char #.+NCCS+)) - #+(or bsd osf1) (c-ispeed unsigned-int) - #+(or bsd osf1) (c-ospeed unsigned-int))) +(defmacro syscall ((name &rest arg-types) success-form &rest args) + `(%syscall (,name (,@arg-types) int) ,success-form ,@args)) -;;; From sys/dir.h +;;; Like syscall, but if it fails, signal an error instead of returing error +;;; codes. Should only be used for syscalls that will never really get an +;;; error. ;;; -;;; (For Solaris, this is not struct direct, but struct dirent!) -#-bsd -(def-alien-type nil - (struct direct - #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry - (d-ino ino-t); inode number of entry - #+(or linux svr4) (d-off long) - (d-reclen unsigned-short) ; length of this record - #-(or linux svr4) - (d-namlen unsigned-short) ; length of string in d-name - (d-name (array char 256)))) ; name must be no longer than this +(defmacro syscall* ((name &rest arg-types) success-form &rest args) + `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (eql -1 result) + (error _"Syscall ~A failed: ~A" ,name (get-unix-error-msg)) + ,success-form))) -#+(and bsd (not netbsd)) -(def-alien-type nil - (struct direct - (d-fileno unsigned-long) - (d-reclen unsigned-short) - (d-type unsigned-char) - (d-namlen unsigned-char) ; length of string in d-name - (d-name (array char 256)))) ; name must be no longer than this +(defmacro void-syscall ((name &rest arg-types) &rest args) + `(syscall (,name ,@arg-types) (values t 0) ,@args)) -#+netbsd -(def-alien-type nil - (struct direct - (d-fileno ino-t) - (d-reclen unsigned-short) - (d-namlen unsigned-short) - (d-type unsigned-char) - (d-name (array char 512)))) +(defmacro int-syscall ((name &rest arg-types) &rest args) + `(syscall (,name ,@arg-types) (values result 0) ,@args)) -;;; The 64-bit version of struct dirent. -#+solaris -(def-alien-type nil - (struct dirent64 - (d-ino ino64-t); inode number of entry - (d-off off64-t) ; offset of next disk directory entry - (d-reclen unsigned-short) ; length of this record - (d-name (array char 256)))) ; name must be no longer than this +(defmacro off-t-syscall ((name arg-types) &rest args) + `(%syscall (,name ,arg-types off-t) (values result 0) ,@args)) + +;;; Operations on Unix Directories. -;;; From sys/stat.h -;; oh boy, in linux-> 2 stat(s)!! +(export '(open-dir read-dir close-dir)) -#-(or svr4 bsd linux) ; eg hpux and alpha -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-size off-t) - (st-atime time-t) - (st-spare1 int) - (st-mtime time-t) - (st-spare2 int) - (st-ctime time-t) - (st-spare3 int) - (st-blksize #-alpha long #+alpha unsigned-int) - (st-blocks #-alpha long #+alpha int) - (st-spare4 (array long 2)))) +(defstruct (%directory + (:conc-name directory-) + (:constructor make-directory) + (:print-function %print-directory)) + name + (dir-struct (required-argument) :type system-area-pointer)) -#+(and bsd (not netbsd)) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize unsigned-long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-lspare long) - (st-qspare (array long 4)))) +(defun %print-directory (dir stream depth) + (declare (ignore depth)) + (format stream "#<Directory ~S>" (directory-name dir))) -#+netbsd -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-mode mode-t) - (st-ino ino-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-birthtime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-spare (array unsigned-long 2)))) +(defun open-dir (pathname) + (declare (type unix-pathname pathname)) + (when (string= pathname "") + (setf pathname ".")) + (let ((kind (unix-file-kind pathname))) + (case kind + (:directory + (let ((dir-struct + (alien-funcall (extern-alien "opendir" + (function system-area-pointer + c-string)) + (%name->file pathname)))) + (if (zerop (sap-int dir-struct)) + (values nil (unix-errno)) + (make-directory :name pathname :dir-struct dir-struct)))) + ((nil) + (values nil enoent)) + (t + (values nil enotdir))))) -#+(or linux svr4) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-pad1 #-linux (array long 3) #+linux unsigned-short) - (st-ino ino-t) - (st-mode #-linux unsigned-long #+linux unsigned-short) - (st-nlink #-linux short #+linux unsigned-short) - (st-uid #-linux uid-t #+linux unsigned-short) - (st-gid #-linux gid-t #+linux unsigned-short) - (st-rdev dev-t) - (st-pad2 #-linux (array long 2) #+linux unsigned-short) - (st-size off-t) - #-linux (st-pad3 long) - #+linux (st-blksize unsigned-long) - #+linux (st-blocks unsigned-long) - #-linux (st-atime (struct timestruc-t)) - #+linux (st-atime unsigned-long) - #+linux (unused-1 unsigned-long) - #-linux (st-mtime (struct timestruc-t)) - #+linux (st-mtime unsigned-long) - #+linux (unused-2 unsigned-long) - #-linux (st-ctime (struct timestruc-t)) - #+linux (st-ctime unsigned-long) - #+linux (unused-3 unsigned-long) - #+linux (unused-4 unsigned-long) - #+linux (unused-5 unsigned-long) - #-linux(st-blksize long) - #-linux (st-blocks long) - #-linux (st-fstype (array char 16)) - #-linux (st-pad4 (array long 8)))) +#-(and bsd (not solaris)) +(defun read-dir (dir) + (declare (type %directory dir)) + (let ((daddr (alien-funcall (extern-alien "readdir" + (function system-area-pointer + system-area-pointer)) + (directory-dir-struct dir)))) + (declare (type system-area-pointer daddr)) + (if (zerop (sap-int daddr)) + nil + (with-alien ((direct (* (struct direct)) daddr)) + #-(or linux svr4) + (let ((nlen (slot direct 'd-namlen)) + (ino (slot direct 'd-ino))) + (declare (type (unsigned-byte 16) nlen)) + (let ((string (make-string nlen))) + #-unicode + (kernel:copy-from-system-area + (alien-sap (addr (slot direct 'd-name))) 0 + string (* vm:vector-data-offset vm:word-bits) + (* nlen vm:byte-bits)) + #+unicode + (let ((sap (alien-sap (addr (slot direct 'd-name))))) + (dotimes (k nlen) + (setf (aref string k) + (code-char (sap-ref-8 sap k))))) + (values (%file->name string) ino))) + #+(or linux svr4) + (values (%file->name (cast (slot direct 'd-name) c-string)) + (slot direct 'd-ino)))))) -;;; 64-bit stat for Solaris +;;; 64-bit readdir for Solaris #+solaris -(def-alien-type nil - (struct stat64 - (st-dev dev-t) - (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned - (st-ino ino64-t) - (st-mode unsigned-long) - (st-nlink short) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned - (st-size off64-t) - (st-atime (struct timestruc-t)) - (st-mtime (struct timestruc-t)) - (st-ctime (struct timestruc-t)) - (st-blksize long) - (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned - (st-blocks blkcnt64-t) - (st-fstype (array char 16)) - (st-pad4 (array long 8)))) +(defun read-dir (dir) + (declare (type %directory dir)) + (let ((daddr (alien-funcall (extern-alien "readdir64" + (function system-area-pointer + system-area-pointer)) + (directory-dir-struct dir)))) + (declare (type system-area-pointer daddr)) + (if (zerop (sap-int daddr)) + nil + (with-alien ((direct (* (struct dirent64)) daddr)) + #-(or linux svr4) + (let ((nlen (slot direct 'd-namlen)) + (ino (slot direct 'd-ino))) + (declare (type (unsigned-byte 16) nlen)) + (let ((string (make-string nlen))) + #-unicode + (kernel:copy-from-system-area + (alien-sap (addr (slot direct 'd-name))) 0 + string (* vm:vector-data-offset vm:word-bits) + (* nlen vm:byte-bits)) + #+unicode + (let ((sap (alien-sap (addr (slot direct 'd-name))))) + (dotimes (k nlen) + (setf (aref string k) + (code-char (sap-ref-8 sap k))))) + (values (%file->name string) ino))) + #+(or linux svr4) + (values (%file->name (cast (slot direct 'd-name) c-string)) + (slot direct 'd-ino)))))) -(defconstant s-ifmt #o0170000) -(defconstant s-ifdir #o0040000) -(defconstant s-ifchr #o0020000) -#+linux (defconstant s-ififo #x0010000) -(defconstant s-ifblk #o0060000) -(defconstant s-ifreg #o0100000) -(defconstant s-iflnk #o0120000) -(defconstant s-ifsock #o0140000) -(defconstant s-isuid #o0004000) -(defconstant s-isgid #o0002000) -(defconstant s-isvtx #o0001000) -(defconstant s-iread #o0000400) -(defconstant s-iwrite #o0000200) -(defconstant s-iexec #o0000100) +#+(and bsd (not solaris)) +(defun read-dir (dir) + (declare (type %directory dir)) + (let ((daddr (alien-funcall (extern-alien "readdir" + (function system-area-pointer + system-area-pointer)) + (directory-dir-struct dir)))) + (declare (type system-area-pointer daddr)) + (if (zerop (sap-int daddr)) + nil + (with-alien ((direct (* (struct direct)) daddr)) + (let ((nlen (slot direct 'd-namlen)) + (fino (slot direct 'd-fileno))) + (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen) + (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino)) + (let ((string (make-string nlen))) + #-unicode + (kernel:copy-from-system-area + (alien-sap (addr (slot direct 'd-name))) 0 + string (* vm:vector-data-offset vm:word-bits) + (* nlen vm:byte-bits)) + #+unicode + (let ((sap (alien-sap (addr (slot direct 'd-name))))) + (dotimes (k nlen) + (setf (aref string k) + (code-char (sap-ref-8 sap k))))) + (values (%file->name string) fino))))))) -;;; From sys/resource.h -(def-alien-type nil - (struct rusage - (ru-utime (struct timeval)) ; user time used - (ru-stime (struct timeval)) ; system time used. - (ru-maxrss long) - (ru-ixrss long) ; integral sharded memory size - (ru-idrss long) ; integral unsharded data " - (ru-isrss long) ; integral unsharded stack " - (ru-minflt long) ; page reclaims - (ru-majflt long) ; page faults - (ru-nswap long) ; swaps - (ru-inblock long) ; block input operations - (ru-oublock long) ; block output operations - (ru-msgsnd long) ; messages sent - (ru-msgrcv long) ; messages received - (ru-nsignals long) ; signals received - (ru-nvcsw long) ; voluntary context switches - (ru-nivcsw long))) ; involuntary " +(defun close-dir (dir) + (declare (type %directory dir)) + (alien-funcall (extern-alien "closedir" + (function void system-area-pointer)) + (directory-dir-struct dir)) + nil) -(def-alien-type nil - (struct rlimit - (rlim-cur #-(or linux alpha) int #+linux long #+alpha unsigned-int) ; current (soft) limit - (rlim-max #-(or linux alpha) int #+linux long #+alpha unsigned-int))); maximum value for rlim-cur +;; Use getcwd instead of getwd. But what should we do if the path +;; won't fit? Try again with a larger size? We don't do that right +;; now. +(defun unix-current-directory () + ;; 5120 is some randomly selected maximum size for the buffer for getcwd. + (with-alien ((buf (array c-call:char 5120))) + (let ((result + (alien-funcall + (extern-alien "getcwd" + (function (* c-call:char) + (* c-call:char) c-call:int)) + (cast buf (* c-call:char)) + 5120))) + + (values (not (zerop + (sap-int (alien-sap result)))) + (%file->name (cast buf c-call:c-string)))))) - -;;;; Errno stuff. +;;; Unix-access accepts a path and a mode. It returns two values the +;;; first is T if the file is accessible and NIL otherwise. The second +;;; only has meaning in the second case and is the unix errno value. -(eval-when (compile eval) +(defconstant r_ok 4 _N"Test for read permission") +(defconstant w_ok 2 _N"Test for write permission") +(defconstant x_ok 1 _N"Test for execute permission") +(defconstant f_ok 0 _N"Test for presence of file") -(defparameter *compiler-unix-errors* nil) +(defun unix-access (path mode) + _N"Given a file path (a string) and one of four constant modes, + unix-access returns T if the file is accessible with that + mode and NIL if not. It also returns an errno value with + NIL which determines why the file was not accessible. -(defmacro def-unix-error (name number description) - `(progn - (eval-when (compile eval) - (push (cons ,number ,description) *compiler-unix-errors*)) - (defconstant ,name ,number ,description) - (export ',name))) + The access modes are: + r_ok Read permission. + w_ok Write permission. + x_ok Execute permission. + f_ok Presence of file." + (declare (type unix-pathname path) + (type (mod 8) mode)) + (void-syscall ("access" c-string int) (%name->file path) mode)) -(defmacro emit-unix-errors () - (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*))) - (array (make-array (1+ max) :initial-element nil))) - (dolist (error *compiler-unix-errors*) - (setf (svref array (car error)) (cdr error))) - `(progn - (defvar *unix-errors* ',array) - (declaim (simple-vector *unix-errors*))))) +;;; Unix-chdir accepts a directory name and makes that the +;;; current working directory. -) ;eval-when +(defun unix-chdir (path) + _N"Given a file path string, unix-chdir changes the current working + directory to the one specified." + (declare (type unix-pathname path)) + (void-syscall ("chdir" c-string) (%name->file path))) -;;; -;;; From <errno.h> -;;; -(def-unix-error ESUCCESS 0 _N"Successful") -(def-unix-error EPERM 1 _N"Operation not permitted") -(def-unix-error ENOENT 2 _N"No such file or directory") -(def-unix-error ESRCH 3 _N"No such process") -(def-unix-error EINTR 4 _N"Interrupted system call") -(def-unix-error EIO 5 _N"I/O error") -(def-unix-error ENXIO 6 _N"Device not configured") -(def-unix-error E2BIG 7 _N"Arg list too long") -(def-unix-error ENOEXEC 8 _N"Exec format error") -(def-unix-error EBADF 9 _N"Bad file descriptor") -(def-unix-error ECHILD 10 _N"No child process") -#+bsd(def-unix-error EDEADLK 11 _N"Resource deadlock avoided") -#-bsd(def-unix-error EAGAIN 11 #-linux _N"No more processes" #+linux _N"Try again") -(def-unix-error ENOMEM 12 _N"Out of memory") -(def-unix-error EACCES 13 _N"Permission denied") -(def-unix-error EFAULT 14 _N"Bad address") -(def-unix-error ENOTBLK 15 _N"Block device required") -(def-unix-error EBUSY 16 _N"Device or resource busy") -(def-unix-error EEXIST 17 _N"File exists") -(def-unix-error EXDEV 18 _N"Cross-device link") -(def-unix-error ENODEV 19 _N"No such device") -(def-unix-error ENOTDIR 20 _N"Not a director") -(def-unix-error EISDIR 21 _N"Is a directory") -(def-unix-error EINVAL 22 _N"Invalid argument") -(def-unix-error ENFILE 23 _N"File table overflow") -(def-unix-error EMFILE 24 _N"Too many open files") -(def-unix-error ENOTTY 25 _N"Inappropriate ioctl for device") -(def-unix-error ETXTBSY 26 _N"Text file busy") -(def-unix-error EFBIG 27 _N"File too large") -(def-unix-error ENOSPC 28 _N"No space left on device") -(def-unix-error ESPIPE 29 _N"Illegal seek") -(def-unix-error EROFS 30 _N"Read-only file system") -(def-unix-error EMLINK 31 _N"Too many links") -(def-unix-error EPIPE 32 _N"Broken pipe") -;;; -;;; Math -(def-unix-error EDOM 33 _N"Numerical argument out of domain") -(def-unix-error ERANGE 34 #-linux _N"Result too large" #+linux _N"Math result not representable") -;;; -#-(or linux svr4) +;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. + +(defconstant setuidexec #o4000 _N"Set user ID on execution") +(defconstant setgidexec #o2000 _N"Set group ID on execution") +(defconstant savetext #o1000 _N"Save text image after execution") +(defconstant readown #o400 _N"Read by owner") +(defconstant writeown #o200 _N"Write by owner") +(defconstant execown #o100 _N"Execute (search directory) by owner") +(defconstant readgrp #o40 _N"Read by group") +(defconstant writegrp #o20 _N"Write by group") +(defconstant execgrp #o10 _N"Execute (search directory) by group") +(defconstant readoth #o4 _N"Read by others") +(defconstant writeoth #o2 _N"Write by others") +(defconstant execoth #o1 _N"Execute (search directory) by others") + +(defun unix-chmod (path mode) + _N"Given a file path string and a constant mode, unix-chmod changes the + permission mode for that file to the one specified. The new mode + can be created by logically OR'ing the following: + + setuidexec Set user ID on execution. + setgidexec Set group ID on execution. + savetext Save text image after execution. + readown Read by owner. + writeown Write by owner. + execown Execute (search directory) by owner. + readgrp Read by group. + writegrp Write by group. + execgrp Execute (search directory) by group. + readoth Read by others. + writeoth Write by others. + execoth Execute (search directory) by others. + + Thus #o444 and (logior unix:readown unix:readgrp unix:readoth) + are equivalent for 'mode. The octal-base is familar to Unix users. + + It returns T on successfully completion; NIL and an error number + otherwise." + (declare (type unix-pathname path) + (type unix-file-mode mode)) + (void-syscall ("chmod" c-string int) (%name->file path) mode)) + +;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode +;;; ("mode") and changes the protection of the file described by "fd" to +;;; "mode". + +(defun unix-fchmod (fd mode) + _N"Given an integer file descriptor and a mode (the same as those + used for unix-chmod), unix-fchmod changes the permission mode + for that file to the one specified. T is returned if the call + was successful." + (declare (type unix-fd fd) + (type unix-file-mode mode)) + (void-syscall ("fchmod" int int) fd mode)) + +;;; Unix-lseek accepts a file descriptor, an offset, and whence value. + +(defconstant l_set 0 _N"set the file pointer") +(defconstant l_incr 1 _N"increment the file pointer") +(defconstant l_xtnd 2 _N"extend the file size") + +(defun unix-lseek (fd offset whence) + _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead + a certain offset for that file. Whence can be any of the following: + + l_set Set the file pointer. + l_incr Increment the file pointer. + l_xtnd Extend the file size. + _N" + (declare (type unix-fd fd) + (type file-offset offset) + (type (integer 0 2) whence)) + (off-t-syscall ("lseek" (int off-t int)) fd offset whence)) + +;;; Unix-mkdir accepts a name and a mode and attempts to create the +;;; corresponding directory with mode mode. + +(defun unix-mkdir (name mode) + _N"Unix-mkdir creates a new directory with the specified name and mode. + (Same as those for unix-chmod.) It returns T upon success, otherwise + NIL and an error number." + (declare (type unix-pathname name) + (type unix-file-mode mode)) + (void-syscall ("mkdir" c-string int) (%name->file name) mode)) + +;;; Unix-unlink accepts a name and deletes the directory entry for that +;;; name and the file if this is the last link. + +(defun unix-unlink (name) + _N"Unix-unlink removes the directory entry for the named file. + NIL and an error code is returned if the call fails." + (declare (type unix-pathname name)) + (void-syscall ("unlink" c-string) (%name->file name))) + +;;; Unix-open accepts a pathname (a simple string), flags, and mode and +;;; attempts to open file with name pathname. + +(defconstant o_rdonly 0 _N"Read-only flag.") +(defconstant o_wronly 1 _N"Write-only flag.") +(defconstant o_rdwr 2 _N"Read-write flag.") +#+(or hpux linux svr4) +(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O") +(defconstant o_append #-linux #o10 #+linux #o2000 _N"Append flag.") +#+(or hpux svr4 linux) (progn -;;; non-blocking and interrupt i/o -(def-unix-error EWOULDBLOCK 35 _N"Operation would block") -#-bsd(def-unix-error EDEADLK 35 _N"Operation would block") ; Ditto -#+bsd(def-unix-error EAGAIN 35 _N"Resource temporarily unavailable") -(def-unix-error EINPROGRESS 36 _N"Operation now in progress") -(def-unix-error EALREADY 37 _N"Operation already in progress") -;;; -;;; ipc/network software -(def-unix-error ENOTSOCK 38 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 39 _N"Destination address required") -(def-unix-error EMSGSIZE 40 _N"Message too long") -(def-unix-error EPROTOTYPE 41 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 42 _N"Protocol not available") -(def-unix-error EPROTONOSUPPORT 43 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 44 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 45 _N"Operation not supported on socket") -(def-unix-error EPFNOSUPPORT 46 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 47 _N"Address family not supported by protocol family") -(def-unix-error EADDRINUSE 48 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 49 _N"Can't assign requested address") -;;; -;;; operational errors -(def-unix-error ENETDOWN 50 _N"Network is down") -(def-unix-error ENETUNREACH 51 _N"Network is unreachable") -(def-unix-error ENETRESET 52 _N"Network dropped connection on reset") -(def-unix-error ECONNABORTED 53 _N"Software caused connection abort") -(def-unix-error ECONNRESET 54 _N"Connection reset by peer") -(def-unix-error ENOBUFS 55 _N"No buffer space available") -(def-unix-error EISCONN 56 _N"Socket is already connected") -(def-unix-error ENOTCONN 57 _N"Socket is not connected") -(def-unix-error ESHUTDOWN 58 _N"Can't send after socket shutdown") -(def-unix-error ETOOMANYREFS 59 _N"Too many references: can't splice") -(def-unix-error ETIMEDOUT 60 _N"Connection timed out") -(def-unix-error ECONNREFUSED 61 _N"Connection refused") -;;; -(def-unix-error ELOOP 62 _N"Too many levels of symbolic links") -(def-unix-error ENAMETOOLONG 63 _N"File name too long") -;;; -(def-unix-error EHOSTDOWN 64 _N"Host is down") -(def-unix-error EHOSTUNREACH 65 _N"No route to host") -(def-unix-error ENOTEMPTY 66 _N"Directory not empty") -;;; -;;; quotas & resource -(def-unix-error EPROCLIM 67 _N"Too many processes") -(def-unix-error EUSERS 68 _N"Too many users") -(def-unix-error EDQUOT 69 _N"Disc quota exceeded") -;;; -;;; CMU RFS -(def-unix-error ELOCAL 126 _N"namei should continue locally") -(def-unix-error EREMOTE 127 _N"namei was handled remotely") -;;; -;;; VICE -(def-unix-error EVICEERR 70 _N"Remote file system error _N") -(def-unix-error EVICEOP 71 _N"syscall was handled by Vice") -) -#+svr4 + (defconstant o_creat #-linux #o400 #+linux #o100 _N"Create if nonexistant flag.") + (defconstant o_trunc #o1000 _N"Truncate flag.") + (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.") + (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800 + _N"Don't assign controlling tty")) +#+(or hpux svr4 BSD) +(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04 + _N"Non-blocking mode") +#+BSD +(defconstant o_ndelay o_nonblock) ; compatibility +#+linux (progn -(def-unix-error ENOMSG 35 _N"No message of desired type") -(def-unix-error EIDRM 36 _N"Identifier removed") -(def-unix-error ECHRNG 37 _N"Channel number out of range") -(def-unix-error EL2NSYNC 38 _N"Level 2 not synchronized") -(def-unix-error EL3HLT 39 _N"Level 3 halted") -(def-unix-error EL3RST 40 _N"Level 3 reset") -(def-unix-error ELNRNG 41 _N"Link number out of range") -(def-unix-error EUNATCH 42 _N"Protocol driver not attached") -(def-unix-error ENOCSI 43 _N"No CSI structure available") -(def-unix-error EL2HLT 44 _N"Level 2 halted") -(def-unix-error EDEADLK 45 _N"Deadlock situation detected/avoided") -(def-unix-error ENOLCK 46 _N"No record locks available") -(def-unix-error ECANCELED 47 _N"Error 47") -(def-unix-error ENOTSUP 48 _N"Error 48") -(def-unix-error EBADE 50 _N"Bad exchange descriptor") -(def-unix-error EBADR 51 _N"Bad request descriptor") -(def-unix-error EXFULL 52 _N"Message tables full") -(def-unix-error ENOANO 53 _N"Anode table overflow") -(def-unix-error EBADRQC 54 _N"Bad request code") -(def-unix-error EBADSLT 55 _N"Invalid slot") -(def-unix-error EDEADLOCK 56 _N"File locking deadlock") -(def-unix-error EBFONT 57 _N"Bad font file format") -(def-unix-error ENOSTR 60 _N"Not a stream device") -(def-unix-error ENODATA 61 _N"No data available") -(def-unix-error ETIME 62 _N"Timer expired") -(def-unix-error ENOSR 63 _N"Out of stream resources") -(def-unix-error ENONET 64 _N"Machine is not on the network") -(def-unix-error ENOPKG 65 _N"Package not installed") -(def-unix-error EREMOTE 66 _N"Object is remote") -(def-unix-error ENOLINK 67 _N"Link has been severed") -(def-unix-error EADV 68 _N"Advertise error") -(def-unix-error ESRMNT 69 _N"Srmount error") -(def-unix-error ECOMM 70 _N"Communication error on send") -(def-unix-error EPROTO 71 _N"Protocol error") -(def-unix-error EMULTIHOP 74 _N"Multihop attempted") -(def-unix-error EBADMSG 77 _N"Not a data message") -(def-unix-error ENAMETOOLONG 78 _N"File name too long") -(def-unix-error EOVERFLOW 79 _N"Value too large for defined data type") -(def-unix-error ENOTUNIQ 80 _N"Name not unique on network") -(def-unix-error EBADFD 81 _N"File descriptor in bad state") -(def-unix-error EREMCHG 82 _N"Remote address changed") -(def-unix-error ELIBACC 83 _N"Can not access a needed shared library") -(def-unix-error ELIBBAD 84 _N"Accessing a corrupted shared library") -(def-unix-error ELIBSCN 85 _N".lib section in a.out corrupted") -(def-unix-error ELIBMAX 86 _N"Attempting to link in more shared libraries than system limit") -(def-unix-error ELIBEXEC 87 _N"Can not exec a shared library directly") -(def-unix-error EILSEQ 88 _N"Error 88") -(def-unix-error ENOSYS 89 _N"Operation not applicable") -(def-unix-error ELOOP 90 _N"Number of symbolic links encountered during path name traversal exceeds MAXSYMLINKS") -(def-unix-error ERESTART 91 _N"Error 91") -(def-unix-error ESTRPIPE 92 _N"Error 92") -(def-unix-error ENOTEMPTY 93 _N"Directory not empty") -(def-unix-error EUSERS 94 _N"Too many users") -(def-unix-error ENOTSOCK 95 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 96 _N"Destination address required") -(def-unix-error EMSGSIZE 97 _N"Message too long") -(def-unix-error EPROTOTYPE 98 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 99 _N"Option not supported by protocol") -(def-unix-error EPROTONOSUPPORT 120 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 121 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 122 _N"Operation not supported on transport endpoint") -(def-unix-error EPFNOSUPPORT 123 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 124 _N"Address family not supported by protocol family") -(def-unix-error EADDRINUSE 125 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 126 _N"Cannot assign requested address") -(def-unix-error ENETDOWN 127 _N"Network is down") -(def-unix-error ENETUNREACH 128 _N"Network is unreachable") -(def-unix-error ENETRESET 129 _N"Network dropped connection because of reset") -(def-unix-error ECONNABORTED 130 _N"Software caused connection abort") -(def-unix-error ECONNRESET 131 _N"Connection reset by peer") -(def-unix-error ENOBUFS 132 _N"No buffer space available") -(def-unix-error EISCONN 133 _N"Transport endpoint is already connected") -(def-unix-error ENOTCONN 134 _N"Transport endpoint is not connected") -(def-unix-error ESHUTDOWN 143 _N"Cannot send after socket shutdown") -(def-unix-error ETOOMANYREFS 144 _N"Too many references: cannot splice") -(def-unix-error ETIMEDOUT 145 _N"Connection timed out") -(def-unix-error ECONNREFUSED 146 _N"Connection refused") -(def-unix-error EHOSTDOWN 147 _N"Host is down") -(def-unix-error EHOSTUNREACH 148 _N"No route to host") -(def-unix-error EWOULDBLOCK 11 _N"Resource temporarily unavailable") -(def-unix-error EALREADY 149 _N"Operation already in progress") -(def-unix-error EINPROGRESS 150 _N"Operation now in progress") -(def-unix-error ESTALE 151 _N"Stale NFS file handle") -) -#+linux + (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)")) + +#-(or hpux svr4 linux) (progn -(def-unix-error EDEADLK 35 _N"Resource deadlock would occur") -(def-unix-error ENAMETOOLONG 36 _N"File name too long") -(def-unix-error ENOLCK 37 _N"No record locks available") -(def-unix-error ENOSYS 38 _N"Function not implemented") -(def-unix-error ENOTEMPTY 39 _N"Directory not empty") -(def-unix-error ELOOP 40 _N"Too many symbolic links encountered") -(def-unix-error EWOULDBLOCK 11 _N"Operation would block") -(def-unix-error ENOMSG 42 _N"No message of desired type") -(def-unix-error EIDRM 43 _N"Identifier removed") -(def-unix-error ECHRNG 44 _N"Channel number out of range") -(def-unix-error EL2NSYNC 45 _N"Level 2 not synchronized") -(def-unix-error EL3HLT 46 _N"Level 3 halted") -(def-unix-error EL3RST 47 _N"Level 3 reset") -(def-unix-error ELNRNG 48 _N"Link number out of range") -(def-unix-error EUNATCH 49 _N"Protocol driver not attached") -(def-unix-error ENOCSI 50 _N"No CSI structure available") -(def-unix-error EL2HLT 51 _N"Level 2 halted") -(def-unix-error EBADE 52 _N"Invalid exchange") -(def-unix-error EBADR 53 _N"Invalid request descriptor") -(def-unix-error EXFULL 54 _N"Exchange full") -(def-unix-error ENOANO 55 _N"No anode") -(def-unix-error EBADRQC 56 _N"Invalid request code") -(def-unix-error EBADSLT 57 _N"Invalid slot") -(def-unix-error EDEADLOCK EDEADLK _N"File locking deadlock error") -(def-unix-error EBFONT 59 _N"Bad font file format") -(def-unix-error ENOSTR 60 _N"Device not a stream") -(def-unix-error ENODATA 61 _N"No data available") -(def-unix-error ETIME 62 _N"Timer expired") -(def-unix-error ENOSR 63 _N"Out of streams resources") -(def-unix-error ENONET 64 _N"Machine is not on the network") -(def-unix-error ENOPKG 65 _N"Package not installed") -(def-unix-error EREMOTE 66 _N"Object is remote") -(def-unix-error ENOLINK 67 _N"Link has been severed") -(def-unix-error EADV 68 _N"Advertise error") -(def-unix-error ESRMNT 69 _N"Srmount error") -(def-unix-error ECOMM 70 _N"Communication error on send") -(def-unix-error EPROTO 71 _N"Protocol error") -(def-unix-error EMULTIHOP 72 _N"Multihop attempted") -(def-unix-error EDOTDOT 73 _N"RFS specific error") -(def-unix-error EBADMSG 74 _N"Not a data message") -(def-unix-error EOVERFLOW 75 _N"Value too large for defined data type") -(def-unix-error ENOTUNIQ 76 _N"Name not unique on network") -(def-unix-error EBADFD 77 _N"File descriptor in bad state") -(def-unix-error EREMCHG 78 _N"Remote address changed") -(def-unix-error ELIBACC 79 _N"Can not access a needed shared library") -(def-unix-error ELIBBAD 80 _N"Accessing a corrupted shared library") -(def-unix-error ELIBSCN 81 _N".lib section in a.out corrupted") -(def-unix-error ELIBMAX 82 _N"Attempting to link in too many shared libraries") -(def-unix-error ELIBEXEC 83 _N"Cannot exec a shared library directly") -(def-unix-error EILSEQ 84 _N"Illegal byte sequence") -(def-unix-error ERESTART 85 _N"Interrupted system call should be restarted _N") -(def-unix-error ESTRPIPE 86 _N"Streams pipe error") -(def-unix-error EUSERS 87 _N"Too many users") -(def-unix-error ENOTSOCK 88 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 89 _N"Destination address required") -(def-unix-error EMSGSIZE 90 _N"Message too long") -(def-unix-error EPROTOTYPE 91 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 92 _N"Protocol not available") -(def-unix-error EPROTONOSUPPORT 93 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 94 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 95 _N"Operation not supported on transport endpoint") -(def-unix-error EPFNOSUPPORT 96 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 97 _N"Address family not supported by protocol") -(def-unix-error EADDRINUSE 98 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 99 _N"Cannot assign requested address") -(def-unix-error ENETDOWN 100 _N"Network is down") -(def-unix-error ENETUNREACH 101 _N"Network is unreachable") -(def-unix-error ENETRESET 102 _N"Network dropped connection because of reset") -(def-unix-error ECONNABORTED 103 _N"Software caused connection abort") -(def-unix-error ECONNRESET 104 _N"Connection reset by peer") -(def-unix-error ENOBUFS 105 _N"No buffer space available") -(def-unix-error EISCONN 106 _N"Transport endpoint is already connected") -(def-unix-error ENOTCONN 107 _N"Transport endpoint is not connected") -(def-unix-error ESHUTDOWN 108 _N"Cannot send after transport endpoint shutdown") -(def-unix-error ETOOMANYREFS 109 _N"Too many references: cannot splice") -(def-unix-error ETIMEDOUT 110 _N"Connection timed out") -(def-unix-error ECONNREFUSED 111 _N"Connection refused") -(def-unix-error EHOSTDOWN 112 _N"Host is down") -(def-unix-error EHOSTUNREACH 113 _N"No route to host") -(def-unix-error EALREADY 114 _N"Operation already in progress") -(def-unix-error EINPROGRESS 115 _N"Operation now in progress") -(def-unix-error ESTALE 116 _N"Stale NFS file handle") -(def-unix-error EUCLEAN 117 _N"Structure needs cleaning") -(def-unix-error ENOTNAM 118 _N"Not a XENIX named type file") -(def-unix-error ENAVAIL 119 _N"No XENIX semaphores available") -(def-unix-error EISNAM 120 _N"Is a named type file") -(def-unix-error EREMOTEIO 121 _N"Remote I/O error") -(def-unix-error EDQUOT 122 _N"Quota exceeded") -) + (defconstant o_creat #o1000 _N"Create if nonexistant flag.") + (defconstant o_trunc #o2000 _N"Truncate flag.") + (defconstant o_excl #o4000 _N"Error if already exists.")) -;;; -;;; And now for something completely different ... -(emit-unix-errors) +(defun unix-open (path flags mode) + _N"Unix-open opens the file whose pathname is specified by path + for reading and/or writing as specified by the flags argument. + The flags argument can be: -(def-alien-routine ("os_get_errno" unix-get-errno) int) -(def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int)) -(defun unix-errno () (unix-get-errno)) -(defun (setf unix-errno) (newvalue) (unix-set-errno newvalue)) + o_rdonly Read-only flag. + o_wronly Write-only flag. + o_rdwr Read-and-write flag. + o_append Append flag. + o_creat Create-if-nonexistant flag. + o_trunc Truncate-to-size-0 flag. -;;; GET-UNIX-ERROR-MSG -- public. -;;; -(defun get-unix-error-msg (&optional (error-number (unix-errno))) - _N"Returns a string describing the error number which was returned by a - UNIX system call." - (declare (type integer error-number)) - (if (array-in-bounds-p *unix-errors* error-number) - (svref *unix-errors* error-number) - (format nil _"Unknown error [~d]" error-number))) + If the o_creat flag is specified, then the file is created with + a permission of argument mode if the file doesn't exist. An + integer file descriptor is returned by unix-open." + (declare (type unix-pathname path) + (type fixnum flags) + (type unix-file-mode mode)) + (int-syscall (#+solaris "open64" #-solaris "open" c-string int int) + (%name->file path) flags mode)) - -;;;; Lisp types used by syscalls. +;;; Unix-close accepts a file descriptor and attempts to close the file +;;; associated with it. -(deftype unix-pathname () 'simple-string) -(deftype unix-fd () `(integer 0 ,most-positive-fixnum)) +(defun unix-close (fd) + _N"Unix-close takes an integer file descriptor as an argument and + closes the file associated with it. T is returned upon successful + completion, otherwise NIL and an error number." + (declare (type unix-fd fd)) + (void-syscall ("close" int) fd)) -(deftype unix-file-mode () '(unsigned-byte 32)) -(deftype unix-pid () '(unsigned-byte 32)) -(deftype unix-uid () '(unsigned-byte 32)) -(deftype unix-gid () '(unsigned-byte 32)) +;;; Unix-creat accepts a file name and a mode. It creates a new file +;;; with name and sets it mode to mode (as for chmod). +(defun unix-creat (name mode) + _N"Unix-creat accepts a file name and a mode (same as those for + unix-chmod) and creates a file by that name with the specified + permission mode. It returns a file descriptor on success, + or NIL and an error number otherwise. - -;;;; User and group database structures + This interface is made obsolete by UNIX-OPEN." + + (declare (type unix-pathname name) + (type unix-file-mode mode)) + (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int) + (%name->file name) mode)) -(defstruct user-info - (name "" :type string) - (password "" :type string) - (uid 0 :type unix-uid) - (gid 0 :type unix-gid) - #+solaris (age "" :type string) - #+solaris (comment "" :type string) - #+freebsd (change -1 :type fixnum) - (gecos "" :type string) - (dir "" :type string) - (shell "" :type string)) +;;; Unix-read accepts a file descriptor, a buffer, and the length to read. +;;; It attempts to read len bytes from the device associated with fd +;;; and store them into the buffer. It returns the actual number of +;;; bytes read. -(defstruct group-info - (name "" :type string) - (password "" :type string) - (gid 0 :type unix-gid) - (members nil :type list)) ; list of logins as strings +;;; Unix-dup returns a duplicate copy of the existing file-descriptor +;;; passed as an argument. -;; see <pwd.h> -#+solaris -(def-alien-type nil - (struct passwd - (pw-name (* char)) ; user's login name - (pw-passwd (* char)) ; no longer used - (pw-uid uid-t) ; user id - (pw-gid gid-t) ; group id - (pw-age (* char)) ; password age (not used) - (pw-comment (* char)) ; not used - (pw-gecos (* char)) ; typically user's full name - (pw-dir (* char)) ; user's home directory - (pw-shell (* char)))) ; user's login shell - -#+bsd -(def-alien-type nil - (struct passwd - (pw-name (* char)) ; user's login name - (pw-passwd (* char)) ; no longer used - (pw-uid uid-t) ; user id - (pw-gid gid-t) ; group id - (pw-change int) ; password change time - (pw-class (* char)) ; user access class - (pw-gecos (* char)) ; typically user's full name - (pw-dir (* char)) ; user's home directory - (pw-shell (* char)) ; user's login shell - (pw-expire int) ; account expiration - #+(or freebsd darwin) - (pw-fields int))) ; internal - -;; see <grp.h> -(def-alien-type nil - (struct group - (gr-name (* char)) ; name of the group - (gr-passwd (* char)) ; encrypted group password - (gr-gid gid-t) ; numerical group ID - (gr-mem (* (* char))))) ; vector of pointers to member names - - -;;;; System calls. - -(defmacro %syscall ((name (&rest arg-types) result-type) - success-form &rest args) - `(let* ((fn (extern-alien ,name (function ,result-type ,@arg-types))) - (result (alien-funcall fn ,@args))) - (if (eql -1 result) - (values nil (unix-errno)) - ,success-form))) - -(defmacro syscall ((name &rest arg-types) success-form &rest args) - `(%syscall (,name (,@arg-types) int) ,success-form ,@args)) - -;;; Like syscall, but if it fails, signal an error instead of returing error -;;; codes. Should only be used for syscalls that will never really get an -;;; error. -;;; -(defmacro syscall* ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (eql -1 result) - (error _"Syscall ~A failed: ~A" ,name (get-unix-error-msg)) - ,success-form))) - -(defmacro void-syscall ((name &rest arg-types) &rest args) - `(syscall (,name ,@arg-types) (values t 0) ,@args)) - -(defmacro int-syscall ((name &rest arg-types) &rest args) - `(syscall (,name ,@arg-types) (values result 0) ,@args)) - -(defmacro off-t-syscall ((name arg-types) &rest args) - `(%syscall (,name ,arg-types off-t) (values result 0) ,@args)) - - -;;;; Memory-mapped files - -(defconstant +null+ (sys:int-sap 0)) - -(defconstant prot_read 1) ; Readable -(defconstant prot_write 2) ; Writable -(defconstant prot_exec 4) ; Executable -(defconstant prot_none 0) ; No access - -(defconstant map_shared 1) ; Changes are shared -(defconstant map_private 2) ; Changes are private -(defconstant map_fixed 16) ; Fixed, user-defined address -(defconstant map_noreserve #x40) ; Don't reserve swap space -(defconstant map_anonymous - #+solaris #x100 ; Solaris - #+linux 32 ; Linux - #+bsd #x1000) - -(defconstant ms_async 1) -(defconstant ms_sync 4) -(defconstant ms_invalidate 2) - -;; The return value from mmap that means mmap failed. -(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits)))) - -(defun unix-mmap (addr length prot flags fd offset) - (declare (type (or null system-area-pointer) addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot) - (type (unsigned-byte 32) flags) - (type (or null unix-fd) fd) - (type file-offset offset)) - ;; Can't use syscall, because the address that is returned could be - ;; "negative". Hence we explicitly check for mmap returning - ;; MAP_FAILED. - (let ((result - (alien-funcall (extern-alien "mmap" (function system-area-pointer - system-area-pointer - size-t int int int off-t)) - (or addr +null+) length prot flags (or fd -1) offset))) - (if (sap= result map_failed) - (values nil (unix-errno)) - (values result 0)))) - -(defun unix-munmap (addr length) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length)) - (syscall ("munmap" system-area-pointer size-t) t addr length)) - -(defun unix-mprotect (addr length prot) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot)) - (syscall ("mprotect" system-area-pointer size-t int) - t addr length prot)) - -(defun unix-setuid (uid) - _N"Set the user ID of the calling process to UID. - If the calling process is the super-user, set the real - and effective user IDs, and the saved set-user-ID to UID; - if not, the effective user ID is set to UID." - (int-syscall ("setuid" uid-t) uid)) - -(defun unix-setgid (gid) - _N"Set the group ID of the calling process to GID. - If the calling process is the super-user, set the real - and effective group IDs, and the saved set-group-ID to GID; - if not, the effective group ID is set to GID." - (int-syscall ("setgid" gid-t) gid)) - - - -(defun unix-msync (addr length flags) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length) - (type (signed-byte 32) flags)) - (syscall ("msync" system-area-pointer size-t int) t addr length flags)) - -;;; Unix-access accepts a path and a mode. It returns two values the -;;; first is T if the file is accessible and NIL otherwise. The second -;;; only has meaning in the second case and is the unix errno value. - -(defconstant r_ok 4 _N"Test for read permission") -(defconstant w_ok 2 _N"Test for write permission") -(defconstant x_ok 1 _N"Test for execute permission") -(defconstant f_ok 0 _N"Test for presence of file") - -(defun unix-access (path mode) - _N"Given a file path (a string) and one of four constant modes, - unix-access returns T if the file is accessible with that - mode and NIL if not. It also returns an errno value with - NIL which determines why the file was not accessible. - - The access modes are: - r_ok Read permission. - w_ok Write permission. - x_ok Execute permission. - f_ok Presence of file." - (declare (type unix-pathname path) - (type (mod 8) mode)) - (void-syscall ("access" c-string int) (%name->file path) mode)) - -;;; Unix-chdir accepts a directory name and makes that the -;;; current working directory. - -(defun unix-chdir (path) - _N"Given a file path string, unix-chdir changes the current working - directory to the one specified." - (declare (type unix-pathname path)) - (void-syscall ("chdir" c-string) (%name->file path))) - -;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. - -(defconstant setuidexec #o4000 _N"Set user ID on execution") -(defconstant setgidexec #o2000 _N"Set group ID on execution") -(defconstant savetext #o1000 _N"Save text image after execution") -(defconstant readown #o400 _N"Read by owner") -(defconstant writeown #o200 _N"Write by owner") -(defconstant execown #o100 _N"Execute (search directory) by owner") -(defconstant readgrp #o40 _N"Read by group") -(defconstant writegrp #o20 _N"Write by group") -(defconstant execgrp #o10 _N"Execute (search directory) by group") -(defconstant readoth #o4 _N"Read by others") -(defconstant writeoth #o2 _N"Write by others") -(defconstant execoth #o1 _N"Execute (search directory) by others") - -(defun unix-chmod (path mode) - _N"Given a file path string and a constant mode, unix-chmod changes the - permission mode for that file to the one specified. The new mode - can be created by logically OR'ing the following: - - setuidexec Set user ID on execution. - setgidexec Set group ID on execution. - savetext Save text image after execution. - readown Read by owner. - writeown Write by owner. - execown Execute (search directory) by owner. - readgrp Read by group. - writegrp Write by group. - execgrp Execute (search directory) by group. - readoth Read by others. - writeoth Write by others. - execoth Execute (search directory) by others. - - Thus #o444 and (logior unix:readown unix:readgrp unix:readoth) - are equivalent for 'mode. The octal-base is familar to Unix users. - - It returns T on successfully completion; NIL and an error number - otherwise." - (declare (type unix-pathname path) - (type unix-file-mode mode)) - (void-syscall ("chmod" c-string int) (%name->file path) mode)) - -;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode -;;; ("mode") and changes the protection of the file described by "fd" to -;;; "mode". - -(defun unix-fchmod (fd mode) - _N"Given an integer file descriptor and a mode (the same as those - used for unix-chmod), unix-fchmod changes the permission mode - for that file to the one specified. T is returned if the call - was successful." - (declare (type unix-fd fd) - (type unix-file-mode mode)) - (void-syscall ("fchmod" int int) fd mode)) - -(defun unix-chown (path uid gid) - _N"Given a file path, an integer user-id, and an integer group-id, - unix-chown changes the owner of the file and the group of the - file to those specified. Either the owner or the group may be - left unchanged by specifying them as -1. Note: Permission will - fail if the caller is not the superuser." - (declare (type unix-pathname path) - (type (or unix-uid (integer -1 -1)) uid) - (type (or unix-gid (integer -1 -1)) gid)) - (void-syscall ("chown" c-string int int) (%name->file path) uid gid)) - -;;; Unix-fchown is exactly the same as unix-chown except that the file -;;; is specified by a file-descriptor ("fd") instead of a pathname. - -(defun unix-fchown (fd uid gid) - _N"Unix-fchown is like unix-chown, except that it accepts an integer - file descriptor instead of a file path name." - (declare (type unix-fd fd) - (type (or unix-uid (integer -1 -1)) uid) - (type (or unix-gid (integer -1 -1)) gid)) - (void-syscall ("fchown" int int int) fd uid gid)) - -;;; Returns the maximum size (i.e. the number of array elements -;;; of the file descriptor table. - -(defun unix-getdtablesize () - _N"Unix-getdtablesize returns the maximum size of the file descriptor - table. (i.e. the maximum number of descriptors that can exist at - one time.)" - (int-syscall ("getdtablesize"))) - -;;; Unix-close accepts a file descriptor and attempts to close the file -;;; associated with it. - -(defun unix-close (fd) - _N"Unix-close takes an integer file descriptor as an argument and - closes the file associated with it. T is returned upon successful - completion, otherwise NIL and an error number." - (declare (type unix-fd fd)) - (void-syscall ("close" int) fd)) - -;;; Unix-creat accepts a file name and a mode. It creates a new file -;;; with name and sets it mode to mode (as for chmod). - -(defun unix-creat (name mode) - _N"Unix-creat accepts a file name and a mode (same as those for - unix-chmod) and creates a file by that name with the specified - permission mode. It returns a file descriptor on success, - or NIL and an error number otherwise. - - This interface is made obsolete by UNIX-OPEN." - - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int) - (%name->file name) mode)) - -;;; Unix-dup returns a duplicate copy of the existing file-descriptor -;;; passed as an argument. - -(defun unix-dup (fd) - _N"Unix-dup duplicates an existing file descriptor (given as the - argument) and return it. If FD is not a valid file descriptor, NIL - and an error number are returned." - (declare (type unix-fd fd)) - (int-syscall ("dup" int) fd)) - -;;; Unix-dup2 makes the second file-descriptor describe the same file -;;; as the first. If the second file-descriptor points to an open -;;; file, it is first closed. In any case, the second should have a -;;; value which is a valid file-descriptor. - -(defun unix-dup2 (fd1 fd2) - _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup - does only the new value of the duplicate descriptor may be requested - through the second argument. If a file already exists with the - requested descriptor number, it will be closed and the number - assigned to the duplicate." - (declare (type unix-fd fd1 fd2)) - (void-syscall ("dup2" int int) fd1 fd2)) +(defun unix-dup (fd) + _N"Unix-dup duplicates an existing file descriptor (given as the + argument) and return it. If FD is not a valid file descriptor, NIL + and an error number are returned." + (declare (type unix-fd fd)) + (int-syscall ("dup" int) fd)) ;;; Unix-fcntl takes a file descriptor, an integer command ;;; number, and optional command arguments. It performs @@ -1404,134 +653,17 @@ (type (unsigned-byte 32) arg)) (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg)) -;;; Unix-link creates a hard link from name2 to name1. - -(defun unix-link (name1 name2) - _N"Unix-link creates a hard link from the file with name1 to the - file with name2." - (declare (type unix-pathname name1 name2)) - (void-syscall ("link" c-string c-string) - (%name->file name1) (%name->file name2))) - -;;; Unix-lseek accepts a file descriptor, an offset, and whence value. - -(defconstant l_set 0 _N"set the file pointer") -(defconstant l_incr 1 _N"increment the file pointer") -(defconstant l_xtnd 2 _N"extend the file size") - -#-solaris -(defun unix-lseek (fd offset whence) - _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead - a certain offset for that file. Whence can be any of the following: - - l_set Set the file pointer. - l_incr Increment the file pointer. - l_xtnd Extend the file size. - _N" - (declare (type unix-fd fd) - (type file-offset offset) - (type (integer 0 2) whence)) - (off-t-syscall ("lseek" (int off-t int)) fd offset whence)) - -#+solaris -(defun unix-lseek (fd offset whence) - _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead - a certain offset for that file. Whence can be any of the following: - - l_set Set the file pointer. - l_incr Increment the file pointer. - l_xtnd Extend the file size. - _N" - (declare (type unix-fd fd) - (type file-offset64 offset) - (type (integer 0 2) whence)) - (let ((result (alien-funcall - (extern-alien "lseek64" (function off64-t int off64-t int)) - fd offset whence))) - (if (minusp result) - (progn - (values nil (unix-errno))) - (values result 0)))) - -;;; Unix-mkdir accepts a name and a mode and attempts to create the -;;; corresponding directory with mode mode. - -(defun unix-mkdir (name mode) - _N"Unix-mkdir creates a new directory with the specified name and mode. - (Same as those for unix-chmod.) It returns T upon success, otherwise - NIL and an error number." - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (void-syscall ("mkdir" c-string int) (%name->file name) mode)) - -;;; Unix-open accepts a pathname (a simple string), flags, and mode and -;;; attempts to open file with name pathname. - -(defconstant o_rdonly 0 _N"Read-only flag.") -(defconstant o_wronly 1 _N"Write-only flag.") -(defconstant o_rdwr 2 _N"Read-write flag.") -#+(or hpux linux svr4) -(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O") -(defconstant o_append #-linux #o10 #+linux #o2000 _N"Append flag.") -#+(or hpux svr4 linux) -(progn - (defconstant o_creat #-linux #o400 #+linux #o100 _N"Create if nonexistant flag.") - (defconstant o_trunc #o1000 _N"Truncate flag.") - (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.") - (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800 - _N"Don't assign controlling tty")) -#+(or hpux svr4 BSD) -(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04 - _N"Non-blocking mode") -#+BSD -(defconstant o_ndelay o_nonblock) ; compatibility -#+linux -(progn - (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)")) - -#-(or hpux svr4 linux) -(progn - (defconstant o_creat #o1000 _N"Create if nonexistant flag.") - (defconstant o_trunc #o2000 _N"Truncate flag.") - (defconstant o_excl #o4000 _N"Error if already exists.")) - -(defun unix-open (path flags mode) - _N"Unix-open opens the file whose pathname is specified by path - for reading and/or writing as specified by the flags argument. - The flags argument can be: - - o_rdonly Read-only flag. - o_wronly Write-only flag. - o_rdwr Read-and-write flag. - o_append Append flag. - o_creat Create-if-nonexistant flag. - o_trunc Truncate-to-size-0 flag. - - If the o_creat flag is specified, then the file is created with - a permission of argument mode if the file doesn't exist. An - integer file descriptor is returned by unix-open." - (declare (type unix-pathname path) - (type fixnum flags) - (type unix-file-mode mode)) - (int-syscall (#+solaris "open64" #-solaris "open" c-string int int) - (%name->file path) flags mode)) - -(defun unix-pipe () - _N"Unix-pipe sets up a unix-piping mechanism consisting of - an input pipe and an output pipe. Unix-Pipe returns two - values: if no error occurred the first value is the pipe - to be read from and the second is can be written to. If - an error occurred the first value is NIL and the second - the unix error code." - (with-alien ((fds (array int 2))) - (syscall ("pipe" (* int)) - (values (deref fds 0) (deref fds 1)) - (cast fds (* int))))) - -;;; Unix-read accepts a file descriptor, a buffer, and the length to read. -;;; It attempts to read len bytes from the device associated with fd -;;; and store them into the buffer. It returns the actual number of -;;; bytes read. +(defun unix-pipe () + _N"Unix-pipe sets up a unix-piping mechanism consisting of + an input pipe and an output pipe. Unix-Pipe returns two + values: if no error occurred the first value is the pipe + to be read from and the second is can be written to. If + an error occurred the first value is NIL and the second + the unix error code." + (with-alien ((fds (array int 2))) + (syscall ("pipe" (* int)) + (values (deref fds 0) (deref fds 1)) + (cast fds (* int))))) (defun unix-read (fd buf len) _N"Unix-read attempts to read from the file described by fd into @@ -1613,143 +745,6 @@ (declare (type unix-pathname name)) (void-syscall ("rmdir" c-string) (%name->file name))) - -;;; UNIX-FAST-SELECT -- public. -;;; -(defmacro unix-fast-select (num-descriptors - read-fds write-fds exception-fds - timeout-secs &optional (timeout-usecs 0)) - _N"Perform the UNIX select(2) system call. - (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) - (type (or (alien (* (struct fd-set))) null) - read-fds write-fds exception-fds) - (type (or null (unsigned-byte 31)) timeout-secs) - (type (unsigned-byte 31) timeout-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" - `(let ((timeout-secs ,timeout-secs)) - (with-alien ((tv (struct timeval))) - (when timeout-secs - (setf (slot tv 'tv-sec) timeout-secs) - (setf (slot tv 'tv-usec) ,timeout-usecs)) - (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - ,num-descriptors ,read-fds ,write-fds ,exception-fds - (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) - - -;;; Unix-select accepts sets of file descriptors and waits for an event -;;; to happen on one of them or to time out. - -(defmacro num-to-fd-set (fdset num) - `(if (fixnump ,num) - (progn - (setf (deref (slot ,fdset 'fds-bits) 0) ,num) - ,@(loop for index upfrom 1 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) - (progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) - (ldb (byte 32 ,(* index 32)) ,num)))))) - -(defmacro fd-set-to-num (nfds fdset) - `(if (<= ,nfds 32) - (deref (slot ,fdset 'fds-bits) 0) - (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(ash (deref (slot ,fdset 'fds-bits) ,index) - ,(* index 32)))))) - -(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) - _N"Unix-select examines the sets of descriptors passed as arguments - to see if they are ready for reading and writing. See the UNIX - Programmers Manual for more information." - (declare (type (integer 0 #.FD-SETSIZE) nfds) - (type unsigned-byte rdfds wrfds xpfds) - (type (or (unsigned-byte 31) null) to-secs) - (type (unsigned-byte 31) to-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (with-alien ((tv (struct timeval)) - (rdf (struct fd-set)) - (wrf (struct fd-set)) - (xpf (struct fd-set))) - (when to-secs - (setf (slot tv 'tv-sec) to-secs) - (setf (slot tv 'tv-usec) to-usecs)) - (num-to-fd-set rdf rdfds) - (num-to-fd-set wrf wrfds) - (num-to-fd-set xpf xpfds) - (macrolet ((frob (lispvar alienvar) - `(if (zerop ,lispvar) - (int-sap 0) - (alien-sap (addr ,alienvar))))) - (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - (values result - (fd-set-to-num nfds rdf) - (fd-set-to-num nfds wrf) - (fd-set-to-num nfds xpf)) - nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) - (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) - - -;;; Unix-sync writes all information in core memory which has been modified -;;; to permanent storage (i.e. disk). - -(defun unix-sync () - _N"Unix-sync writes all information in core memory which has been - modified to disk. It returns NIL and an error code if an error - occured." - (void-syscall ("sync"))) - -;;; Unix-fsync writes the core-image of the file described by "fd" to -;;; permanent storage (i.e. disk). - -(defun unix-fsync (fd) - _N"Unix-fsync writes the core image of the file described by - fd to disk." - (declare (type unix-fd fd)) - (void-syscall ("fsync" int) fd)) - -;;; Unix-truncate accepts a file name and a new length. The file is -;;; truncated to the new length. - -(defun unix-truncate (name len) - _N"Unix-truncate truncates the named file to the length (in - bytes) specified by len. NIL and an error number is returned - if the call is unsuccessful." - (declare (type unix-pathname name) - (type (unsigned-byte #+solaris 64 #-solaris 32) len)) - #-(and bsd x86) - (void-syscall (#+solaris "truncate64" #-solaris "truncate" c-string int) name len) - #+(and bsd x86) - (void-syscall ("truncate" c-string unsigned-long unsigned-long) name len 0)) - -(defun unix-ftruncate (fd len) - _N"Unix-ftruncate is similar to unix-truncate except that the first - argument is a file descriptor rather than a file name." - (declare (type unix-fd fd) - (type (unsigned-byte #+solaris 64 #-solaris 32) len)) - #-(and bsd x86) - (void-syscall (#+solaris "ftruncate64" #-solaris "ftruncate" int int) fd len) - #+(and bsd x86) - (void-syscall ("ftruncate" int unsigned-long unsigned-long) fd len 0)) - -(defun unix-symlink (name1 name2) - _N"Unix-symlink creates a symbolic link named name2 to the file - named name1. NIL and an error number is returned if the call - is unsuccessful." - (declare (type unix-pathname name1 name2)) - (void-syscall ("symlink" c-string c-string) - (%name->file name1) (%name->file name2))) - -;;; Unix-unlink accepts a name and deletes the directory entry for that -;;; name and the file if this is the last link. - -(defun unix-unlink (name) - _N"Unix-unlink removes the directory entry for the named file. - NIL and an error code is returned if the call fails." - (declare (type unix-pathname name)) - (void-syscall ("unlink" c-string) (%name->file name))) - ;;; Unix-write accepts a file descriptor, a buffer, an offset, and the ;;; length to write. It attempts to write len bytes to the device ;;; associated with fd from the buffer starting at offset. It returns @@ -1981,165 +976,52 @@ (type (unsigned-byte 32) cmd)) (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) -#+(or svr4 hpux bsd linux) -(progn - (defun unix-tcgetattr (fd termios) - _N"Get terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) - - (defun unix-tcsetattr (fd opt termios) - _N"Set terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios)) - - ;; XXX rest of functions in this progn probably are present in linux, but - ;; not verified. - #-bsd - (defun unix-cfgetospeed (termios) - _N"Get terminal output speed." - (multiple-value-bind (speed errno) - (int-syscall ("cfgetospeed" (* (struct termios))) termios) - (if speed - (values (svref terminal-speeds speed) 0) - (values speed errno)))) - - #+bsd - (defun unix-cfgetospeed (termios) - _N"Get terminal output speed." - (int-syscall ("cfgetospeed" (* (struct termios))) termios)) - - #-bsd - (defun unix-cfsetospeed (termios speed) - _N"Set terminal output speed." - (let ((baud (or (position speed terminal-speeds) - (error _"Bogus baud rate ~S" speed)))) - (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud))) - - #+bsd - (defun unix-cfsetospeed (termios speed) - _N"Set terminal output speed." - (void-syscall ("cfsetospeed" (* (struct termios)) int) termios speed)) - - #-bsd - (defun unix-cfgetispeed (termios) - _N"Get terminal input speed." - (multiple-value-bind (speed errno) - (int-syscall ("cfgetispeed" (* (struct termios))) termios) - (if speed - (values (svref terminal-speeds speed) 0) - (values speed errno)))) - - #+bsd - (defun unix-cfgetispeed (termios) - _N"Get terminal input speed." - (int-syscall ("cfgetispeed" (* (struct termios))) termios)) - - #-bsd - (defun unix-cfsetispeed (termios speed) - _N"Set terminal input speed." - (let ((baud (or (position speed terminal-speeds) - (error _"Bogus baud rate ~S" speed)))) - (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud))) - - #+bsd - (defun unix-cfsetispeed (termios speed) - _N"Set terminal input speed." - (void-syscall ("cfsetispeed" (* (struct termios)) int) termios speed)) - - (defun unix-tcsendbreak (fd duration) - _N"Send break" - (declare (type unix-fd fd)) - (void-syscall ("tcsendbreak" int int) fd duration)) - - (defun unix-tcdrain (fd) - _N"Wait for output for finish" - (declare (type unix-fd fd)) - (void-syscall ("tcdrain" int) fd)) - - (defun unix-tcflush (fd selector) - _N"See tcflush(3)" - (declare (type unix-fd fd)) - (void-syscall ("tcflush" int int) fd selector)) - - (defun unix-tcflow (fd action) - _N"Flow control" - (declare (type unix-fd fd)) - (void-syscall ("tcflow" int int) fd action))) - -(defun tcsetpgrp (fd pgrp) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP." - (alien:with-alien ((alien-pgrp c-call:int pgrp)) - (unix-ioctl fd - tiocspgrp - (alien:alien-sap (alien:addr alien-pgrp))))) - -(defun tcgetpgrp (fd) - _N"Get the tty-process-group for the unix file-descriptor FD." - (alien:with-alien ((alien-pgrp c-call:int)) - (multiple-value-bind (ok err) - (unix-ioctl fd - tiocgpgrp - (alien:alien-sap (alien:addr alien-pgrp))) - (if ok - (values alien-pgrp nil) - (values nil err))))) - -(defun tty-process-group (&optional fd) - _N"Get the tty-process-group for the unix file-descriptor FD. If not supplied, - FD defaults to /dev/tty." - (if fd - (tcgetpgrp fd) - (multiple-value-bind (tty-fd errno) - (unix-open "/dev/tty" o_rdwr 0) - (cond (tty-fd - (multiple-value-prog1 - (tcgetpgrp tty-fd) - (unix-close tty-fd))) - (t - (values nil errno)))))) - -(defun %set-tty-process-group (pgrp &optional fd) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not - supplied, FD defaults to /dev/tty." - (let ((old-sigs - (unix-sigblock - (sigmask :sigttou :sigttin :sigtstp :sigchld)))) - (declare (type (unsigned-byte 32) old-sigs)) - (unwind-protect - (if fd - (tcsetpgrp fd pgrp) - (multiple-value-bind (tty-fd errno) - (unix-open "/dev/tty" o_rdwr 0) - (cond (tty-fd - (multiple-value-prog1 - (tcsetpgrp tty-fd pgrp) - (unix-close tty-fd))) - (t - (values nil errno))))) - (unix-sigsetmask old-sigs)))) - -(defsetf tty-process-group (&optional fd) (pgrp) - _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not - supplied, FD defaults to /dev/tty." - `(%set-tty-process-group ,pgrp ,fd)) +(defun unix-tcgetattr (fd termios) + _N"Get terminal attributes." + (declare (type unix-fd fd)) + (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) +(defun unix-tcsetattr (fd opt termios) + _N"Set terminal attributes." + (declare (type unix-fd fd)) + (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios)) -;;; Socket options. +;; XXX rest of functions in this progn probably are present in linux, but +;; not verified. +#-bsd +(defun unix-cfgetospeed (termios) + _N"Get terminal output speed." + (multiple-value-bind (speed errno) + (int-syscall ("cfgetospeed" (* (struct termios))) termios) + (if speed + (values (svref terminal-speeds speed) 0) + (values speed errno)))) -#+(or hpux bsd) -(define-ioctl-command SIOCSPGRP #\s 8 int :in) +#+bsd +(defun unix-cfgetospeed (termios) + _N"Get terminal output speed." + (int-syscall ("cfgetospeed" (* (struct termios))) termios)) -#+linux -(define-ioctl-command SIOCSPGRP #\s #x8904 int :in) +(def-alien-routine ("getuid" unix-getuid) int + _N"Unix-getuid returns the real user-id associated with the + current process.") -#+(or hpux bsd linux) -(defun siocspgrp (fd pgrp) - _N"Set the socket process-group for the unix file-descriptor FD to PGRP." - (alien:with-alien ((alien-pgrp c-call:int pgrp)) - (unix-ioctl fd - siocspgrp - (alien:alien-sap (alien:addr alien-pgrp))))) +;;; Unix-getpagesize returns the number of bytes in the system page. + +(defun unix-getpagesize () + _N"Unix-getpagesize returns the number of bytes in a system page." + (int-syscall ("getpagesize"))) + +(defun unix-gethostname () + _N"Unix-gethostname returns the name of the host machine as a string." + (with-alien ((buf (array char 256))) + (syscall* ("gethostname" (* char) int) + (cast buf c-string) + (cast buf (* char)) 256))) + +(def-alien-routine ("gethostid" unix-gethostid) unsigned-long + _N"Unix-gethostid returns a 32-bit integer which provides unique + identification for the host machine.") ;;; Unix-exit terminates a program. @@ -2150,14 +1032,227 @@ (declare (type (signed-byte 32) code)) (void-syscall ("exit" int) code)) -;;; STAT and friends. +;;; From sys/termios.h -(defmacro extract-stat-results (buf) - `(values T - (slot ,buf 'st-dev) - (slot ,buf 'st-ino) - (slot ,buf 'st-mode) - (slot ,buf 'st-nlink) +;;; NOTE: There is both a termio (SYSV) and termios (POSIX) +;;; structure with similar but incompatible definitions. It may be that +;;; the non-BSD variant of termios below is really a termio but I (pw) +;;; can't verify. The BSD variant uses the Posix termios def. Some systems +;;; (Ultrix and OSF1) seem to support both if used independently. +;;; The 17f version of this seems a bit confused wrt the conditionals. +;;; Please check these defs for your system. + +;;; TSM: from what I can tell looking at the 17f definition, my guess is that it +;;; was originally a termio for sunos (nonsolaris) (because it had the c-line +;;; member for sunos only), and then was mutated into the termios definition for +;;; later systems. The definition here is definitely not an IRIX termio because +;;; it doesn't have c-line. In any case, the functions tcgetattr, etc., +;;; definitely take a termios, and termios seems to be the more standard +;;; standard now, so my suggestion is to just go with termios and forget about +;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've +;;; changed it (which means you need to bootstrap it to avoid a reader error). + +;;; On top of all that, SGI decided to change the termios structure on irix +;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library, +;;; but introduced static functions in termios.h to redirect new calls to the +;;; new library--which means it's important not to #include termios.h before +;;; undefineds.h when building lisp. + +(defconstant +NCCS+ + #+hpux 16 + #+irix 23 + #+(or linux solaris) 19 + #+(or bsd osf1) 20 + #+(and sunos (not svr4)) 17 + _N"Size of control character vector.") + +(def-alien-type nil + (struct termios + (c-iflag unsigned-int) + (c-oflag unsigned-int) + (c-cflag unsigned-int) + (c-lflag unsigned-int) + #+(or linux hpux (and sunos (not svr4))) + (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int + #+(or linux (and sunos (not svr4))) unsigned-char) + (c-cc (array unsigned-char #.+NCCS+)) + #+(or bsd osf1) (c-ispeed unsigned-int) + #+(or bsd osf1) (c-ospeed unsigned-int))) + +;;; From sys/dir.h +;;; +;;; (For Solaris, this is not struct direct, but struct dirent!) +#-bsd +(def-alien-type nil + (struct direct + #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry + (d-ino ino-t); inode number of entry + #+(or linux svr4) (d-off long) + (d-reclen unsigned-short) ; length of this record + #-(or linux svr4) + (d-namlen unsigned-short) ; length of string in d-name + (d-name (array char 256)))) ; name must be no longer than this + +#+(and bsd (not netbsd)) +(def-alien-type nil + (struct direct + (d-fileno unsigned-long) + (d-reclen unsigned-short) + (d-type unsigned-char) + (d-namlen unsigned-char) ; length of string in d-name + (d-name (array char 256)))) ; name must be no longer than this + +#+netbsd +(def-alien-type nil + (struct direct + (d-fileno ino-t) + (d-reclen unsigned-short) + (d-namlen unsigned-short) + (d-type unsigned-char) + (d-name (array char 512)))) + +#+(or linux svr4) +; High-res time. Actually posix definition under svr4 name. +(def-alien-type nil + (struct timestruc-t + (tv-sec time-t) + (tv-nsec long))) + + +;;; Large file support for Solaris. Define some of the 64-bit types +;;; we need. Unlike unix-glibc's large file support, Solaris's +;;; version is a little simpler because all of the 64-bit versions of +;;; the functions actually exist as functions. So instead of calling +;;; the 32-bit versions of the functions, we call the 64-bit versions. +;;; +;;; These functions are: creat64, open64, truncate64, ftruncate64, +;;; stat64, lstat64, fstat64, readdir64. +;;; +;;; There are also some new structures for large file support: +;;; dirent64, stat64. +;;; +;;; FIXME: We should abstract this better, but I (rtoy) don't have any +;;; other system to test this out on, so it's a Solaris hack for now. +#+solaris +(progn + (deftype file-offset64 () '(signed-byte 64)) + (def-alien-type off64-t int64-t) + (def-alien-type ino64-t u-int64-t) + (def-alien-type blkcnt64-t u-int64-t)) + +;;; The 64-bit version of struct dirent. +#+solaris +(def-alien-type nil + (struct dirent64 + (d-ino ino64-t); inode number of entry + (d-off off64-t) ; offset of next disk directory entry + (d-reclen unsigned-short) ; length of this record + (d-name (array char 256)))) ; name must be no longer than this + + +#+(and bsd (not netbsd)) +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-ino ino-t) + (st-mode mode-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-atime (struct timespec-t)) + (st-mtime (struct timespec-t)) + (st-ctime (struct timespec-t)) + (st-size off-t) + (st-blocks off-t) + (st-blksize unsigned-long) + (st-flags unsigned-long) + (st-gen unsigned-long) + (st-lspare long) + (st-qspare (array long 4)))) + +#+(or linux svr4) +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-pad1 #-linux (array long 3) #+linux unsigned-short) + (st-ino ino-t) + (st-mode #-linux unsigned-long #+linux unsigned-short) + (st-nlink #-linux short #+linux unsigned-short) + (st-uid #-linux uid-t #+linux unsigned-short) + (st-gid #-linux gid-t #+linux unsigned-short) + (st-rdev dev-t) + (st-pad2 #-linux (array long 2) #+linux unsigned-short) + (st-size off-t) + #-linux (st-pad3 long) + #+linux (st-blksize unsigned-long) + #+linux (st-blocks unsigned-long) + #-linux (st-atime (struct timestruc-t)) + #+linux (st-atime unsigned-long) + #+linux (unused-1 unsigned-long) + #-linux (st-mtime (struct timestruc-t)) + #+linux (st-mtime unsigned-long) + #+linux (unused-2 unsigned-long) + #-linux (st-ctime (struct timestruc-t)) + #+linux (st-ctime unsigned-long) + #+linux (unused-3 unsigned-long) + #+linux (unused-4 unsigned-long) + #+linux (unused-5 unsigned-long) + #-linux(st-blksize long) + #-linux (st-blocks long) + #-linux (st-fstype (array char 16)) + #-linux (st-pad4 (array long 8)))) + +;;; 64-bit stat for Solaris +#+solaris +(def-alien-type nil + (struct stat64 + (st-dev dev-t) + (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned + (st-ino ino64-t) + (st-mode unsigned-long) + (st-nlink short) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned + (st-size off64-t) + (st-atime (struct timestruc-t)) + (st-mtime (struct timestruc-t)) + (st-ctime (struct timestruc-t)) + (st-blksize long) + (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned + (st-blocks blkcnt64-t) + (st-fstype (array char 16)) + (st-pad4 (array long 8)))) + +#+netbsd +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-mode mode-t) + (st-ino ino-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-atime (struct timespec-t)) + (st-mtime (struct timespec-t)) + (st-ctime (struct timespec-t)) + (st-birthtime (struct timespec-t)) + (st-size off-t) + (st-blocks off-t) + (st-blksize long) + (st-flags unsigned-long) + (st-gen unsigned-long) + (st-spare (array unsigned-long 2)))) + +(defmacro extract-stat-results (buf) + `(values T + (slot ,buf 'st-dev) + (slot ,buf 'st-ino) + (slot ,buf 'st-mode) + (slot ,buf 'st-nlink) (slot ,buf 'st-uid) (slot ,buf 'st-gid) (slot ,buf 'st-rdev) @@ -2246,6 +1341,24 @@ fd (addr buf)))) ) +(def-alien-type nil + (struct rusage + (ru-utime (struct timeval)) ; user time used + (ru-stime (struct timeval)) ; system time used. + (ru-maxrss long) + (ru-ixrss long) ; integral sharded memory size + (ru-idrss long) ; integral unsharded data " + (ru-isrss long) ; integral unsharded stack " + (ru-minflt long) ; page reclaims + (ru-majflt long) ; page faults + (ru-nswap long) ; swaps + (ru-inblock long) ; block input operations + (ru-oublock long) ; block output operations + (ru-msgsnd long) ; messages sent + (ru-msgrcv long) ; messages received + (ru-nsignals long) ; signals received + (ru-nvcsw long) ; voluntary context switches + (ru-nivcsw long))) ; involuntary " (defconstant rusage_self 0 _N"The calling process.") (defconstant rusage_children -1 _N"Terminated child processes.") @@ -2295,706 +1408,695 @@ (slot usage 'ru-nivcsw)) who (addr usage)))) -;;; Getrusage is not provided in the C library on Solaris 2.4, and is -;;; rather slow on later versions so the "times" system call is -;;; provided. -#+(and sparc svr4) -(progn -(def-alien-type nil - (struct tms - (tms-utime #-alpha long #+alpha int) ; user time used - (tms-stime #-alpha long #+alpha int) ; system time used. - (tms-cutime #-alpha long #+alpha int) ; user time, children - (tms-cstime #-alpha long #+alpha int))) ; system time, children +;;;; Support routines for dealing with unix pathnames. -(declaim (inline unix-times)) -(defun unix-times () - _N"Unix-times returns information about the cpu time usage of the process - and its children." - (with-alien ((usage (struct tms))) - (alien-funcall (extern-alien "times" (function int (* (struct tms)))) - (addr usage)) - (values t - (slot usage 'tms-utime) - (slot usage 'tms-stime) - (slot usage 'tms-cutime) - (slot usage 'tms-cstime)))) -) ; end progn +(defconstant s-ifmt #o0170000) +(defconstant s-ifdir #o0040000) +(defconstant s-ifchr #o0020000) +#+linux (defconstant s-ififo #x0010000) +(defconstant s-ifblk #o0060000) +(defconstant s-ifreg #o0100000) +(defconstant s-iflnk #o0120000) +(defconstant s-ifsock #o0140000) +(defconstant s-isuid #o0004000) +(defconstant s-isgid #o0002000) +(defconstant s-isvtx #o0001000) +(defconstant s-iread #o0000400) +(defconstant s-iwrite #o0000200) +(defconstant s-iexec #o0000100) -;; Requires call to tzset() in main. -;; Don't use this now: we -#+(or linux svr4) +(defun unix-file-kind (name &optional check-for-links) + _N"Returns either :file, :directory, :link, :special, or NIL." + (declare (simple-string name)) + (multiple-value-bind (res dev ino mode) + (if check-for-links + (unix-lstat name) + (unix-stat name)) + (declare (type (or fixnum null) mode) + (ignore dev ino)) + (when res + (let ((kind (logand mode s-ifmt))) + (cond ((eql kind s-ifdir) :directory) + ((eql kind s-ifreg) :file) + ((eql kind s-iflnk) :link) + (t :special)))))) + +(defun unix-maybe-prepend-current-directory (name) + (declare (simple-string name)) + (if (and (> (length name) 0) (char= (schar name 0) #\/)) + name + (multiple-value-bind (win dir) (unix-current-directory) + (if win + (concatenate 'simple-string dir "/" name) + name)))) + +(defun unix-resolve-links (pathname) + _N"Returns the pathname with all symbolic links resolved." + (declare (simple-string pathname)) + (let ((len (length pathname)) + (pending pathname)) + (declare (fixnum len) (simple-string pending)) + (if (zerop len) + pathname + (let ((result (make-string 100 :initial-element (code-char 0))) + (fill-ptr 0) + (name-start 0)) + (loop + (let* ((name-end (or (position #\/ pending :start name-start) len)) + (new-fill-ptr (+ fill-ptr (- name-end name-start)))) + ;; grow the result string, if necessary. the ">=" (instead of + ;; using ">") allows for the trailing "/" if we find this + ;; component is a directory. + (when (>= new-fill-ptr (length result)) + (let ((longer (make-string (* 3 (length result)) + :initial-element (code-char 0)))) + (replace longer result :end1 fill-ptr) + (setq result longer))) + (replace result pending + :start1 fill-ptr + :end1 new-fill-ptr + :start2 name-start + :end2 name-end) + (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t))) + (unless kind (return nil)) + (cond ((eq kind :link) + (multiple-value-bind (link err) (unix-readlink result) + (unless link + (error (intl:gettext "Error reading link ~S: ~S") + (subseq result 0 fill-ptr) + (get-unix-error-msg err))) + (cond ((or (zerop (length link)) + (char/= (schar link 0) #\/)) + ;; It's a relative link + (fill result (code-char 0) + :start fill-ptr + :end new-fill-ptr)) + ((string= result "/../" :end1 4) + ;; It's across the super-root. + (let ((slash (or (position #\/ result :start 4) + 0))) + (fill result (code-char 0) + :start slash + :end new-fill-ptr) + (setf fill-ptr slash))) + (t + ;; It's absolute. + (and (> (length link) 0) + (char= (schar link 0) #\/)) + (fill result (code-char 0) :end new-fill-ptr) + (setf fill-ptr 0))) + (setf pending + (if (= name-end len) + link + (concatenate 'simple-string + link + (subseq pending name-end)))) + (setf len (length pending)) + (setf name-start 0))) + ((= name-end len) + (when (eq kind :directory) + (setf (schar result new-fill-ptr) #\/) + (incf new-fill-ptr)) + (return (subseq result 0 new-fill-ptr))) + ((eq kind :directory) + (setf (schar result new-fill-ptr) #\/) + (setf fill-ptr (1+ new-fill-ptr)) + (setf name-start (1+ name-end))) + (t + (return nil)))))))))) + +(defun unix-simplify-pathname (src) + (declare (simple-string src)) + (let* ((src-len (length src)) + (dst (make-string src-len)) + (dst-len 0) + (dots 0) + (last-slash nil)) + (macrolet ((deposit (char) + `(progn + (setf (schar dst dst-len) ,char) + (incf dst-len)))) + (dotimes (src-index src-len) + (let ((char (schar src src-index))) + (cond ((char= char #\.) + (when dots + (incf dots)) + (deposit char)) + ((char= char #\/) + (case dots + (0 + ;; Either ``/...' or ``...//...' + (unless last-slash + (setf last-slash dst-len) + (deposit char))) + (1 + ;; Either ``./...'' or ``..././...'' + (decf dst-len)) + (2 + ;; We've found .. + (cond + ((and last-slash (not (zerop last-slash))) + ;; There is something before this .. + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (cond ((and (= (+ (or prev-prev-slash 0) 2) + last-slash) + (char= (schar dst (- last-slash 2)) #\.) + (char= (schar dst (1- last-slash)) #\.)) + ;; The something before this .. is another .. + (deposit char) + (setf last-slash dst-len)) + (t + ;; The something is some random dir. + (setf dst-len + (if prev-prev-slash + (1+ prev-prev-slash) + 0)) + (setf last-slash prev-prev-slash))))) + (t + ;; There is nothing before this .., so we need to keep it + (setf last-slash dst-len) + (deposit char)))) + (t + ;; Something other than a dot between slashes. + (setf last-slash dst-len) + (deposit char))) + (setf dots 0)) + (t + (setf dots nil) + (setf (schar dst dst-len) char) + (incf dst-len)))))) + (when (and last-slash (not (zerop last-slash))) + (case dots + (1 + ;; We've got ``foobar/.'' + (decf dst-len)) + (2 + ;; We've got ``foobar/..'' + (unless (and (>= last-slash 2) + (char= (schar dst (1- last-slash)) #\.) + (char= (schar dst (- last-slash 2)) #\.) + (or (= last-slash 2) + (char= (schar dst (- last-slash 3)) #\/))) + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (if prev-prev-slash + (setf dst-len (1+ prev-prev-slash)) + (return-from unix-simplify-pathname "./"))))))) + (cond ((zerop dst-len) + "./") + ((= dst-len src-len) + dst) + (t + (subseq dst 0 dst-len))))) + +;;;; Errno stuff. + +(eval-when (compile eval) + +(defparameter *compiler-unix-errors* nil) + +(defmacro def-unix-error (name number description) + `(progn + (eval-when (compile eval) + (push (cons ,number ,description) *compiler-unix-errors*)) + (defconstant ,name ,number ,description) + (export ',name))) + +(defmacro emit-unix-errors () + (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*))) + (array (make-array (1+ max) :initial-element nil))) + (dolist (error *compiler-unix-errors*) + (setf (svref array (car error)) (cdr error))) + `(progn + (defvar *unix-errors* ',array) + (declaim (simple-vector *unix-errors*))))) + +) ;eval-when + +;;; +;;; From <errno.h> +;;; +(def-unix-error ESUCCESS 0 _N"Successful") +(def-unix-error EPERM 1 _N"Operation not permitted") +(def-unix-error ENOENT 2 _N"No such file or directory") +(def-unix-error ESRCH 3 _N"No such process") +(def-unix-error EINTR 4 _N"Interrupted system call") +(def-unix-error EIO 5 _N"I/O error") +(def-unix-error ENXIO 6 _N"Device not configured") +(def-unix-error E2BIG 7 _N"Arg list too long") +(def-unix-error ENOEXEC 8 _N"Exec format error") +(def-unix-error EBADF 9 _N"Bad file descriptor") +(def-unix-error ECHILD 10 _N"No child process") +#+bsd(def-unix-error EDEADLK 11 _N"Resource deadlock avoided") +#-bsd(def-unix-error EAGAIN 11 #-linux _N"No more processes" #+linux _N"Try again") +(def-unix-error ENOMEM 12 _N"Out of memory") +(def-unix-error EACCES 13 _N"Permission denied") +(def-unix-error EFAULT 14 _N"Bad address") +(def-unix-error ENOTBLK 15 _N"Block device required") +(def-unix-error EBUSY 16 _N"Device or resource busy") +(def-unix-error EEXIST 17 _N"File exists") +(def-unix-error EXDEV 18 _N"Cross-device link") +(def-unix-error ENODEV 19 _N"No such device") +(def-unix-error ENOTDIR 20 _N"Not a director") +(def-unix-error EISDIR 21 _N"Is a directory") +(def-unix-error EINVAL 22 _N"Invalid argument") +(def-unix-error ENFILE 23 _N"File table overflow") +(def-unix-error EMFILE 24 _N"Too many open files") +(def-unix-error ENOTTY 25 _N"Inappropriate ioctl for device") +(def-unix-error ETXTBSY 26 _N"Text file busy") +(def-unix-error EFBIG 27 _N"File too large") +(def-unix-error ENOSPC 28 _N"No space left on device") +(def-unix-error ESPIPE 29 _N"Illegal seek") +(def-unix-error EROFS 30 _N"Read-only file system") +(def-unix-error EMLINK 31 _N"Too many links") +(def-unix-error EPIPE 32 _N"Broken pipe") +;;; +;;; Math +(def-unix-error EDOM 33 _N"Numerical argument out of domain") +(def-unix-error ERANGE 34 #-linux _N"Result too large" #+linux _N"Math result not representable") +;;; +#-(or linux svr4) (progn - (def-alien-variable ("daylight" unix-daylight) int) - (def-alien-variable ("timezone" unix-timezone) time-t) - (def-alien-variable ("altzone" unix-altzone) time-t) - #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2)) - #+irix (defvar unix-tzname-addr nil) - #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil)) - ext:*after-save-initializations*) - #+irix (declaim (notinline fakeout-compiler)) - #+irix (defun fakeout-compiler (name dst) - (unless unix-tzname-addr - (setf unix-tzname-addr (system:foreign-symbol-address - name - :flavor :data))) - (deref (sap-alien unix-tzname-addr (array c-string 2)) dst)) - (def-alien-routine get-timezone c-call:void - (when c-call:long :in) - (minutes-west c-call:int :out) - (daylight-savings-p alien:boolean :out)) - (defun unix-get-minutes-west (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore dst)) - (values minutes)) - ) - (defun unix-get-timezone (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore minutes)) - (values #-irix (deref unix-tzname (if dst 1 0)) - #+irix (fakeout-compiler "tzname" (if dst 1 0))) - ) ) +;;; non-blocking and interrupt i/o +(def-unix-error EWOULDBLOCK 35 _N"Operation would block") +#-bsd(def-unix-error EDEADLK 35 _N"Operation would block") ; Ditto +#+bsd(def-unix-error EAGAIN 35 _N"Resource temporarily unavailable") +(def-unix-error EINPROGRESS 36 _N"Operation now in progress") +(def-unix-error EALREADY 37 _N"Operation already in progress") +;;; +;;; ipc/network software +(def-unix-error ENOTSOCK 38 _N"Socket operation on non-socket") +(def-unix-error EDESTADDRREQ 39 _N"Destination address required") +(def-unix-error EMSGSIZE 40 _N"Message too long") +(def-unix-error EPROTOTYPE 41 _N"Protocol wrong type for socket") +(def-unix-error ENOPROTOOPT 42 _N"Protocol not available") +(def-unix-error EPROTONOSUPPORT 43 _N"Protocol not supported") +(def-unix-error ESOCKTNOSUPPORT 44 _N"Socket type not supported") +(def-unix-error EOPNOTSUPP 45 _N"Operation not supported on socket") +(def-unix-error EPFNOSUPPORT 46 _N"Protocol family not supported") +(def-unix-error EAFNOSUPPORT 47 _N"Address family not supported by protocol family") +(def-unix-error EADDRINUSE 48 _N"Address already in use") +(def-unix-error EADDRNOTAVAIL 49 _N"Can't assign requested address") +;;; +;;; operational errors +(def-unix-error ENETDOWN 50 _N"Network is down") +(def-unix-error ENETUNREACH 51 _N"Network is unreachable") +(def-unix-error ENETRESET 52 _N"Network dropped connection on reset") +(def-unix-error ECONNABORTED 53 _N"Software caused connection abort") +(def-unix-error ECONNRESET 54 _N"Connection reset by peer") +(def-unix-error ENOBUFS 55 _N"No buffer space available") +(def-unix-error EISCONN 56 _N"Socket is already connected") +(def-unix-error ENOTCONN 57 _N"Socket is not connected") +(def-unix-error ESHUTDOWN 58 _N"Can't send after socket shutdown") +(def-unix-error ETOOMANYREFS 59 _N"Too many references: can't splice") +(def-unix-error ETIMEDOUT 60 _N"Connection timed out") +(def-unix-error ECONNREFUSED 61 _N"Connection refused") +;;; +(def-unix-error ELOOP 62 _N"Too many levels of symbolic links") +(def-unix-error ENAMETOOLONG 63 _N"File name too long") +;;; +(def-unix-error EHOSTDOWN 64 _N"Host is down") +(def-unix-error EHOSTUNREACH 65 _N"No route to host") +(def-unix-error ENOTEMPTY 66 _N"Directory not empty") +;;; +;;; quotas & resource +(def-unix-error EPROCLIM 67 _N"Too many processes") +(def-unix-error EUSERS 68 _N"Too many users") +(def-unix-error EDQUOT 69 _N"Disc quota exceeded") +;;; +;;; CMU RFS +(def-unix-error ELOCAL 126 _N"namei should continue locally") +(def-unix-error EREMOTE 127 _N"namei was handled remotely") +;;; +;;; VICE +(def-unix-error EVICEERR 70 _N"Remote file system error _N") +(def-unix-error EVICEOP 71 _N"syscall was handled by Vice") +) +#+svr4 +(progn +(def-unix-error ENOMSG 35 _N"No message of desired type") +(def-unix-error EIDRM 36 _N"Identifier removed") +(def-unix-error ECHRNG 37 _N"Channel number out of range") +(def-unix-error EL2NSYNC 38 _N"Level 2 not synchronized") +(def-unix-error EL3HLT 39 _N"Level 3 halted") +(def-unix-error EL3RST 40 _N"Level 3 reset") +(def-unix-error ELNRNG 41 _N"Link number out of range") +(def-unix-error EUNATCH 42 _N"Protocol driver not attached") +(def-unix-error ENOCSI 43 _N"No CSI structure available") +(def-unix-error EL2HLT 44 _N"Level 2 halted") +(def-unix-error EDEADLK 45 _N"Deadlock situation detected/avoided") +(def-unix-error ENOLCK 46 _N"No record locks available") +(def-unix-error ECANCELED 47 _N"Error 47") +(def-unix-error ENOTSUP 48 _N"Error 48") +(def-unix-error EBADE 50 _N"Bad exchange descriptor") +(def-unix-error EBADR 51 _N"Bad request descriptor") +(def-unix-error EXFULL 52 _N"Message tables full") +(def-unix-error ENOANO 53 _N"Anode table overflow") +(def-unix-error EBADRQC 54 _N"Bad request code") +(def-unix-error EBADSLT 55 _N"Invalid slot") +(def-unix-error EDEADLOCK 56 _N"File locking deadlock") +(def-unix-error EBFONT 57 _N"Bad font file format") +(def-unix-error ENOSTR 60 _N"Not a stream device") +(def-unix-error ENODATA 61 _N"No data available") +(def-unix-error ETIME 62 _N"Timer expired") +(def-unix-error ENOSR 63 _N"Out of stream resources") +(def-unix-error ENONET 64 _N"Machine is not on the network") +(def-unix-error ENOPKG 65 _N"Package not installed") +(def-unix-error EREMOTE 66 _N"Object is remote") +(def-unix-error ENOLINK 67 _N"Link has been severed") +(def-unix-error EADV 68 _N"Advertise error") +(def-unix-error ESRMNT 69 _N"Srmount error") +(def-unix-error ECOMM 70 _N"Communication error on send") +(def-unix-error EPROTO 71 _N"Protocol error") +(def-unix-error EMULTIHOP 74 _N"Multihop attempted") +(def-unix-error EBADMSG 77 _N"Not a data message") +(def-unix-error ENAMETOOLONG 78 _N"File name too long") +(def-unix-error EOVERFLOW 79 _N"Value too large for defined data type") +(def-unix-error ENOTUNIQ 80 _N"Name not unique on network") +(def-unix-error EBADFD 81 _N"File descriptor in bad state") +(def-unix-error EREMCHG 82 _N"Remote address changed") +(def-unix-error ELIBACC 83 _N"Can not access a needed shared library") +(def-unix-error ELIBBAD 84 _N"Accessing a corrupted shared library") +(def-unix-error ELIBSCN 85 _N".lib section in a.out corrupted") +(def-unix-error ELIBMAX 86 _N"Attempting to link in more shared libraries than system limit") +(def-unix-error ELIBEXEC 87 _N"Can not exec a shared library directly") +(def-unix-error EILSEQ 88 _N"Error 88") +(def-unix-error ENOSYS 89 _N"Operation not applicable") +(def-unix-error ELOOP 90 _N"Number of symbolic links encountered during path name traversal exceeds MAXSYMLINKS") +(def-unix-error ERESTART 91 _N"Error 91") +(def-unix-error ESTRPIPE 92 _N"Error 92") +(def-unix-error ENOTEMPTY 93 _N"Directory not empty") +(def-unix-error EUSERS 94 _N"Too many users") +(def-unix-error ENOTSOCK 95 _N"Socket operation on non-socket") +(def-unix-error EDESTADDRREQ 96 _N"Destination address required") +(def-unix-error EMSGSIZE 97 _N"Message too long") +(def-unix-error EPROTOTYPE 98 _N"Protocol wrong type for socket") +(def-unix-error ENOPROTOOPT 99 _N"Option not supported by protocol") +(def-unix-error EPROTONOSUPPORT 120 _N"Protocol not supported") +(def-unix-error ESOCKTNOSUPPORT 121 _N"Socket type not supported") +(def-unix-error EOPNOTSUPP 122 _N"Operation not supported on transport endpoint") +(def-unix-error EPFNOSUPPORT 123 _N"Protocol family not supported") +(def-unix-error EAFNOSUPPORT 124 _N"Address family not supported by protocol family") +(def-unix-error EADDRINUSE 125 _N"Address already in use") +(def-unix-error EADDRNOTAVAIL 126 _N"Cannot assign requested address") +(def-unix-error ENETDOWN 127 _N"Network is down") +(def-unix-error ENETUNREACH 128 _N"Network is unreachable") +(def-unix-error ENETRESET 129 _N"Network dropped connection because of reset") +(def-unix-error ECONNABORTED 130 _N"Software caused connection abort") +(def-unix-error ECONNRESET 131 _N"Connection reset by peer") +(def-unix-error ENOBUFS 132 _N"No buffer space available") +(def-unix-error EISCONN 133 _N"Transport endpoint is already connected") +(def-unix-error ENOTCONN 134 _N"Transport endpoint is not connected") +(def-unix-error ESHUTDOWN 143 _N"Cannot send after socket shutdown") +(def-unix-error ETOOMANYREFS 144 _N"Too many references: cannot splice") +(def-unix-error ETIMEDOUT 145 _N"Connection timed out") +(def-unix-error ECONNREFUSED 146 _N"Connection refused") +(def-unix-error EHOSTDOWN 147 _N"Host is down") +(def-unix-error EHOSTUNREACH 148 _N"No route to host") +(def-unix-error EWOULDBLOCK 11 _N"Resource temporarily unavailable") +(def-unix-error EALREADY 149 _N"Operation already in progress") +(def-unix-error EINPROGRESS 150 _N"Operation now in progress") +(def-unix-error ESTALE 151 _N"Stale NFS file handle") +) +#+linux +(progn +(def-unix-error EDEADLK 35 _N"Resource deadlock would occur") +(def-unix-error ENAMETOOLONG 36 _N"File name too long") +(def-unix-error ENOLCK 37 _N"No record locks available") +(def-unix-error ENOSYS 38 _N"Function not implemented") +(def-unix-error ENOTEMPTY 39 _N"Directory not empty") +(def-unix-error ELOOP 40 _N"Too many symbolic links encountered") +(def-unix-error EWOULDBLOCK 11 _N"Operation would block") +(def-unix-error ENOMSG 42 _N"No message of desired type") +(def-unix-error EIDRM 43 _N"Identifier removed") +(def-unix-error ECHRNG 44 _N"Channel number out of range") +(def-unix-error EL2NSYNC 45 _N"Level 2 not synchronized") +(def-unix-error EL3HLT 46 _N"Level 3 halted") +(def-unix-error EL3RST 47 _N"Level 3 reset") +(def-unix-error ELNRNG 48 _N"Link number out of range") +(def-unix-error EUNATCH 49 _N"Protocol driver not attached") +(def-unix-error ENOCSI 50 _N"No CSI structure available") +(def-unix-error EL2HLT 51 _N"Level 2 halted") +(def-unix-error EBADE 52 _N"Invalid exchange") +(def-unix-error EBADR 53 _N"Invalid request descriptor") +(def-unix-error EXFULL 54 _N"Exchange full") +(def-unix-error ENOANO 55 _N"No anode") +(def-unix-error EBADRQC 56 _N"Invalid request code") +(def-unix-error EBADSLT 57 _N"Invalid slot") +(def-unix-error EDEADLOCK EDEADLK _N"File locking deadlock error") +(def-unix-error EBFONT 59 _N"Bad font file format") +(def-unix-error ENOSTR 60 _N"Device not a stream") +(def-unix-error ENODATA 61 _N"No data available") +(def-unix-error ETIME 62 _N"Timer expired") +(def-unix-error ENOSR 63 _N"Out of streams resources") +(def-unix-error ENONET 64 _N"Machine is not on the network") +(def-unix-error ENOPKG 65 _N"Package not installed") +(def-unix-error EREMOTE 66 _N"Object is remote") +(def-unix-error ENOLINK 67 _N"Link has been severed") +(def-unix-error EADV 68 _N"Advertise error") +(def-unix-error ESRMNT 69 _N"Srmount error") +(def-unix-error ECOMM 70 _N"Communication error on send") +(def-unix-error EPROTO 71 _N"Protocol error") +(def-unix-error EMULTIHOP 72 _N"Multihop attempted") +(def-unix-error EDOTDOT 73 _N"RFS specific error") +(def-unix-error EBADMSG 74 _N"Not a data message") +(def-unix-error EOVERFLOW 75 _N"Value too large for defined data type") +(def-unix-error ENOTUNIQ 76 _N"Name not unique on network") +(def-unix-error EBADFD 77 _N"File descriptor in bad state") +(def-unix-error EREMCHG 78 _N"Remote address changed") +(def-unix-error ELIBACC 79 _N"Can not access a needed shared library") +(def-unix-error ELIBBAD 80 _N"Accessing a corrupted shared library") +(def-unix-error ELIBSCN 81 _N".lib section in a.out corrupted") +(def-unix-error ELIBMAX 82 _N"Attempting to link in too many shared libraries") +(def-unix-error ELIBEXEC 83 _N"Cannot exec a shared library directly") +(def-unix-error EILSEQ 84 _N"Illegal byte sequence") +(def-unix-error ERESTART 85 _N"Interrupted system call should be restarted _N") +(def-unix-error ESTRPIPE 86 _N"Streams pipe error") +(def-unix-error EUSERS 87 _N"Too many users") +(def-unix-error ENOTSOCK 88 _N"Socket operation on non-socket") +(def-unix-error EDESTADDRREQ 89 _N"Destination address required") +(def-unix-error EMSGSIZE 90 _N"Message too long") +(def-unix-error EPROTOTYPE 91 _N"Protocol wrong type for socket") +(def-unix-error ENOPROTOOPT 92 _N"Protocol not available") +(def-unix-error EPROTONOSUPPORT 93 _N"Protocol not supported") +(def-unix-error ESOCKTNOSUPPORT 94 _N"Socket type not supported") +(def-unix-error EOPNOTSUPP 95 _N"Operation not supported on transport endpoint") +(def-unix-error EPFNOSUPPORT 96 _N"Protocol family not supported") +(def-unix-error EAFNOSUPPORT 97 _N"Address family not supported by protocol") +(def-unix-error EADDRINUSE 98 _N"Address already in use") +(def-unix-error EADDRNOTAVAIL 99 _N"Cannot assign requested address") +(def-unix-error ENETDOWN 100 _N"Network is down") +(def-unix-error ENETUNREACH 101 _N"Network is unreachable") +(def-unix-error ENETRESET 102 _N"Network dropped connection because of reset") +(def-unix-error ECONNABORTED 103 _N"Software caused connection abort") +(def-unix-error ECONNRESET 104 _N"Connection reset by peer") +(def-unix-error ENOBUFS 105 _N"No buffer space available") +(def-unix-error EISCONN 106 _N"Transport endpoint is already connected") +(def-unix-error ENOTCONN 107 _N"Transport endpoint is not connected") +(def-unix-error ESHUTDOWN 108 _N"Cannot send after transport endpoint shutdown") +(def-unix-error ETOOMANYREFS 109 _N"Too many references: cannot splice") +(def-unix-error ETIMEDOUT 110 _N"Connection timed out") +(def-unix-error ECONNREFUSED 111 _N"Connection refused") +(def-unix-error EHOSTDOWN 112 _N"Host is down") +(def-unix-error EHOSTUNREACH 113 _N"No route to host") +(def-unix-error EALREADY 114 _N"Operation already in progress") +(def-unix-error EINPROGRESS 115 _N"Operation now in progress") +(def-unix-error ESTALE 116 _N"Stale NFS file handle") +(def-unix-error EUCLEAN 117 _N"Structure needs cleaning") +(def-unix-error ENOTNAM 118 _N"Not a XENIX named type file") +(def-unix-error ENAVAIL 119 _N"No XENIX semaphores available") +(def-unix-error EISNAM 120 _N"Is a named type file") +(def-unix-error EREMOTEIO 121 _N"Remote I/O error") +(def-unix-error EDQUOT 122 _N"Quota exceeded") ) -(declaim (inline unix-gettimeofday)) -(defun unix-gettimeofday () - _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and - microseconds of the current time of day, the timezone (in minutes west - of Greenwich), and a daylight-savings flag. If it doesn't work, it - returns NIL and the errno." - (with-alien ((tv (struct timeval)) - #-(or svr4 netbsd) (tz (struct timezone))) - (syscall* (#-netbsd "gettimeofday" - #+netbsd "__gettimeofday50" - (* (struct timeval)) #-svr4 (* (struct timezone))) - (values T - (slot tv 'tv-sec) - (slot tv 'tv-usec) - #-(or svr4 netbsd) (slot tz 'tz-minuteswest) - #+svr4 (unix-get-minutes-west (slot tv 'tv-sec)) - #-(or svr4 netbsd) (slot tz 'tz-dsttime) - #+svr4 (unix-get-timezone (slot tv 'tv-sec)) - ) - (addr tv) - #-(or svr4 netbsd) (addr tz) #+netbsd nil))) - -;;; Unix-utimes changes the accessed and updated times on UNIX -;;; files. The first argument is the filename (a string) and -;;; the second argument is a list of the 4 times- accessed and -;;; updated seconds and microseconds. - -#-hpux -(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec) - _N"Unix-utimes sets the 'last-accessed' and 'last-updated' - times on a specified file. NIL and an error number is - returned if the call is unsuccessful." - (declare (type unix-pathname file) - (type (alien unsigned-long) - atime-sec atime-usec - mtime-sec mtime-usec)) - (with-alien ((tvp (array (struct timeval) 2))) - (setf (slot (deref tvp 0) 'tv-sec) atime-sec) - (setf (slot (deref tvp 0) 'tv-usec) atime-usec) - (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) - (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) - (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval))) - file - (cast tvp (* (struct timeval)))))) - -;;; Unix-setreuid sets the real and effective user-id's of the current -;;; process to the arguments "ruid" and "euid", respectively. Usage is -;;; restricted for anyone but the super-user. Setting either "ruid" or -;;; "euid" to -1 makes the system use the current id instead. - -#-(or svr4 hpux) -(defun unix-setreuid (ruid euid) - _N"Unix-setreuid sets the real and effective user-id's of the current - process to the specified ones. NIL and an error number is returned - if the call fails." - (void-syscall ("setreuid" int int) ruid euid)) - -;;; Unix-setregid sets the real and effective group-id's of the current -;;; process to the arguments "rgid" and "egid", respectively. Usage is -;;; restricted for anyone but the super-user. Setting either "rgid" or -;;; "egid" to -1 makes the system use the current id instead. - -#-(or svr4 hpux) -(defun unix-setregid (rgid egid) - _N"Unix-setregid sets the real and effective group-id's of the current - process process to the specified ones. NIL and an error number is - returned if the call fails." - (void-syscall ("setregid" int int) rgid egid)) - -(def-alien-routine ("getpid" unix-getpid) int - _N"Unix-getpid returns the process-id of the current process.") - -(def-alien-routine ("getppid" unix-getppid) int - _N"Unix-getppid returns the process-id of the parent of the current process.") - -(def-alien-routine ("getgid" unix-getgid) int - _N"Unix-getgid returns the real group-id of the current process.") - -(def-alien-routine ("getegid" unix-getegid) int - _N"Unix-getegid returns the effective group-id of the current process.") - -;;; Unix-getpgrp returns the group-id associated with the -;;; current process. - -(defun unix-getpgrp () - _N"Unix-getpgrp returns the group-id of the calling process." - (int-syscall ("getpgrp"))) - -;;; Unix-setpgid sets the group-id of the process specified by -;;; "pid" to the value of "pgrp". The process must either have -;;; the same effective user-id or be a super-user process. - -;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained -;;; for backward compatibility. setpgrp(void)[solaris] is being phased -;;; out in favor of setsid(). - -(defun unix-setpgrp (pid pgrp) - _N"Unix-setpgrp sets the process group on the process pid to - pgrp. NIL and an error number are returned upon failure." - (void-syscall (#-svr4 "setpgrp" #+svr4 "setpgid" int int) pid pgrp)) - -(defun unix-setpgid (pid pgrp) - _N"Unix-setpgid sets the process group of the process pid to - pgrp. If pgid is equal to pid, the process becomes a process - group leader. NIL and an error number are returned upon failure." - (void-syscall ("setpgid" int int) pid pgrp)) - -(def-alien-routine ("getuid" unix-getuid) int - _N"Unix-getuid returns the real user-id associated with the - current process.") - -;;; Unix-getpagesize returns the number of bytes in the system page. - -(defun unix-getpagesize () - _N"Unix-getpagesize returns the number of bytes in a system page." - (int-syscall ("getpagesize"))) - -(defun unix-gethostname () - _N"Unix-gethostname returns the name of the host machine as a string." - (with-alien ((buf (array char 256))) - (syscall* ("gethostname" (* char) int) - (cast buf c-string) - (cast buf (* char)) 256))) - -(def-alien-routine ("gethostid" unix-gethostid) unsigned-long - _N"Unix-gethostid returns a 32-bit integer which provides unique - identification for the host machine.") - -(defun unix-fork () - _N"Executes the unix fork system call. Returns 0 in the child and the pid - of the child in the parent if it works, or NIL and an error number if it - doesn't work." - (int-syscall ("fork"))) - -;; Environment manipulation; man getenv(3) -(def-alien-routine ("getenv" unix-getenv) c-call:c-string - (name c-call:c-string) - _N"Get the value of the environment variable named Name. If no such - variable exists, Nil is returned.") - -;; This doesn't exist in Solaris 8 but does exist in Solaris 10. -(def-alien-routine ("setenv" unix-setenv) c-call:int - (name c-call:c-string) - (value c-call:c-string) - (overwrite c-call:int) - _N"Adds the environment variable named Name to the environment with - the given Value if Name does not already exist. If Name does exist, - the value is changed to Value if Overwrite is non-zero. Otherwise, - the value is not changed.") - - -(def-alien-routine ("putenv" unix-putenv) c-call:int - (name-value c-call:c-string) - _N"Adds or changes the environment. Name-value must be a string of - the form \"name=value\". If the name does not exist, it is added. - If name does exist, the value is updated to the given value.") - -;; This doesn't exist in Solaris 8 but does exist in Solaris 10. -(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int - (name c-call:c-string) - _N"Removes the variable Name from the environment") - - -;;; Operations on Unix Directories. - -(export '(open-dir read-dir close-dir)) - -(defstruct (%directory - (:conc-name directory-) - (:constructor make-directory) - (:print-function %print-directory)) - name - (dir-struct (required-argument) :type system-area-pointer)) - -(defun %print-directory (dir stream depth) - (declare (ignore depth)) - (format stream "#<Directory ~S>" (directory-name dir))) - -(defun open-dir (pathname) - (declare (type unix-pathname pathname)) - (when (string= pathname "") - (setf pathname ".")) - (let ((kind (unix-file-kind pathname))) - (case kind - (:directory - (let ((dir-struct - (alien-funcall (extern-alien "opendir" - (function system-area-pointer - c-string)) - (%name->file pathname)))) - (if (zerop (sap-int dir-struct)) - (values nil (unix-errno)) - (make-directory :name pathname :dir-struct dir-struct)))) - ((nil) - (values nil enoent)) - (t - (values nil enotdir))))) - -#-(and bsd (not solaris)) -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct direct)) daddr)) - #-(or linux svr4) - (let ((nlen (slot direct 'd-namlen)) - (ino (slot direct 'd-ino))) - (declare (type (unsigned-byte 16) nlen)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) ino))) - #+(or linux svr4) - (values (%file->name (cast (slot direct 'd-name) c-string)) - (slot direct 'd-ino)))))) - -;;; 64-bit readdir for Solaris -#+solaris -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir64" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct dirent64)) daddr)) - #-(or linux svr4) - (let ((nlen (slot direct 'd-namlen)) - (ino (slot direct 'd-ino))) - (declare (type (unsigned-byte 16) nlen)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) ino))) - #+(or linux svr4) - (values (%file->name (cast (slot direct 'd-name) c-string)) - (slot direct 'd-ino)))))) -#+(and bsd (not solaris)) -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct direct)) daddr)) - (let ((nlen (slot direct 'd-namlen)) - (fino (slot direct 'd-fileno))) - (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen) - (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) fino))))))) +;;; +;;; And now for something completely different ... +(emit-unix-errors) +(def-alien-routine ("os_get_errno" unix-get-errno) int) +(def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int)) +(defun unix-errno () (unix-get-errno)) -(defun close-dir (dir) - (declare (type %directory dir)) - (alien-funcall (extern-alien "closedir" - (function void system-area-pointer)) - (directory-dir-struct dir)) - nil) +;;; GET-UNIX-ERROR-MSG -- public. +;;; +(defun get-unix-error-msg (&optional (error-number (unix-errno))) + _N"Returns a string describing the error number which was returned by a + UNIX system call." + (declare (type integer error-number)) + (if (array-in-bounds-p *unix-errors* error-number) + (svref *unix-errors* error-number) + (format nil _"Unknown error [~d]" error-number))) + +;;;; Lisp types used by syscalls. -;; Use getcwd instead of getwd. But what should we do if the path -;; won't fit? Try again with a larger size? We don't do that right -;; now. -(defun unix-current-directory () - ;; 5120 is some randomly selected maximum size for the buffer for getcwd. - (with-alien ((buf (array c-call:char 5120))) - (let ((result - (alien-funcall - (extern-alien "getcwd" - (function (* c-call:char) - (* c-call:char) c-call:int)) - (cast buf (* c-call:char)) - 5120))) - - (values (not (zerop - (sap-int (alien-sap result)))) - (%file->name (cast buf c-call:c-string)))))) +(deftype unix-pathname () 'simple-string) +(deftype unix-fd () `(integer 0 ,most-positive-fixnum)) +(deftype unix-file-mode () '(unsigned-byte 32)) +(deftype unix-uid () '(unsigned-byte 32)) +(deftype unix-gid () '(unsigned-byte 32)) - -;;;; Support routines for dealing with unix pathnames. -(export '(unix-file-kind unix-maybe-prepend-current-directory - unix-resolve-links unix-simplify-pathname)) +;;; UNIX-FAST-SELECT -- public. +;;; +(defmacro unix-fast-select (num-descriptors + read-fds write-fds exception-fds + timeout-secs &optional (timeout-usecs 0)) + _N"Perform the UNIX select(2) system call. + (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) + (type (or (alien (* (struct fd-set))) null) + read-fds write-fds exception-fds) + (type (or null (unsigned-byte 31)) timeout-secs) + (type (unsigned-byte 31) timeout-usecs) + (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" + `(let ((timeout-secs ,timeout-secs)) + (with-alien ((tv (struct timeval))) + (when timeout-secs + (setf (slot tv 'tv-sec) timeout-secs) + (setf (slot tv 'tv-usec) ,timeout-usecs)) + (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) + (* (struct fd-set)) (* (struct timeval))) + ,num-descriptors ,read-fds ,write-fds ,exception-fds + (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) -(defun unix-file-kind (name &optional check-for-links) - _N"Returns either :file, :directory, :link, :special, or NIL." - (declare (simple-string name)) - (multiple-value-bind (res dev ino mode) - (if check-for-links - (unix-lstat name) - (unix-stat name)) - (declare (type (or fixnum null) mode) - (ignore dev ino)) - (when res - (let ((kind (logand mode s-ifmt))) - (cond ((eql kind s-ifdir) :directory) - ((eql kind s-ifreg) :file) - ((eql kind s-iflnk) :link) - (t :special)))))) +;;; Unix-select accepts sets of file descriptors and waits for an event +;;; to happen on one of them or to time out. -(defun unix-maybe-prepend-current-directory (name) - (declare (simple-string name)) - (if (and (> (length name) 0) (char= (schar name 0) #\/)) - name - (multiple-value-bind (win dir) (unix-current-directory) - (if win - (concatenate 'simple-string dir "/" name) - name)))) +(defmacro num-to-fd-set (fdset num) + `(if (fixnump ,num) + (progn + (setf (deref (slot ,fdset 'fds-bits) 0) ,num) + ,@(loop for index upfrom 1 below (/ fd-setsize 32) + collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) + (progn + ,@(loop for index upfrom 0 below (/ fd-setsize 32) + collect `(setf (deref (slot ,fdset 'fds-bits) ,index) + (ldb (byte 32 ,(* index 32)) ,num)))))) -(defun unix-resolve-links (pathname) - _N"Returns the pathname with all symbolic links resolved." - (declare (simple-string pathname)) - (let ((len (length pathname)) - (pending pathname)) - (declare (fixnum len) (simple-string pending)) - (if (zerop len) - pathname - (let ((result (make-string 100 :initial-element (code-char 0))) - (fill-ptr 0) - (name-start 0)) - (loop - (let* ((name-end (or (position #\/ pending :start name-start) len)) - (new-fill-ptr (+ fill-ptr (- name-end name-start)))) - ;; grow the result string, if necessary. the ">=" (instead of - ;; using ">") allows for the trailing "/" if we find this - ;; component is a directory. - (when (>= new-fill-ptr (length result)) - (let ((longer (make-string (* 3 (length result)) - :initial-element (code-char 0)))) - (replace longer result :end1 fill-ptr) - (setq result longer))) - (replace result pending - :start1 fill-ptr - :end1 new-fill-ptr - :start2 name-start - :end2 name-end) - (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t))) - (unless kind (return nil)) - (cond ((eq kind :link) - (multiple-value-bind (link err) (unix-readlink result) - (unless link - (error (intl:gettext "Error reading link ~S: ~S") - (subseq result 0 fill-ptr) - (get-unix-error-msg err))) - (cond ((or (zerop (length link)) - (char/= (schar link 0) #\/)) - ;; It's a relative link - (fill result (code-char 0) - :start fill-ptr - :end new-fill-ptr)) - ((string= result "/../" :end1 4) - ;; It's across the super-root. - (let ((slash (or (position #\/ result :start 4) - 0))) - (fill result (code-char 0) - :start slash - :end new-fill-ptr) - (setf fill-ptr slash))) - (t - ;; It's absolute. - (and (> (length link) 0) - (char= (schar link 0) #\/)) - (fill result (code-char 0) :end new-fill-ptr) - (setf fill-ptr 0))) - (setf pending - (if (= name-end len) - link - (concatenate 'simple-string - link - (subseq pending name-end)))) - (setf len (length pending)) - (setf name-start 0))) - ((= name-end len) - (when (eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (incf new-fill-ptr)) - (return (subseq result 0 new-fill-ptr))) - ((eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (setf fill-ptr (1+ new-fill-ptr)) - (setf name-start (1+ name-end))) - (t - (return nil)))))))))) +(defmacro fd-set-to-num (nfds fdset) + `(if (<= ,nfds 32) + (deref (slot ,fdset 'fds-bits) 0) + (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32) + collect `(ash (deref (slot ,fdset 'fds-bits) ,index) + ,(* index 32)))))) -(defun unix-simplify-pathname (src) - (declare (simple-string src)) - (let* ((src-len (length src)) - (dst (make-string src-len)) - (dst-len 0) - (dots 0) - (last-slash nil)) - (macrolet ((deposit (char) - `(progn - (setf (schar dst dst-len) ,char) - (incf dst-len)))) - (dotimes (src-index src-len) - (let ((char (schar src src-index))) - (cond ((char= char #\.) - (when dots - (incf dots)) - (deposit char)) - ((char= char #\/) - (case dots - (0 - ;; Either ``/...' or ``...//...' - (unless last-slash - (setf last-slash dst-len) - (deposit char))) - (1 - ;; Either ``./...'' or ``..././...'' - (decf dst-len)) - (2 - ;; We've found .. - (cond - ((and last-slash (not (zerop last-slash))) - ;; There is something before this .. - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (cond ((and (= (+ (or prev-prev-slash 0) 2) - last-slash) - (char= (schar dst (- last-slash 2)) #\.) - (char= (schar dst (1- last-slash)) #\.)) - ;; The something before this .. is another .. - (deposit char) - (setf last-slash dst-len)) - (t - ;; The something is some random dir. - (setf dst-len - (if prev-prev-slash - (1+ prev-prev-slash) - 0)) - (setf last-slash prev-prev-slash))))) - (t - ;; There is nothing before this .., so we need to keep it - (setf last-slash dst-len) - (deposit char)))) - (t - ;; Something other than a dot between slashes. - (setf last-slash dst-len) - (deposit char))) - (setf dots 0)) - (t - (setf dots nil) - (setf (schar dst dst-len) char) - (incf dst-len)))))) - (when (and last-slash (not (zerop last-slash))) - (case dots - (1 - ;; We've got ``foobar/.'' - (decf dst-len)) - (2 - ;; We've got ``foobar/..'' - (unless (and (>= last-slash 2) - (char= (schar dst (1- last-slash)) #\.) - (char= (schar dst (- last-slash 2)) #\.) - (or (= last-slash 2) - (char= (schar dst (- last-slash 3)) #\/))) - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (if prev-prev-slash - (setf dst-len (1+ prev-prev-slash)) - (return-from unix-simplify-pathname "./"))))))) - (cond ((zerop dst-len) - "./") - ((= dst-len src-len) - dst) - (t - (subseq dst 0 dst-len))))) +;; not checked for linux... +(defmacro fd-set (offset fd-set) + (let ((word (gensym)) + (bit (gensym))) + `(multiple-value-bind (,word ,bit) (floor ,offset 32) + (setf (deref (slot ,fd-set 'fds-bits) ,word) + (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) + (deref (slot ,fd-set 'fds-bits) ,word)))))) - -;;;; Other random routines. +;; not checked for linux... +(defmacro fd-zero (fd-set) + `(progn + ,@(loop for index upfrom 0 below (/ fd-setsize 32) + collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) -(def-alien-routine ("isatty" unix-isatty) boolean - _N"Accepts a Unix file descriptor and returns T if the device - associated with it is a terminal." - (fd int)) +(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) + _N"Unix-select examines the sets of descriptors passed as arguments + to see if they are ready for reading and writing. See the UNIX + Programmers Manual for more information." + (declare (type (integer 0 #.FD-SETSIZE) nfds) + (type unsigned-byte rdfds wrfds xpfds) + (type (or (unsigned-byte 31) null) to-secs) + (type (unsigned-byte 31) to-usecs) + (optimize (speed 3) (safety 0) (inhibit-warnings 3))) + (with-alien ((tv (struct timeval)) + (rdf (struct fd-set)) + (wrf (struct fd-set)) + (xpf (struct fd-set))) + (when to-secs + (setf (slot tv 'tv-sec) to-secs) + (setf (slot tv 'tv-usec) to-usecs)) + (num-to-fd-set rdf rdfds) + (num-to-fd-set wrf wrfds) + (num-to-fd-set xpf xpfds) + (macrolet ((frob (lispvar alienvar) + `(if (zerop ,lispvar) + (int-sap 0) + (alien-sap (addr ,alienvar))))) + (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) + (* (struct fd-set)) (* (struct timeval))) + (values result + (fd-set-to-num nfds rdf) + (fd-set-to-num nfds wrf) + (fd-set-to-num nfds xpf)) + nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) + (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) -(def-alien-routine ("ttyname" unix-ttyname) c-string - (fd int)) +(defun unix-symlink (name1 name2) + _N"Unix-symlink creates a symbolic link named name2 to the file + named name1. NIL and an error number is returned if the call + is unsuccessful." + (declare (type unix-pathname name1 name2)) + (void-syscall ("symlink" c-string c-string) + (%name->file name1) (%name->file name2))) -(def-alien-routine ("openpty" unix-openpty) int - (amaster int :out) - (aslave int :out) - (name c-string) - (termp (* (struct termios))) - (winp (* (struct winsize)))) +(def-alien-type nil + (struct timeval + (tv-sec #-linux time-t #+linux int) ; seconds + (tv-usec int))) ; and microseconds + +(def-alien-type nil + (struct timezone + (tz-minuteswest int) ; minutes west of Greenwich + (tz-dsttime ; type of dst correction + #-linux (enum nil :none :usa :aust :wet :met :eet :can) + #+linux int))) +(declaim (inline unix-gettimeofday)) +(defun unix-gettimeofday () + _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and + microseconds of the current time of day, the timezone (in minutes west + of Greenwich), and a daylight-savings flag. If it doesn't work, it + returns NIL and the errno." + (with-alien ((tv (struct timeval)) + #-(or svr4 netbsd) (tz (struct timezone))) + (syscall* (#-netbsd "gettimeofday" + #+netbsd "__gettimeofday50" + (* (struct timeval)) #-svr4 (* (struct timezone))) + (values T + (slot tv 'tv-sec) + (slot tv 'tv-usec) + #-(or svr4 netbsd) (slot tz 'tz-minuteswest) + #+svr4 (unix-get-minutes-west (slot tv 'tv-sec)) + #-(or svr4 netbsd) (slot tz 'tz-dsttime) + #+svr4 (unix-get-timezone (slot tv 'tv-sec)) + ) + (addr tv) + #-(or svr4 netbsd) (addr tz) #+netbsd nil))) - -;;;; UNIX-EXECVE - -(defun unix-execve (program &optional arg-list - (environment *environment-list*)) - _N"Executes the Unix execve system call. If the system call suceeds, lisp - will no longer be running in this process. If the system call fails this - function returns two values: NIL and an error code. Arg-list should be a - list of simple-strings which are passed as arguments to the exec'ed program. - Environment should be an a-list mapping symbols to simple-strings which this - function bashes together to form the environment for the exec'ed program." - (check-type program simple-string) - (let ((env-list (let ((envlist nil)) - (dolist (cons environment) - (push (if (cdr cons) - (concatenate 'simple-string - (string (car cons)) "=" - (cdr cons)) - (car cons)) - envlist)) - envlist))) - (sub-unix-execve (%name->file program) arg-list env-list))) - - -(defmacro round-bytes-to-words (n) - `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3))) +;;; Unix-utimes changes the accessed and updated times on UNIX +;;; files. The first argument is the filename (a string) and +;;; the second argument is a list of the 4 times- accessed and +;;; updated seconds and microseconds. -;;; -;;; STRING-LIST-TO-C-STRVEC -- Internal -;;; -;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of -;;; simple-strings and constructs a C-style string vector (strvec) -- -;;; a null-terminated array of pointers to null-terminated strings. -;;; This function returns two values: a sap and a byte count. When the -;;; memory is no longer needed it should be deallocated with -;;; vm_deallocate. -;;; -(defun string-list-to-c-strvec (string-list) - ;; - ;; Make a pass over string-list to calculate the amount of memory - ;; needed to hold the strvec. - (let ((string-bytes 0) - (vec-bytes (* 4 (1+ (length string-list))))) - (declare (fixnum string-bytes vec-bytes)) - (dolist (s string-list) - (check-type s simple-string) - (incf string-bytes (round-bytes-to-words (1+ (length s))))) - ;; - ;; Now allocate the memory and fill it in. - (let* ((total-bytes (+ string-bytes vec-bytes)) - (vec-sap (system:allocate-system-memory total-bytes)) - (string-sap (sap+ vec-sap vec-bytes)) - (i 0)) - (declare (type (and unsigned-byte fixnum) total-bytes i) - (type system:system-area-pointer vec-sap string-sap)) - (dolist (s string-list) - (declare (simple-string s)) - (let ((n (length s))) - ;; - ;; Blast the string into place - #-unicode - (kernel:copy-to-system-area (the simple-string s) - (* vm:vector-data-offset vm:word-bits) - string-sap 0 - (* (1+ n) vm:byte-bits)) - #+unicode - (progn - ;; FIXME: Do we need to apply some kind of transformation - ;; to convert Lisp unicode strings to C strings? Utf-8? - (dotimes (k n) - (setf (sap-ref-8 string-sap k) - (logand #xff (char-code (aref s k))))) - (setf (sap-ref-8 string-sap n) 0)) - - ;; - ;; Blast the pointer to the string into place - (setf (sap-ref-sap vec-sap i) string-sap) - (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n)))) - (incf i 4))) - ;; Blast in last null pointer - (setf (sap-ref-sap vec-sap i) (int-sap 0)) - (values vec-sap total-bytes)))) - -(defun sub-unix-execve (program arg-list env-list) - (let ((argv nil) - (argv-bytes 0) - (envp nil) - (envp-bytes 0) - result error-code) - (unwind-protect - (progn - ;; Blast the stuff into the proper format - (multiple-value-setq - (argv argv-bytes) - (string-list-to-c-strvec arg-list)) - (multiple-value-setq - (envp envp-bytes) - (string-list-to-c-strvec env-list)) - ;; - ;; Now do the system call - (multiple-value-setq - (result error-code) - (int-syscall ("execve" - c-string system-area-pointer system-area-pointer) - program argv envp))) - ;; - ;; Deallocate memory - (when argv - (system:deallocate-system-memory argv argv-bytes)) - (when envp - (system:deallocate-system-memory envp envp-bytes))) - (values result error-code))) +#-hpux +(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec) + _N"Unix-utimes sets the 'last-accessed' and 'last-updated' + times on a specified file. NIL and an error number is + returned if the call is unsuccessful." + (declare (type unix-pathname file) + (type (alien unsigned-long) + atime-sec atime-usec + mtime-sec mtime-usec)) + (with-alien ((tvp (array (struct timeval) 2))) + (setf (slot (deref tvp 0) 'tv-sec) atime-sec) + (setf (slot (deref tvp 0) 'tv-usec) atime-usec) + (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) + (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) + (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval))) + file + (cast tvp (* (struct timeval)))))) +(def-alien-routine ("getpid" unix-getpid) int + _N"Unix-getpid returns the process-id of the current process.") ;;;; Socket support. @@ -3061,88 +2163,190 @@ ;; Datagram support -(defun unix-recvfrom (fd buffer length flags sockaddr len) - (with-alien ((l c-call:int len)) - (values - (alien-funcall (extern-alien "recvfrom" - (function c-call:int - c-call:int - system-area-pointer - c-call:int - c-call:int - (* t) - (* c-call:int))) - fd - (system:vector-sap buffer) - length - flags - sockaddr - (addr l)) - l))) +(defun unix-recvfrom (fd buffer length flags sockaddr len) + (with-alien ((l c-call:int len)) + (values + (alien-funcall (extern-alien "recvfrom" + (function c-call:int + c-call:int + system-area-pointer + c-call:int + c-call:int + (* t) + (* c-call:int))) + fd + (system:vector-sap buffer) + length + flags + sockaddr + (addr l)) + l))) + +#-unicode +(def-alien-routine ("sendto" unix-sendto) int + (fd int) + (buffer c-string) + (length int) + (flags int) + (sockaddr (* t)) + (len int)) + +(defun unix-sendto (fd buffer length flags sockaddr len) + (alien-funcall (extern-alien "sendto" + (function c-call:int + c-call:int + system-area-pointer + c-call:int + c-call:int + (* t) + c-call:int)) + fd + (system:vector-sap buffer) + length + flags + sockaddr + len)) + +(def-alien-routine ("shutdown" unix-shutdown) int + (socket int) + (level int)) + + +;;;; Memory-mapped files + +(defconstant +null+ (sys:int-sap 0)) + +(defconstant prot_read 1) ; Readable +(defconstant prot_write 2) ; Writable +(defconstant prot_exec 4) ; Executable +(defconstant prot_none 0) ; No access + +(defconstant map_shared 1) ; Changes are shared +(defconstant map_private 2) ; Changes are private +(defconstant map_fixed 16) ; Fixed, user-defined address +(defconstant map_noreserve #x40) ; Don't reserve swap space +(defconstant map_anonymous + #+solaris #x100 ; Solaris + #+linux 32 ; Linux + #+bsd #x1000) + +(defconstant ms_async 1) +(defconstant ms_sync 4) +(defconstant ms_invalidate 2) + +;; The return value from mmap that means mmap failed. +(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits)))) + +(defun unix-mmap (addr length prot flags fd offset) + (declare (type (or null system-area-pointer) addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot) + (type (unsigned-byte 32) flags) + (type (or null unix-fd) fd) + (type file-offset offset)) + ;; Can't use syscall, because the address that is returned could be + ;; "negative". Hence we explicitly check for mmap returning + ;; MAP_FAILED. + (let ((result + (alien-funcall (extern-alien "mmap" (function system-area-pointer + system-area-pointer + size-t int int int off-t)) + (or addr +null+) length prot flags (or fd -1) offset))) + (if (sap= result map_failed) + (values nil (unix-errno)) + (values result 0)))) + +(defun unix-munmap (addr length) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length)) + (syscall ("munmap" system-area-pointer size-t) t addr length)) + +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + +(defun unix-msync (addr length flags) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (signed-byte 32) flags)) + (syscall ("msync" system-area-pointer size-t int) t addr length flags)) + + +;;;; User and group database structures + +(defstruct user-info + (name "" :type string) + (password "" :type string) + (uid 0 :type unix-uid) + (gid 0 :type unix-gid) + #+solaris (age "" :type string) + #+solaris (comment "" :type string) + #+freebsd (change -1 :type fixnum) + (gecos "" :type string) + (dir "" :type string) + (shell "" :type string)) + +;; see <pwd.h> +#+solaris +(def-alien-type nil + (struct passwd + (pw-name (* char)) ; user's login name + (pw-passwd (* char)) ; no longer used + (pw-uid uid-t) ; user id + (pw-gid gid-t) ; group id + (pw-age (* char)) ; password age (not used) + (pw-comment (* char)) ; not used + (pw-gecos (* char)) ; typically user's full name + (pw-dir (* char)) ; user's home directory + (pw-shell (* char)))) ; user's login shell + +#+bsd +(def-alien-type nil + (struct passwd + (pw-name (* char)) ; user's login name + (pw-passwd (* char)) ; no longer used + (pw-uid uid-t) ; user id + (pw-gid gid-t) ; group id + (pw-change int) ; password change time + (pw-class (* char)) ; user access class + (pw-gecos (* char)) ; typically user's full name + (pw-dir (* char)) ; user's home directory + (pw-shell (* char)) ; user's login shell + (pw-expire int) ; account expiration + #+(or freebsd darwin) + (pw-fields int))) ; internal + +;;;; Other random routines. +(def-alien-routine ("isatty" unix-isatty) boolean + _N"Accepts a Unix file descriptor and returns T if the device + associated with it is a terminal." + (fd int)) -#-unicode -(def-alien-routine ("sendto" unix-sendto) int - (fd int) - (buffer c-string) - (length int) - (flags int) - (sockaddr (* t)) - (len int)) +(def-alien-routine ("ttyname" unix-ttyname) c-string + (fd int)) -(defun unix-sendto (fd buffer length flags sockaddr len) - (alien-funcall (extern-alien "sendto" - (function c-call:int - c-call:int - system-area-pointer - c-call:int - c-call:int - (* t) - c-call:int)) - fd - (system:vector-sap buffer) - length - flags - sockaddr - len)) +(def-alien-routine ("openpty" unix-openpty) int + (amaster int :out) + (aslave int :out) + (name c-string) + (termp (* (struct termios))) + (winp (* (struct winsize)))) -(def-alien-routine ("shutdown" unix-shutdown) int - (socket int) - (level int)) +(def-alien-type nil + (struct itimerval + (it-interval (struct timeval)) ; timer interval + (it-value (struct timeval)))) ; current value - ;;; ;;; Support for the Interval Timer (experimental) ;;; - - (defconstant ITIMER-REAL 0) (defconstant ITIMER-VIRTUAL 1) (defconstant ITIMER-PROF 2) -(defun unix-getitimer (which) - _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of - three system timers (:real :virtual or :profile). On success, - unix-getitimer returns 5 values, - T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." - (declare (type (member :real :virtual :profile) which) - (values t - #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) - (mod 1000000) - #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) - (mod 1000000))) - (let ((which (ecase which - (:real ITIMER-REAL) - (:virtual ITIMER-VIRTUAL) - (:profile ITIMER-PROF)))) - (with-alien ((itv (struct itimerval))) - (syscall* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval))) - (values T - (slot (slot itv 'it-interval) 'tv-sec) - (slot (slot itv 'it-interval) 'tv-usec) - (slot (slot itv 'it-value) 'tv-sec) - (slot (slot itv 'it-value) 'tv-usec)) - which (alien-sap (addr itv)))))) - (defun unix-setitimer (which int-secs int-usec val-secs val-usec) _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of three system timers (:real :virtual or :profile). A SIGALRM signal @@ -3182,57 +2386,6 @@ ;;;; User and group database access, POSIX Standard 9.2.2 #+solaris -(defun unix-getpwnam (login) - _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." - (declare (type simple-string login)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd))) - (let ((result - (alien-funcall - (extern-alien "getpwnam_r" - (function (* (struct passwd)) - c-call:c-string - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int)) - login - (addr user-info) - (cast buf (* c-call:char)) - 1024))) - (when (not (zerop (sap-int (alien-sap result)))) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :age (string (cast (slot result 'pw-age) c-call:c-string)) - :comment (string (cast (slot result 'pw-comment) c-call:c-string)) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - -#+bsd -(defun unix-getpwnam (login) - _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." - (declare (type simple-string login)) - (let ((result - (alien-funcall - (extern-alien "getpwnam" - (function (* (struct passwd)) - c-call:c-string)) - login))) - (when (not (zerop (sap-int (alien-sap result)))) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - #-darwin :change #-darwin (slot result 'pw-change) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) - -#+solaris (defun unix-getpwuid (uid) _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." (declare (type unix-uid uid)) @@ -3282,145 +2435,66 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) -#+solaris -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; sysconf(_SC_GETGR_R_SIZE_MAX) - (defconstant +sc-getgr-r-size-max+ 7296 - _N"The maximum size of the group entry buffer")) - -#+solaris -(defun unix-getgrnam (name) - _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." - (declare (type simple-string name)) - (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+)) - (group-info (struct group))) - (let ((result - (alien-funcall - (extern-alien "getgrnam_r" - (function (* (struct group)) - c-call:c-string - (* (struct group)) - (* c-call:char) - c-call:unsigned-int)) - name - (addr group-info) - (cast buf (* c-call:char)) - #.+sc-getgr-r-size-max+))) - (unless (zerop (sap-int (alien-sap result))) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string)))))))) - -#+bsd -(defun unix-getgrnam (name) - _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." - (declare (type simple-string name)) - (let ((result - (alien-funcall - (extern-alien "getgrnam" - (function (* (struct group)) - c-call:c-string)) - name))) - (unless (zerop (sap-int (alien-sap result))) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string))))))) - -#+solaris -(defun unix-getgrgid (gid) - _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." - (declare (type unix-gid gid)) - (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+)) - (group-info (struct group))) - (let ((result - (alien-funcall - (extern-alien "getgrgid_r" - (function (* (struct group)) - c-call:unsigned-int - (* (struct group)) - (* c-call:char) - c-call:unsigned-int)) - gid - (addr group-info) - (cast buf (* c-call:char)) - #.+sc-getgr-r-size-max+))) - (unless (zerop (sap-int (alien-sap result))) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string)))))))) - -#+bsd -(defun unix-getgrgid (gid) - _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." - (declare (type unix-gid gid)) - (let ((result - (alien-funcall - (extern-alien "getgrgid" - (function (* (struct group)) - c-call:unsigned-int)) - gid))) - (unless (zerop (sap-int (alien-sap result))) - (make-group-info - :name (string (cast (slot result 'gr-name) c-call:c-string)) - :password (string (cast (slot result 'gr-passwd) c-call:c-string)) - :gid (slot result 'gr-gid) - :members (loop :with members = (slot result 'gr-mem) - :for i :from 0 - :for member = (deref members i) - :until (zerop (sap-int (alien-sap member))) - :collect (string (cast member c-call:c-string))))))) - -#+solaris -(defun unix-setpwent () - (void-syscall ("setpwent"))) +;;; Getrusage is not provided in the C library on Solaris 2.4, and is +;;; rather slow on later versions so the "times" system call is +;;; provided. +#+(and sparc svr4) +(progn +(def-alien-type nil + (struct tms + (tms-utime #-alpha long #+alpha int) ; user time used + (tms-stime #-alpha long #+alpha int) ; system time used. + (tms-cutime #-alpha long #+alpha int) ; user time, children + (tms-cstime #-alpha long #+alpha int))) ; system time, children -#+solaris -(defun unix-endpwent () - (void-syscall ("endpwent"))) +(declaim (inline unix-times)) +(defun unix-times () + _N"Unix-times returns information about the cpu time usage of the process + and its children." + (with-alien ((usage (struct tms))) + (alien-funcall (extern-alien "times" (function int (* (struct tms)))) + (addr usage)) + (values t + (slot usage 'tms-utime) + (slot usage 'tms-stime) + (slot usage 'tms-cutime) + (slot usage 'tms-cstime)))) +) ; end progn -#+solaris -(defun unix-getpwent () - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd))) - (let ((result - (alien-funcall - (extern-alien "getpwent_r" - (function (* (struct passwd)) - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int)) - (addr user-info) - (cast buf (* c-call:char)) - 1024))) - (when (not (zerop (sap-int (alien-sap result)))) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :age (string (cast (slot result 'pw-age) c-call:c-string)) - :comment (string (cast (slot result 'pw-comment) c-call:c-string)) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) +;; Requires call to tzset() in main. +;; Don't use this now: we +#+(or linux svr4) +(progn + (def-alien-variable ("daylight" unix-daylight) int) + (def-alien-variable ("timezone" unix-timezone) time-t) + (def-alien-variable ("altzone" unix-altzone) time-t) + #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2)) + #+irix (defvar unix-tzname-addr nil) + #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil)) + ext:*after-save-initializations*) + #+irix (declaim (notinline fakeout-compiler)) + #+irix (defun fakeout-compiler (name dst) + (unless unix-tzname-addr + (setf unix-tzname-addr (system:foreign-symbol-address + name + :flavor :data))) + (deref (sap-alien unix-tzname-addr (array c-string 2)) dst)) + (def-alien-routine get-timezone c-call:void + (when c-call:long :in) + (minutes-west c-call:int :out) + (daylight-savings-p alien:boolean :out)) + (defun unix-get-minutes-west (secs) + (multiple-value-bind (ignore minutes dst) (get-timezone secs) + (declare (ignore ignore) (ignore dst)) + (values minutes)) + ) + (defun unix-get-timezone (secs) + (multiple-value-bind (ignore minutes dst) (get-timezone secs) + (declare (ignore ignore) (ignore minutes)) + (values #-irix (deref unix-tzname (if dst 1 0)) + #+irix (fakeout-compiler "tzname" (if dst 1 0))) + ) ) +) (def-alien-type nil (struct utsname @@ -3443,105 +2517,3 @@ (cast (slot names 'machine) c-string)) #+freebsd 256 (addr names)))) - -#+(and solaris svr4) -(export '(unix-sysinfo - si-sysname si-hostname si-release si-version si-machine - si-architecture si-hw-serial si-hw-provider si-srpc-domain - si-platform si-isalist si-dhcp-cache)) - -#+(and solaris svr4) -(progn -;; From sys/systeminfo.h. We don't list the set values here. -(def-enum + 1 - si-sysname si-hostname si-release si-version si-machine - si-architecture si-hw-serial si-hw-provider si-srpc-domain) - -(def-enum + 513 - si-platform si-isalist si-dhcp-cache) - - -(defun unix-sysinfo (command) - ;; Hope a buffer of length 2048 is long enough. - (with-alien ((buf (array c-call:unsigned-char 2048))) - (let ((result - (alien-funcall - (extern-alien "sysinfo" - (function c-call:int - c-call:int - c-call:c-string - c-call:int)) - command - (cast buf (* c-call:char)) - 2048))) - (when (>= result 0) - (cast buf c-call:c-string))))) -) - -#+solaris -(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core rlimit_nofile - rlimit_vmem rlimit_as)) - -#+solaris -(progn -(defconstant rlimit_cpu 0 - _N"CPU time per process (in milliseconds)") -(defconstant rlimit_fsize 1 - _N"Maximum file size") -(defconstant rlimit_data 2 - _N"Data segment size") -(defconstant rlimit_stack 3 - _N"Stack size") -(defconstant rlimit_core 4 - _N"Core file size") -(defconstant rlimit_nofile 5 - _N"Number of open files") -(defconstant rlimit_vmem 6 - _N"Maximum mapped memory") -(defconstant rlimit_as rlimit_vmem) -) - -#+(and darwin x86) -(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core - rlimit_as rlimit_rss rlimit_memlock rlimit_nproc rlimit_nofile)) - -#+(and darwin x86) -(progn -(defconstant rlimit_cpu 0 - _N"CPU time per process") -(defconstant rlimit_fsize 1 - _N"File size") -(defconstant rlimit_data 2 - _N"Data segment size") -(defconstant rlimit_stack 3 - _N"Stack size") -(defconstant rlimit_core 4 - _N"Core file size") -(defconstant rlimit_as 5 - _N"Addess space (resident set size)") -(defconstant rlimit_rss rlimit_as) -(defconstant rlimit_memlock 6 - _N"Locked-in-memory address space") -(defconstant rlimit_nproc 7 - _N"Number of processes") -(defconstant rlimit_nofile 8 - _N"Number of open files") -) - - -#+(or solaris (and darwin x86)) -(export '(unix-getrlimit)) - -#+(or solaris (and darwin x86)) -(defun unix-getrlimit (resource) - _N"Get the limits on the consumption of system resouce specified by - Resource. If successful, return three values: T, the current (soft) - limit, and the maximum (hard) limit." - - (with-alien ((rlimit (struct rlimit))) - (syscall ("getrlimit" c-call:int (* (struct rlimit))) - (values t - (slot rlimit 'rlim-cur) - (slot rlimit 'rlim-max)) - resource (addr rlimit)))) -;; EOF ===================================== src/contrib/load-unix.lisp ===================================== --- /dev/null +++ b/src/contrib/load-unix.lisp @@ -0,0 +1,7 @@ +;; Load extra functionality in the UNIX package. + +(ext:without-package-locks + (load (compile-file-pathname #-linux "modules:unix/unix" + #+linux "modules:unix/unix-glibc2"))) + +(provide 'unix) ===================================== src/contrib/unix/unix-glibc2.lisp ===================================== --- /dev/null +++ b/src/contrib/unix/unix-glibc2.lisp @@ -0,0 +1,2053 @@ +;;; -*- Package: UNIX -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/unix-glibc2.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; This file contains the UNIX low-level support for glibc2. Based +;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998). +;;; Alpha support by Julian Dolby, 1999. +;;; +;;; All the functions with #+(or) in front are work in progress, +;;; and mostly don't work. +;;; +;; Todo: #+(or)'ed stuff and ioctl's +;; +;; +;; Large File Support (LFS) added by Pierre Mai and Eric Marsden, Feb +;; 2003. This is necessary to be able to read/write/stat files that +;; are larger than 2GB on a 32-bit system. From a C program, defining +;; a preprocessor macro _LARGEFILE64_SOURCE makes the preproccessor +;; replace a call to open() by open64(), and similarly for stat, +;; fstat, lstat, lseek, readdir and friends. Furthermore, certain data +;; types, that are normally 32 bits wide, are replaced by 64-bit wide +;; equivalents: off_t -> off64_t etc. The libc.so fiddles around with +;; weak symbols to support this mess. +;; +;; From CMUCL, we make FFI calls to the xxx64 functions, and use the +;; 64-bit wide versions of the data structures. The most ugly aspect +;; is that some of the stat functions are not available via dlsym, so +;; we reference them explicitly from linux-stubs.S. Another amusing +;; fact is that on glibc 2.2, stat64() returns a struct stat with a +;; 32-bit ino_t, whereas readdir64() returns a struct dirent that +;; contains a 64-bit ino_t. On glibc 2.1, OTOH, both stat64 and +;; readdir64 use structs with 32-bit ino_t. +;; +;; The current version deals with this by going with the glibc 2.2 +;; definitions, unless the keyword :glibc2.1 also occurs on *features*, +;; in addition to :glibc2, in which case we go with the glibc 2.1 +;; definitions. Note that binaries compiled against glibc 2.1 do in +;; fact work fine on glibc 2.2, because readdir64 is available in both +;; glibc 2.1 and glibc 2.2 versions in glibc 2.2, disambiguated through +;; ELF symbol versioning. We use an entry for readdir64 in linux-stubs.S +;; in order to force usage of the correct version of readdir64 at runtime. +;; +;; So in order to compile for glibc 2.2 and newer, just compile CMUCL +;; on a glibc 2.2 system, and make sure that :glibc2.1 doesn't appear +;; on the *features* list. In order to compile for glibc 2.1 and newer, +;; compile CMUCL on a glibc 2.1 system, and make sure that :glibc2.1 does +;; appear on the *features* list. + +(in-package "UNIX") +(use-package "ALIEN") +(use-package "C-CALL") +(use-package "SYSTEM") +(use-package "EXT") +(intl:textdomain "cmucl-unix-glibc2") + +(export '( + daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t + blkcnt-t fsblkcnt-t fsfilcnt-t + unix-lockf f_ulock f_lock f_tlock f_test + timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime + itimerval it-interval it-value tchars t-intrc t-quitc t-startc + t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc + t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill + sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel + direct d-off d-ino d-reclen d-name + stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size + st-atime st-mtime st-ctime st-blksize st-blocks + s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock + s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec + ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss + ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock + ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw + rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc + unix-errno get-unix-error-msg + prot_read prot_write prot_exec prot_none + map_shared map_private map_fixed map_anonymous + ms_async ms_sync ms_invalidate + unix-mmap unix-munmap unix-msync unix-mprotect + unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid + unix-setitimer unix-getitimer + unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec + setgidexec savetext readown writeown execown readgrp writegrp + execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown + unix-getdtablesize unix-close unix-creat unix-dup unix-dup2 + unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown + fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek + l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr + o_ndelay + o_noctty + o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink + unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr + fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate + unix-ftruncate unix-symlink unix-unlink unix-write unix-ioctl + unix-uname utsname + tcsetpgrp tcgetpgrp tty-process-group + terminal-speeds tty-raw tty-crmod tty-echo tty-lcase + tty-cbreak + termios + c-lflag + c-iflag + c-oflag + tty-icrnl + tty-ocrnl + veof + vintr + vquit + vstart + vstop + vsusp + c-cflag + c-cc + tty-icanon + vmin + vtime + tty-ixon + tcsanow + tcsadrain + tciflush + tcoflush + tcioflush + tcsaflush + unix-tcgetattr + unix-tcsetattr + tty-ignbrk + tty-brkint + tty-ignpar + tty-parmrk + tty-inpck + tty-istrip + tty-inlcr + tty-igncr + tty-iuclc + tty-ixany + tty-ixoff + tty-imaxbel + tty-opost + tty-olcuc + tty-onlcr + tty-onocr + tty-onlret + tty-ofill + tty-ofdel + tty-isig + tty-xcase + tty-echoe + tty-echok + tty-echonl + tty-noflsh + tty-iexten + tty-tostop + tty-echoctl + tty-echoprt + tty-echoke + tty-pendin + tty-cstopb + tty-cread + tty-parenb + tty-parodd + tty-hupcl + tty-clocal + vintr + verase + vkill + veol + veol2 + TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC + TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ + TIOCSIGSEND + + KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK + KBDSCLICK FIONREAD unix-exit unix-stat unix-lstat unix-fstat + unix-getrusage unix-fast-getrusage rusage_self rusage_children + unix-gettimeofday + unix-utimes unix-sched-yield unix-setreuid + unix-setregid + unix-getpid unix-getppid + unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid + unix-getpagesize unix-gethostname unix-gethostid unix-fork + unix-getenv unix-setenv unix-putenv unix-unsetenv + unix-current-directory unix-isatty unix-ttyname unix-execve + unix-socket unix-connect unix-bind unix-listen unix-accept + unix-recv unix-send unix-getpeername unix-getsockname + unix-getsockopt unix-setsockopt unix-openpty + + unix-recvfrom unix-sendto unix-shutdown + + unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid + user-info user-info-name user-info-password user-info-uid + user-info-gid user-info-gecos user-info-dir user-info-shell + group-info group-info-name group-info-gid group-info-members)) + +;;;; Common machine independent structures. + +(defmacro def-enum (inc cur &rest names) + (flet ((defform (name) + (prog1 (when name `(defconstant ,name ,cur)) + (setf cur (funcall inc cur 1))))) + `(progn ,@(mapcar #'defform names)))) + +;;;; User and group database structures: <pwd.h> and <grp.h> + +(defstruct group-info + (name "" :type string) + (password "" :type string) + (gid 0 :type unix-gid) + (members nil :type list)) ; list of logins as strings + +(def-alien-type nil + (struct group + (gr-name (* char)) ; name of the group + (gr-passwd (* char)) ; encrypted group password + (gr-gid gid-t) ; numerical group ID + (gr-mem (* (* char))))) ; vector of pointers to member names + +;;; From stdio.h + +;;; From sys/types.h +;;; and +;;; gnu/types.h + +(defconstant +max-s-long+ 2147483647) + +(def-alien-type quad-t #+alpha long #-alpha (array long 2)) +(def-alien-type qaddr-t (* quad-t)) +(def-alien-type daddr-t int) +(def-alien-type caddr-t (* char)) +(def-alien-type swblk-t long) +(def-alien-type clock-t long) +(def-alien-type uid-t unsigned-int) +(def-alien-type ssize-t #-alpha int #+alpha long) +(def-alien-type key-t int) +(def-alien-type int8-t char) +(def-alien-type u-int8-t unsigned-char) +(def-alien-type int16-t short) +(def-alien-type u-int16-t unsigned-short) +(def-alien-type int32-t int) +(def-alien-type register-t #-alpha int #+alpha long) + +(def-alien-type fsblkcnt-t u-int64-t) +(def-alien-type fsfilcnt-t u-int64-t) +(def-alien-type pid-t int) +;(def-alien-type ssize-t #-alpha int #+alpha long) + +(def-alien-type fsid-t (array int 2)) + +(def-alien-type key-t int) + +(def-alien-type ipc-pid-t unsigned-short) + + +;;; dlfcn.h -> in foreign.lisp + +(defun unix-getdtablesize () + _N"Unix-getdtablesize returns the maximum size of the file descriptor + table. (i.e. the maximum number of descriptors that can exist at + one time.)" + (int-syscall ("getdtablesize"))) + +;;; fcntlbits.h + + + +(defconstant f-dupfd 0 _N"Duplicate a file descriptor") +(defconstant f-getfd 1 _N"Get file desc. flags") +(defconstant f-setfd 2 _N"Set file desc. flags") + +(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl") + +#-alpha +(progn + (defconstant F-RDLCK 0 _N"for fcntl and lockf") + (defconstant F-WRLCK 1 _N"for fcntl and lockf") + (defconstant F-UNLCK 2 _N"for fcntl and lockf") + (defconstant F-EXLCK 4 _N"old bsd flock (depricated)") + (defconstant F-SHLCK 8 _N"old bsd flock (depricated)")) +#+alpha +(progn + (defconstant F-RDLCK 1 _N"for fcntl and lockf") + (defconstant F-WRLCK 2 _N"for fcntl and lockf") + (defconstant F-UNLCK 8 _N"for fcntl and lockf") + (defconstant F-EXLCK 16 _N"old bsd flock (depricated)") + (defconstant F-SHLCK 32 _N"old bsd flock (depricated)")) + +(defconstant F-LOCK-SH 1 _N"Shared lock for bsd flock") +(defconstant F-LOCK-EX 2 _N"Exclusive lock for bsd flock") +(defconstant F-LOCK-NB 4 _N"Don't block. Combine with F-LOCK-SH or F-LOCK-EX") +(defconstant F-LOCK-UN 8 _N"Remove lock for bsd flock") + +(def-alien-type nil + (struct flock + (l-type short) + (l-whence short) + (l-start off-t) + (l-len off-t) + (l-pid pid-t))) + +;;; grp.h + +;;; POSIX Standard: 9.2.1 Group Database Access <grp.h> + +#+(or) +(defun unix-setgrend () + _N"Rewind the group-file stream." + (void-syscall ("setgrend"))) + +#+(or) +(defun unix-endgrent () + _N"Close the group-file stream." + (void-syscall ("endgrent"))) + +#+(or) +(defun unix-getgrent () + _N"Read an entry from the group-file stream, opening it if necessary." + + (let ((result (alien-funcall (extern-alien "getgrent" + (function (* (struct group))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;;; ioctl-types.h + +(defconstant +NCC+ 8 + _N"Size of control character vector.") + +(def-alien-type nil + (struct termio + (c-iflag unsigned-int) ; input mode flags + (c-oflag unsigned-int) ; output mode flags + (c-cflag unsigned-int) ; control mode flags + (c-lflag unsigned-int) ; local mode flags + (c-line unsigned-char) ; line discipline + (c-cc (array unsigned-char #.+NCC+)))) ; control characters + +;;; modem lines +(defconstant tiocm-le 1) +(defconstant tiocm-dtr 2) +(defconstant tiocm-rts 4) +(defconstant tiocm-st 8) +(defconstant tiocm-sr #x10) +(defconstant tiocm-cts #x20) +(defconstant tiocm-car #x40) +(defconstant tiocm-rng #x80) +(defconstant tiocm-dsr #x100) +(defconstant tiocm-cd tiocm-car) +(defconstant tiocm-ri #x80) + +;;; ioctl (fd, TIOCSERGETLSR, &result) where result may be as below + +;;; line disciplines +(defconstant N-TTY 0) +(defconstant N-SLIP 1) +(defconstant N-MOUSE 2) +(defconstant N-PPP 3) +(defconstant N-STRIP 4) +(defconstant N-AX25 5) + + +;;; ioctls.h + +;;; Routing table calls. +(defconstant siocaddrt #x890B) ;; add routing table entry +(defconstant siocdelrt #x890C) ;; delete routing table entry +(defconstant siocrtmsg #x890D) ;; call to routing system + +;;; Socket configuration controls. +(defconstant siocgifname #x8910) ;; get iface name +(defconstant siocsiflink #x8911) ;; set iface channel +(defconstant siocgifconf #x8912) ;; get iface list +(defconstant siocgifflags #x8913) ;; get flags +(defconstant siocsifflags #x8914) ;; set flags +(defconstant siocgifaddr #x8915) ;; get PA address +(defconstant siocsifaddr #x8916) ;; set PA address +(defconstant siocgifdstaddr #x8917 ) ;; get remote PA address +(defconstant siocsifdstaddr #x8918 ) ;; set remote PA address +(defconstant siocgifbrdaddr #x8919 ) ;; get broadcast PA address +(defconstant siocsifbrdaddr #x891a ) ;; set broadcast PA address +(defconstant siocgifnetmask #x891b ) ;; get network PA mask +(defconstant siocsifnetmask #x891c ) ;; set network PA mask +(defconstant siocgifmetric #x891d ) ;; get metric +(defconstant siocsifmetric #x891e ) ;; set metric +(defconstant siocgifmem #x891f ) ;; get memory address (BSD) +(defconstant siocsifmem #x8920 ) ;; set memory address (BSD) +(defconstant siocgifmtu #x8921 ) ;; get MTU size +(defconstant siocsifmtu #x8922 ) ;; set MTU size +(defconstant siocsifhwaddr #x8924 ) ;; set hardware address +(defconstant siocgifencap #x8925 ) ;; get/set encapsulations +(defconstant siocsifencap #x8926) +(defconstant siocgifhwaddr #x8927 ) ;; Get hardware address +(defconstant siocgifslave #x8929 ) ;; Driver slaving support +(defconstant siocsifslave #x8930) +(defconstant siocaddmulti #x8931 ) ;; Multicast address lists +(defconstant siocdelmulti #x8932) +(defconstant siocgifindex #x8933 ) ;; name -> if_index mapping +(defconstant siogifindex SIOCGIFINDEX ) ;; misprint compatibility :-) +(defconstant siocsifpflags #x8934 ) ;; set/get extended flags set +(defconstant siocgifpflags #x8935) +(defconstant siocdifaddr #x8936 ) ;; delete PA address +(defconstant siocsifhwbroadcast #x8937 ) ;; set hardware broadcast addr +(defconstant siocgifcount #x8938 ) ;; get number of devices + +(defconstant siocgifbr #x8940 ) ;; Bridging support +(defconstant siocsifbr #x8941 ) ;; Set bridging options + +(defconstant siocgiftxqlen #x8942 ) ;; Get the tx queue length +(defconstant siocsiftxqlen #x8943 ) ;; Set the tx queue length + + +;;; ARP cache control calls. +;; 0x8950 - 0x8952 * obsolete calls, don't re-use +(defconstant siocdarp #x8953 ) ;; delete ARP table entry +(defconstant siocgarp #x8954 ) ;; get ARP table entry +(defconstant siocsarp #x8955 ) ;; set ARP table entry + +;;; RARP cache control calls. +(defconstant siocdrarp #x8960 ) ;; delete RARP table entry +(defconstant siocgrarp #x8961 ) ;; get RARP table entry +(defconstant siocsrarp #x8962 ) ;; set RARP table entry + +;;; Driver configuration calls + +(defconstant siocgifmap #x8970 ) ;; Get device parameters +(defconstant siocsifmap #x8971 ) ;; Set device parameters + +;;; DLCI configuration calls + +(defconstant siocadddlci #x8980 ) ;; Create new DLCI device +(defconstant siocdeldlci #x8981 ) ;; Delete DLCI device + +;;; Device private ioctl calls. + +;; These 16 ioctls are available to devices via the do_ioctl() device +;; vector. Each device should include this file and redefine these +;; names as their own. Because these are device dependent it is a good +;; idea _NOT_ to issue them to random objects and hope. + +(defconstant siocdevprivate #x89F0 ) ;; to 89FF + + +;;; netdb.h + +;; All data returned by the network data base library are supplied in +;; host order and returned in network order (suitable for use in +;; system calls). + +;;; Absolute file name for network data base files. +(defconstant path-hequiv "/etc/hosts.equiv") +(defconstant path-hosts "/etc/hosts") +(defconstant path-networks "/etc/networks") +(defconstant path-nsswitch_conf "/etc/nsswitch.conf") +(defconstant path-protocols "/etc/protocols") +(defconstant path-services "/etc/services") + + +;;; Possible values left in `h_errno'. +(defconstant netdb-internal -1 _N"See errno.") +(defconstant netdb-success 0 _N"No problem.") +(defconstant host-not-found 1 _N"Authoritative Answer Host not found.") +(defconstant try-again 2 _N"Non-Authoritative Host not found,or SERVERFAIL.") +(defconstant no-recovery 3 _N"Non recoverable errors, FORMERR, REFUSED, NOTIMP.") +(defconstant no-data 4 "Valid name, no data record of requested type.") +(defconstant no-address no-data "No address, look for MX record.") + +;;; Description of data base entry for a single host. + +(def-alien-type nil + (struct hostent + (h-name c-string) ; Official name of host. + (h-aliases (* c-string)) ; Alias list. + (h-addrtype int) ; Host address type. + (h_length int) ; Length of address. + (h-addr-list (* c-string)))) ; List of addresses from name server. + +#+(or) +(defun unix-sethostent (stay-open) + _N"Open host data base files and mark them as staying open even after +a later search if STAY_OPEN is non-zero." + (void-syscall ("sethostent" int) stay-open)) + +#+(or) +(defun unix-endhostent () + _N"Close host data base files and clear `stay open' flag." + (void-syscall ("endhostent"))) + +#+(or) +(defun unix-gethostent () + _N"Get next entry from host data base file. Open data base if +necessary." + (let ((result (alien-funcall (extern-alien "gethostent" + (function (* (struct hostent))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-gethostbyaddr(addr length type) + _N"Return entry from host data base which address match ADDR with +length LEN and type TYPE." + (let ((result (alien-funcall (extern-alien "gethostbyaddr" + (function (* (struct hostent)) + c-string int int)) + addr len type))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-gethostbyname (name) + _N"Return entry from host data base for host with NAME." + (let ((result (alien-funcall (extern-alien "gethostbyname" + (function (* (struct hostent)) + c-string)) + name))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-gethostbyname2 (name af) + _N"Return entry from host data base for host with NAME. AF must be + set to the address type which as `AF_INET' for IPv4 or `AF_INET6' + for IPv6." + (let ((result (alien-funcall (extern-alien "gethostbyname2" + (function (* (struct hostent)) + c-string int)) + name af))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;; Description of data base entry for a single network. NOTE: here a +;; poor assumption is made. The network number is expected to fit +;; into an unsigned long int variable. + +(def-alien-type nil + (struct netent + (n-name c-string) ; Official name of network. + (n-aliases (* c-string)) ; Alias list. + (n-addrtype int) ; Net address type. + (n-net unsigned-long))) ; Network number. + +#+(or) +(defun unix-setnetent (stay-open) + _N"Open network data base files and mark them as staying open even + after a later search if STAY_OPEN is non-zero." + (void-syscall ("setnetent" int) stay-open)) + + +#+(or) +(defun unix-endnetent () + _N"Close network data base files and clear `stay open' flag." + (void-syscall ("endnetent"))) + + +#+(or) +(defun unix-getnetent () + _N"Get next entry from network data base file. Open data base if + necessary." + (let ((result (alien-funcall (extern-alien "getnetent" + (function (* (struct netent))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + + +#+(or) +(defun unix-getnetbyaddr (net type) + _N"Return entry from network data base which address match NET and + type TYPE." + (let ((result (alien-funcall (extern-alien "getnetbyaddr" + (function (* (struct netent)) + unsigned-long int)) + net type))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getnetbyname (name) + _N"Return entry from network data base for network with NAME." + (let ((result (alien-funcall (extern-alien "getnetbyname" + (function (* (struct netent)) + c-string)) + name))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;; Description of data base entry for a single service. +(def-alien-type nil + (struct servent + (s-name c-string) ; Official service name. + (s-aliases (* c-string)) ; Alias list. + (s-port int) ; Port number. + (s-proto c-string))) ; Protocol to use. + +#+(or) +(defun unix-setservent (stay-open) + _N"Open service data base files and mark them as staying open even + after a later search if STAY_OPEN is non-zero." + (void-syscall ("setservent" int) stay-open)) + +#+(or) +(defun unix-endservent (stay-open) + _N"Close service data base files and clear `stay open' flag." + (void-syscall ("endservent"))) + + +#+(or) +(defun unix-getservent () + _N"Get next entry from service data base file. Open data base if + necessary." + (let ((result (alien-funcall (extern-alien "getservent" + (function (* (struct servent))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getservbyname (name proto) + _N"Return entry from network data base for network with NAME and + protocol PROTO." + (let ((result (alien-funcall (extern-alien "getservbyname" + (function (* (struct netent)) + c-string (* char))) + name proto))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getservbyport (port proto) + _N"Return entry from service data base which matches port PORT and + protocol PROTO." + (let ((result (alien-funcall (extern-alien "getservbyport" + (function (* (struct netent)) + int (* char))) + port proto))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;; Description of data base entry for a single service. + +(def-alien-type nil + (struct protoent + (p-name c-string) ; Official protocol name. + (p-aliases (* c-string)) ; Alias list. + (p-proto int))) ; Protocol number. + +#+(or) +(defun unix-setprotoent (stay-open) + _N"Open protocol data base files and mark them as staying open even + after a later search if STAY_OPEN is non-zero." + (void-syscall ("setprotoent" int) stay-open)) + +#+(or) +(defun unix-endprotoent () + _N"Close protocol data base files and clear `stay open' flag." + (void-syscall ("endprotoent"))) + +#+(or) +(defun unix-getprotoent () + _N"Get next entry from protocol data base file. Open data base if + necessary." + (let ((result (alien-funcall (extern-alien "getprotoent" + (function (* (struct protoent))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getprotobyname (name) + _N"Return entry from protocol data base for network with NAME." + (let ((result (alien-funcall (extern-alien "getprotobyname" + (function (* (struct protoent)) + c-string)) + name))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getprotobynumber (proto) + _N"Return entry from protocol data base which number is PROTO." + (let ((result (alien-funcall (extern-alien "getprotobynumber" + (function (* (struct protoent)) + int)) + proto))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-setnetgrent (netgroup) + _N"Establish network group NETGROUP for enumeration." + (int-syscall ("setservent" c-string) netgroup)) + +#+(or) +(defun unix-endnetgrent () + _N"Free all space allocated by previous `setnetgrent' call." + (void-syscall ("endnetgrent"))) + +#+(or) +(defun unix-getnetgrent (hostp userp domainp) + _N"Get next member of netgroup established by last `setnetgrent' call + and return pointers to elements in HOSTP, USERP, and DOMAINP." + (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string)) + hostp userp domainp)) + +#+(or) +(defun unix-innetgr (netgroup host user domain) + _N"Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)." + (int-syscall ("innetgr" c-string c-string c-string c-string) + netgroup host user domain)) + +(def-alien-type nil + (struct addrinfo + (ai-flags int) ; Input flags. + (ai-family int) ; Protocol family for socket. + (ai-socktype int) ; Socket type. + (ai-protocol int) ; Protocol for socket. + (ai-addrlen int) ; Length of socket address. + (ai-addr (* (struct sockaddr))) + ; Socket address for socket. + (ai-cononname c-string) + ; Canonical name for service location. + (ai-net (* (struct addrinfo))))) ; Pointer to next in list. + +;; Possible values for `ai_flags' field in `addrinfo' structure. + +(defconstant ai_passive 1 _N"Socket address is intended for `bind'.") +(defconstant ai_canonname 2 _N"Request for canonical name.") + +;; Error values for `getaddrinfo' function. +(defconstant eai_badflags -1 _N"Invalid value for `ai_flags' field.") +(defconstant eai_noname -2 _N"NAME or SERVICE is unknown.") +(defconstant eai_again -3 _N"Temporary failure in name resolution.") +(defconstant eai_fail -4 _N"Non-recoverable failure in name res.") +(defconstant eai_nodata -5 _N"No address associated with NAME.") +(defconstant eai_family -6 _N"ai_family not supported.") +(defconstant eai_socktype -7 _N"ai_socktype not supported.") +(defconstant eai_service -8 _N"SERVICE not supported for ai_socktype.") +(defconstant eai_addrfamily -9 _N"Address family for NAME not supported.") +(defconstant eai_memory -10 _N"Memory allocation failure.") +(defconstant eai_system -11 _N"System error returned in errno.") + + +#+(or) +(defun unix-getaddrinfo (name service req pai) + _N"Translate name of a service location and/or a service name to set of + socket addresses." + (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo)) + (* (* struct addrinfo))) + name service req pai)) + + +#+(or) +(defun unix-freeaddrinfo (ai) + _N"Free `addrinfo' structure AI including associated storage." + (void-syscall ("freeaddrinfo" (* struct addrinfo)) + ai)) + + +#+(or) +(defun unix-forkpty (amaster name termp winp) + _N"Create child process and establish the slave pseudo terminal as the + child's controlling terminal." + (int-syscall ("forkpty" (* int) c-string (* (struct termios)) + (* (struct winsize))) + amaster name termp winp)) + + +;; POSIX Standard: 9.2.2 User Database Access <pwd.h> + +#+(or) +(defun unix-setpwent () + _N"Rewind the password-file stream." + (void-syscall ("setpwent"))) + +#+(or) +(defun unix-endpwent () + _N"Close the password-file stream." + (void-syscall ("endpwent"))) + +#+(or) +(defun unix-getpwent () + _N"Read an entry from the password-file stream, opening it if necessary." + (let ((result (alien-funcall (extern-alien "getpwent" + (function (* (struct passwd))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;;; resourcebits.h + +(def-alien-type nil + (struct rlimit + (rlim-cur long) ; current (soft) limit + (rlim-max long))); maximum value for rlim-cur + +;; Priority limits. + +(defconstant prio-min -20 _N"Minimum priority a process can have") +(defconstant prio-max 20 _N"Maximum priority a process can have") + + +;;; The type of the WHICH argument to `getpriority' and `setpriority', +;;; indicating what flavor of entity the WHO argument specifies. + +(defconstant priority-process 0 _N"WHO is a process ID") +(defconstant priority-pgrp 1 _N"WHO is a process group ID") +(defconstant priority-user 2 _N"WHO is a user ID") + +;;; sched.h + +#+(or) +(defun unix-sched_setparam (pid param) + _N"Rewind the password-file stream." + (int-syscall ("sched_setparam" pid-t (struct psched-param)) + pid param)) + +#+(or) +(defun unix-sched_getparam (pid param) + _N"Rewind the password-file stream." + (int-syscall ("sched_getparam" pid-t (struct psched-param)) + pid param)) + + +#+(or) +(defun unix-sched_setscheduler (pid policy param) + _N"Set scheduling algorithm and/or parameters for a process." + (int-syscall ("sched_setscheduler" pid-t int (struct psched-param)) + pid policy param)) + +#+(or) +(defun unix-sched_getscheduler (pid) + _N"Retrieve scheduling algorithm for a particular purpose." + (int-syscall ("sched_getscheduler" pid-t) + pid)) + +(defun unix-sched-yield () + _N"Retrieve scheduling algorithm for a particular purpose." + (int-syscall ("sched_yield"))) + +#+(or) +(defun unix-sched_get_priority_max (algorithm) + _N"Get maximum priority value for a scheduler." + (int-syscall ("sched_get_priority_max" int) + algorithm)) + +#+(or) +(defun unix-sched_get_priority_min (algorithm) + _N"Get minimum priority value for a scheduler." + (int-syscall ("sched_get_priority_min" int) + algorithm)) + + + +#+(or) +(defun unix-sched_rr_get_interval (pid t) + _N"Get the SCHED_RR interval for the named process." + (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec))) + pid t)) + +;;; schedbits.h + +(defconstant scheduler-other 0) +(defconstant scheduler-fifo 1) +(defconstant scheduler-rr 2) + + +;; Data structure to describe a process' schedulability. + +(def-alien-type nil + (struct sched_param + (sched-priority int))) + +;; Cloning flags. +(defconstant csignal #x000000ff _N"Signal mask to be sent at exit.") +(defconstant clone_vm #x00000100 _N"Set if VM shared between processes.") +(defconstant clone_fs #x00000200 _N"Set if fs info shared between processes") +(defconstant clone_files #x00000400 _N"Set if open files shared between processe") +(defconstant clone_sighand #x00000800 _N"Set if signal handlers shared.") +(defconstant clone_pid #x00001000 _N"Set if pid shared.") + + +;;; shadow.h + +;; Structure of the password file. + +(def-alien-type nil + (struct spwd + (sp-namp c-string) ; Login name. + (sp-pwdp c-string) ; Encrypted password. + (sp-lstchg long) ; Date of last change. + (sp-min long) ; Minimum number of days between changes. + (sp-max long) ; Maximum number of days between changes. + (sp-warn long) ; Number of days to warn user to change the password. + (sp-inact long) ; Number of days the account may be inactive. + (sp-expire long) ; Number of days since 1970-01-01 until account expires. + (sp-flags long))) ; Reserved. + +#+(or) +(defun unix-setspent () + _N"Open database for reading." + (void-syscall ("setspent"))) + +#+(or) +(defun unix-endspent () + _N"Close database." + (void-syscall ("endspent"))) + +#+(or) +(defun unix-getspent () + _N"Get next entry from database, perhaps after opening the file." + (let ((result (alien-funcall (extern-alien "getspent" + (function (* (struct spwd))))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-getspnam (name) + _N"Get shadow entry matching NAME." + (let ((result (alien-funcall (extern-alien "getspnam" + (function (* (struct spwd)) + c-string)) + name))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+(or) +(defun unix-sgetspent (string) + _N"Read shadow entry from STRING." + (let ((result (alien-funcall (extern-alien "sgetspent" + (function (* (struct spwd)) + c-string)) + string))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;; + +#+(or) +(defun unix-lckpwdf () + _N"Protect password file against multi writers." + (void-syscall ("lckpwdf"))) + + +#+(or) +(defun unix-ulckpwdf () + _N"Unlock password file." + (void-syscall ("ulckpwdf"))) + +;; Protection bits. + +(defconstant s-isuid #o0004000 _N"Set user ID on execution.") +(defconstant s-isgid #o0002000 _N"Set group ID on execution.") +(defconstant s-isvtx #o0001000 _N"Save swapped text after use (sticky).") +(defconstant s-iread #o0000400 _N"Read by owner") +(defconstant s-iwrite #o0000200 _N"Write by owner.") +(defconstant s-iexec #o0000100 _N"Execute by owner.") + +;;; statfsbuf.h + +(def-alien-type nil + (struct statfs + (f-type int) + (f-bsize int) + (f-blocks fsblkcnt-t) + (f-bfree fsblkcnt-t) + (f-bavail fsblkcnt-t) + (f-files fsfilcnt-t) + (f-ffree fsfilcnt-t) + (f-fsid fsid-t) + (f-namelen int) + (f-spare (array int 6)))) + + +;;; termbits.h + + + +(def-enum + 0 tciflush tcoflush tcioflush) + +(defconstant tty-nl0 0) +(defconstant tty-nl1 #o400) + +(defconstant tty-crdly #o0003000) +(defconstant tty-cr0 #o0000000) +(defconstant tty-cr1 #o0001000) +(defconstant tty-cr2 #o0002000) +(defconstant tty-cr3 #o0003000) +(defconstant tty-tabdly #o0014000) +(defconstant tty-tab0 #o0000000) +(defconstant tty-tab1 #o0004000) +(defconstant tty-tab2 #o0010000) +(defconstant tty-tab3 #o0014000) +(defconstant tty-xtabs #o0014000) +(defconstant tty-bsdly #o0020000) +(defconstant tty-bs0 #o0000000) +(defconstant tty-bs1 #o0020000) +(defconstant tty-vtdly #o0040000) +(defconstant tty-vt0 #o0000000) +(defconstant tty-vt1 #o0040000) +(defconstant tty-ffdly #o0100000) +(defconstant tty-ff0 #o0000000) +(defconstant tty-ff1 #o0100000) + +;; c-cflag bit meaning +(defconstant tty-cbaud #o0010017) +(defconstant tty-b0 #o0000000) ;; hang up +(defconstant tty-b50 #o0000001) +(defconstant tty-b75 #o0000002) +(defconstant tty-b110 #o0000003) +(defconstant tty-b134 #o0000004) +(defconstant tty-b150 #o0000005) +(defconstant tty-b200 #o0000006) +(defconstant tty-b300 #o0000007) +(defconstant tty-b600 #o0000010) +(defconstant tty-b1200 #o0000011) +(defconstant tty-b1800 #o0000012) +(defconstant tty-b2400 #o0000013) +(defconstant tty-b4800 #o0000014) +(defconstant tty-b9600 #o0000015) +(defconstant tty-b19200 #o0000016) +(defconstant tty-b38400 #o0000017) +(defconstant tty-exta tty-b19200) +(defconstant tty-extb tty-b38400) +(defconstant tty-csize #o0000060) +(defconstant tty-cs5 #o0000000) +(defconstant tty-cs6 #o0000020) +(defconstant tty-cs7 #o0000040) +(defconstant tty-cs8 #o0000060) +(defconstant tty-cstopb #o0000100) +(defconstant tty-cread #o0000200) +(defconstant tty-parenb #o0000400) +(defconstant tty-parodd #o0001000) +(defconstant tty-hupcl #o0002000) +(defconstant tty-clocal #o0004000) +(defconstant tty-cbaudex #o0010000) +(defconstant tty-b57600 #o0010001) +(defconstant tty-b115200 #o0010002) +(defconstant tty-b230400 #o0010003) +(defconstant tty-b460800 #o0010004) +(defconstant tty-cibaud #o002003600000) ; input baud rate (not used) +(defconstant tty-crtscts #o020000000000) ;flow control + +;;; tcflow() and TCXONC use these +(def-enum + 0 tty-tcooff tty-tcoon tty-tcioff tty-tcion) + +;; tcflush() and TCFLSH use these */ +(def-enum + 0 tty-tciflush tty-tcoflush tty-tcioflush) + +;; tcsetattr uses these +(def-enum + 0 tty-tcsanow tty-tcsadrain tty-tcsaflush) + +;;; termios.h + +(defun unix-cfsetospeed (termios speed) + _N"Set terminal output speed." + (let ((baud (or (position speed terminal-speeds) + (error _"Bogus baud rate ~S" speed)))) + (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud))) + +(defun unix-cfgetispeed (termios) + _N"Get terminal input speed." + (multiple-value-bind (speed errno) + (int-syscall ("cfgetispeed" (* (struct termios))) termios) + (if speed + (values (svref terminal-speeds speed) 0) + (values speed errno)))) + +(defun unix-cfsetispeed (termios speed) + _N"Set terminal input speed." + (let ((baud (or (position speed terminal-speeds) + (error _"Bogus baud rate ~S" speed)))) + (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud))) + +(defun unix-tcsendbreak (fd duration) + _N"Send break" + (declare (type unix-fd fd)) + (void-syscall ("tcsendbreak" int int) fd duration)) + +(defun unix-tcdrain (fd) + _N"Wait for output for finish" + (declare (type unix-fd fd)) + (void-syscall ("tcdrain" int) fd)) + +(defun unix-tcflush (fd selector) + _N"See tcflush(3)" + (declare (type unix-fd fd)) + (void-syscall ("tcflush" int int) fd selector)) + +(defun unix-tcflow (fd action) + _N"Flow control" + (declare (type unix-fd fd)) + (void-syscall ("tcflow" int int) fd action)) + +;;; timebits.h + +;;; unistd.h + +(defun sub-unix-execve (program arg-list env-list) + (let ((argv nil) + (argv-bytes 0) + (envp nil) + (envp-bytes 0) + result error-code) + (unwind-protect + (progn + ;; Blast the stuff into the proper format + (multiple-value-setq + (argv argv-bytes) + (string-list-to-c-strvec arg-list)) + (multiple-value-setq + (envp envp-bytes) + (string-list-to-c-strvec env-list)) + ;; + ;; Now do the system call + (multiple-value-setq + (result error-code) + (int-syscall ("execve" + c-string system-area-pointer system-area-pointer) + program argv envp))) + ;; + ;; Deallocate memory + (when argv + (system:deallocate-system-memory argv argv-bytes)) + (when envp + (system:deallocate-system-memory envp envp-bytes))) + (values result error-code))) + +;;;; UNIX-EXECVE + +(defun unix-execve (program &optional arg-list + (environment *environment-list*)) + _N"Executes the Unix execve system call. If the system call suceeds, lisp + will no longer be running in this process. If the system call fails this + function returns two values: NIL and an error code. Arg-list should be a + list of simple-strings which are passed as arguments to the exec'ed program. + Environment should be an a-list mapping symbols to simple-strings which this + function bashes together to form the environment for the exec'ed program." + (check-type program simple-string) + (let ((env-list (let ((envlist nil)) + (dolist (cons environment) + (push (if (cdr cons) + (concatenate 'simple-string + (string (car cons)) "=" + (cdr cons)) + (car cons)) + envlist)) + envlist))) + (sub-unix-execve (%name->file program) arg-list env-list))) + + +(defmacro round-bytes-to-words (n) + `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3))) + +(defun unix-chown (path uid gid) + _N"Given a file path, an integer user-id, and an integer group-id, + unix-chown changes the owner of the file and the group of the + file to those specified. Either the owner or the group may be + left unchanged by specifying them as -1. Note: Permission will + fail if the caller is not the superuser." + (declare (type unix-pathname path) + (type (or unix-uid (integer -1 -1)) uid) + (type (or unix-gid (integer -1 -1)) gid)) + (void-syscall ("chown" c-string int int) (%name->file path) uid gid)) + +;;; Unix-fchown is exactly the same as unix-chown except that the file +;;; is specified by a file-descriptor ("fd") instead of a pathname. + +(defun unix-fchown (fd uid gid) + _N"Unix-fchown is like unix-chown, except that it accepts an integer + file descriptor instead of a file path name." + (declare (type unix-fd fd) + (type (or unix-uid (integer -1 -1)) uid) + (type (or unix-gid (integer -1 -1)) gid)) + (void-syscall ("fchown" int int int) fd uid gid)) + +#+(or) +(defun unix-pathconf (path name) + _N"Get file-specific configuration information about PATH." + (int-syscall ("pathconf" c-string int) (%name->file path) name)) + +#+(or) +(defun unix-sysconf (name) + _N"Get the value of the system variable NAME." + (int-syscall ("sysconf" int) name)) + +#+(or) +(defun unix-confstr (name) + _N"Get the value of the string-valued system variable NAME." + (with-alien ((buf (array char 1024))) + (values (not (zerop (alien-funcall (extern-alien "confstr" + (function int + c-string + size-t)) + name buf 1024))) + (cast buf c-string)))) + + +(def-alien-routine ("getppid" unix-getppid) int + _N"Unix-getppid returns the process-id of the parent of the current process.") + +;;; Unix-getpgrp returns the group-id associated with the +;;; current process. + +(defun unix-getpgrp () + _N"Unix-getpgrp returns the group-id of the calling process." + (int-syscall ("getpgrp"))) + +;;; Unix-setpgid sets the group-id of the process specified by +;;; "pid" to the value of "pgrp". The process must either have +;;; the same effective user-id or be a super-user process. + +;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained +;;; for backward compatibility. setpgrp(void)[solaris] is being phased +;;; out in favor of setsid(). + +(defun unix-setpgrp (pid pgrp) + _N"Unix-setpgrp sets the process group on the process pid to + pgrp. NIL and an error number are returned upon failure." + (void-syscall ("setpgid" int int) pid pgrp)) + +(defun unix-setpgid (pid pgrp) + _N"Unix-setpgid sets the process group of the process pid to + pgrp. If pgid is equal to pid, the process becomes a process + group leader. NIL and an error number are returned upon failure." + (void-syscall ("setpgid" int int) pid pgrp)) + +#+(or) +(defun unix-setsid () + _N"Create a new session with the calling process as its leader. + The process group IDs of the session and the calling process + are set to the process ID of the calling process, which is returned." + (void-syscall ( "setsid"))) + +#+(or) +(defun unix-getsid () + _N"Return the session ID of the given process." + (int-syscall ( "getsid"))) + +#+(or) +(def-alien-routine ("geteuid" unix-getuid) int + _N"Get the effective user ID of the calling process.") + +(def-alien-routine ("getgid" unix-getgid) int + _N"Unix-getgid returns the real group-id of the current process.") + +(def-alien-routine ("getegid" unix-getegid) int + _N"Unix-getegid returns the effective group-id of the current process.") + +;/* If SIZE is zero, return the number of supplementary groups +; the calling process is in. Otherwise, fill in the group IDs +; of its supplementary groups in LIST and return the number written. */ +;extern int getgroups __P ((int __size, __gid_t __list[])); + +#+(or) +(defun unix-group-member (gid) + _N"Return nonzero iff the calling process is in group GID." + (int-syscall ( "group-member" gid-t) gid)) + + +(defun unix-setuid (uid) + _N"Set the user ID of the calling process to UID. + If the calling process is the super-user, set the real + and effective user IDs, and the saved set-user-ID to UID; + if not, the effective user ID is set to UID." + (int-syscall ("setuid" uid-t) uid)) + +;;; Unix-setreuid sets the real and effective user-id's of the current +;;; process to the arguments "ruid" and "euid", respectively. Usage is +;;; restricted for anyone but the super-user. Setting either "ruid" or +;;; "euid" to -1 makes the system use the current id instead. + +(defun unix-setreuid (ruid euid) + _N"Unix-setreuid sets the real and effective user-id's of the current + process to the specified ones. NIL and an error number is returned + if the call fails." + (void-syscall ("setreuid" int int) ruid euid)) + +(defun unix-setgid (gid) + _N"Set the group ID of the calling process to GID. + If the calling process is the super-user, set the real + and effective group IDs, and the saved set-group-ID to GID; + if not, the effective group ID is set to GID." + (int-syscall ("setgid" gid-t) gid)) + + +;;; Unix-setregid sets the real and effective group-id's of the current +;;; process to the arguments "rgid" and "egid", respectively. Usage is +;;; restricted for anyone but the super-user. Setting either "rgid" or +;;; "egid" to -1 makes the system use the current id instead. + +(defun unix-setregid (rgid egid) + _N"Unix-setregid sets the real and effective group-id's of the current + process process to the specified ones. NIL and an error number is + returned if the call fails." + (void-syscall ("setregid" int int) rgid egid)) + +(defun unix-fork () + _N"Executes the unix fork system call. Returns 0 in the child and the pid + of the child in the parent if it works, or NIL and an error number if it + doesn't work." + (int-syscall ("fork"))) + +;; Environment maninpulation; man getenv(3) +(def-alien-routine ("getenv" unix-getenv) c-call:c-string + (name c-call:c-string) + _N"Get the value of the environment variable named Name. If no such + variable exists, Nil is returned.") + +(def-alien-routine ("setenv" unix-setenv) c-call:int + (name c-call:c-string) + (value c-call:c-string) + (overwrite c-call:int) + _N"Adds the environment variable named Name to the environment with + the given Value if Name does not already exist. If Name does exist, + the value is changed to Value if Overwrite is non-zero. Otherwise, + the value is not changed.") + +(def-alien-routine ("putenv" unix-putenv) c-call:int + (name c-call:c-string) + _N"Adds or changes the environment. Name-value must be a string of + the form \"name=value\". If the name does not exist, it is added. + If name does exist, the value is updated to the given value.") + +(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int + (name c-call:c-string) + _N"Removes the variable Name from the environment") + +;;; Unix-link creates a hard link from name2 to name1. + +(defun unix-link (name1 name2) + _N"Unix-link creates a hard link from the file with name1 to the + file with name2." + (declare (type unix-pathname name1 name2)) + (void-syscall ("link" c-string c-string) + (%name->file name1) (%name->file name2))) + +(defun tcgetpgrp (fd) + _N"Get the tty-process-group for the unix file-descriptor FD." + (alien:with-alien ((alien-pgrp c-call:int)) + (multiple-value-bind (ok err) + (unix-ioctl fd + tiocgpgrp + (alien:alien-sap (alien:addr alien-pgrp))) + (if ok + (values alien-pgrp nil) + (values nil err))))) + +(defun tty-process-group (&optional fd) + _N"Get the tty-process-group for the unix file-descriptor FD. If not supplied, + FD defaults to /dev/tty." + (if fd + (tcgetpgrp fd) + (multiple-value-bind (tty-fd errno) + (unix-open "/dev/tty" o_rdwr 0) + (cond (tty-fd + (multiple-value-prog1 + (tcgetpgrp tty-fd) + (unix-close tty-fd))) + (t + (values nil errno)))))) + +(defun tcsetpgrp (fd pgrp) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP." + (alien:with-alien ((alien-pgrp c-call:int pgrp)) + (unix-ioctl fd + tiocspgrp + (alien:alien-sap (alien:addr alien-pgrp))))) + +(defun %set-tty-process-group (pgrp &optional fd) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not + supplied, FD defaults to /dev/tty." + (let ((old-sigs + (unix-sigblock + (sigmask :sigttou :sigttin :sigtstp :sigchld)))) + (declare (type (unsigned-byte 32) old-sigs)) + (unwind-protect + (if fd + (tcsetpgrp fd pgrp) + (multiple-value-bind (tty-fd errno) + (unix-open "/dev/tty" o_rdwr 0) + (cond (tty-fd + (multiple-value-prog1 + (tcsetpgrp tty-fd pgrp) + (unix-close tty-fd))) + (t + (values nil errno))))) + (unix-sigsetmask old-sigs)))) + +(defsetf tty-process-group (&optional fd) (pgrp) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not + supplied, FD defaults to /dev/tty." + `(%set-tty-process-group ,pgrp ,fd)) + +#+(or) +(defun unix-getlogin () + _N"Return the login name of the user." + (let ((result (alien-funcall (extern-alien "getlogin" + (function c-string))))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + + +#+(or) +(defun unix-sethostname (name len) + (int-syscall ("sethostname" c-string size-t) name len)) + +#+(or) +(defun unix-sethostid (id) + (int-syscall ("sethostid" long) id)) + +#+(or) +(defun unix-getdomainname (name len) + (int-syscall ("getdomainname" c-string size-t) name len)) + +#+(or) +(defun unix-setdomainname (name len) + (int-syscall ("setdomainname" c-string size-t) name len)) + +;;; Unix-fsync writes the core-image of the file described by "fd" to +;;; permanent storage (i.e. disk). + +(defun unix-fsync (fd) + _N"Unix-fsync writes the core image of the file described by + fd to disk." + (declare (type unix-fd fd)) + (void-syscall ("fsync" int) fd)) + + +#+(or) +(defun unix-vhangup () + _N"Revoke access permissions to all processes currently communicating + with the control terminal, and then send a SIGHUP signal to the process + group of the control terminal." + (int-syscall ("vhangup"))) + +#+(or) +(defun unix-revoke (file) + _N"Revoke the access of all descriptors currently open on FILE." + (int-syscall ("revoke" c-string) (%name->file file))) + + +#+(or) +(defun unix-chroot (path) + _N"Make PATH be the root directory (the starting point for absolute paths). + This call is restricted to the super-user." + (int-syscall ("chroot" c-string) (%name->file path))) + +;;; Unix-sync writes all information in core memory which has been modified +;;; to permanent storage (i.e. disk). + +(defun unix-sync () + _N"Unix-sync writes all information in core memory which has been + modified to disk. It returns NIL and an error code if an error + occured." + (void-syscall ("sync"))) + +;;; Unix-truncate accepts a file name and a new length. The file is +;;; truncated to the new length. + +(defun unix-truncate (name length) + _N"Unix-truncate truncates the named file to the length (in + bytes) specified by LENGTH. NIL and an error number is returned + if the call is unsuccessful." + (declare (type unix-pathname name) + (type (unsigned-byte 64) length)) + (void-syscall ("truncate64" c-string off-t) (%name->file name) length)) + +(defun unix-ftruncate (fd length) + _N"Unix-ftruncate is similar to unix-truncate except that the first + argument is a file descriptor rather than a file name." + (declare (type unix-fd fd) + (type (unsigned-byte 64) length)) + (void-syscall ("ftruncate64" int off-t) fd length)) + +#+(or) +(defun unix-getdtablesize () + _N"Return the maximum number of file descriptors + the current process could possibly have." + (int-syscall ("getdtablesize"))) + +(defconstant f_ulock 0 _N"Unlock a locked region") +(defconstant f_lock 1 _N"Lock a region for exclusive use") +(defconstant f_tlock 2 _N"Test and lock a region for exclusive use") +(defconstant f_test 3 _N"Test a region for othwer processes locks") + +(defun unix-lockf (fd cmd length) + _N"Unix-locks can lock, unlock and test files according to the cmd + which can be one of the following: + + f_ulock Unlock a locked region + f_lock Lock a region for exclusive use + f_tlock Test and lock a region for exclusive use + f_test Test a region for othwer processes locks + + The lock is for a region from the current location for a length + of length. + + This is a simpler version of the interface provided by unix-fcntl. + " + (declare (type unix-fd fd) + (type (unsigned-byte 64) length) + (type (integer 0 3) cmd)) + (int-syscall ("lockf64" int int off-t) fd cmd length)) + +;;; utime.h + +;; Structure describing file times. + +(def-alien-type nil + (struct utimbuf + (actime time-t) ; Access time. + (modtime time-t))) ; Modification time. + +;;; waitflags.h + +;; Bits in the third argument to `waitpid'. + +(defconstant waitpid-wnohang 1 _N"Don't block waiting.") +(defconstant waitpid-wuntranced 2 _N"Report status of stopped children.") + +(defconstant waitpid-wclone #x80000000 _N"Wait for cloned process.") + + +;;; sys/fsuid.h + +#+(or) +(defun unix-setfsuid (uid) + _N"Change uid used for file access control to UID, without affecting + other priveledges (such as who can send signals at the process)." + (int-syscall ("setfsuid" uid-t) uid)) + +#+(or) +(defun unix-setfsgid (gid) + _N"Change gid used for file access control to GID, without affecting + other priveledges (such as who can send signals at the process)." + (int-syscall ("setfsgid" gid-t) gid)) + +;;; sys/poll.h + +;; Data structure describing a polling request. + +(def-alien-type nil + (struct pollfd + (fd int) ; File descriptor to poll. + (events short) ; Types of events poller cares about. + (revents short))) ; Types of events that actually occurred. + +;; Event types that can be polled for. These bits may be set in `events' +;; to indicate the interesting event types; they will appear in `revents' +;; to indicate the status of the file descriptor. + +(defconstant POLLIN #o1 _N"There is data to read.") +(defconstant POLLPRI #o2 _N"There is urgent data to read.") +(defconstant POLLOUT #o4 _N"Writing now will not block.") + +;; Event types always implicitly polled for. These bits need not be set in +;;`events', but they will appear in `revents' to indicate the status of +;; the file descriptor. */ + + +(defconstant POLLERR #o10 _N"Error condition.") +(defconstant POLLHUP #o20 _N"Hung up.") +(defconstant POLLNVAL #o40 _N"Invalid polling request.") + + +(defconstant +npollfile+ 30 _N"Canonical number of polling requests to read +in at a time in poll.") + +#+(or) +(defun unix-poll (fds nfds timeout) + _N" Poll the file descriptors described by the NFDS structures starting at + FDS. If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for + an event to occur; if TIMEOUT is -1, block until an event occurs. + Returns the number of file descriptors with events, zero if timed out, + or -1 for errors." + (int-syscall ("poll" (* (struct pollfd)) long int) + fds nfds timeout)) + +;;; sys/resource.h + +(defun unix-getrlimit (resource) + _N"Get the soft and hard limits for RESOURCE." + (with-alien ((rlimits (struct rlimit))) + (syscall ("getrlimit" int (* (struct rlimit))) + (values t + (slot rlimits 'rlim-cur) + (slot rlimits 'rlim-max)) + resource (addr rlimits)))) + +(defun unix-setrlimit (resource current maximum) + _N"Set the current soft and hard maximum limits for RESOURCE. + Only the super-user can increase hard limits." + (with-alien ((rlimits (struct rlimit))) + (setf (slot rlimits 'rlim-cur) current) + (setf (slot rlimits 'rlim-max) maximum) + (void-syscall ("setrlimit" int (* (struct rlimit))) + resource (addr rlimits)))) + + +#+(or) +(defun unix-ulimit (cmd newlimit) + _N"Function depends on CMD: + 1 = Return the limit on the size of a file, in units of 512 bytes. + 2 = Set the limit on the size of a file to NEWLIMIT. Only the + super-user can increase the limit. + 3 = Return the maximum possible address of the data segment. + 4 = Return the maximum number of files that the calling process can open. + Returns -1 on errors." + (int-syscall ("ulimit" int long) cmd newlimit)) + +#+(or) +(defun unix-getpriority (which who) + _N"Return the highest priority of any process specified by WHICH and WHO + (see above); if WHO is zero, the current process, process group, or user + (as specified by WHO) is used. A lower priority number means higher + priority. Priorities range from PRIO_MIN to PRIO_MAX (above)." + (int-syscall ("getpriority" int int) + which who)) + +#+(or) +(defun unix-setpriority (which who) + _N"Set the priority of all processes specified by WHICH and WHO (see above) + to PRIO. Returns 0 on success, -1 on errors." + (int-syscall ("setpriority" int int) + which who)) + + +(defun unix-umask (mask) + _N"Set the file creation mask of the current process to MASK, + and return the old creation mask." + (int-syscall ("umask" mode-t) mask)) + +#+(or) +(defun unix-makedev (path mode dev) + _N"Create a device file named PATH, with permission and special bits MODE + and device number DEV (which can be constructed from major and minor + device numbers with the `makedev' macro above)." + (declare (type unix-pathname path) + (type unix-file-mode mode)) + (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev)) + + +#+(or) +(defun unix-fifo (name mode) + _N"Create a new FIFO named PATH, with permission bits MODE." + (declare (type unix-pathname name) + (type unix-file-mode mode)) + (void-syscall ("mkfifo" c-string int) (%name->file name) mode)) + +;;; sys/statfs.h + +#+(or) +(defun unix-statfs (file buf) + _N"Return information about the filesystem on which FILE resides." + (int-syscall ("statfs64" c-string (* (struct statfs))) + (%name->file file) buf)) + +;;; sys/swap.h + +#+(or) +(defun unix-swapon (path flags) + _N"Make the block special device PATH available to the system for swapping. + This call is restricted to the super-user." + (int-syscall ("swapon" c-string int) (%name->file path) flags)) + +#+(or) +(defun unix-swapoff (path) + _N"Make the block special device PATH unavailable to the system for swapping. + This call is restricted to the super-user." + (int-syscall ("swapoff" c-string) (%name->file path))) + +;;; sys/sysctl.h + +#+(or) +(defun unix-sysctl (name nlen oldval oldlenp newval newlen) + _N"Read or write system parameters." + (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t) + name nlen oldval oldlenp newval newlen)) + +;;; time.h + +;; POSIX.4 structure for a time value. This is like a `struct timeval' but +;; has nanoseconds instead of microseconds. + +(def-alien-type nil + (struct timespec + (tv-sec long) ;Seconds + (tv-nsec long))) ;Nanoseconds + +;; Used by other time functions. + +(def-alien-type nil + (struct tm + (tm-sec int) ; Seconds. [0-60] (1 leap second) + (tm-min int) ; Minutes. [0-59] + (tm-hour int) ; Hours. [0-23] + (tm-mday int) ; Day. [1-31] + (tm-mon int) ; Month. [0-11] + (tm-year int) ; Year - 1900. + (tm-wday int) ; Day of week. [0-6] + (tm-yday int) ; Days in year.[0-365] + (tm-isdst int) ; DST. [-1/0/1] + (tm-gmtoff long) ; Seconds east of UTC. + (tm-zone c-string))) ; Timezone abbreviation. + +#+(or) +(defun unix-clock () + _N"Time used by the program so far (user time + system time). + The result / CLOCKS_PER_SECOND is program time in seconds." + (int-syscall ("clock"))) + +#+(or) +(defun unix-time (timer) + _N"Return the current time and put it in *TIMER if TIMER is not NULL." + (int-syscall ("time" time-t) timer)) + +;; Requires call to tzset() in main. + +(def-alien-variable ("daylight" unix-daylight) int) +(def-alien-variable ("timezone" unix-timezone) time-t) +;(def-alien-variable ("altzone" unix-altzone) time-t) doesn't exist +(def-alien-variable ("tzname" unix-tzname) (array c-string 2)) + +(def-alien-routine get-timezone c-call:void + (when c-call:long :in) + (minutes-west c-call:int :out) + (daylight-savings-p alien:boolean :out)) + +(defun unix-get-minutes-west (secs) + (multiple-value-bind (ignore minutes dst) (get-timezone secs) + (declare (ignore ignore) (ignore dst)) + (values minutes))) + +(defun unix-get-timezone (secs) + (multiple-value-bind (ignore minutes dst) (get-timezone secs) + (declare (ignore ignore) (ignore minutes)) + (values (deref unix-tzname (if dst 1 0))))) + +;/* Set the current time of day and timezone information. +; This call is restricted to the super-user. */ +;extern int __settimeofday __P ((__const struct timeval *__tv, +; __const struct timezone *__tz)); +;extern int settimeofday __P ((__const struct timeval *__tv, +; __const struct timezone *__tz)); + +;/* Adjust the current time of day by the amount in DELTA. +; If OLDDELTA is not NULL, it is filled in with the amount +; of time adjustment remaining to be done from the last `adjtime' call. +; This call is restricted to the super-user. */ +;extern int __adjtime __P ((__const struct timeval *__delta, +; struct timeval *__olddelta)); +;extern int adjtime __P ((__const struct timeval *__delta, +; struct timeval *__olddelta)); + + +;;; sys/timeb.h + +;; Structure returned by the `ftime' function. + +(def-alien-type nil + (struct timeb + (time time-t) ; Seconds since epoch, as from `time'. + (millitm short) ; Additional milliseconds. + (timezone int) ; Minutes west of GMT. + (dstflag short))) ; Nonzero if Daylight Savings Time used. + +#+(or) +(defun unix-fstime (timebuf) + _N"Fill in TIMEBUF with information about the current time." + (int-syscall ("ftime" (* (struct timeb))) timebuf)) + + +;;; sys/times.h + +;; Structure describing CPU time used by a process and its children. + +(def-alien-type nil + (struct tms + (tms-utime clock-t) ; User CPU time. + (tms-stime clock-t) ; System CPU time. + (tms-cutime clock-t) ; User CPU time of dead children. + (tms-cstime clock-t))) ; System CPU time of dead children. + +#+(or) +(defun unix-times (buffer) + _N"Store the CPU time used by this process and all its + dead children (and their dead children) in BUFFER. + Return the elapsed real time, or (clock_t) -1 for errors. + All times are in CLK_TCKths of a second." + (int-syscall ("times" (* (struct tms))) buffer)) + +;;; sys/wait.h + +#+(or) +(defun unix-wait (status) + _N"Wait for a child to die. When one does, put its status in *STAT_LOC + and return its process ID. For errors, return (pid_t) -1." + (int-syscall ("wait" (* int)) status)) + +#+(or) +(defun unix-waitpid (pid status options) + _N"Wait for a child matching PID to die. + If PID is greater than 0, match any process whose process ID is PID. + If PID is (pid_t) -1, match any process. + If PID is (pid_t) 0, match any process with the + same process group as the current process. + If PID is less than -1, match any process whose + process group is the absolute value of PID. + If the WNOHANG bit is set in OPTIONS, and that child + is not already dead, return (pid_t) 0. If successful, + return PID and store the dead child's status in STAT_LOC. + Return (pid_t) -1 for errors. If the WUNTRACED bit is + set in OPTIONS, return status for stopped children; otherwise don't." + (int-syscall ("waitpit" pid-t (* int) int) + pid status options)) + +;;; the ioctl's. +;;; +;;; I've deleted all the stuff that wasn't in the header files. +;;; This is what survived. + + +;;; asm/sockios.h + +;;; Socket options. + +(define-ioctl-command SIOCSPGRP #x89 #x02) + +(defun siocspgrp (fd pgrp) + _N"Set the socket process-group for the unix file-descriptor FD to PGRP." + (alien:with-alien ((alien-pgrp c-call:int pgrp)) + (unix-ioctl fd + siocspgrp + (alien:alien-sap (alien:addr alien-pgrp))))) + +;;; A few random constants and functions + +(defconstant setuidexec #o4000 _N"Set user ID on execution") +(defconstant setgidexec #o2000 _N"Set group ID on execution") +(defconstant savetext #o1000 _N"Save text image after execution") +(defconstant readown #o400 _N"Read by owner") +(defconstant execown #o100 _N"Execute (search directory) by owner") +(defconstant readgrp #o40 _N"Read by group") +(defconstant writegrp #o20 _N"Write by group") +(defconstant execgrp #o10 _N"Execute (search directory) by group") +(defconstant readoth #o4 _N"Read by others") +(defconstant writeoth #o2 _N"Write by others") +(defconstant execoth #o1 _N"Execute (search directory) by others") + +;;;; Support routines for dealing with unix pathnames. + +(export '(unix-file-kind unix-maybe-prepend-current-directory + unix-resolve-links unix-simplify-pathname)) + +;;; +;;; STRING-LIST-TO-C-STRVEC -- Internal +;;; +;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of +;;; simple-strings and constructs a C-style string vector (strvec) -- +;;; a null-terminated array of pointers to null-terminated strings. +;;; This function returns two values: a sap and a byte count. When the +;;; memory is no longer needed it should be deallocated with +;;; vm_deallocate. +;;; +(defun string-list-to-c-strvec (string-list) + ;; + ;; Make a pass over string-list to calculate the amount of memory + ;; needed to hold the strvec. + (let ((string-bytes 0) + (vec-bytes (* 4 (1+ (length string-list))))) + (declare (fixnum string-bytes vec-bytes)) + (dolist (s string-list) + (check-type s simple-string) + (incf string-bytes (round-bytes-to-words (1+ (length s))))) + ;; + ;; Now allocate the memory and fill it in. + (let* ((total-bytes (+ string-bytes vec-bytes)) + (vec-sap (system:allocate-system-memory total-bytes)) + (string-sap (sap+ vec-sap vec-bytes)) + (i 0)) + (declare (type (and unsigned-byte fixnum) total-bytes i) + (type system:system-area-pointer vec-sap string-sap)) + (dolist (s string-list) + (declare (simple-string s)) + (let ((n (length s))) + ;; + ;; Blast the string into place + #-unicode + (kernel:copy-to-system-area (the simple-string s) + (* vm:vector-data-offset vm:word-bits) + string-sap 0 + (* (1+ n) vm:byte-bits)) + #+unicode + (progn + ;; FIXME: Do we need to apply some kind of transformation + ;; to convert Lisp unicode strings to C strings? Utf-8? + (dotimes (k n) + (setf (sap-ref-8 string-sap k) + (logand #xff (char-code (aref s k))))) + (setf (sap-ref-8 string-sap n) 0)) + ;; + ;; Blast the pointer to the string into place + (setf (sap-ref-sap vec-sap i) string-sap) + (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n)))) + (incf i 4))) + ;; Blast in last null pointer + (setf (sap-ref-sap vec-sap i) (int-sap 0)) + (values vec-sap total-bytes)))) + +;;; Stuff not yet found in the header files... +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Abandon all hope who enters here... + + +;;;; User and group database access, POSIX Standard 9.2.2 + +(defun unix-getpwnam (login) + _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." + (declare (type simple-string login)) + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd)) + (result (* (struct passwd)))) + (let ((returned + (alien-funcall + (extern-alien "getpwnam_r" + (function c-call:int + c-call:c-string + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct passwd))))) + login + (addr user-info) + (cast buf (* c-call:char)) + 1024 + (addr result)))) + (when (zerop returned) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) + +(defun unix-getgrnam (name) + _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." + (declare (type simple-string name)) + (with-alien ((buf (array c-call:char 2048)) + (group-info (struct group)) + (result (* (struct group)))) + (let ((returned + (alien-funcall + (extern-alien "getgrnam_r" + (function c-call:int + c-call:c-string + (* (struct group)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct group))))) + name + (addr group-info) + (cast buf (* c-call:char)) + 2048 + (addr result)))) + (when (zerop returned) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string)))))))) + +(defun unix-getgrgid (gid) + _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." + (declare (type unix-gid gid)) + (with-alien ((buf (array c-call:char 2048)) + (group-info (struct group)) + (result (* (struct group)))) + (let ((returned + (alien-funcall + (extern-alien "getgrgid_r" + (function c-call:int + c-call:unsigned-int + (* (struct group)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct group))))) + gid + (addr group-info) + (cast buf (* c-call:char)) + 2048 + (addr result)))) + (when (zerop returned) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string)))))))) + + +;; EOF ===================================== src/contrib/unix/unix.lisp ===================================== --- /dev/null +++ b/src/contrib/unix/unix.lisp @@ -0,0 +1,1116 @@ +;;; -*- Package: UNIX -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; +;;; This contains extra functionality for the UNIX package that is not +;;; needed by CMUCL core. +(ext:file-comment + "$Header: src/contrib/unix/unix.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; This file contains the UNIX low-level support. +;;; +(in-package "UNIX") +(use-package "ALIEN") +(use-package "C-CALL") +(use-package "SYSTEM") +(use-package "EXT") +(intl:textdomain "cmucl-unix") + +(export '(daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t + timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime + itimerval it-interval it-value tchars t-intrc t-quitc t-startc + t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc + t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill + sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel + direct d-off d-ino d-reclen #-(or linux svr4) d-namlen d-name + stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size + st-atime st-mtime st-ctime st-blksize st-blocks + s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock + s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec + ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss + ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock + ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw + rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc + + unix-errno get-unix-error-msg + + prot_read prot_write prot_exec prot_none + map_shared map_private map_fixed map_anonymous + ms_async ms_sync ms_invalidate + unix-mmap unix-munmap unix-msync + unix-mprotect + + unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid + unix-setitimer unix-getitimer + unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec + setgidexec savetext readown writeown execown readgrp writegrp + execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown + unix-getdtablesize unix-close unix-creat unix-dup unix-dup2 + unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown + fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek + l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr + #+(or hpux svr4 bsd linux) o_ndelay + #+(or hpux svr4 bsd linux) o_noctty #+(or hpux svr4 bsd) o_nonblock + o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink + unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr + fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate + unix-ftruncate unix-symlink + #+(and sparc svr4) unix-times + unix-unlink unix-write unix-ioctl + tcsetpgrp tcgetpgrp tty-process-group + terminal-speeds tty-raw tty-crmod tty-echo tty-lcase + #-hpux tty-cbreak #-(or hpux linux) tty-tandem + #+(or hpux svr4 linux bsd) termios + #+(or hpux svr4 linux bsd) c-lflag + #+(or hpux svr4 linux bsd) c-iflag + #+(or hpux svr4 linux bsd) c-oflag + #+(or hpux svr4 linux bsd) tty-icrnl + #+(or hpux svr4 linux) tty-ocrnl + #+(or hpux svr4 bsd) vdsusp #+(or hpux svr4 linux bsd) veof + #+(or hpux svr4 linux bsd) vintr + #+(or hpux svr4 linux bsd) vquit + #+(or hpux svr4 linux bsd) vstart + #+(or hpux svr4 linux bsd) vstop + #+(or hpux svr4 linux bsd) vsusp + #+(or hpux svr4 linux bsd) c-cflag + #+(or hpux svr4 linux bsd) c-cc + #+(or bsd osf1) c-ispeed + #+(or bsd osf1) c-ospeed + #+(or hpux svr4 linux bsd) tty-icanon + #+(or hpux svr4 linux bsd) vmin + #+(or hpux svr4 linux bsd) vtime + #+(or hpux svr4 linux bsd) tty-ixon + #+(or hpux svr4 linux bsd) tcsanow + #+(or hpux svr4 linux bsd) tcsadrain + #+(or hpux svr4 linux bsd) tciflush + #+(or hpux svr4 linux bsd) tcoflush + #+(or hpux svr4 linux bsd) tcioflush + #+(or hpux svr4 linux bsd) tcsaflush + #+(or hpux svr4 linux bsd) unix-tcgetattr + #+(or hpux svr4 linux bsd) unix-tcsetattr + #+(or hpux svr4 bsd) unix-cfgetospeed + #+(or hpux svr4 bsd) unix-cfsetospeed + #+(or hpux svr4 bsd) unix-cfgetispeed + #+(or hpux svr4 bsd) unix-cfsetispeed + #+(or hpux svr4 linux bsd) tty-ignbrk + #+(or hpux svr4 linux bsd) tty-brkint + #+(or hpux svr4 linux bsd) tty-ignpar + #+(or hpux svr4 linux bsd) tty-parmrk + #+(or hpux svr4 linux bsd) tty-inpck + #+(or hpux svr4 linux bsd) tty-istrip + #+(or hpux svr4 linux bsd) tty-inlcr + #+(or hpux svr4 linux bsd) tty-igncr + #+(or hpux svr4 linux) tty-iuclc + #+(or hpux svr4 linux bsd) tty-ixany + #+(or hpux svr4 linux bsd) tty-ixoff + #+hpux tty-ienqak + #+(or hpux irix solaris linux bsd) tty-imaxbel + #+(or hpux svr4 linux bsd) tty-opost + #+(or hpux svr4 linux) tty-olcuc + #+(or hpux svr4 linux bsd) tty-onlcr + #+(or hpux svr4 linux) tty-onocr + #+(or hpux svr4 linux) tty-onlret + #+(or hpux svr4 linux) tty-ofill + #+(or hpux svr4 linux) tty-ofdel + #+(or hpux svr4 linux bsd) tty-isig + #+(or hpux svr4 linux) tty-xcase + #+(or hpux svr4 linux bsd) tty-echoe + #+(or hpux svr4 linux bsd) tty-echok + #+(or hpux svr4 linux bsd) tty-echonl + #+(or hpux svr4 linux bsd) tty-noflsh + #+(or hpux svr4 linux bsd) tty-iexten + #+(or hpux svr4 linux bsd) tty-tostop + #+(or hpux irix solaris linux bsd) tty-echoctl + #+(or hpux irix solaris linux bsd) tty-echoprt + #+(or hpux irix solaris linux bsd) tty-echoke + #+(or hpux irix solaris) tty-defecho + #+(or hpux irix solaris bsd) tty-flusho + #+(or hpux irix solaris linux bsd) tty-pendin + #+(or hpux svr4 linux bsd) tty-cstopb + #+(or hpux svr4 linux bsd) tty-cread + #+(or hpux svr4 linux bsd) tty-parenb + #+(or hpux svr4 linux bsd) tty-parodd + #+(or hpux svr4 linux bsd) tty-hupcl + #+(or hpux svr4 linux bsd) tty-clocal + #+(or irix solaris) rcv1en + #+(or irix solaris) xmt1en + #+(or hpux irix solaris) tty-loblk + #+(or hpux svr4 linux bsd) vintr + #+(or hpux svr4 linux bsd) verase + #+(or hpux svr4 linux bsd) vkill + #+(or hpux svr4 linux bsd) veol + #+(or hpux irix solaris linux bsd) veol2 + #+(or hpux irix solaris) tty-cbaud + #+(or hpux svr4 bsd) tty-csize #+(or hpux svr4 bsd) tty-cs5 + #+(or hpux svr4 bsd) tty-cs6 #+(or hpux svr4 bsd) tty-cs7 + #+(or hpux svr4 bsd) tty-cs8 + #+(or hpux svr4 bsd) unix-tcsendbreak + #+(or hpux svr4 bsd) unix-tcdrain + #+(or hpux svr4 bsd) unix-tcflush + #+(or hpux svr4 bsd) unix-tcflow + + TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC + TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ + TIOCSIGSEND + + KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK + KBDSCLICK FIONREAD #+(or hpux bsd) siocspgrp + unix-exit unix-stat unix-lstat unix-fstat + unix-getrusage unix-fast-getrusage rusage_self rusage_children + unix-gettimeofday + #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid + #-(or svr4 hpux) unix-setregid + unix-getpid unix-getppid + #+(or svr4 bsd)unix-setpgid + unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid + unix-getpagesize unix-gethostname unix-gethostid unix-fork + unix-getenv unix-setenv unix-putenv unix-unsetenv + unix-current-directory unix-isatty unix-ttyname unix-execve + unix-socket unix-connect unix-bind unix-listen unix-accept + unix-recv unix-send unix-getpeername unix-getsockname + unix-getsockopt unix-setsockopt unix-openpty + + unix-recvfrom unix-sendto unix-shutdown + + unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid + user-info user-info-name user-info-password user-info-uid + user-info-gid user-info-gecos user-info-dir user-info-shell + group-info group-info-name group-info-gid group-info-members + + unix-uname)) + + +;;;; Common machine independent structures. + +;;; From sys/types.h + +(def-alien-type u-int64-t (unsigned 64)) + +(def-alien-type daddr-t + #-(or linux alpha) long + #+(or linux alpha) int) + +(def-alien-type caddr-t (* char)) + +(def-alien-type swblk-t long) + + + +;;; Large file support for Solaris. Define some of the 64-bit types +;;; we need. Unlike unix-glibc's large file support, Solaris's +;;; version is a little simpler because all of the 64-bit versions of +;;; the functions actually exist as functions. So instead of calling +;;; the 32-bit versions of the functions, we call the 64-bit versions. +;;; +;;; These functions are: creat64, open64, truncate64, ftruncate64, +;;; stat64, lstat64, fstat64, readdir64. +;;; +;;; There are also some new structures for large file support: +;;; dirent64, stat64. +;;; +;;; FIXME: We should abstract this better, but I (rtoy) don't have any +;;; other system to test this out on, so it's a Solaris hack for now. +#+solaris +(progn + (deftype file-offset64 () '(signed-byte 64)) + (def-alien-type off64-t int64-t) + (def-alien-type ino64-t u-int64-t) + (def-alien-type blkcnt64-t u-int64-t)) + +;;; From sys/time.h + +;;; From ioctl.h + + +;;; From sys/dir.h +;;; + + +;;; From sys/stat.h +;; oh boy, in linux-> 2 stat(s)!! + +#-(or svr4 bsd linux) ; eg hpux and alpha +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-ino ino-t) + (st-mode mode-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-size off-t) + (st-atime time-t) + (st-spare1 int) + (st-mtime time-t) + (st-spare2 int) + (st-ctime time-t) + (st-spare3 int) + (st-blksize #-alpha long #+alpha unsigned-int) + (st-blocks #-alpha long #+alpha int) + (st-spare4 (array long 2)))) + +#+netbsd +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-mode mode-t) + (st-ino ino-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-atime (struct timespec-t)) + (st-mtime (struct timespec-t)) + (st-ctime (struct timespec-t)) + (st-birthtime (struct timespec-t)) + (st-size off-t) + (st-blocks off-t) + (st-blksize long) + (st-flags unsigned-long) + (st-gen unsigned-long) + (st-spare (array unsigned-long 2)))) + +;;; From sys/resource.h + +(def-alien-type nil + (struct rlimit + (rlim-cur #-(or linux alpha) int #+linux long #+alpha unsigned-int) ; current (soft) limit + (rlim-max #-(or linux alpha) int #+linux long #+alpha unsigned-int))); maximum value for rlim-cur + + + + +(defun (setf unix-errno) (newvalue) (unix-set-errno newvalue)) + + + +;;;; User and group database structures + + + +(defstruct group-info + (name "" :type string) + (password "" :type string) + (gid 0 :type unix-gid) + (members nil :type list)) ; list of logins as strings + +;; see <grp.h> +(def-alien-type nil + (struct group + (gr-name (* char)) ; name of the group + (gr-passwd (* char)) ; encrypted group password + (gr-gid gid-t) ; numerical group ID + (gr-mem (* (* char))))) ; vector of pointers to member names + + + + +(defun unix-setuid (uid) + _N"Set the user ID of the calling process to UID. + If the calling process is the super-user, set the real + and effective user IDs, and the saved set-user-ID to UID; + if not, the effective user ID is set to UID." + (int-syscall ("setuid" uid-t) uid)) + +(defun unix-setgid (gid) + _N"Set the group ID of the calling process to GID. + If the calling process is the super-user, set the real + and effective group IDs, and the saved set-group-ID to GID; + if not, the effective group ID is set to GID." + (int-syscall ("setgid" gid-t) gid)) + + + +(defun unix-msync (addr length flags) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (signed-byte 32) flags)) + (syscall ("msync" system-area-pointer size-t int) t addr length flags)) + + + +(defun unix-chown (path uid gid) + _N"Given a file path, an integer user-id, and an integer group-id, + unix-chown changes the owner of the file and the group of the + file to those specified. Either the owner or the group may be + left unchanged by specifying them as -1. Note: Permission will + fail if the caller is not the superuser." + (declare (type unix-pathname path) + (type (or unix-uid (integer -1 -1)) uid) + (type (or unix-gid (integer -1 -1)) gid)) + (void-syscall ("chown" c-string int int) (%name->file path) uid gid)) + +;;; Unix-fchown is exactly the same as unix-chown except that the file +;;; is specified by a file-descriptor ("fd") instead of a pathname. + +(defun unix-fchown (fd uid gid) + _N"Unix-fchown is like unix-chown, except that it accepts an integer + file descriptor instead of a file path name." + (declare (type unix-fd fd) + (type (or unix-uid (integer -1 -1)) uid) + (type (or unix-gid (integer -1 -1)) gid)) + (void-syscall ("fchown" int int int) fd uid gid)) + +;;; Returns the maximum size (i.e. the number of array elements +;;; of the file descriptor table. + +(defun unix-getdtablesize () + _N"Unix-getdtablesize returns the maximum size of the file descriptor + table. (i.e. the maximum number of descriptors that can exist at + one time.)" + (int-syscall ("getdtablesize"))) + +;;; Unix-dup2 makes the second file-descriptor describe the same file +;;; as the first. If the second file-descriptor points to an open +;;; file, it is first closed. In any case, the second should have a +;;; value which is a valid file-descriptor. + +(defun unix-dup2 (fd1 fd2) + _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup + does only the new value of the duplicate descriptor may be requested + through the second argument. If a file already exists with the + requested descriptor number, it will be closed and the number + assigned to the duplicate." + (declare (type unix-fd fd1 fd2)) + (void-syscall ("dup2" int int) fd1 fd2)) + + +;;; Unix-link creates a hard link from name2 to name1. + +(defun unix-link (name1 name2) + _N"Unix-link creates a hard link from the file with name1 to the + file with name2." + (declare (type unix-pathname name1 name2)) + (void-syscall ("link" c-string c-string) + (%name->file name1) (%name->file name2))) + + +;;; Unix-sync writes all information in core memory which has been modified +;;; to permanent storage (i.e. disk). + +(defun unix-sync () + _N"Unix-sync writes all information in core memory which has been + modified to disk. It returns NIL and an error code if an error + occured." + (void-syscall ("sync"))) + +;;; Unix-fsync writes the core-image of the file described by "fd" to +;;; permanent storage (i.e. disk). + +(defun unix-fsync (fd) + _N"Unix-fsync writes the core image of the file described by + fd to disk." + (declare (type unix-fd fd)) + (void-syscall ("fsync" int) fd)) + +;;; Unix-truncate accepts a file name and a new length. The file is +;;; truncated to the new length. + +(defun unix-truncate (name len) + _N"Unix-truncate truncates the named file to the length (in + bytes) specified by len. NIL and an error number is returned + if the call is unsuccessful." + (declare (type unix-pathname name) + (type (unsigned-byte #+solaris 64 #-solaris 32) len)) + #-(and bsd x86) + (void-syscall (#+solaris "truncate64" #-solaris "truncate" c-string int) name len) + #+(and bsd x86) + (void-syscall ("truncate" c-string unsigned-long unsigned-long) name len 0)) + +(defun unix-ftruncate (fd len) + _N"Unix-ftruncate is similar to unix-truncate except that the first + argument is a file descriptor rather than a file name." + (declare (type unix-fd fd) + (type (unsigned-byte #+solaris 64 #-solaris 32) len)) + #-(and bsd x86) + (void-syscall (#+solaris "ftruncate64" #-solaris "ftruncate" int int) fd len) + #+(and bsd x86) + (void-syscall ("ftruncate" int unsigned-long unsigned-long) fd len 0)) + +;;; TTY ioctl commands. + + + +#+(or svr4 hpux bsd linux) +(progn + #+bsd + (defun unix-cfgetospeed (termios) + _N"Get terminal output speed." + (int-syscall ("cfgetospeed" (* (struct termios))) termios)) + + #-bsd + (defun unix-cfsetospeed (termios speed) + _N"Set terminal output speed." + (let ((baud (or (position speed terminal-speeds) + (error _"Bogus baud rate ~S" speed)))) + (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud))) + + #+bsd + (defun unix-cfsetospeed (termios speed) + _N"Set terminal output speed." + (void-syscall ("cfsetospeed" (* (struct termios)) int) termios speed)) + + #-bsd + (defun unix-cfgetispeed (termios) + _N"Get terminal input speed." + (multiple-value-bind (speed errno) + (int-syscall ("cfgetispeed" (* (struct termios))) termios) + (if speed + (values (svref terminal-speeds speed) 0) + (values speed errno)))) + + #+bsd + (defun unix-cfgetispeed (termios) + _N"Get terminal input speed." + (int-syscall ("cfgetispeed" (* (struct termios))) termios)) + + #-bsd + (defun unix-cfsetispeed (termios speed) + _N"Set terminal input speed." + (let ((baud (or (position speed terminal-speeds) + (error _"Bogus baud rate ~S" speed)))) + (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud))) + + #+bsd + (defun unix-cfsetispeed (termios speed) + _N"Set terminal input speed." + (void-syscall ("cfsetispeed" (* (struct termios)) int) termios speed)) + + (defun unix-tcsendbreak (fd duration) + _N"Send break" + (declare (type unix-fd fd)) + (void-syscall ("tcsendbreak" int int) fd duration)) + + (defun unix-tcdrain (fd) + _N"Wait for output for finish" + (declare (type unix-fd fd)) + (void-syscall ("tcdrain" int) fd)) + + (defun unix-tcflush (fd selector) + _N"See tcflush(3)" + (declare (type unix-fd fd)) + (void-syscall ("tcflush" int int) fd selector)) + + (defun unix-tcflow (fd action) + _N"Flow control" + (declare (type unix-fd fd)) + (void-syscall ("tcflow" int int) fd action))) + +(defun tcsetpgrp (fd pgrp) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP." + (alien:with-alien ((alien-pgrp c-call:int pgrp)) + (unix-ioctl fd + tiocspgrp + (alien:alien-sap (alien:addr alien-pgrp))))) + +(defun tcgetpgrp (fd) + _N"Get the tty-process-group for the unix file-descriptor FD." + (alien:with-alien ((alien-pgrp c-call:int)) + (multiple-value-bind (ok err) + (unix-ioctl fd + tiocgpgrp + (alien:alien-sap (alien:addr alien-pgrp))) + (if ok + (values alien-pgrp nil) + (values nil err))))) + +(defun tty-process-group (&optional fd) + _N"Get the tty-process-group for the unix file-descriptor FD. If not supplied, + FD defaults to /dev/tty." + (if fd + (tcgetpgrp fd) + (multiple-value-bind (tty-fd errno) + (unix-open "/dev/tty" o_rdwr 0) + (cond (tty-fd + (multiple-value-prog1 + (tcgetpgrp tty-fd) + (unix-close tty-fd))) + (t + (values nil errno)))))) + +(defun %set-tty-process-group (pgrp &optional fd) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not + supplied, FD defaults to /dev/tty." + (let ((old-sigs + (unix-sigblock + (sigmask :sigttou :sigttin :sigtstp :sigchld)))) + (declare (type (unsigned-byte 32) old-sigs)) + (unwind-protect + (if fd + (tcsetpgrp fd pgrp) + (multiple-value-bind (tty-fd errno) + (unix-open "/dev/tty" o_rdwr 0) + (cond (tty-fd + (multiple-value-prog1 + (tcsetpgrp tty-fd pgrp) + (unix-close tty-fd))) + (t + (values nil errno))))) + (unix-sigsetmask old-sigs)))) + +(defsetf tty-process-group (&optional fd) (pgrp) + _N"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not + supplied, FD defaults to /dev/tty." + `(%set-tty-process-group ,pgrp ,fd)) + + +;;; Socket options. + +#+(or hpux bsd) +(define-ioctl-command SIOCSPGRP #\s 8 int :in) + +#+linux +(define-ioctl-command SIOCSPGRP #\s #x8904 int :in) + +#+(or hpux bsd linux) +(defun siocspgrp (fd pgrp) + _N"Set the socket process-group for the unix file-descriptor FD to PGRP." + (alien:with-alien ((alien-pgrp c-call:int pgrp)) + (unix-ioctl fd + siocspgrp + (alien:alien-sap (alien:addr alien-pgrp))))) + +;;; Unix-setreuid sets the real and effective user-id's of the current +;;; process to the arguments "ruid" and "euid", respectively. Usage is +;;; restricted for anyone but the super-user. Setting either "ruid" or +;;; "euid" to -1 makes the system use the current id instead. + +#-(or svr4 hpux) +(defun unix-setreuid (ruid euid) + _N"Unix-setreuid sets the real and effective user-id's of the current + process to the specified ones. NIL and an error number is returned + if the call fails." + (void-syscall ("setreuid" int int) ruid euid)) + +;;; Unix-setregid sets the real and effective group-id's of the current +;;; process to the arguments "rgid" and "egid", respectively. Usage is +;;; restricted for anyone but the super-user. Setting either "rgid" or +;;; "egid" to -1 makes the system use the current id instead. + +#-(or svr4 hpux) +(defun unix-setregid (rgid egid) + _N"Unix-setregid sets the real and effective group-id's of the current + process process to the specified ones. NIL and an error number is + returned if the call fails." + (void-syscall ("setregid" int int) rgid egid)) + +(def-alien-routine ("getppid" unix-getppid) int + _N"Unix-getppid returns the process-id of the parent of the current process.") + +(def-alien-routine ("getgid" unix-getgid) int + _N"Unix-getgid returns the real group-id of the current process.") + +(def-alien-routine ("getegid" unix-getegid) int + _N"Unix-getegid returns the effective group-id of the current process.") + +;;; Unix-getpgrp returns the group-id associated with the +;;; current process. + +(defun unix-getpgrp () + _N"Unix-getpgrp returns the group-id of the calling process." + (int-syscall ("getpgrp"))) + +;;; Unix-setpgid sets the group-id of the process specified by +;;; "pid" to the value of "pgrp". The process must either have +;;; the same effective user-id or be a super-user process. + +;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained +;;; for backward compatibility. setpgrp(void)[solaris] is being phased +;;; out in favor of setsid(). + +(defun unix-setpgrp (pid pgrp) + _N"Unix-setpgrp sets the process group on the process pid to + pgrp. NIL and an error number are returned upon failure." + (void-syscall (#-svr4 "setpgrp" #+svr4 "setpgid" int int) pid pgrp)) + +(defun unix-setpgid (pid pgrp) + _N"Unix-setpgid sets the process group of the process pid to + pgrp. If pgid is equal to pid, the process becomes a process + group leader. NIL and an error number are returned upon failure." + (void-syscall ("setpgid" int int) pid pgrp)) + +(defun unix-fork () + _N"Executes the unix fork system call. Returns 0 in the child and the pid + of the child in the parent if it works, or NIL and an error number if it + doesn't work." + (int-syscall ("fork"))) + +;; Environment manipulation; man getenv(3) +(def-alien-routine ("getenv" unix-getenv) c-call:c-string + (name c-call:c-string) + _N"Get the value of the environment variable named Name. If no such + variable exists, Nil is returned.") + +;; This doesn't exist in Solaris 8 but does exist in Solaris 10. +(def-alien-routine ("setenv" unix-setenv) c-call:int + (name c-call:c-string) + (value c-call:c-string) + (overwrite c-call:int) + _N"Adds the environment variable named Name to the environment with + the given Value if Name does not already exist. If Name does exist, + the value is changed to Value if Overwrite is non-zero. Otherwise, + the value is not changed.") + + +(def-alien-routine ("putenv" unix-putenv) c-call:int + (name-value c-call:c-string) + _N"Adds or changes the environment. Name-value must be a string of + the form \"name=value\". If the name does not exist, it is added. + If name does exist, the value is updated to the given value.") + +;; This doesn't exist in Solaris 8 but does exist in Solaris 10. +(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int + (name c-call:c-string) + _N"Removes the variable Name from the environment") + + +;;;; Support routines for dealing with unix pathnames. + +(export '(unix-file-kind unix-maybe-prepend-current-directory + unix-resolve-links unix-simplify-pathname)) + + +;;;; UNIX-EXECVE + +(defun unix-execve (program &optional arg-list + (environment *environment-list*)) + _N"Executes the Unix execve system call. If the system call suceeds, lisp + will no longer be running in this process. If the system call fails this + function returns two values: NIL and an error code. Arg-list should be a + list of simple-strings which are passed as arguments to the exec'ed program. + Environment should be an a-list mapping symbols to simple-strings which this + function bashes together to form the environment for the exec'ed program." + (check-type program simple-string) + (let ((env-list (let ((envlist nil)) + (dolist (cons environment) + (push (if (cdr cons) + (concatenate 'simple-string + (string (car cons)) "=" + (cdr cons)) + (car cons)) + envlist)) + envlist))) + (sub-unix-execve (%name->file program) arg-list env-list))) + + +(defmacro round-bytes-to-words (n) + `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3))) + +;;; +;;; STRING-LIST-TO-C-STRVEC -- Internal +;;; +;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of +;;; simple-strings and constructs a C-style string vector (strvec) -- +;;; a null-terminated array of pointers to null-terminated strings. +;;; This function returns two values: a sap and a byte count. When the +;;; memory is no longer needed it should be deallocated with +;;; vm_deallocate. +;;; +(defun string-list-to-c-strvec (string-list) + ;; + ;; Make a pass over string-list to calculate the amount of memory + ;; needed to hold the strvec. + (let ((string-bytes 0) + (vec-bytes (* 4 (1+ (length string-list))))) + (declare (fixnum string-bytes vec-bytes)) + (dolist (s string-list) + (check-type s simple-string) + (incf string-bytes (round-bytes-to-words (1+ (length s))))) + ;; + ;; Now allocate the memory and fill it in. + (let* ((total-bytes (+ string-bytes vec-bytes)) + (vec-sap (system:allocate-system-memory total-bytes)) + (string-sap (sap+ vec-sap vec-bytes)) + (i 0)) + (declare (type (and unsigned-byte fixnum) total-bytes i) + (type system:system-area-pointer vec-sap string-sap)) + (dolist (s string-list) + (declare (simple-string s)) + (let ((n (length s))) + ;; + ;; Blast the string into place + #-unicode + (kernel:copy-to-system-area (the simple-string s) + (* vm:vector-data-offset vm:word-bits) + string-sap 0 + (* (1+ n) vm:byte-bits)) + #+unicode + (progn + ;; FIXME: Do we need to apply some kind of transformation + ;; to convert Lisp unicode strings to C strings? Utf-8? + (dotimes (k n) + (setf (sap-ref-8 string-sap k) + (logand #xff (char-code (aref s k))))) + (setf (sap-ref-8 string-sap n) 0)) + + ;; + ;; Blast the pointer to the string into place + (setf (sap-ref-sap vec-sap i) string-sap) + (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n)))) + (incf i 4))) + ;; Blast in last null pointer + (setf (sap-ref-sap vec-sap i) (int-sap 0)) + (values vec-sap total-bytes)))) + +(defun sub-unix-execve (program arg-list env-list) + (let ((argv nil) + (argv-bytes 0) + (envp nil) + (envp-bytes 0) + result error-code) + (unwind-protect + (progn + ;; Blast the stuff into the proper format + (multiple-value-setq + (argv argv-bytes) + (string-list-to-c-strvec arg-list)) + (multiple-value-setq + (envp envp-bytes) + (string-list-to-c-strvec env-list)) + ;; + ;; Now do the system call + (multiple-value-setq + (result error-code) + (int-syscall ("execve" + c-string system-area-pointer system-area-pointer) + program argv envp))) + ;; + ;; Deallocate memory + (when argv + (system:deallocate-system-memory argv argv-bytes)) + (when envp + (system:deallocate-system-memory envp envp-bytes))) + (values result error-code))) + + + +;;; +;;; Support for the Interval Timer (experimental) +;;; + + +(defun unix-getitimer (which) + _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). On success, + unix-getitimer returns 5 values, + T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." + (declare (type (member :real :virtual :profile) which) + (values t + #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) + (mod 1000000) + #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) + (mod 1000000))) + (let ((which (ecase which + (:real ITIMER-REAL) + (:virtual ITIMER-VIRTUAL) + (:profile ITIMER-PROF)))) + (with-alien ((itv (struct itimerval))) + (syscall* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval))) + (values T + (slot (slot itv 'it-interval) 'tv-sec) + (slot (slot itv 'it-interval) 'tv-usec) + (slot (slot itv 'it-value) 'tv-sec) + (slot (slot itv 'it-value) 'tv-usec)) + which (alien-sap (addr itv)))))) + + +;;;; User and group database access, POSIX Standard 9.2.2 + +#+solaris +(defun unix-getpwnam (login) + _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." + (declare (type simple-string login)) + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd))) + (let ((result + (alien-funcall + (extern-alien "getpwnam_r" + (function (* (struct passwd)) + c-call:c-string + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int)) + login + (addr user-info) + (cast buf (* c-call:char)) + 1024))) + (when (not (zerop (sap-int (alien-sap result)))) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :age (string (cast (slot result 'pw-age) c-call:c-string)) + :comment (string (cast (slot result 'pw-comment) c-call:c-string)) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) + +#+bsd +(defun unix-getpwnam (login) + _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." + (declare (type simple-string login)) + (let ((result + (alien-funcall + (extern-alien "getpwnam" + (function (* (struct passwd)) + c-call:c-string)) + login))) + (when (not (zerop (sap-int (alien-sap result)))) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + #-darwin :change #-darwin (slot result 'pw-change) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) + + +#+solaris +(eval-when (:compile-toplevel :load-toplevel :execute) + ;; sysconf(_SC_GETGR_R_SIZE_MAX) + (defconstant +sc-getgr-r-size-max+ 7296 + _N"The maximum size of the group entry buffer")) + +#+solaris +(defun unix-getgrnam (name) + _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." + (declare (type simple-string name)) + (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+)) + (group-info (struct group))) + (let ((result + (alien-funcall + (extern-alien "getgrnam_r" + (function (* (struct group)) + c-call:c-string + (* (struct group)) + (* c-call:char) + c-call:unsigned-int)) + name + (addr group-info) + (cast buf (* c-call:char)) + #.+sc-getgr-r-size-max+))) + (unless (zerop (sap-int (alien-sap result))) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string)))))))) + +#+bsd +(defun unix-getgrnam (name) + _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found." + (declare (type simple-string name)) + (let ((result + (alien-funcall + (extern-alien "getgrnam" + (function (* (struct group)) + c-call:c-string)) + name))) + (unless (zerop (sap-int (alien-sap result))) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string))))))) + +#+solaris +(defun unix-getgrgid (gid) + _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." + (declare (type unix-gid gid)) + (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+)) + (group-info (struct group))) + (let ((result + (alien-funcall + (extern-alien "getgrgid_r" + (function (* (struct group)) + c-call:unsigned-int + (* (struct group)) + (* c-call:char) + c-call:unsigned-int)) + gid + (addr group-info) + (cast buf (* c-call:char)) + #.+sc-getgr-r-size-max+))) + (unless (zerop (sap-int (alien-sap result))) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string)))))))) + +#+bsd +(defun unix-getgrgid (gid) + _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." + (declare (type unix-gid gid)) + (let ((result + (alien-funcall + (extern-alien "getgrgid" + (function (* (struct group)) + c-call:unsigned-int)) + gid))) + (unless (zerop (sap-int (alien-sap result))) + (make-group-info + :name (string (cast (slot result 'gr-name) c-call:c-string)) + :password (string (cast (slot result 'gr-passwd) c-call:c-string)) + :gid (slot result 'gr-gid) + :members (loop :with members = (slot result 'gr-mem) + :for i :from 0 + :for member = (deref members i) + :until (zerop (sap-int (alien-sap member))) + :collect (string (cast member c-call:c-string))))))) + +#+solaris +(defun unix-setpwent () + (void-syscall ("setpwent"))) + +#+solaris +(defun unix-endpwent () + (void-syscall ("endpwent"))) + +#+solaris +(defun unix-getpwent () + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd))) + (let ((result + (alien-funcall + (extern-alien "getpwent_r" + (function (* (struct passwd)) + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int)) + (addr user-info) + (cast buf (* c-call:char)) + 1024))) + (when (not (zerop (sap-int (alien-sap result)))) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :age (string (cast (slot result 'pw-age) c-call:c-string)) + :comment (string (cast (slot result 'pw-comment) c-call:c-string)) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) + +#+(and solaris svr4) +(export '(unix-sysinfo + si-sysname si-hostname si-release si-version si-machine + si-architecture si-hw-serial si-hw-provider si-srpc-domain + si-platform si-isalist si-dhcp-cache)) + +#+(and solaris svr4) +(progn +;; From sys/systeminfo.h. We don't list the set values here. +(def-enum + 1 + si-sysname si-hostname si-release si-version si-machine + si-architecture si-hw-serial si-hw-provider si-srpc-domain) + +(def-enum + 513 + si-platform si-isalist si-dhcp-cache) + + +(defun unix-sysinfo (command) + ;; Hope a buffer of length 2048 is long enough. + (with-alien ((buf (array c-call:unsigned-char 2048))) + (let ((result + (alien-funcall + (extern-alien "sysinfo" + (function c-call:int + c-call:int + c-call:c-string + c-call:int)) + command + (cast buf (* c-call:char)) + 2048))) + (when (>= result 0) + (cast buf c-call:c-string))))) +) + +#+solaris +(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core rlimit_nofile + rlimit_vmem rlimit_as)) + +#+solaris +(progn +(defconstant rlimit_cpu 0 + _N"CPU time per process (in milliseconds)") +(defconstant rlimit_fsize 1 + _N"Maximum file size") +(defconstant rlimit_data 2 + _N"Data segment size") +(defconstant rlimit_stack 3 + _N"Stack size") +(defconstant rlimit_core 4 + _N"Core file size") +(defconstant rlimit_nofile 5 + _N"Number of open files") +(defconstant rlimit_vmem 6 + _N"Maximum mapped memory") +(defconstant rlimit_as rlimit_vmem) +) + +#+(and darwin x86) +(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core + rlimit_as rlimit_rss rlimit_memlock rlimit_nproc rlimit_nofile)) + +#+(and darwin x86) +(progn +(defconstant rlimit_cpu 0 + _N"CPU time per process") +(defconstant rlimit_fsize 1 + _N"File size") +(defconstant rlimit_data 2 + _N"Data segment size") +(defconstant rlimit_stack 3 + _N"Stack size") +(defconstant rlimit_core 4 + _N"Core file size") +(defconstant rlimit_as 5 + _N"Addess space (resident set size)") +(defconstant rlimit_rss rlimit_as) +(defconstant rlimit_memlock 6 + _N"Locked-in-memory address space") +(defconstant rlimit_nproc 7 + _N"Number of processes") +(defconstant rlimit_nofile 8 + _N"Number of open files") +) + + +#+(or solaris (and darwin x86)) +(export '(unix-getrlimit)) + +#+(or solaris (and darwin x86)) +(defun unix-getrlimit (resource) + _N"Get the limits on the consumption of system resouce specified by + Resource. If successful, return three values: T, the current (soft) + limit, and the maximum (hard) limit." + + (with-alien ((rlimit (struct rlimit))) + (syscall ("getrlimit" c-call:int (* (struct rlimit))) + (values t + (slot rlimit 'rlim-cur) + (slot rlimit 'rlim-max)) + resource (addr rlimit)))) +;; EOF ===================================== src/i18n/locale/cmucl-unix-glibc2.pot ===================================== --- a/src/i18n/locale/cmucl-unix-glibc2.pot +++ b/src/i18n/locale/cmucl-unix-glibc2.pot @@ -16,712 +16,701 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/unix-glibc2.lisp -msgid "Class not yet defined: ~S" +msgid "" +"Put the absolute pathname of the current working directory in BUF.\n" +" If successful, return BUF. If not, put an error message in\n" +" BUF and return NULL. BUF should be at least PATH_MAX bytes long." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Returns a string describing the error number which was returned by a\n" -" UNIX system call." +msgid "Open for reading" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unknown error [~d]" +msgid "Open for writing" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-rename renames the file with string name1 to the string\n" -" name2. NIL and an error code is returned if an error occured." +msgid "Read-only flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for read permission" +msgid "Write-only flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for write permission" +msgid "Read-write flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for execute permission" +msgid "Access mode mask." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for presence of file" +msgid "Create if nonexistant flag. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-fcntl manipulates file descriptors accoridng to the\n" -" argument CMD which can be one of the following:\n" -"\n" -" F-DUPFD Duplicate a file descriptor.\n" -" F-GETFD Get file descriptor flags.\n" -" F-SETFD Set file descriptor flags.\n" -" F-GETFL Get file flags.\n" -" F-SETFL Set file flags.\n" -" F-GETOWN Get owner.\n" -" F-SETOWN Set owner.\n" -"\n" -" The flags that can be specified for F-SETFL are:\n" -"\n" -" FNDELAY Non-blocking reads.\n" -" FAPPEND Append on each write.\n" -" FASYNC Signal pgrp when data ready.\n" -" FCREAT Create if nonexistant.\n" -" FTRUNC Truncate to zero length.\n" -" FEXCL Error if already created.\n" -" " +msgid "Error if already exists. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-open opens the file whose pathname is specified by PATH\n" -" for reading and/or writing as specified by the FLAGS argument.\n" -" Returns an integer file descriptor.\n" -" The flags argument can be:\n" -"\n" -" o_rdonly Read-only flag.\n" -" o_wronly Write-only flag.\n" -" o_rdwr Read-and-write flag.\n" -" o_append Append flag.\n" -" o_creat Create-if-nonexistant flag.\n" -" o_trunc Truncate-to-size-0 flag.\n" -" o_excl Error if the file already exists\n" -" o_noctty Don't assign controlling tty\n" -" o_ndelay Non-blocking I/O\n" -" o_sync Synchronous I/O\n" -" o_async Asynchronous I/O\n" -"\n" -" If the o_creat flag is specified, then the file is created with\n" -" a permission of argument MODE if the file doesn't exist." +msgid "Don't assign controlling tty. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-getdtablesize returns the maximum size of the file descriptor\n" -" table. (i.e. the maximum number of descriptors that can exist at\n" -" one time.)" +msgid "Truncate flag. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-close takes an integer file descriptor as an argument and\n" -" closes the file associated with it. T is returned upon successful\n" -" completion, otherwise NIL and an error number." +msgid "Append flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-creat accepts a file name and a mode (same as those for\n" -" unix-chmod) and creates a file by that name with the specified\n" -" permission mode. It returns a file descriptor on success,\n" -" or NIL and an error number otherwise.\n" -"\n" -" This interface is made obsolete by UNIX-OPEN." +msgid "Non-blocking I/O" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open for reading" +msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open for writing" +msgid "Asynchronous I/O" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read-only flag." +msgid "Get lock" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Write-only flag." +msgid "Set lock" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read-write flag." +msgid "Set lock, wait for release" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Access mode mask." +msgid "Set owner (for sockets)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Create if nonexistant flag. (not fcntl)" +msgid "Get owner (for sockets)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Error if already exists. (not fcntl)" +msgid "for f-getfl and f-setfl" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Don't assign controlling tty. (not fcntl)" +msgid "" +"Unix-open opens the file whose pathname is specified by PATH\n" +" for reading and/or writing as specified by the FLAGS argument.\n" +" Returns an integer file descriptor.\n" +" The flags argument can be:\n" +"\n" +" o_rdonly Read-only flag.\n" +" o_wronly Write-only flag.\n" +" o_rdwr Read-and-write flag.\n" +" o_append Append flag.\n" +" o_creat Create-if-nonexistant flag.\n" +" o_trunc Truncate-to-size-0 flag.\n" +" o_excl Error if the file already exists\n" +" o_noctty Don't assign controlling tty\n" +" o_ndelay Non-blocking I/O\n" +" o_sync Synchronous I/O\n" +" o_async Asynchronous I/O\n" +"\n" +" If the o_creat flag is specified, then the file is created with\n" +" a permission of argument MODE if the file doesn't exist." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Truncate flag. (not fcntl)" +msgid "Successful" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Append flag." +msgid "Operation not permitted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-blocking I/O" +msgid "No such file or directory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Synchronous writes (on ext2)" +msgid "No such process" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Asynchronous I/O" +msgid "Interrupted system call" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Duplicate a file descriptor" +msgid "I/O error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file desc. flags" +msgid "No such device or address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set file desc. flags" +msgid "Arg list too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file flags" +msgid "Exec format error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set file flags" +msgid "Bad file number" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get lock" +msgid "No children" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set lock" +msgid "Try again" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set lock, wait for release" +msgid "Out of memory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set owner (for sockets)" +msgid "Permission denied" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get owner (for sockets)" +msgid "Bad address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "for f-getfl and f-setfl" +msgid "Block device required" msgstr "" #: src/code/unix-glibc2.lisp -msgid "for fcntl and lockf" +msgid "Device or resource busy" msgstr "" #: src/code/unix-glibc2.lisp -msgid "old bsd flock (depricated)" +msgid "File exists" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Shared lock for bsd flock" +msgid "Cross-device link" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Exclusive lock for bsd flock" +msgid "No such device" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Don't block. Combine with F-LOCK-SH or F-LOCK-EX" +msgid "Not a director" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Remove lock for bsd flock" +msgid "Is a directory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "depricated stuff" +msgid "Invalid argument" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Rewind the group-file stream." +msgid "File table overflow" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close the group-file stream." +msgid "Too many open files" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read an entry from the group-file stream, opening it if necessary." +msgid "Not a typewriter" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Size of control character vector." +msgid "Text file busy" msgstr "" #: src/code/unix-glibc2.lisp -msgid "See errno." +msgid "File too large" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No problem." +msgid "No space left on device" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Authoritative Answer Host not found." +msgid "Illegal seek" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-Authoritative Host not found,or SERVERFAIL." +msgid "Read-only file system" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non recoverable errors, FORMERR, REFUSED, NOTIMP." +msgid "Too many links" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Valid name, no data record of requested type." +msgid "Broken pipe" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No address, look for MX record." +msgid "Math argument out of domain" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open host data base files and mark them as staying open even after\n" -"a later search if STAY_OPEN is non-zero." +msgid "Math result not representable" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close host data base files and clear `stay open' flag." +msgid "Resource deadlock would occur" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get next entry from host data base file. Open data base if\n" -"necessary." +msgid "File name too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from host data base which address match ADDR with\n" -"length LEN and type TYPE." +msgid "No record locks available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from host data base for host with NAME." +msgid "Function not implemented" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from host data base for host with NAME. AF must be\n" -" set to the address type which as `AF_INET' for IPv4 or `AF_INET6'\n" -" for IPv6." +msgid "Directory not empty" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open network data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "Too many symbolic links encountered" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close network data base files and clear `stay open' flag." +msgid "Operation would block" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from network data base file. Open data base if\n" -" necessary." +msgid "No message of desired type" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from network data base which address match NET and\n" -" type TYPE." +msgid "Identifier removed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from network data base for network with NAME." +msgid "Channel number out of range" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open service data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "Level 2 not synchronized" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close service data base files and clear `stay open' flag." +msgid "Level 3 halted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from service data base file. Open data base if\n" -" necessary." +msgid "Level 3 reset" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from network data base for network with NAME and\n" -" protocol PROTO." +msgid "Link number out of range" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from service data base which matches port PORT and\n" -" protocol PROTO." +msgid "Protocol driver not attached" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open protocol data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "No CSI structure available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close protocol data base files and clear `stay open' flag." +msgid "Level 2 halted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from protocol data base file. Open data base if\n" -" necessary." +msgid "Invalid exchange" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from protocol data base for network with NAME." +msgid "Invalid request descriptor" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from protocol data base which number is PROTO." +msgid "Exchange full" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Establish network group NETGROUP for enumeration." +msgid "No anode" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Free all space allocated by previous `setnetgrent' call." +msgid "Invalid request code" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next member of netgroup established by last `setnetgrent' call\n" -" and return pointers to elements in HOSTP, USERP, and DOMAINP." +msgid "Invalid slot" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)." +msgid "File locking deadlock error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Socket address is intended for `bind'." +msgid "Bad font file format" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Request for canonical name." +msgid "Device not a stream" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Invalid value for `ai_flags' field." +msgid "No data available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "NAME or SERVICE is unknown." +msgid "Timer expired" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Temporary failure in name resolution." +msgid "Out of streams resources" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-recoverable failure in name res." +msgid "Machine is not on the network" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No address associated with NAME." +msgid "Package not installed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "ai_family not supported." +msgid "Object is remote" msgstr "" #: src/code/unix-glibc2.lisp -msgid "ai_socktype not supported." +msgid "Link has been severed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "SERVICE not supported for ai_socktype." +msgid "Advertise error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Address family for NAME not supported." +msgid "Srmount error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Memory allocation failure." +msgid "Communication error on send" msgstr "" #: src/code/unix-glibc2.lisp -msgid "System error returned in errno." +msgid "Protocol error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Translate name of a service location and/or a service name to set of\n" -" socket addresses." +msgid "Multihop attempted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Free `addrinfo' structure AI including associated storage." +msgid "RFS specific error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create pseudo tty master slave pair with NAME and set terminal\n" -" attributes according to TERMP and WINP and return handles for both\n" -" ends in AMASTER and ASLAVE." +msgid "Not a data message" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create child process and establish the slave pseudo terminal as the\n" -" child's controlling terminal." +msgid "Value too large for defined data type" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Rewind the password-file stream." +msgid "Name not unique on network" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close the password-file stream." +msgid "File descriptor in bad state" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read an entry from the password-file stream, opening it if necessary." +msgid "Remote address changed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "The calling process." +msgid "Can not access a needed shared library" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Terminated child processes." +msgid "Accessing a corrupted shared library" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Minimum priority a process can have" +msgid ".lib section in a.out corrupted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Maximum priority a process can have" +msgid "Attempting to link in too many shared libraries" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a process ID" +msgid "Cannot exec a shared library directly" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a process group ID" +msgid "Illegal byte sequence" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a user ID" +msgid "Interrupted system call should be restarted _N" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set scheduling algorithm and/or parameters for a process." +msgid "Streams pipe error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Retrieve scheduling algorithm for a particular purpose." +msgid "Too many users" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get maximum priority value for a scheduler." +msgid "Socket operation on non-socket" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get minimum priority value for a scheduler." +msgid "Destination address required" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the SCHED_RR interval for the named process." +msgid "Message too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Signal mask to be sent at exit." +msgid "Protocol wrong type for socket" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if VM shared between processes." +msgid "Protocol not available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if fs info shared between processes" +msgid "Protocol not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if open files shared between processe" +msgid "Socket type not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if signal handlers shared." +msgid "Operation not supported on transport endpoint" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if pid shared." +msgid "Protocol family not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open database for reading." +msgid "Address family not supported by protocol" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close database." +msgid "Address already in use" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get next entry from database, perhaps after opening the file." +msgid "Cannot assign requested address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get shadow entry matching NAME." +msgid "Network is down" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read shadow entry from STRING." +msgid "Network is unreachable" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Protect password file against multi writers." +msgid "Network dropped connection because of reset" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unlock password file." +msgid "Software caused connection abort" msgstr "" #: src/code/unix-glibc2.lisp -msgid "These bits determine file type." +msgid "Connection reset by peer" msgstr "" #: src/code/unix-glibc2.lisp -msgid "FIFO" +msgid "No buffer space available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Character device" +msgid "Transport endpoint is already connected" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Directory" +msgid "Transport endpoint is not connected" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Block device" +msgid "Cannot send after transport endpoint shutdown" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Regular file" +msgid "Too many references: cannot splice" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Symbolic link." +msgid "Connection timed out" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Socket." +msgid "Connection refused" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set user ID on execution." +msgid "Host is down" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set group ID on execution." +msgid "No route to host" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Save swapped text after use (sticky)." +msgid "Operation already in progress" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read by owner" +msgid "Operation now in progress" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Write by owner." +msgid "Stale NFS file handle" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Execute by owner." +msgid "Structure needs cleaning" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal output speed." +msgid "Not a XENIX named type file" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal output speed." +msgid "No XENIX semaphores available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Bogus baud rate ~S" +msgid "Is a named type file" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal input speed." +msgid "Remote I/O error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal input speed." +msgid "Quota exceeded" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal attributes." +msgid "" +"Returns a string describing the error number which was returned by a\n" +" UNIX system call." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal attributes." +msgid "Unknown error [~d]" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "" +"Unix-write attempts to write a character buffer (buf) of length\n" +" len to the file described by the file descriptor fd. NIL and an\n" +" error is returned if the call is unsuccessful." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "" +"Unix-pipe sets up a unix-piping mechanism consisting of\n" +" an input pipe and an output pipe. Unix-Pipe returns two\n" +" values: if no error occurred the first value is the pipe\n" +" to be read from and the second is can be written to. If\n" +" an error occurred the first value is NIL and the second\n" +" the unix error code." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Send break" +msgid "" +"UNIX-READ attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Wait for output for finish" +msgid "Unix-getpagesize returns the number of bytes in a system page." msgstr "" #: src/code/unix-glibc2.lisp -msgid "See tcflush(3)" +msgid "" +"UNIX-STAT retrieves information about the specified\n" +" file returning them in the form of multiple values.\n" +" See the UNIX Programmer's Manual for a description\n" +" of the values returned. If the call fails, then NIL\n" +" and an error number is returned instead." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Flow control" +msgid "" +"UNIX-FSTAT is similar to UNIX-STAT except the file is specified\n" +" by the file descriptor FD." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Executes the Unix execve system call. If the system call suceeds, lisp\n" -" will no longer be running in this process. If the system call fails " -"this\n" -" function returns two values: NIL and an error code. Arg-list should be " -"a\n" -" list of simple-strings which are passed as arguments to the exec'ed " -"program.\n" -" Environment should be an a-list mapping symbols to simple-strings which " -"this\n" -" function bashes together to form the environment for the exec'ed " -"program." +"UNIX-LSTAT is similar to UNIX-STAT except the specified\n" +" file must be a symbolic link." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "These bits determine file type." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "FIFO" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Character device" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Directory" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Block device" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Regular file" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Symbolic link." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Socket." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" #: src/code/unix-glibc2.lisp @@ -763,55 +752,35 @@ msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-READ attempts to read from the file described by fd into\n" -" the buffer buf until it is full. Len is the length of the buffer.\n" -" The number of bytes actually read is returned or NIL and an error\n" -" number if an error occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-write attempts to write a character buffer (buf) of length\n" -" len to the file described by the file descriptor fd. NIL and an\n" -" error is returned if the call is unsuccessful." +"Unix-close takes an integer file descriptor as an argument and\n" +" closes the file associated with it. T is returned upon successful\n" +" completion, otherwise NIL and an error number." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-pipe sets up a unix-piping mechanism consisting of\n" -" an input pipe and an output pipe. Unix-Pipe returns two\n" -" values: if no error occurred the first value is the pipe\n" -" to be read from and the second is can be written to. If\n" -" an error occurred the first value is NIL and the second\n" -" the unix error code." +"Unix-creat accepts a file name and a mode (same as those for\n" +" unix-chmod) and creates a file by that name with the specified\n" +" permission mode. It returns a file descriptor on success,\n" +" or NIL and an error number otherwise.\n" +"\n" +" This interface is made obsolete by UNIX-OPEN." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path, an integer user-id, and an integer group-id,\n" -" unix-chown changes the owner of the file and the group of the\n" -" file to those specified. Either the owner or the group may be\n" -" left unchanged by specifying them as -1. Note: Permission will\n" -" fail if the caller is not the superuser." +msgid "Returns the pathname with all symbolic links resolved." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-fchown is like unix-chown, except that it accepts an integer\n" -" file descriptor instead of a file path name." +msgid "Error reading link ~S: ~S" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path string, unix-chdir changes the current working \n" -" directory to the one specified." +msgid "Unix-gethostname returns the name of the host machine as a string." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Put the absolute pathname of the current working directory in BUF.\n" -" If successful, return BUF. If not, put an error message in\n" -" BUF and return NULL. BUF should be at least PATH_MAX bytes long." +msgid "Syscall ~A failed: ~A" msgstr "" #: src/code/unix-glibc2.lisp @@ -838,200 +807,224 @@ msgid "" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file-specific configuration information about PATH." +msgid "" +"Unix-getuid returns the real user-id associated with the\n" +" current process." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the value of the system variable NAME." +msgid "" +"Given a file path string, unix-chdir changes the current working \n" +" directory to the one specified." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the value of the string-valued system variable NAME." +msgid "" +"Given a file path string and a constant mode, unix-chmod changes the\n" +" permission mode for that file to the one specified. The new mode\n" +" can be created by logically OR'ing the following:\n" +"\n" +" setuidexec Set user ID on execution.\n" +" setgidexec Set group ID on execution.\n" +" savetext Save text image after execution.\n" +" readown Read by owner.\n" +" writeown Write by owner.\n" +" execown Execute (search directory) by owner.\n" +" readgrp Read by group.\n" +" writegrp Write by group.\n" +" execgrp Execute (search directory) by group.\n" +" readoth Read by others.\n" +" writeoth Write by others.\n" +" execoth Execute (search directory) by others.\n" +"\n" +" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" +" are equivalent for 'mode. The octal-base is familar to Unix users.\n" +" \n" +" It returns T on successfully completion; NIL and an error number\n" +" otherwise." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getpid returns the process-id of the current process." +msgid "" +"Given an integer file descriptor and a mode (the same as those\n" +" used for unix-chmod), unix-fchmod changes the permission mode\n" +" for that file to the one specified. T is returned if the call\n" +" was successful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-getppid returns the process-id of the parent of the current process." +"Unix-readlink invokes the readlink system call on the file name\n" +" specified by the simple string path. It returns up to two values:\n" +" the contents of the symbolic link if the call is successful, or\n" +" NIL and the Unix error number." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getpgrp returns the group-id of the calling process." +msgid "" +"Unix-unlink removes the directory entry for the named file.\n" +" NIL and an error code is returned if the call fails." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setpgrp sets the process group on the process pid to\n" -" pgrp. NIL and an error number are returned upon failure." +msgid "Test for read permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setpgid sets the process group of the process pid to\n" -" pgrp. If pgid is equal to pid, the process becomes a process\n" -" group leader. NIL and an error number are returned upon failure." +msgid "Test for write permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create a new session with the calling process as its leader.\n" -" The process group IDs of the session and the calling process\n" -" are set to the process ID of the calling process, which is returned." +msgid "Test for execute permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return the session ID of the given process." +msgid "Test for presence of file" msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-getuid returns the real user-id associated with the\n" -" current process." +"Unix-fcntl manipulates file descriptors accoridng to the\n" +" argument CMD which can be one of the following:\n" +"\n" +" F-DUPFD Duplicate a file descriptor.\n" +" F-GETFD Get file descriptor flags.\n" +" F-SETFD Set file descriptor flags.\n" +" F-GETFL Get file flags.\n" +" F-SETFL Set file flags.\n" +" F-GETOWN Get owner.\n" +" F-SETOWN Set owner.\n" +"\n" +" The flags that can be specified for F-SETFL are:\n" +"\n" +" FNDELAY Non-blocking reads.\n" +" FAPPEND Append on each write.\n" +" FASYNC Signal pgrp when data ready.\n" +" FCREAT Create if nonexistant.\n" +" FTRUNC Truncate to zero length.\n" +" FEXCL Error if already created.\n" +" " msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the effective user ID of the calling process." +msgid "" +"Unix-rename renames the file with string name1 to the string\n" +" name2. NIL and an error code is returned if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getgid returns the real group-id of the current process." +msgid "" +"Unix-rmdir attempts to remove the directory name. NIL and\n" +" an error number is returned if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getegid returns the effective group-id of the current process." +msgid "" +"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" +" then ioctl argument size and direction are included as for ioctls defined\n" +" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" +" is the characters code, else DEV may be an integer giving the type." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return nonzero iff the calling process is in group GID." +msgid "Get file flags" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the user ID of the calling process to UID.\n" -" If the calling process is the super-user, set the real\n" -" and effective user IDs, and the saved set-user-ID to UID;\n" -" if not, the effective user ID is set to UID." +msgid "Set file flags" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setreuid sets the real and effective user-id's of the current\n" -" process to the specified ones. NIL and an error number is returned\n" -" if the call fails." +msgid "depricated stuff" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the group ID of the calling process to GID.\n" -" If the calling process is the super-user, set the real\n" -" and effective group IDs, and the saved set-group-ID to GID;\n" -" if not, the effective group ID is set to GID." +msgid "The calling process." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setregid sets the real and effective group-id's of the current\n" -" process process to the specified ones. NIL and an error number is\n" -" returned if the call fails." +msgid "Class not yet defined: ~S" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Executes the unix fork system call. Returns 0 in the child and the pid\n" -" of the child in the parent if it works, or NIL and an error number if it\n" -" doesn't work." +msgid "Terminated child processes." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Get the value of the environment variable named Name. If no such\n" -" variable exists, Nil is returned." +"Like call getrusage, but return only the system and user time, and returns\n" +" the seconds and microseconds as separate values." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Adds the environment variable named Name to the environment with\n" -" the given Value if Name does not already exist. If Name does exist,\n" -" the value is changed to Value if Overwrite is non-zero. Otherwise,\n" -" the value is not changed." +"Unix-getrusage returns information about the resource usage\n" +" of the process specified by who. Who can be either the\n" +" current process (rusage_self) or all of the terminated\n" +" child processes (rusage_children). NIL and an error number\n" +" is returned if the call fails." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Adds or changes the environment. Name-value must be a string of\n" -" the form \"name=value\". If the name does not exist, it is added.\n" -" If name does exist, the value is updated to the given value." +msgid "Perform the UNIX select(2) system call." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Removes the variable Name from the environment" +msgid "" +"Unix-select examines the sets of descriptors passed as arguments\n" +" to see if they are ready for reading and writing. See the UNIX\n" +" Programmers Manual for more information." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Accepts a Unix file descriptor and returns T if the device\n" -" associated with it is a terminal." +"Unix-symlink creates a symbolic link named name2 to the file\n" +" named name1. NIL and an error number is returned if the call\n" +" is unsuccessful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-link creates a hard link from the file with name1 to the\n" -" file with name2." +"Unix-gethostid returns a 32-bit integer which provides unique\n" +" identification for the host machine." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-symlink creates a symbolic link named name2 to the file\n" -" named name1. NIL and an error number is returned if the call\n" -" is unsuccessful." +msgid "Unix-getpid returns the process-id of the current process." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-readlink invokes the readlink system call on the file name\n" -" specified by the simple string path. It returns up to two values:\n" -" the contents of the symbolic link if the call is successful, or\n" -" NIL and the Unix error number." +"Return a USER-INFO structure for the user identified by UID, or NIL if not " +"found." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-unlink removes the directory entry for the named file.\n" -" NIL and an error code is returned if the call fails." +"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" +" microseconds of the current time of day, the timezone (in minutes west\n" +" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" +" returns NIL and the errno." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-rmdir attempts to remove the directory name. NIL and\n" -" an error number is returned if an error occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Get the tty-process-group for the unix file-descriptor FD." +"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" +" times on a specified file. NIL and an error number is\n" +" returned if the call is unsuccessful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Get the tty-process-group for the unix file-descriptor FD. If not supplied," -"\n" -" FD defaults to /dev/tty." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set the tty-process-group for the unix file-descriptor FD to PGRP." +"Accepts a Unix file descriptor and returns T if the device\n" +" associated with it is a terminal." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not\n" -" supplied, FD defaults to /dev/tty." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return the login name of the user." +"Create pseudo tty master slave pair with NAME and set terminal\n" +" attributes according to TERMP and WINP and return handles for both\n" +" ends in AMASTER and ASLAVE." msgstr "" #: src/code/unix-glibc2.lisp @@ -1042,125 +1035,6 @@ msgid "" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Syscall ~A failed: ~A" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unix-gethostname returns the name of the host machine as a string." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-fsync writes the core image of the file described by\n" -" fd to disk." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Revoke access permissions to all processes currently communicating\n" -" with the control terminal, and then send a SIGHUP signal to the process\n" -" group of the control terminal." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Revoke the access of all descriptors currently open on FILE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make PATH be the root directory (the starting point for absolute paths).\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-gethostid returns a 32-bit integer which provides unique\n" -" identification for the host machine." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-sync writes all information in core memory which has been\n" -" modified to disk. It returns NIL and an error code if an error\n" -" occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-truncate truncates the named file to the length (in\n" -" bytes) specified by LENGTH. NIL and an error number is returned\n" -" if the call is unsuccessful." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-ftruncate is similar to unix-truncate except that the first\n" -" argument is a file descriptor rather than a file name." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return the maximum number of file descriptors\n" -" the current process could possibly have." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unlock a locked region" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Lock a region for exclusive use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Test and lock a region for exclusive use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Test a region for othwer processes locks" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-locks can lock, unlock and test files according to the cmd\n" -" which can be one of the following:\n" -"\n" -" f_ulock Unlock a locked region\n" -" f_lock Lock a region for exclusive use\n" -" f_tlock Test and lock a region for exclusive use\n" -" f_test Test a region for othwer processes locks\n" -"\n" -" The lock is for a region from the current location for a length\n" -" of length.\n" -"\n" -" This is a simpler version of the interface provided by unix-fcntl.\n" -" " -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" -" times on a specified file. NIL and an error number is\n" -" returned if the call is unsuccessful." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Don't block waiting." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Report status of stopped children." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Wait for cloned process." -msgstr "" - -#: src/code/unix-glibc2.lisp msgid "" "Unix-ioctl performs a variety of operations on open i/o\n" " descriptors. See the UNIX Programmer's Manual for more\n" @@ -1169,867 +1043,48 @@ msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Change uid used for file access control to UID, without affecting\n" -" other priveledges (such as who can send signals at the process)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Change gid used for file access control to GID, without affecting\n" -" other priveledges (such as who can send signals at the process)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "There is data to read." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "There is urgent data to read." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Writing now will not block." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Error condition." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Hung up." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid polling request." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Canonical number of polling requests to read\n" -"in at a time in poll." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -" Poll the file descriptors described by the NFDS structures starting at\n" -" FDS. If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for\n" -" an event to occur; if TIMEOUT is -1, block until an event occurs.\n" -" Returns the number of file descriptors with events, zero if timed out,\n" -" or -1 for errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Get the soft and hard limits for RESOURCE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Set the current soft and hard maximum limits for RESOURCE.\n" -" Only the super-user can increase hard limits." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Like call getrusage, but return only the system and user time, and returns\n" -" the seconds and microseconds as separate values." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-getrusage returns information about the resource usage\n" -" of the process specified by who. Who can be either the\n" -" current process (rusage_self) or all of the terminated\n" -" child processes (rusage_children). NIL and an error number\n" -" is returned if the call fails." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Function depends on CMD:\n" -" 1 = Return the limit on the size of a file, in units of 512 bytes.\n" -" 2 = Set the limit on the size of a file to NEWLIMIT. Only the\n" -" super-user can increase the limit.\n" -" 3 = Return the maximum possible address of the data segment.\n" -" 4 = Return the maximum number of files that the calling process can open.\n" -" Returns -1 on errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return the highest priority of any process specified by WHICH and WHO\n" -" (see above); if WHO is zero, the current process, process group, or user\n" -" (as specified by WHO) is used. A lower priority number means higher\n" -" priority. Priorities range from PRIO_MIN to PRIO_MAX (above)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Set the priority of all processes specified by WHICH and WHO (see above)\n" -" to PRIO. Returns 0 on success, -1 on errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Perform the UNIX select(2) system call." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-select examines the sets of descriptors passed as arguments\n" -" to see if they are ready for reading and writing. See the UNIX\n" -" Programmers Manual for more information." +"Unix-mkdir creates a new directory with the specified name and mode.\n" +" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" +" NIL and an error number." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-STAT retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." +"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). On success,\n" +" unix-getitimer returns 5 values,\n" +" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-FSTAT is similar to UNIX-STAT except the file is specified\n" -" by the file descriptor FD." +" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). A SIGALRM signal\n" +" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" +" when non-zero, is <seconds+microseconds> to be loaded each time\n" +" the timer expires. Setting INTERVAL and VALUE to zero disables\n" +" the timer. See the Unix man page for more details. On success,\n" +" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" +" slots as in unix-getitimer." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"UNIX-LSTAT is similar to UNIX-STAT except the specified\n" -" file must be a symbolic link." +msgid "Size of control character vector." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path string and a constant mode, unix-chmod changes the\n" -" permission mode for that file to the one specified. The new mode\n" -" can be created by logically OR'ing the following:\n" -"\n" -" setuidexec Set user ID on execution.\n" -" setgidexec Set group ID on execution.\n" -" savetext Save text image after execution.\n" -" readown Read by owner.\n" -" writeown Write by owner.\n" -" execown Execute (search directory) by owner.\n" -" readgrp Read by group.\n" -" writegrp Write by group.\n" -" execgrp Execute (search directory) by group.\n" -" readoth Read by others.\n" -" writeoth Write by others.\n" -" execoth Execute (search directory) by others.\n" -"\n" -" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" -" are equivalent for 'mode. The octal-base is familar to Unix users.\n" -" \n" -" It returns T on successfully completion; NIL and an error number\n" -" otherwise." +msgid "Get terminal attributes." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given an integer file descriptor and a mode (the same as those\n" -" used for unix-chmod), unix-fchmod changes the permission mode\n" -" for that file to the one specified. T is returned if the call\n" -" was successful." +msgid "Set terminal attributes." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the file creation mask of the current process to MASK,\n" -" and return the old creation mask." +msgid "Write by owner" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-mkdir creates a new directory with the specified name and mode.\n" -" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" -" NIL and an error number." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Create a device file named PATH, with permission and special bits MODE\n" -" and device number DEV (which can be constructed from major and minor\n" -" device numbers with the `makedev' macro above)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Create a new FIFO named PATH, with permission bits MODE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return information about the filesystem on which FILE resides." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make the block special device PATH available to the system for swapping.\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make the block special device PATH unavailable to the system for swapping.\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read or write system parameters." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Time used by the program so far (user time + system time).\n" -" The result / CLOCKS_PER_SECOND is program time in seconds." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return the current time and put it in *TIMER if TIMER is not NULL." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" -" microseconds of the current time of day, the timezone (in minutes west\n" -" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" -" returns NIL and the errno." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). On success,\n" -" unix-getitimer returns 5 values,\n" -" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). A SIGALRM signal\n" -" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" -" when non-zero, is <seconds+microseconds> to be loaded each time\n" -" the timer expires. Setting INTERVAL and VALUE to zero disables\n" -" the timer. See the Unix man page for more details. On success,\n" -" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" -" slots as in unix-getitimer." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Fill in TIMEBUF with information about the current time." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Store the CPU time used by this process and all its\n" -" dead children (and their dead children) in BUFFER.\n" -" Return the elapsed real time, or (clock_t) -1 for errors.\n" -" All times are in CLK_TCKths of a second." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Wait for a child to die. When one does, put its status in *STAT_LOC\n" -" and return its process ID. For errors, return (pid_t) -1." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Wait for a child matching PID to die.\n" -" If PID is greater than 0, match any process whose process ID is PID.\n" -" If PID is (pid_t) -1, match any process.\n" -" If PID is (pid_t) 0, match any process with the\n" -" same process group as the current process.\n" -" If PID is less than -1, match any process whose\n" -" process group is the absolute value of PID.\n" -" If the WNOHANG bit is set in OPTIONS, and that child\n" -" is not already dead, return (pid_t) 0. If successful,\n" -" return PID and store the dead child's status in STAT_LOC.\n" -" Return (pid_t) -1 for errors. If the WUNTRACED bit is\n" -" set in OPTIONS, return status for stopped children; otherwise don't." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Successful" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation not permitted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such file or directory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such process" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Interrupted system call" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "I/O error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such device or address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Arg list too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Exec format error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad file number" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No children" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Try again" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Out of memory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Permission denied" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Block device required" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Device or resource busy" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File exists" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cross-device link" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such device" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a director" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Is a directory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid argument" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File table overflow" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many open files" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a typewriter" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Text file busy" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File too large" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No space left on device" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Illegal seek" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read-only file system" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many links" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Broken pipe" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Math argument out of domain" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Math result not representable" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Resource deadlock would occur" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File name too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No record locks available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Function not implemented" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Directory not empty" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many symbolic links encountered" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation would block" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No message of desired type" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Identifier removed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Channel number out of range" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 2 not synchronized" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 3 halted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 3 reset" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Link number out of range" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol driver not attached" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No CSI structure available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 2 halted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid exchange" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid request descriptor" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Exchange full" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No anode" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid request code" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid slot" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File locking deadlock error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad font file format" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Device not a stream" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No data available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Timer expired" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Out of streams resources" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Machine is not on the network" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Package not installed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Object is remote" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Link has been severed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Advertise error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Srmount error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Communication error on send" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Multihop attempted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "RFS specific error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a data message" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Value too large for defined data type" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Name not unique on network" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File descriptor in bad state" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Remote address changed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Can not access a needed shared library" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Accessing a corrupted shared library" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid ".lib section in a.out corrupted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Attempting to link in too many shared libraries" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot exec a shared library directly" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Illegal byte sequence" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Interrupted system call should be restarted _N" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Streams pipe error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many users" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Socket operation on non-socket" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Destination address required" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Message too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol wrong type for socket" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol not available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Socket type not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation not supported on transport endpoint" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol family not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Address family not supported by protocol" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Address already in use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot assign requested address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network is down" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network is unreachable" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network dropped connection because of reset" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Software caused connection abort" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection reset by peer" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No buffer space available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Transport endpoint is already connected" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Transport endpoint is not connected" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot send after transport endpoint shutdown" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many references: cannot splice" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection timed out" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection refused" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Host is down" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No route to host" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation already in progress" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation now in progress" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Stale NFS file handle" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Structure needs cleaning" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a XENIX named type file" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No XENIX semaphores available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Is a named type file" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Remote I/O error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Quota exceeded" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" -" then ioctl argument size and direction are included as for ioctls defined\n" -" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" -" is the characters code, else DEV may be an integer giving the type." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set the socket process-group for the unix file-descriptor FD to PGRP." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set user ID on execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set group ID on execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Save text image after execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by owner" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by owner" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Returns either :file, :directory, :link, :special, or NIL." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Returns the pathname with all symbolic links resolved." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Error reading link ~S: ~S" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a USER-INFO structure for the user identified by LOGIN, or NIL if " -"not found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a USER-INFO structure for the user identified by UID, or NIL if not " -"found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by NAME, or NIL if " -"not found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by GID, or NIL if " -"not found." +msgid "Get terminal output speed." msgstr "" ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -16,1535 +16,1223 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/unix.lisp -msgid "Size of control character vector." -msgstr "" - -#: src/code/unix.lisp -msgid "Successful" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation not permitted" -msgstr "" - -#: src/code/unix.lisp -msgid "No such file or directory" -msgstr "" - -#: src/code/unix.lisp -msgid "No such process" -msgstr "" - -#: src/code/unix.lisp -msgid "Interrupted system call" -msgstr "" - -#: src/code/unix.lisp -msgid "I/O error" -msgstr "" - -#: src/code/unix.lisp -msgid "Device not configured" -msgstr "" - -#: src/code/unix.lisp -msgid "Arg list too long" -msgstr "" - -#: src/code/unix.lisp -msgid "Exec format error" -msgstr "" - -#: src/code/unix.lisp -msgid "Bad file descriptor" -msgstr "" - -#: src/code/unix.lisp -msgid "No child process" -msgstr "" - -#: src/code/unix.lisp -msgid "Resource deadlock avoided" -msgstr "" - -#: src/code/unix.lisp -msgid "No more processes" -msgstr "" - -#: src/code/unix.lisp -msgid "Try again" -msgstr "" - -#: src/code/unix.lisp -msgid "Out of memory" -msgstr "" - -#: src/code/unix.lisp -msgid "Permission denied" -msgstr "" - -#: src/code/unix.lisp -msgid "Bad address" -msgstr "" - -#: src/code/unix.lisp -msgid "Block device required" -msgstr "" - -#: src/code/unix.lisp -msgid "Device or resource busy" -msgstr "" - -#: src/code/unix.lisp -msgid "File exists" -msgstr "" - -#: src/code/unix.lisp -msgid "Cross-device link" -msgstr "" - -#: src/code/unix.lisp -msgid "No such device" -msgstr "" - -#: src/code/unix.lisp -msgid "Not a director" -msgstr "" - -#: src/code/unix.lisp -msgid "Is a directory" -msgstr "" - -#: src/code/unix.lisp -msgid "Invalid argument" -msgstr "" - -#: src/code/unix.lisp -msgid "File table overflow" -msgstr "" - -#: src/code/unix.lisp -msgid "Too many open files" -msgstr "" - -#: src/code/unix.lisp -msgid "Inappropriate ioctl for device" -msgstr "" - -#: src/code/unix.lisp -msgid "Text file busy" -msgstr "" - -#: src/code/unix.lisp -msgid "File too large" -msgstr "" - -#: src/code/unix.lisp -msgid "No space left on device" -msgstr "" - -#: src/code/unix.lisp -msgid "Illegal seek" -msgstr "" - -#: src/code/unix.lisp -msgid "Read-only file system" -msgstr "" - -#: src/code/unix.lisp -msgid "Too many links" -msgstr "" - -#: src/code/unix.lisp -msgid "Broken pipe" -msgstr "" - -#: src/code/unix.lisp -msgid "Numerical argument out of domain" -msgstr "" - -#: src/code/unix.lisp -msgid "Result too large" -msgstr "" - -#: src/code/unix.lisp -msgid "Math result not representable" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation would block" -msgstr "" - -#: src/code/unix.lisp -msgid "Resource temporarily unavailable" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation now in progress" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation already in progress" -msgstr "" - -#: src/code/unix.lisp -msgid "Socket operation on non-socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Destination address required" -msgstr "" - -#: src/code/unix.lisp -msgid "Message too long" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol wrong type for socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol not available" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Socket type not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation not supported on socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol family not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Address family not supported by protocol family" -msgstr "" - -#: src/code/unix.lisp -msgid "Address already in use" -msgstr "" - -#: src/code/unix.lisp -msgid "Can't assign requested address" -msgstr "" - -#: src/code/unix.lisp -msgid "Network is down" -msgstr "" - -#: src/code/unix.lisp -msgid "Network is unreachable" -msgstr "" - -#: src/code/unix.lisp -msgid "Network dropped connection on reset" +msgid "Syscall ~A failed: ~A" msgstr "" #: src/code/unix.lisp -msgid "Software caused connection abort" +msgid "Test for read permission" msgstr "" #: src/code/unix.lisp -msgid "Connection reset by peer" +msgid "Class not yet defined: ~S" msgstr "" #: src/code/unix.lisp -msgid "No buffer space available" +msgid "Test for write permission" msgstr "" #: src/code/unix.lisp -msgid "Socket is already connected" +msgid "Test for execute permission" msgstr "" #: src/code/unix.lisp -msgid "Socket is not connected" +msgid "Test for presence of file" msgstr "" #: src/code/unix.lisp -msgid "Can't send after socket shutdown" +msgid "" +"Given a file path (a string) and one of four constant modes,\n" +" unix-access returns T if the file is accessible with that\n" +" mode and NIL if not. It also returns an errno value with\n" +" NIL which determines why the file was not accessible.\n" +"\n" +" The access modes are:\n" +" r_ok Read permission.\n" +" w_ok Write permission.\n" +" x_ok Execute permission.\n" +" f_ok Presence of file." msgstr "" #: src/code/unix.lisp -msgid "Too many references: can't splice" +msgid "" +"Given a file path string, unix-chdir changes the current working \n" +" directory to the one specified." msgstr "" #: src/code/unix.lisp -msgid "Connection timed out" +msgid "Set user ID on execution" msgstr "" #: src/code/unix.lisp -msgid "Connection refused" +msgid "Set group ID on execution" msgstr "" #: src/code/unix.lisp -msgid "Too many levels of symbolic links" +msgid "Save text image after execution" msgstr "" #: src/code/unix.lisp -msgid "File name too long" +msgid "Read by owner" msgstr "" #: src/code/unix.lisp -msgid "Host is down" +msgid "Write by owner" msgstr "" #: src/code/unix.lisp -msgid "No route to host" +msgid "Execute (search directory) by owner" msgstr "" #: src/code/unix.lisp -msgid "Directory not empty" +msgid "Read by group" msgstr "" #: src/code/unix.lisp -msgid "Too many processes" +msgid "Write by group" msgstr "" #: src/code/unix.lisp -msgid "Too many users" +msgid "Execute (search directory) by group" msgstr "" #: src/code/unix.lisp -msgid "Disc quota exceeded" +msgid "Read by others" msgstr "" #: src/code/unix.lisp -msgid "namei should continue locally" +msgid "Write by others" msgstr "" #: src/code/unix.lisp -msgid "namei was handled remotely" +msgid "Execute (search directory) by others" msgstr "" #: src/code/unix.lisp -msgid "Remote file system error _N" +msgid "" +"Given a file path string and a constant mode, unix-chmod changes the\n" +" permission mode for that file to the one specified. The new mode\n" +" can be created by logically OR'ing the following:\n" +"\n" +" setuidexec Set user ID on execution.\n" +" setgidexec Set group ID on execution.\n" +" savetext Save text image after execution.\n" +" readown Read by owner.\n" +" writeown Write by owner.\n" +" execown Execute (search directory) by owner.\n" +" readgrp Read by group.\n" +" writegrp Write by group.\n" +" execgrp Execute (search directory) by group.\n" +" readoth Read by others.\n" +" writeoth Write by others.\n" +" execoth Execute (search directory) by others.\n" +" \n" +" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" +" are equivalent for 'mode. The octal-base is familar to Unix users.\n" +"\n" +" It returns T on successfully completion; NIL and an error number\n" +" otherwise." msgstr "" #: src/code/unix.lisp -msgid "syscall was handled by Vice" +msgid "" +"Given an integer file descriptor and a mode (the same as those\n" +" used for unix-chmod), unix-fchmod changes the permission mode\n" +" for that file to the one specified. T is returned if the call\n" +" was successful." msgstr "" #: src/code/unix.lisp -msgid "No message of desired type" +msgid "set the file pointer" msgstr "" #: src/code/unix.lisp -msgid "Identifier removed" +msgid "increment the file pointer" msgstr "" #: src/code/unix.lisp -msgid "Channel number out of range" +msgid "extend the file size" msgstr "" #: src/code/unix.lisp -msgid "Level 2 not synchronized" +msgid "" +"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n" +" a certain offset for that file. Whence can be any of the following:\n" +"\n" +" l_set Set the file pointer.\n" +" l_incr Increment the file pointer.\n" +" l_xtnd Extend the file size.\n" +" _N" msgstr "" #: src/code/unix.lisp -msgid "Level 3 halted" +msgid "" +"Unix-mkdir creates a new directory with the specified name and mode.\n" +" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" +" NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Level 3 reset" +msgid "" +"Unix-unlink removes the directory entry for the named file.\n" +" NIL and an error code is returned if the call fails." msgstr "" #: src/code/unix.lisp -msgid "Link number out of range" +msgid "Read-only flag." msgstr "" #: src/code/unix.lisp -msgid "Protocol driver not attached" +msgid "Write-only flag." msgstr "" #: src/code/unix.lisp -msgid "No CSI structure available" +msgid "Read-write flag." msgstr "" #: src/code/unix.lisp -msgid "Level 2 halted" +msgid "Non-blocking I/O" msgstr "" #: src/code/unix.lisp -msgid "Deadlock situation detected/avoided" +msgid "Append flag." msgstr "" #: src/code/unix.lisp -msgid "No record locks available" +msgid "Create if nonexistant flag." msgstr "" #: src/code/unix.lisp -msgid "Error 47" +msgid "Truncate flag." msgstr "" #: src/code/unix.lisp -msgid "Error 48" +msgid "Error if already exists." msgstr "" #: src/code/unix.lisp -msgid "Bad exchange descriptor" +msgid "Don't assign controlling tty" msgstr "" #: src/code/unix.lisp -msgid "Bad request descriptor" +msgid "Non-blocking mode" msgstr "" #: src/code/unix.lisp -msgid "Message tables full" +msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix.lisp -msgid "Anode table overflow" +msgid "" +"Unix-open opens the file whose pathname is specified by path\n" +" for reading and/or writing as specified by the flags argument.\n" +" The flags argument can be:\n" +"\n" +" o_rdonly Read-only flag.\n" +" o_wronly Write-only flag.\n" +" o_rdwr Read-and-write flag.\n" +" o_append Append flag.\n" +" o_creat Create-if-nonexistant flag.\n" +" o_trunc Truncate-to-size-0 flag.\n" +"\n" +" If the o_creat flag is specified, then the file is created with\n" +" a permission of argument mode if the file doesn't exist. An\n" +" integer file descriptor is returned by unix-open." msgstr "" #: src/code/unix.lisp -msgid "Bad request code" +msgid "" +"Unix-close takes an integer file descriptor as an argument and\n" +" closes the file associated with it. T is returned upon successful\n" +" completion, otherwise NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Invalid slot" +msgid "" +"Unix-creat accepts a file name and a mode (same as those for\n" +" unix-chmod) and creates a file by that name with the specified\n" +" permission mode. It returns a file descriptor on success,\n" +" or NIL and an error number otherwise.\n" +"\n" +" This interface is made obsolete by UNIX-OPEN." msgstr "" #: src/code/unix.lisp -msgid "File locking deadlock" +msgid "" +"Unix-dup duplicates an existing file descriptor (given as the\n" +" argument) and return it. If FD is not a valid file descriptor, NIL\n" +" and an error number are returned." msgstr "" #: src/code/unix.lisp -msgid "Bad font file format" +msgid "Duplicate a file descriptor" msgstr "" #: src/code/unix.lisp -msgid "Not a stream device" +msgid "Get file desc. flags" msgstr "" #: src/code/unix.lisp -msgid "No data available" +msgid "Set file desc. flags" msgstr "" #: src/code/unix.lisp -msgid "Timer expired" +msgid "Get file flags" msgstr "" #: src/code/unix.lisp -msgid "Out of stream resources" +msgid "Set file flags" msgstr "" #: src/code/unix.lisp -msgid "Machine is not on the network" +msgid "Get owner" msgstr "" #: src/code/unix.lisp -msgid "Package not installed" +msgid "Get lock" msgstr "" #: src/code/unix.lisp -msgid "Object is remote" +msgid "Set owner" msgstr "" #: src/code/unix.lisp -msgid "Link has been severed" +msgid "Set lock" msgstr "" #: src/code/unix.lisp -msgid "Advertise error" +msgid "Set lock, wait for release" msgstr "" #: src/code/unix.lisp -msgid "Srmount error" +msgid "Non-blocking reads" msgstr "" #: src/code/unix.lisp -msgid "Communication error on send" +msgid "Append on each write" msgstr "" #: src/code/unix.lisp -msgid "Protocol error" +msgid "Signal pgrp when data ready" msgstr "" #: src/code/unix.lisp -msgid "Multihop attempted" +msgid "Create if nonexistant" msgstr "" #: src/code/unix.lisp -msgid "Not a data message" +msgid "Truncate to zero length" msgstr "" #: src/code/unix.lisp -msgid "Value too large for defined data type" +msgid "Error if already created" msgstr "" #: src/code/unix.lisp -msgid "Name not unique on network" +msgid "" +"Unix-fcntl manipulates file descriptors according to the\n" +" argument CMD which can be one of the following:\n" +"\n" +" F-DUPFD Duplicate a file descriptor.\n" +" F-GETFD Get file descriptor flags.\n" +" F-SETFD Set file descriptor flags.\n" +" F-GETFL Get file flags.\n" +" F-SETFL Set file flags.\n" +" F-GETOWN Get owner.\n" +" F-SETOWN Set owner.\n" +"\n" +" The flags that can be specified for F-SETFL are:\n" +"\n" +" FNDELAY Non-blocking reads.\n" +" FAPPEND Append on each write.\n" +" FASYNC Signal pgrp when data ready.\n" +" FCREAT Create if nonexistant.\n" +" FTRUNC Truncate to zero length.\n" +" FEXCL Error if already created.\n" +" " msgstr "" #: src/code/unix.lisp -msgid "File descriptor in bad state" +msgid "" +"Unix-pipe sets up a unix-piping mechanism consisting of\n" +" an input pipe and an output pipe. Unix-Pipe returns two\n" +" values: if no error occurred the first value is the pipe\n" +" to be read from and the second is can be written to. If\n" +" an error occurred the first value is NIL and the second\n" +" the unix error code." msgstr "" #: src/code/unix.lisp -msgid "Remote address changed" +msgid "" +"Unix-read attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." msgstr "" #: src/code/unix.lisp -msgid "Can not access a needed shared library" +msgid "" +"Unix-readlink invokes the readlink system call on the file name\n" +" specified by the simple string path. It returns up to two values:\n" +" the contents of the symbolic link if the call is successful, or\n" +" NIL and the Unix error number." msgstr "" #: src/code/unix.lisp -msgid "Accessing a corrupted shared library" +msgid "" +"Unix-rename renames the file with string name1 to the string\n" +" name2. NIL and an error code is returned if an error occured." msgstr "" #: src/code/unix.lisp -msgid ".lib section in a.out corrupted" +msgid "" +"Unix-rmdir attempts to remove the directory name. NIL and\n" +" an error number is returned if an error occured." msgstr "" #: src/code/unix.lisp -msgid "Attempting to link in more shared libraries than system limit" +msgid "" +"Unix-write attempts to write a character buffer (buf) of length\n" +" len to the file described by the file descriptor fd. NIL and an\n" +" error is returned if the call is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "Can not exec a shared library directly" +msgid "" +"Unix-ioctl performs a variety of operations on open i/o\n" +" descriptors. See the UNIX Programmer's Manual for more\n" +" information." msgstr "" #: src/code/unix.lisp -msgid "Error 88" +msgid "Get terminal attributes." msgstr "" #: src/code/unix.lisp -msgid "Operation not applicable" +msgid "Set terminal attributes." msgstr "" #: src/code/unix.lisp -msgid "" -"Number of symbolic links encountered during path name traversal exceeds " -"MAXSYMLINKS" +msgid "Get terminal output speed." msgstr "" #: src/code/unix.lisp -msgid "Error 91" +msgid "" +"Unix-getuid returns the real user-id associated with the\n" +" current process." msgstr "" #: src/code/unix.lisp -msgid "Error 92" +msgid "Unix-getpagesize returns the number of bytes in a system page." msgstr "" #: src/code/unix.lisp -msgid "Option not supported by protocol" +msgid "Unix-gethostname returns the name of the host machine as a string." msgstr "" #: src/code/unix.lisp -msgid "Operation not supported on transport endpoint" +msgid "" +"Unix-gethostid returns a 32-bit integer which provides unique\n" +" identification for the host machine." msgstr "" #: src/code/unix.lisp -msgid "Cannot assign requested address" +msgid "" +"Unix-exit terminates the current process with an optional\n" +" error code. If successful, the call doesn't return. If\n" +" unsuccessful, the call returns NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Network dropped connection because of reset" +msgid "Size of control character vector." msgstr "" #: src/code/unix.lisp -msgid "Transport endpoint is already connected" +msgid "" +"Unix-stat retrieves information about the specified\n" +" file returning them in the form of multiple values.\n" +" See the UNIX Programmer's Manual for a description\n" +" of the values returned. If the call fails, then NIL\n" +" and an error number is returned instead." msgstr "" #: src/code/unix.lisp -msgid "Transport endpoint is not connected" +msgid "" +"Unix-lstat is similar to unix-stat except the specified\n" +" file must be a symbolic link." msgstr "" #: src/code/unix.lisp -msgid "Cannot send after socket shutdown" +msgid "" +"Unix-fstat is similar to unix-stat except the file is specified\n" +" by the file descriptor fd." msgstr "" #: src/code/unix.lisp -msgid "Too many references: cannot splice" +msgid "The calling process." msgstr "" #: src/code/unix.lisp -msgid "Stale NFS file handle" +msgid "Terminated child processes." msgstr "" #: src/code/unix.lisp -msgid "Resource deadlock would occur" +msgid "" +"Like call getrusage, but return only the system and user time, and returns\n" +" the seconds and microseconds as separate values." msgstr "" #: src/code/unix.lisp -msgid "Function not implemented" +msgid "" +"Unix-getrusage returns information about the resource usage\n" +" of the process specified by who. Who can be either the\n" +" current process (rusage_self) or all of the terminated\n" +" child processes (rusage_children). NIL and an error number\n" +" is returned if the call fails." msgstr "" #: src/code/unix.lisp -msgid "Too many symbolic links encountered" +msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" #: src/code/unix.lisp -msgid "Invalid exchange" +msgid "Returns the pathname with all symbolic links resolved." msgstr "" #: src/code/unix.lisp -msgid "Invalid request descriptor" +msgid "Error reading link ~S: ~S" msgstr "" #: src/code/unix.lisp -msgid "Exchange full" +msgid "Successful" msgstr "" #: src/code/unix.lisp -msgid "No anode" +msgid "Operation not permitted" msgstr "" #: src/code/unix.lisp -msgid "Invalid request code" +msgid "No such file or directory" msgstr "" #: src/code/unix.lisp -msgid "File locking deadlock error" +msgid "No such process" msgstr "" #: src/code/unix.lisp -msgid "Device not a stream" +msgid "Interrupted system call" msgstr "" #: src/code/unix.lisp -msgid "Out of streams resources" +msgid "I/O error" msgstr "" #: src/code/unix.lisp -msgid "RFS specific error" +msgid "Device not configured" msgstr "" #: src/code/unix.lisp -msgid "Attempting to link in too many shared libraries" +msgid "Arg list too long" msgstr "" #: src/code/unix.lisp -msgid "Cannot exec a shared library directly" +msgid "Exec format error" msgstr "" #: src/code/unix.lisp -msgid "Illegal byte sequence" +msgid "Bad file descriptor" msgstr "" #: src/code/unix.lisp -msgid "Interrupted system call should be restarted _N" +msgid "No child process" msgstr "" #: src/code/unix.lisp -msgid "Streams pipe error" +msgid "Resource deadlock avoided" msgstr "" #: src/code/unix.lisp -msgid "Address family not supported by protocol" +msgid "No more processes" msgstr "" #: src/code/unix.lisp -msgid "Cannot send after transport endpoint shutdown" +msgid "Try again" msgstr "" #: src/code/unix.lisp -msgid "Structure needs cleaning" +msgid "Out of memory" msgstr "" #: src/code/unix.lisp -msgid "Not a XENIX named type file" +msgid "Permission denied" msgstr "" #: src/code/unix.lisp -msgid "No XENIX semaphores available" +msgid "Bad address" msgstr "" #: src/code/unix.lisp -msgid "Is a named type file" +msgid "Block device required" msgstr "" #: src/code/unix.lisp -msgid "Remote I/O error" +msgid "Device or resource busy" msgstr "" #: src/code/unix.lisp -msgid "Quota exceeded" +msgid "File exists" msgstr "" #: src/code/unix.lisp -msgid "" -"Returns a string describing the error number which was returned by a\n" -" UNIX system call." +msgid "Cross-device link" msgstr "" #: src/code/unix.lisp -msgid "Unknown error [~d]" +msgid "No such device" msgstr "" #: src/code/unix.lisp -msgid "Class not yet defined: ~S" +msgid "Not a director" msgstr "" #: src/code/unix.lisp -msgid "Syscall ~A failed: ~A" +msgid "Is a directory" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the user ID of the calling process to UID.\n" -" If the calling process is the super-user, set the real\n" -" and effective user IDs, and the saved set-user-ID to UID;\n" -" if not, the effective user ID is set to UID." +msgid "Invalid argument" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the group ID of the calling process to GID.\n" -" If the calling process is the super-user, set the real\n" -" and effective group IDs, and the saved set-group-ID to GID;\n" -" if not, the effective group ID is set to GID." +msgid "File table overflow" msgstr "" #: src/code/unix.lisp -msgid "Test for read permission" +msgid "Too many open files" msgstr "" #: src/code/unix.lisp -msgid "Test for write permission" +msgid "Inappropriate ioctl for device" msgstr "" #: src/code/unix.lisp -msgid "Test for execute permission" +msgid "Text file busy" msgstr "" #: src/code/unix.lisp -msgid "Test for presence of file" +msgid "File too large" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path (a string) and one of four constant modes,\n" -" unix-access returns T if the file is accessible with that\n" -" mode and NIL if not. It also returns an errno value with\n" -" NIL which determines why the file was not accessible.\n" -"\n" -" The access modes are:\n" -" r_ok Read permission.\n" -" w_ok Write permission.\n" -" x_ok Execute permission.\n" -" f_ok Presence of file." +msgid "No space left on device" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path string, unix-chdir changes the current working \n" -" directory to the one specified." +msgid "Illegal seek" msgstr "" #: src/code/unix.lisp -msgid "Set user ID on execution" +msgid "Read-only file system" msgstr "" #: src/code/unix.lisp -msgid "Set group ID on execution" +msgid "Too many links" msgstr "" #: src/code/unix.lisp -msgid "Save text image after execution" +msgid "Broken pipe" msgstr "" #: src/code/unix.lisp -msgid "Read by owner" +msgid "Numerical argument out of domain" msgstr "" #: src/code/unix.lisp -msgid "Write by owner" +msgid "Result too large" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by owner" +msgid "Math result not representable" msgstr "" #: src/code/unix.lisp -msgid "Read by group" +msgid "Operation would block" msgstr "" #: src/code/unix.lisp -msgid "Write by group" +msgid "Resource temporarily unavailable" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by group" +msgid "Operation now in progress" msgstr "" #: src/code/unix.lisp -msgid "Read by others" +msgid "Operation already in progress" msgstr "" #: src/code/unix.lisp -msgid "Write by others" +msgid "Socket operation on non-socket" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by others" +msgid "Destination address required" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path string and a constant mode, unix-chmod changes the\n" -" permission mode for that file to the one specified. The new mode\n" -" can be created by logically OR'ing the following:\n" -"\n" -" setuidexec Set user ID on execution.\n" -" setgidexec Set group ID on execution.\n" -" savetext Save text image after execution.\n" -" readown Read by owner.\n" -" writeown Write by owner.\n" -" execown Execute (search directory) by owner.\n" -" readgrp Read by group.\n" -" writegrp Write by group.\n" -" execgrp Execute (search directory) by group.\n" -" readoth Read by others.\n" -" writeoth Write by others.\n" -" execoth Execute (search directory) by others.\n" -" \n" -" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" -" are equivalent for 'mode. The octal-base is familar to Unix users.\n" -"\n" -" It returns T on successfully completion; NIL and an error number\n" -" otherwise." +msgid "Message too long" msgstr "" #: src/code/unix.lisp -msgid "" -"Given an integer file descriptor and a mode (the same as those\n" -" used for unix-chmod), unix-fchmod changes the permission mode\n" -" for that file to the one specified. T is returned if the call\n" -" was successful." +msgid "Protocol wrong type for socket" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path, an integer user-id, and an integer group-id,\n" -" unix-chown changes the owner of the file and the group of the\n" -" file to those specified. Either the owner or the group may be\n" -" left unchanged by specifying them as -1. Note: Permission will\n" -" fail if the caller is not the superuser." +msgid "Protocol not available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fchown is like unix-chown, except that it accepts an integer\n" -" file descriptor instead of a file path name." +msgid "Protocol not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getdtablesize returns the maximum size of the file descriptor\n" -" table. (i.e. the maximum number of descriptors that can exist at\n" -" one time.)" +msgid "Socket type not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-close takes an integer file descriptor as an argument and\n" -" closes the file associated with it. T is returned upon successful\n" -" completion, otherwise NIL and an error number." +msgid "Operation not supported on socket" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-creat accepts a file name and a mode (same as those for\n" -" unix-chmod) and creates a file by that name with the specified\n" -" permission mode. It returns a file descriptor on success,\n" -" or NIL and an error number otherwise.\n" -"\n" -" This interface is made obsolete by UNIX-OPEN." +msgid "Protocol family not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-dup duplicates an existing file descriptor (given as the\n" -" argument) and return it. If FD is not a valid file descriptor, NIL\n" -" and an error number are returned." +msgid "Address family not supported by protocol family" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-dup2 duplicates an existing file descriptor just as unix-dup\n" -" does only the new value of the duplicate descriptor may be requested\n" -" through the second argument. If a file already exists with the\n" -" requested descriptor number, it will be closed and the number\n" -" assigned to the duplicate." +msgid "Address already in use" msgstr "" #: src/code/unix.lisp -msgid "Duplicate a file descriptor" +msgid "Can't assign requested address" msgstr "" #: src/code/unix.lisp -msgid "Get file desc. flags" +msgid "Network is down" msgstr "" #: src/code/unix.lisp -msgid "Set file desc. flags" +msgid "Network is unreachable" msgstr "" #: src/code/unix.lisp -msgid "Get file flags" +msgid "Network dropped connection on reset" msgstr "" #: src/code/unix.lisp -msgid "Set file flags" +msgid "Software caused connection abort" msgstr "" #: src/code/unix.lisp -msgid "Get owner" +msgid "Connection reset by peer" msgstr "" #: src/code/unix.lisp -msgid "Get lock" +msgid "No buffer space available" msgstr "" #: src/code/unix.lisp -msgid "Set owner" +msgid "Socket is already connected" msgstr "" #: src/code/unix.lisp -msgid "Set lock" +msgid "Socket is not connected" msgstr "" #: src/code/unix.lisp -msgid "Set lock, wait for release" +msgid "Can't send after socket shutdown" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking reads" +msgid "Too many references: can't splice" msgstr "" #: src/code/unix.lisp -msgid "Append on each write" +msgid "Connection timed out" msgstr "" #: src/code/unix.lisp -msgid "Signal pgrp when data ready" +msgid "Connection refused" msgstr "" #: src/code/unix.lisp -msgid "Create if nonexistant" +msgid "Too many levels of symbolic links" msgstr "" #: src/code/unix.lisp -msgid "Truncate to zero length" +msgid "File name too long" msgstr "" #: src/code/unix.lisp -msgid "Error if already created" +msgid "Host is down" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fcntl manipulates file descriptors according to the\n" -" argument CMD which can be one of the following:\n" -"\n" -" F-DUPFD Duplicate a file descriptor.\n" -" F-GETFD Get file descriptor flags.\n" -" F-SETFD Set file descriptor flags.\n" -" F-GETFL Get file flags.\n" -" F-SETFL Set file flags.\n" -" F-GETOWN Get owner.\n" -" F-SETOWN Set owner.\n" -"\n" -" The flags that can be specified for F-SETFL are:\n" -"\n" -" FNDELAY Non-blocking reads.\n" -" FAPPEND Append on each write.\n" -" FASYNC Signal pgrp when data ready.\n" -" FCREAT Create if nonexistant.\n" -" FTRUNC Truncate to zero length.\n" -" FEXCL Error if already created.\n" -" " +msgid "No route to host" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-link creates a hard link from the file with name1 to the\n" -" file with name2." +msgid "Directory not empty" msgstr "" #: src/code/unix.lisp -msgid "set the file pointer" +msgid "Too many processes" msgstr "" #: src/code/unix.lisp -msgid "increment the file pointer" +msgid "Too many users" msgstr "" #: src/code/unix.lisp -msgid "extend the file size" +msgid "Disc quota exceeded" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n" -" a certain offset for that file. Whence can be any of the following:\n" -"\n" -" l_set Set the file pointer.\n" -" l_incr Increment the file pointer.\n" -" l_xtnd Extend the file size.\n" -" _N" +msgid "namei should continue locally" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-mkdir creates a new directory with the specified name and mode.\n" -" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" -" NIL and an error number." +msgid "namei was handled remotely" msgstr "" #: src/code/unix.lisp -msgid "Read-only flag." +msgid "Remote file system error _N" msgstr "" #: src/code/unix.lisp -msgid "Write-only flag." +msgid "syscall was handled by Vice" msgstr "" #: src/code/unix.lisp -msgid "Read-write flag." +msgid "No message of desired type" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking I/O" +msgid "Identifier removed" msgstr "" #: src/code/unix.lisp -msgid "Append flag." +msgid "Channel number out of range" msgstr "" #: src/code/unix.lisp -msgid "Create if nonexistant flag." +msgid "Level 2 not synchronized" msgstr "" #: src/code/unix.lisp -msgid "Truncate flag." +msgid "Level 3 halted" msgstr "" #: src/code/unix.lisp -msgid "Error if already exists." +msgid "Level 3 reset" msgstr "" #: src/code/unix.lisp -msgid "Don't assign controlling tty" +msgid "Link number out of range" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking mode" +msgid "Protocol driver not attached" msgstr "" #: src/code/unix.lisp -msgid "Synchronous writes (on ext2)" +msgid "No CSI structure available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-open opens the file whose pathname is specified by path\n" -" for reading and/or writing as specified by the flags argument.\n" -" The flags argument can be:\n" -"\n" -" o_rdonly Read-only flag.\n" -" o_wronly Write-only flag.\n" -" o_rdwr Read-and-write flag.\n" -" o_append Append flag.\n" -" o_creat Create-if-nonexistant flag.\n" -" o_trunc Truncate-to-size-0 flag.\n" -"\n" -" If the o_creat flag is specified, then the file is created with\n" -" a permission of argument mode if the file doesn't exist. An\n" -" integer file descriptor is returned by unix-open." +msgid "Level 2 halted" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-pipe sets up a unix-piping mechanism consisting of\n" -" an input pipe and an output pipe. Unix-Pipe returns two\n" -" values: if no error occurred the first value is the pipe\n" -" to be read from and the second is can be written to. If\n" -" an error occurred the first value is NIL and the second\n" -" the unix error code." +msgid "Deadlock situation detected/avoided" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-read attempts to read from the file described by fd into\n" -" the buffer buf until it is full. Len is the length of the buffer.\n" -" The number of bytes actually read is returned or NIL and an error\n" -" number if an error occured." +msgid "No record locks available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-readlink invokes the readlink system call on the file name\n" -" specified by the simple string path. It returns up to two values:\n" -" the contents of the symbolic link if the call is successful, or\n" -" NIL and the Unix error number." +msgid "Error 47" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-rename renames the file with string name1 to the string\n" -" name2. NIL and an error code is returned if an error occured." +msgid "Error 48" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-rmdir attempts to remove the directory name. NIL and\n" -" an error number is returned if an error occured." +msgid "Bad exchange descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Perform the UNIX select(2) system call.\n" -" (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n" -" (type (or (alien (* (struct fd-set))) null)\n" -" read-fds write-fds exception-fds)\n" -" (type (or null (unsigned-byte 31)) timeout-secs)\n" -" (type (unsigned-byte 31) timeout-usecs)\n" -" (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" +msgid "Bad request descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-select examines the sets of descriptors passed as arguments\n" -" to see if they are ready for reading and writing. See the UNIX\n" -" Programmers Manual for more information." +msgid "Message tables full" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-sync writes all information in core memory which has been\n" -" modified to disk. It returns NIL and an error code if an error\n" -" occured." +msgid "Anode table overflow" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fsync writes the core image of the file described by\n" -" fd to disk." +msgid "Bad request code" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-truncate truncates the named file to the length (in\n" -" bytes) specified by len. NIL and an error number is returned\n" -" if the call is unsuccessful." +msgid "Invalid slot" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-ftruncate is similar to unix-truncate except that the first\n" -" argument is a file descriptor rather than a file name." +msgid "File locking deadlock" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-symlink creates a symbolic link named name2 to the file\n" -" named name1. NIL and an error number is returned if the call\n" -" is unsuccessful." +msgid "Bad font file format" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-unlink removes the directory entry for the named file.\n" -" NIL and an error code is returned if the call fails." +msgid "Not a stream device" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-write attempts to write a character buffer (buf) of length\n" -" len to the file described by the file descriptor fd. NIL and an\n" -" error is returned if the call is unsuccessful." +msgid "No data available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-ioctl performs a variety of operations on open i/o\n" -" descriptors. See the UNIX Programmer's Manual for more\n" -" information." +msgid "Timer expired" msgstr "" #: src/code/unix.lisp -msgid "Get terminal attributes." +msgid "Out of stream resources" msgstr "" #: src/code/unix.lisp -msgid "Set terminal attributes." +msgid "Machine is not on the network" msgstr "" #: src/code/unix.lisp -msgid "Get terminal output speed." +msgid "Package not installed" msgstr "" #: src/code/unix.lisp -msgid "Set terminal output speed." +msgid "Object is remote" msgstr "" #: src/code/unix.lisp -msgid "Bogus baud rate ~S" +msgid "Link has been severed" msgstr "" #: src/code/unix.lisp -msgid "Get terminal input speed." +msgid "Advertise error" msgstr "" #: src/code/unix.lisp -msgid "Set terminal input speed." +msgid "Srmount error" msgstr "" #: src/code/unix.lisp -msgid "Send break" +msgid "Communication error on send" msgstr "" #: src/code/unix.lisp -msgid "Wait for output for finish" +msgid "Protocol error" msgstr "" #: src/code/unix.lisp -msgid "See tcflush(3)" +msgid "Multihop attempted" msgstr "" #: src/code/unix.lisp -msgid "Flow control" +msgid "Not a data message" msgstr "" #: src/code/unix.lisp -msgid "Set the tty-process-group for the unix file-descriptor FD to PGRP." +msgid "Value too large for defined data type" msgstr "" #: src/code/unix.lisp -msgid "Get the tty-process-group for the unix file-descriptor FD." +msgid "Name not unique on network" msgstr "" #: src/code/unix.lisp -msgid "" -"Get the tty-process-group for the unix file-descriptor FD. If not supplied," -"\n" -" FD defaults to /dev/tty." +msgid "File descriptor in bad state" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not\n" -" supplied, FD defaults to /dev/tty." +msgid "Remote address changed" msgstr "" #: src/code/unix.lisp -msgid "Set the socket process-group for the unix file-descriptor FD to PGRP." +msgid "Can not access a needed shared library" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-exit terminates the current process with an optional\n" -" error code. If successful, the call doesn't return. If\n" -" unsuccessful, the call returns NIL and an error number." +msgid "Accessing a corrupted shared library" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-stat retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." +msgid ".lib section in a.out corrupted" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-lstat is similar to unix-stat except the specified\n" -" file must be a symbolic link." +msgid "Attempting to link in more shared libraries than system limit" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fstat is similar to unix-stat except the file is specified\n" -" by the file descriptor fd." +msgid "Can not exec a shared library directly" msgstr "" #: src/code/unix.lisp -msgid "The calling process." +msgid "Error 88" msgstr "" #: src/code/unix.lisp -msgid "Terminated child processes." +msgid "Operation not applicable" msgstr "" #: src/code/unix.lisp msgid "" -"Like call getrusage, but return only the system and user time, and returns\n" -" the seconds and microseconds as separate values." +"Number of symbolic links encountered during path name traversal exceeds " +"MAXSYMLINKS" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getrusage returns information about the resource usage\n" -" of the process specified by who. Who can be either the\n" -" current process (rusage_self) or all of the terminated\n" -" child processes (rusage_children). NIL and an error number\n" -" is returned if the call fails." +msgid "Error 91" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-times returns information about the cpu time usage of the process\n" -" and its children." +msgid "Error 92" msgstr "" #: src/code/unix.lisp -msgid "" -"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" -" microseconds of the current time of day, the timezone (in minutes west\n" -" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" -" returns NIL and the errno." +msgid "Option not supported by protocol" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" -" times on a specified file. NIL and an error number is\n" -" returned if the call is unsuccessful." +msgid "Operation not supported on transport endpoint" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setreuid sets the real and effective user-id's of the current\n" -" process to the specified ones. NIL and an error number is returned\n" -" if the call fails." +msgid "Cannot assign requested address" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setregid sets the real and effective group-id's of the current\n" -" process process to the specified ones. NIL and an error number is\n" -" returned if the call fails." +msgid "Network dropped connection because of reset" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpid returns the process-id of the current process." +msgid "Transport endpoint is already connected" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getppid returns the process-id of the parent of the current process." +msgid "Transport endpoint is not connected" msgstr "" #: src/code/unix.lisp -msgid "Unix-getgid returns the real group-id of the current process." +msgid "Cannot send after socket shutdown" msgstr "" #: src/code/unix.lisp -msgid "Unix-getegid returns the effective group-id of the current process." +msgid "Too many references: cannot splice" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpgrp returns the group-id of the calling process." +msgid "Stale NFS file handle" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setpgrp sets the process group on the process pid to\n" -" pgrp. NIL and an error number are returned upon failure." +msgid "Resource deadlock would occur" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setpgid sets the process group of the process pid to\n" -" pgrp. If pgid is equal to pid, the process becomes a process\n" -" group leader. NIL and an error number are returned upon failure." +msgid "Function not implemented" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getuid returns the real user-id associated with the\n" -" current process." +msgid "Too many symbolic links encountered" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." +msgid "Invalid exchange" msgstr "" #: src/code/unix.lisp -msgid "Unix-gethostname returns the name of the host machine as a string." +msgid "Invalid request descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-gethostid returns a 32-bit integer which provides unique\n" -" identification for the host machine." +msgid "Exchange full" msgstr "" #: src/code/unix.lisp -msgid "" -"Executes the unix fork system call. Returns 0 in the child and the pid\n" -" of the child in the parent if it works, or NIL and an error number if it\n" -" doesn't work." +msgid "No anode" msgstr "" #: src/code/unix.lisp -msgid "" -"Get the value of the environment variable named Name. If no such\n" -" variable exists, Nil is returned." +msgid "Invalid request code" msgstr "" #: src/code/unix.lisp -msgid "" -"Adds the environment variable named Name to the environment with\n" -" the given Value if Name does not already exist. If Name does exist,\n" -" the value is changed to Value if Overwrite is non-zero. Otherwise,\n" -" the value is not changed." +msgid "File locking deadlock error" msgstr "" #: src/code/unix.lisp -msgid "" -"Adds or changes the environment. Name-value must be a string of\n" -" the form \"name=value\". If the name does not exist, it is added.\n" -" If name does exist, the value is updated to the given value." +msgid "Device not a stream" msgstr "" #: src/code/unix.lisp -msgid "Removes the variable Name from the environment" +msgid "Out of streams resources" msgstr "" #: src/code/unix.lisp -msgid "Returns either :file, :directory, :link, :special, or NIL." +msgid "RFS specific error" msgstr "" #: src/code/unix.lisp -msgid "Returns the pathname with all symbolic links resolved." +msgid "Attempting to link in too many shared libraries" msgstr "" #: src/code/unix.lisp -msgid "Error reading link ~S: ~S" +msgid "Cannot exec a shared library directly" msgstr "" #: src/code/unix.lisp -msgid "" -"Accepts a Unix file descriptor and returns T if the device\n" -" associated with it is a terminal." +msgid "Illegal byte sequence" msgstr "" #: src/code/unix.lisp -msgid "" -"Executes the Unix execve system call. If the system call suceeds, lisp\n" -" will no longer be running in this process. If the system call fails " -"this\n" -" function returns two values: NIL and an error code. Arg-list should be " -"a\n" -" list of simple-strings which are passed as arguments to the exec'ed " -"program.\n" -" Environment should be an a-list mapping symbols to simple-strings which " -"this\n" -" function bashes together to form the environment for the exec'ed " -"program." +msgid "Interrupted system call should be restarted _N" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). On success,\n" -" unix-getitimer returns 5 values,\n" -" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." +msgid "Streams pipe error" msgstr "" #: src/code/unix.lisp -msgid "" -" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). A SIGALRM signal\n" -" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" -" when non-zero, is <seconds+microseconds> to be loaded each time\n" -" the timer expires. Setting INTERVAL and VALUE to zero disables\n" -" the timer. See the Unix man page for more details. On success,\n" -" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" -" slots as in unix-getitimer." +msgid "Address family not supported by protocol" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a USER-INFO structure for the user identified by LOGIN, or NIL if " -"not found." +msgid "Cannot send after transport endpoint shutdown" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a USER-INFO structure for the user identified by UID, or NIL if not " -"found." +msgid "Structure needs cleaning" +msgstr "" + +#: src/code/unix.lisp +msgid "Not a XENIX named type file" msgstr "" #: src/code/unix.lisp -msgid "The maximum size of the group entry buffer" +msgid "No XENIX semaphores available" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by NAME, or NIL if " -"not found." +msgid "Is a named type file" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by GID, or NIL if " -"not found." +msgid "Remote I/O error" msgstr "" #: src/code/unix.lisp -msgid "CPU time per process (in milliseconds)" +msgid "Quota exceeded" msgstr "" #: src/code/unix.lisp -msgid "Maximum file size" +msgid "" +"Returns a string describing the error number which was returned by a\n" +" UNIX system call." msgstr "" #: src/code/unix.lisp -msgid "Data segment size" +msgid "Unknown error [~d]" msgstr "" #: src/code/unix.lisp -msgid "Stack size" +msgid "" +"Perform the UNIX select(2) system call.\n" +" (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n" +" (type (or (alien (* (struct fd-set))) null)\n" +" read-fds write-fds exception-fds)\n" +" (type (or null (unsigned-byte 31)) timeout-secs)\n" +" (type (unsigned-byte 31) timeout-usecs)\n" +" (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" msgstr "" #: src/code/unix.lisp -msgid "Core file size" +msgid "" +"Unix-select examines the sets of descriptors passed as arguments\n" +" to see if they are ready for reading and writing. See the UNIX\n" +" Programmers Manual for more information." msgstr "" #: src/code/unix.lisp -msgid "Number of open files" +msgid "" +"Unix-symlink creates a symbolic link named name2 to the file\n" +" named name1. NIL and an error number is returned if the call\n" +" is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "Maximum mapped memory" +msgid "" +"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" +" microseconds of the current time of day, the timezone (in minutes west\n" +" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" +" returns NIL and the errno." msgstr "" #: src/code/unix.lisp -msgid "CPU time per process" +msgid "" +"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" +" times on a specified file. NIL and an error number is\n" +" returned if the call is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "File size" +msgid "Unix-getpid returns the process-id of the current process." msgstr "" #: src/code/unix.lisp -msgid "Addess space (resident set size)" +msgid "" +"Accepts a Unix file descriptor and returns T if the device\n" +" associated with it is a terminal." msgstr "" #: src/code/unix.lisp -msgid "Locked-in-memory address space" +msgid "" +" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). A SIGALRM signal\n" +" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" +" when non-zero, is <seconds+microseconds> to be loaded each time\n" +" the timer expires. Setting INTERVAL and VALUE to zero disables\n" +" the timer. See the Unix man page for more details. On success,\n" +" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" +" slots as in unix-getitimer." msgstr "" #: src/code/unix.lisp -msgid "Number of processes" +msgid "" +"Return a USER-INFO structure for the user identified by UID, or NIL if not " +"found." msgstr "" #: src/code/unix.lisp msgid "" -"Get the limits on the consumption of system resouce specified by\n" -" Resource. If successful, return three values: T, the current (soft)\n" -" limit, and the maximum (hard) limit." +"Unix-times returns information about the cpu time usage of the process\n" +" and its children." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/ea775196480fd9f029c2a701…

1 0

[cmucl/cmucl][rtoy-unix-core] More exported symbols for solaris.
by Raymond Toy 18 May '15

18 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: 7be5c100 by Raymond Toy at 2015-05-17T17:57:44Z More exported symbols for solaris. - - - - - 1 changed file: - src/code/exports.lisp Changes: ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -401,6 +401,7 @@ #+solaris (:export "D-INO" "D-OFF" + "DIRECT" "EADV" "EBADE" "EBADFD" @@ -448,13 +449,78 @@ "ESTRPIPE" "ETIME" "EUNATCH" + "EXECGRP" + "EXECOTH" + "EXECOWN" "EXFULL" + "F-DUPFD" + "F-GETFD" + "F-SETFD" + "FCREAT" + "FEXCL" + "FTRUNC" + "LTCHARS" "O_NOCTTY" "RCV1EN" + "READGRP" + "READOTH" + "READOWN" + "S-IEXEC" + "S-IREAD" + "S-ISGID" + "S-ISUID" + "S-ISVTX" + "S-IWRITE" + "SAVETEXT" + "SETGIDEXEC" + "SETUIDEXEC" + "SG-ERASE" + "SG-FLAGS" + "SG-ISPEED" + "SG-KILL" + "SG-OSPEED" + "SGTTYB" + "SIGEMT" + "SIGSYS" "SIGWAITING" + "T-BRKC" + "T-DSUSPC" + "T-EOFC" + "T-FLUSHC" + "T-INTRC" + "T-LNEXTC" + "T-QUITC" + "T-RPRNTC" + "T-STARTC" + "T-STOPC" + "T-SUSPC" + "T-WERASC" + "TCHARS" + "TCIFLUSH" + "TCIOFLUSH" + "TCOFLUSH" + "TIOCFLUSH" + "TIOCGETC" + "TIOCGETP" + "TIOCGLTC" + "TIOCSETC" + "TIOCSETP" + "TIOCSLTC" "TTY-CBAUD" + "TTY-CBREAK" + "TTY-CLOCAL" + "TTY-CREAD" + "TTY-CRMOD" + "TTY-CS5" + "TTY-CS6" + "TTY-CS7" + "TTY-CS8" + "TTY-CSIZE" + "TTY-CSTOPB" "TTY-DEFECHO" + "TTY-HUPCL" "TTY-IUCLC" + "TTY-LCASE" "TTY-LOBLK" "TTY-OCRNL" "TTY-OFDEL" @@ -462,9 +528,15 @@ "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" + "TTY-PARENB" + "TTY-PARODD" + "TTY-RAW" + "TTY-TANDEM" "TTY-XCASE" "UNIX-TIMES" "UTSNAME" + "WRITEGRP" + "WRITEOTH" "XMT1EN" )) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7be5c1003bd54c14a9ffd6bde…

1 0

[cmucl/cmucl][rtoy-unix-core] 2 commits: Regenerated.
by Raymond Toy 18 May '15

18 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: e46eaa11 by Raymond Toy at 2015-05-17T08:15:28Z Regenerated. - - - - - 7f683946 by Raymond Toy at 2015-05-17T17:04:37Z Add exported symbols for solaris unix.lisp. - - - - - 2 changed files: - src/code/exports.lisp - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -357,7 +357,7 @@ "FIONREAD" "TERMINAL-SPEEDS" ) - #-linux + #-(or linux solaris) (:export "TCHARS" "LTCHARS" "D-NAMLEN" @@ -397,8 +397,76 @@ "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" "UTSNAME" + ) + #+solaris + (:export "D-INO" + "D-OFF" + "EADV" + "EBADE" + "EBADFD" + "EBADMSG" + "EBADR" + "EBADRQC" + "EBADSLT" + "EBFONT" + "ECANCELED" + "ECHRNG" + "ECOMM" + "EDEADLOCK" + "EIDRM" + "EILSEQ" + "EL2HLT" + "EL2NSYNC" + "EL3HLT" + "EL3RST" + "ELIBACC" + "ELIBBAD" + "ELIBEXEC" + "ELIBMAX" + "ELIBSCN" + "ELNRNG" + "EMULTIHOP" + "ENOANO" + "ENOCSI" + "ENODATA" + "ENOLCK" + "ENOLINK" + "ENOMSG" + "ENONET" + "ENOPKG" + "ENOSR" + "ENOSTR" + "ENOSYS" + "ENOTSUP" + "ENOTUNIQ" + "EOVERFLOW" + "EPROTO" + "EREMCHG" + "ERESTART" + "ESRMNT" + "ESTALE" + "ESTRPIPE" + "ETIME" + "EUNATCH" + "EXFULL" + "O_NOCTTY" + "RCV1EN" + "SIGWAITING" + "TTY-CBAUD" + "TTY-DEFECHO" + "TTY-IUCLC" + "TTY-LOBLK" + "TTY-OCRNL" + "TTY-OFDEL" + "TTY-OFILL" + "TTY-OLCUC" + "TTY-ONLRET" + "TTY-ONOCR" + "TTY-XCASE" + "UNIX-TIMES" + "UTSNAME" + "XMT1EN" )) - (defpackage "FORMAT") ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -1230,3 +1230,9 @@ msgid "" "found." msgstr "" +#: src/code/unix.lisp +msgid "" +"Unix-times returns information about the cpu time usage of the process\n" +" and its children." +msgstr "" + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0f59b9a32ebf2d210386bd30…

1 0

[cmucl/cmucl][rtoy-unix-core] Regenerated.
by Raymond Toy 17 May '15

17 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: 0f59b9a3 by Raymond Toy at 2015-05-17T08:00:51Z Regenerated. - - - - - 1 changed file: - src/i18n/locale/cmucl-unix-glibc2.pot Changes: ===================================== src/i18n/locale/cmucl-unix-glibc2.pot ===================================== --- a/src/i18n/locale/cmucl-unix-glibc2.pot +++ b/src/i18n/locale/cmucl-unix-glibc2.pot @@ -16,712 +16,701 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/unix-glibc2.lisp -msgid "Class not yet defined: ~S" +msgid "" +"Put the absolute pathname of the current working directory in BUF.\n" +" If successful, return BUF. If not, put an error message in\n" +" BUF and return NULL. BUF should be at least PATH_MAX bytes long." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Returns a string describing the error number which was returned by a\n" -" UNIX system call." +msgid "Open for reading" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unknown error [~d]" +msgid "Open for writing" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-rename renames the file with string name1 to the string\n" -" name2. NIL and an error code is returned if an error occured." +msgid "Read-only flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for read permission" +msgid "Write-only flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for write permission" +msgid "Read-write flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for execute permission" +msgid "Access mode mask." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test for presence of file" +msgid "Create if nonexistant flag. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-fcntl manipulates file descriptors accoridng to the\n" -" argument CMD which can be one of the following:\n" -"\n" -" F-DUPFD Duplicate a file descriptor.\n" -" F-GETFD Get file descriptor flags.\n" -" F-SETFD Set file descriptor flags.\n" -" F-GETFL Get file flags.\n" -" F-SETFL Set file flags.\n" -" F-GETOWN Get owner.\n" -" F-SETOWN Set owner.\n" -"\n" -" The flags that can be specified for F-SETFL are:\n" -"\n" -" FNDELAY Non-blocking reads.\n" -" FAPPEND Append on each write.\n" -" FASYNC Signal pgrp when data ready.\n" -" FCREAT Create if nonexistant.\n" -" FTRUNC Truncate to zero length.\n" -" FEXCL Error if already created.\n" -" " +msgid "Error if already exists. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-open opens the file whose pathname is specified by PATH\n" -" for reading and/or writing as specified by the FLAGS argument.\n" -" Returns an integer file descriptor.\n" -" The flags argument can be:\n" -"\n" -" o_rdonly Read-only flag.\n" -" o_wronly Write-only flag.\n" -" o_rdwr Read-and-write flag.\n" -" o_append Append flag.\n" -" o_creat Create-if-nonexistant flag.\n" -" o_trunc Truncate-to-size-0 flag.\n" -" o_excl Error if the file already exists\n" -" o_noctty Don't assign controlling tty\n" -" o_ndelay Non-blocking I/O\n" -" o_sync Synchronous I/O\n" -" o_async Asynchronous I/O\n" -"\n" -" If the o_creat flag is specified, then the file is created with\n" -" a permission of argument MODE if the file doesn't exist." +msgid "Don't assign controlling tty. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-getdtablesize returns the maximum size of the file descriptor\n" -" table. (i.e. the maximum number of descriptors that can exist at\n" -" one time.)" +msgid "Truncate flag. (not fcntl)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-close takes an integer file descriptor as an argument and\n" -" closes the file associated with it. T is returned upon successful\n" -" completion, otherwise NIL and an error number." +msgid "Append flag." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-creat accepts a file name and a mode (same as those for\n" -" unix-chmod) and creates a file by that name with the specified\n" -" permission mode. It returns a file descriptor on success,\n" -" or NIL and an error number otherwise.\n" -"\n" -" This interface is made obsolete by UNIX-OPEN." +msgid "Non-blocking I/O" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open for reading" +msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open for writing" +msgid "Asynchronous I/O" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read-only flag." +msgid "Get lock" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Write-only flag." +msgid "Set lock" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read-write flag." +msgid "Set lock, wait for release" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Access mode mask." +msgid "Set owner (for sockets)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Create if nonexistant flag. (not fcntl)" +msgid "Get owner (for sockets)" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Error if already exists. (not fcntl)" +msgid "for f-getfl and f-setfl" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Don't assign controlling tty. (not fcntl)" +msgid "" +"Unix-open opens the file whose pathname is specified by PATH\n" +" for reading and/or writing as specified by the FLAGS argument.\n" +" Returns an integer file descriptor.\n" +" The flags argument can be:\n" +"\n" +" o_rdonly Read-only flag.\n" +" o_wronly Write-only flag.\n" +" o_rdwr Read-and-write flag.\n" +" o_append Append flag.\n" +" o_creat Create-if-nonexistant flag.\n" +" o_trunc Truncate-to-size-0 flag.\n" +" o_excl Error if the file already exists\n" +" o_noctty Don't assign controlling tty\n" +" o_ndelay Non-blocking I/O\n" +" o_sync Synchronous I/O\n" +" o_async Asynchronous I/O\n" +"\n" +" If the o_creat flag is specified, then the file is created with\n" +" a permission of argument MODE if the file doesn't exist." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Truncate flag. (not fcntl)" +msgid "Successful" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Append flag." +msgid "Operation not permitted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-blocking I/O" +msgid "No such file or directory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Synchronous writes (on ext2)" +msgid "No such process" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Asynchronous I/O" +msgid "Interrupted system call" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Duplicate a file descriptor" +msgid "I/O error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file desc. flags" +msgid "No such device or address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set file desc. flags" +msgid "Arg list too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file flags" +msgid "Exec format error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set file flags" +msgid "Bad file number" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get lock" +msgid "No children" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set lock" +msgid "Try again" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set lock, wait for release" +msgid "Out of memory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set owner (for sockets)" +msgid "Permission denied" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get owner (for sockets)" +msgid "Bad address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "for f-getfl and f-setfl" +msgid "Block device required" msgstr "" #: src/code/unix-glibc2.lisp -msgid "for fcntl and lockf" +msgid "Device or resource busy" msgstr "" #: src/code/unix-glibc2.lisp -msgid "old bsd flock (depricated)" +msgid "File exists" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Shared lock for bsd flock" +msgid "Cross-device link" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Exclusive lock for bsd flock" +msgid "No such device" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Don't block. Combine with F-LOCK-SH or F-LOCK-EX" +msgid "Not a director" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Remove lock for bsd flock" +msgid "Is a directory" msgstr "" #: src/code/unix-glibc2.lisp -msgid "depricated stuff" +msgid "Invalid argument" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Rewind the group-file stream." +msgid "File table overflow" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close the group-file stream." +msgid "Too many open files" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read an entry from the group-file stream, opening it if necessary." +msgid "Not a typewriter" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Size of control character vector." +msgid "Text file busy" msgstr "" #: src/code/unix-glibc2.lisp -msgid "See errno." +msgid "File too large" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No problem." +msgid "No space left on device" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Authoritative Answer Host not found." +msgid "Illegal seek" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-Authoritative Host not found,or SERVERFAIL." +msgid "Read-only file system" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non recoverable errors, FORMERR, REFUSED, NOTIMP." +msgid "Too many links" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Valid name, no data record of requested type." +msgid "Broken pipe" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No address, look for MX record." +msgid "Math argument out of domain" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open host data base files and mark them as staying open even after\n" -"a later search if STAY_OPEN is non-zero." +msgid "Math result not representable" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close host data base files and clear `stay open' flag." +msgid "Resource deadlock would occur" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get next entry from host data base file. Open data base if\n" -"necessary." +msgid "File name too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from host data base which address match ADDR with\n" -"length LEN and type TYPE." +msgid "No record locks available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from host data base for host with NAME." +msgid "Function not implemented" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from host data base for host with NAME. AF must be\n" -" set to the address type which as `AF_INET' for IPv4 or `AF_INET6'\n" -" for IPv6." +msgid "Directory not empty" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open network data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "Too many symbolic links encountered" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close network data base files and clear `stay open' flag." +msgid "Operation would block" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from network data base file. Open data base if\n" -" necessary." +msgid "No message of desired type" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from network data base which address match NET and\n" -" type TYPE." +msgid "Identifier removed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from network data base for network with NAME." +msgid "Channel number out of range" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open service data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "Level 2 not synchronized" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close service data base files and clear `stay open' flag." +msgid "Level 3 halted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from service data base file. Open data base if\n" -" necessary." +msgid "Level 3 reset" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from network data base for network with NAME and\n" -" protocol PROTO." +msgid "Link number out of range" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Return entry from service data base which matches port PORT and\n" -" protocol PROTO." +msgid "Protocol driver not attached" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Open protocol data base files and mark them as staying open even\n" -" after a later search if STAY_OPEN is non-zero." +msgid "No CSI structure available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close protocol data base files and clear `stay open' flag." +msgid "Level 2 halted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next entry from protocol data base file. Open data base if\n" -" necessary." +msgid "Invalid exchange" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from protocol data base for network with NAME." +msgid "Invalid request descriptor" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return entry from protocol data base which number is PROTO." +msgid "Exchange full" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Establish network group NETGROUP for enumeration." +msgid "No anode" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Free all space allocated by previous `setnetgrent' call." +msgid "Invalid request code" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Get next member of netgroup established by last `setnetgrent' call\n" -" and return pointers to elements in HOSTP, USERP, and DOMAINP." +msgid "Invalid slot" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)." +msgid "File locking deadlock error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Socket address is intended for `bind'." +msgid "Bad font file format" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Request for canonical name." +msgid "Device not a stream" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Invalid value for `ai_flags' field." +msgid "No data available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "NAME or SERVICE is unknown." +msgid "Timer expired" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Temporary failure in name resolution." +msgid "Out of streams resources" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Non-recoverable failure in name res." +msgid "Machine is not on the network" msgstr "" #: src/code/unix-glibc2.lisp -msgid "No address associated with NAME." +msgid "Package not installed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "ai_family not supported." +msgid "Object is remote" msgstr "" #: src/code/unix-glibc2.lisp -msgid "ai_socktype not supported." +msgid "Link has been severed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "SERVICE not supported for ai_socktype." +msgid "Advertise error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Address family for NAME not supported." +msgid "Srmount error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Memory allocation failure." +msgid "Communication error on send" msgstr "" #: src/code/unix-glibc2.lisp -msgid "System error returned in errno." +msgid "Protocol error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Translate name of a service location and/or a service name to set of\n" -" socket addresses." +msgid "Multihop attempted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Free `addrinfo' structure AI including associated storage." +msgid "RFS specific error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create pseudo tty master slave pair with NAME and set terminal\n" -" attributes according to TERMP and WINP and return handles for both\n" -" ends in AMASTER and ASLAVE." +msgid "Not a data message" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create child process and establish the slave pseudo terminal as the\n" -" child's controlling terminal." +msgid "Value too large for defined data type" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Rewind the password-file stream." +msgid "Name not unique on network" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close the password-file stream." +msgid "File descriptor in bad state" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read an entry from the password-file stream, opening it if necessary." +msgid "Remote address changed" msgstr "" #: src/code/unix-glibc2.lisp -msgid "The calling process." +msgid "Can not access a needed shared library" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Terminated child processes." +msgid "Accessing a corrupted shared library" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Minimum priority a process can have" +msgid ".lib section in a.out corrupted" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Maximum priority a process can have" +msgid "Attempting to link in too many shared libraries" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a process ID" +msgid "Cannot exec a shared library directly" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a process group ID" +msgid "Illegal byte sequence" msgstr "" #: src/code/unix-glibc2.lisp -msgid "WHO is a user ID" +msgid "Interrupted system call should be restarted _N" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set scheduling algorithm and/or parameters for a process." +msgid "Streams pipe error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Retrieve scheduling algorithm for a particular purpose." +msgid "Too many users" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get maximum priority value for a scheduler." +msgid "Socket operation on non-socket" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get minimum priority value for a scheduler." +msgid "Destination address required" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the SCHED_RR interval for the named process." +msgid "Message too long" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Signal mask to be sent at exit." +msgid "Protocol wrong type for socket" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if VM shared between processes." +msgid "Protocol not available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if fs info shared between processes" +msgid "Protocol not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if open files shared between processe" +msgid "Socket type not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if signal handlers shared." +msgid "Operation not supported on transport endpoint" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set if pid shared." +msgid "Protocol family not supported" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Open database for reading." +msgid "Address family not supported by protocol" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Close database." +msgid "Address already in use" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get next entry from database, perhaps after opening the file." +msgid "Cannot assign requested address" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get shadow entry matching NAME." +msgid "Network is down" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read shadow entry from STRING." +msgid "Network is unreachable" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Protect password file against multi writers." +msgid "Network dropped connection because of reset" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unlock password file." +msgid "Software caused connection abort" msgstr "" #: src/code/unix-glibc2.lisp -msgid "These bits determine file type." +msgid "Connection reset by peer" msgstr "" #: src/code/unix-glibc2.lisp -msgid "FIFO" +msgid "No buffer space available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Character device" +msgid "Transport endpoint is already connected" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Directory" +msgid "Transport endpoint is not connected" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Block device" +msgid "Cannot send after transport endpoint shutdown" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Regular file" +msgid "Too many references: cannot splice" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Symbolic link." +msgid "Connection timed out" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Socket." +msgid "Connection refused" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set user ID on execution." +msgid "Host is down" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set group ID on execution." +msgid "No route to host" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Save swapped text after use (sticky)." +msgid "Operation already in progress" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Read by owner" +msgid "Operation now in progress" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Write by owner." +msgid "Stale NFS file handle" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Execute by owner." +msgid "Structure needs cleaning" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal output speed." +msgid "Not a XENIX named type file" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal output speed." +msgid "No XENIX semaphores available" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Bogus baud rate ~S" +msgid "Is a named type file" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal input speed." +msgid "Remote I/O error" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal input speed." +msgid "Quota exceeded" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get terminal attributes." +msgid "" +"Returns a string describing the error number which was returned by a\n" +" UNIX system call." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Set terminal attributes." +msgid "Unknown error [~d]" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "" +"Unix-write attempts to write a character buffer (buf) of length\n" +" len to the file described by the file descriptor fd. NIL and an\n" +" error is returned if the call is unsuccessful." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "" +"Unix-pipe sets up a unix-piping mechanism consisting of\n" +" an input pipe and an output pipe. Unix-Pipe returns two\n" +" values: if no error occurred the first value is the pipe\n" +" to be read from and the second is can be written to. If\n" +" an error occurred the first value is NIL and the second\n" +" the unix error code." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Send break" +msgid "" +"UNIX-READ attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Wait for output for finish" +msgid "Unix-getpagesize returns the number of bytes in a system page." msgstr "" #: src/code/unix-glibc2.lisp -msgid "See tcflush(3)" +msgid "" +"UNIX-STAT retrieves information about the specified\n" +" file returning them in the form of multiple values.\n" +" See the UNIX Programmer's Manual for a description\n" +" of the values returned. If the call fails, then NIL\n" +" and an error number is returned instead." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Flow control" +msgid "" +"UNIX-FSTAT is similar to UNIX-STAT except the file is specified\n" +" by the file descriptor FD." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Executes the Unix execve system call. If the system call suceeds, lisp\n" -" will no longer be running in this process. If the system call fails " -"this\n" -" function returns two values: NIL and an error code. Arg-list should be " -"a\n" -" list of simple-strings which are passed as arguments to the exec'ed " -"program.\n" -" Environment should be an a-list mapping symbols to simple-strings which " -"this\n" -" function bashes together to form the environment for the exec'ed " -"program." +"UNIX-LSTAT is similar to UNIX-STAT except the specified\n" +" file must be a symbolic link." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "These bits determine file type." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "FIFO" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Character device" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Directory" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Block device" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Regular file" +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Symbolic link." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Socket." +msgstr "" + +#: src/code/unix-glibc2.lisp +msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" #: src/code/unix-glibc2.lisp @@ -763,55 +752,35 @@ msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-READ attempts to read from the file described by fd into\n" -" the buffer buf until it is full. Len is the length of the buffer.\n" -" The number of bytes actually read is returned or NIL and an error\n" -" number if an error occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-write attempts to write a character buffer (buf) of length\n" -" len to the file described by the file descriptor fd. NIL and an\n" -" error is returned if the call is unsuccessful." +"Unix-close takes an integer file descriptor as an argument and\n" +" closes the file associated with it. T is returned upon successful\n" +" completion, otherwise NIL and an error number." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-pipe sets up a unix-piping mechanism consisting of\n" -" an input pipe and an output pipe. Unix-Pipe returns two\n" -" values: if no error occurred the first value is the pipe\n" -" to be read from and the second is can be written to. If\n" -" an error occurred the first value is NIL and the second\n" -" the unix error code." +"Unix-creat accepts a file name and a mode (same as those for\n" +" unix-chmod) and creates a file by that name with the specified\n" +" permission mode. It returns a file descriptor on success,\n" +" or NIL and an error number otherwise.\n" +"\n" +" This interface is made obsolete by UNIX-OPEN." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path, an integer user-id, and an integer group-id,\n" -" unix-chown changes the owner of the file and the group of the\n" -" file to those specified. Either the owner or the group may be\n" -" left unchanged by specifying them as -1. Note: Permission will\n" -" fail if the caller is not the superuser." +msgid "Returns the pathname with all symbolic links resolved." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-fchown is like unix-chown, except that it accepts an integer\n" -" file descriptor instead of a file path name." +msgid "Error reading link ~S: ~S" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path string, unix-chdir changes the current working \n" -" directory to the one specified." +msgid "Unix-gethostname returns the name of the host machine as a string." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Put the absolute pathname of the current working directory in BUF.\n" -" If successful, return BUF. If not, put an error message in\n" -" BUF and return NULL. BUF should be at least PATH_MAX bytes long." +msgid "Syscall ~A failed: ~A" msgstr "" #: src/code/unix-glibc2.lisp @@ -838,200 +807,224 @@ msgid "" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get file-specific configuration information about PATH." +msgid "" +"Unix-getuid returns the real user-id associated with the\n" +" current process." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the value of the system variable NAME." +msgid "" +"Given a file path string, unix-chdir changes the current working \n" +" directory to the one specified." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the value of the string-valued system variable NAME." +msgid "" +"Given a file path string and a constant mode, unix-chmod changes the\n" +" permission mode for that file to the one specified. The new mode\n" +" can be created by logically OR'ing the following:\n" +"\n" +" setuidexec Set user ID on execution.\n" +" setgidexec Set group ID on execution.\n" +" savetext Save text image after execution.\n" +" readown Read by owner.\n" +" writeown Write by owner.\n" +" execown Execute (search directory) by owner.\n" +" readgrp Read by group.\n" +" writegrp Write by group.\n" +" execgrp Execute (search directory) by group.\n" +" readoth Read by others.\n" +" writeoth Write by others.\n" +" execoth Execute (search directory) by others.\n" +"\n" +" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" +" are equivalent for 'mode. The octal-base is familar to Unix users.\n" +" \n" +" It returns T on successfully completion; NIL and an error number\n" +" otherwise." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getpid returns the process-id of the current process." +msgid "" +"Given an integer file descriptor and a mode (the same as those\n" +" used for unix-chmod), unix-fchmod changes the permission mode\n" +" for that file to the one specified. T is returned if the call\n" +" was successful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-getppid returns the process-id of the parent of the current process." +"Unix-readlink invokes the readlink system call on the file name\n" +" specified by the simple string path. It returns up to two values:\n" +" the contents of the symbolic link if the call is successful, or\n" +" NIL and the Unix error number." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getpgrp returns the group-id of the calling process." +msgid "" +"Unix-unlink removes the directory entry for the named file.\n" +" NIL and an error code is returned if the call fails." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setpgrp sets the process group on the process pid to\n" -" pgrp. NIL and an error number are returned upon failure." +msgid "Test for read permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setpgid sets the process group of the process pid to\n" -" pgrp. If pgid is equal to pid, the process becomes a process\n" -" group leader. NIL and an error number are returned upon failure." +msgid "Test for write permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Create a new session with the calling process as its leader.\n" -" The process group IDs of the session and the calling process\n" -" are set to the process ID of the calling process, which is returned." +msgid "Test for execute permission" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return the session ID of the given process." +msgid "Test for presence of file" msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-getuid returns the real user-id associated with the\n" -" current process." +"Unix-fcntl manipulates file descriptors accoridng to the\n" +" argument CMD which can be one of the following:\n" +"\n" +" F-DUPFD Duplicate a file descriptor.\n" +" F-GETFD Get file descriptor flags.\n" +" F-SETFD Set file descriptor flags.\n" +" F-GETFL Get file flags.\n" +" F-SETFL Set file flags.\n" +" F-GETOWN Get owner.\n" +" F-SETOWN Set owner.\n" +"\n" +" The flags that can be specified for F-SETFL are:\n" +"\n" +" FNDELAY Non-blocking reads.\n" +" FAPPEND Append on each write.\n" +" FASYNC Signal pgrp when data ready.\n" +" FCREAT Create if nonexistant.\n" +" FTRUNC Truncate to zero length.\n" +" FEXCL Error if already created.\n" +" " msgstr "" #: src/code/unix-glibc2.lisp -msgid "Get the effective user ID of the calling process." +msgid "" +"Unix-rename renames the file with string name1 to the string\n" +" name2. NIL and an error code is returned if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getgid returns the real group-id of the current process." +msgid "" +"Unix-rmdir attempts to remove the directory name. NIL and\n" +" an error number is returned if an error occured." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Unix-getegid returns the effective group-id of the current process." +msgid "" +"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" +" then ioctl argument size and direction are included as for ioctls defined\n" +" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" +" is the characters code, else DEV may be an integer giving the type." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Return nonzero iff the calling process is in group GID." +msgid "Get file flags" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the user ID of the calling process to UID.\n" -" If the calling process is the super-user, set the real\n" -" and effective user IDs, and the saved set-user-ID to UID;\n" -" if not, the effective user ID is set to UID." +msgid "Set file flags" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setreuid sets the real and effective user-id's of the current\n" -" process to the specified ones. NIL and an error number is returned\n" -" if the call fails." +msgid "depricated stuff" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the group ID of the calling process to GID.\n" -" If the calling process is the super-user, set the real\n" -" and effective group IDs, and the saved set-group-ID to GID;\n" -" if not, the effective group ID is set to GID." +msgid "The calling process." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-setregid sets the real and effective group-id's of the current\n" -" process process to the specified ones. NIL and an error number is\n" -" returned if the call fails." +msgid "Class not yet defined: ~S" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Executes the unix fork system call. Returns 0 in the child and the pid\n" -" of the child in the parent if it works, or NIL and an error number if it\n" -" doesn't work." +msgid "Terminated child processes." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Get the value of the environment variable named Name. If no such\n" -" variable exists, Nil is returned." +"Like call getrusage, but return only the system and user time, and returns\n" +" the seconds and microseconds as separate values." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Adds the environment variable named Name to the environment with\n" -" the given Value if Name does not already exist. If Name does exist,\n" -" the value is changed to Value if Overwrite is non-zero. Otherwise,\n" -" the value is not changed." +"Unix-getrusage returns information about the resource usage\n" +" of the process specified by who. Who can be either the\n" +" current process (rusage_self) or all of the terminated\n" +" child processes (rusage_children). NIL and an error number\n" +" is returned if the call fails." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Adds or changes the environment. Name-value must be a string of\n" -" the form \"name=value\". If the name does not exist, it is added.\n" -" If name does exist, the value is updated to the given value." +msgid "Perform the UNIX select(2) system call." msgstr "" #: src/code/unix-glibc2.lisp -msgid "Removes the variable Name from the environment" +msgid "" +"Unix-select examines the sets of descriptors passed as arguments\n" +" to see if they are ready for reading and writing. See the UNIX\n" +" Programmers Manual for more information." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Accepts a Unix file descriptor and returns T if the device\n" -" associated with it is a terminal." +"Unix-symlink creates a symbolic link named name2 to the file\n" +" named name1. NIL and an error number is returned if the call\n" +" is unsuccessful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-link creates a hard link from the file with name1 to the\n" -" file with name2." +"Unix-gethostid returns a 32-bit integer which provides unique\n" +" identification for the host machine." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-symlink creates a symbolic link named name2 to the file\n" -" named name1. NIL and an error number is returned if the call\n" -" is unsuccessful." +msgid "Unix-getpid returns the process-id of the current process." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-readlink invokes the readlink system call on the file name\n" -" specified by the simple string path. It returns up to two values:\n" -" the contents of the symbolic link if the call is successful, or\n" -" NIL and the Unix error number." +"Return a USER-INFO structure for the user identified by UID, or NIL if not " +"found." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-unlink removes the directory entry for the named file.\n" -" NIL and an error code is returned if the call fails." +"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" +" microseconds of the current time of day, the timezone (in minutes west\n" +" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" +" returns NIL and the errno." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Unix-rmdir attempts to remove the directory name. NIL and\n" -" an error number is returned if an error occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Get the tty-process-group for the unix file-descriptor FD." +"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" +" times on a specified file. NIL and an error number is\n" +" returned if the call is unsuccessful." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Get the tty-process-group for the unix file-descriptor FD. If not supplied," -"\n" -" FD defaults to /dev/tty." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set the tty-process-group for the unix file-descriptor FD to PGRP." +"Accepts a Unix file descriptor and returns T if the device\n" +" associated with it is a terminal." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not\n" -" supplied, FD defaults to /dev/tty." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return the login name of the user." +"Create pseudo tty master slave pair with NAME and set terminal\n" +" attributes according to TERMP and WINP and return handles for both\n" +" ends in AMASTER and ASLAVE." msgstr "" #: src/code/unix-glibc2.lisp @@ -1042,125 +1035,6 @@ msgid "" msgstr "" #: src/code/unix-glibc2.lisp -msgid "Syscall ~A failed: ~A" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unix-gethostname returns the name of the host machine as a string." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-fsync writes the core image of the file described by\n" -" fd to disk." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Revoke access permissions to all processes currently communicating\n" -" with the control terminal, and then send a SIGHUP signal to the process\n" -" group of the control terminal." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Revoke the access of all descriptors currently open on FILE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make PATH be the root directory (the starting point for absolute paths).\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-gethostid returns a 32-bit integer which provides unique\n" -" identification for the host machine." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-sync writes all information in core memory which has been\n" -" modified to disk. It returns NIL and an error code if an error\n" -" occured." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-truncate truncates the named file to the length (in\n" -" bytes) specified by LENGTH. NIL and an error number is returned\n" -" if the call is unsuccessful." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-ftruncate is similar to unix-truncate except that the first\n" -" argument is a file descriptor rather than a file name." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return the maximum number of file descriptors\n" -" the current process could possibly have." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Unlock a locked region" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Lock a region for exclusive use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Test and lock a region for exclusive use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Test a region for othwer processes locks" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-locks can lock, unlock and test files according to the cmd\n" -" which can be one of the following:\n" -"\n" -" f_ulock Unlock a locked region\n" -" f_lock Lock a region for exclusive use\n" -" f_tlock Test and lock a region for exclusive use\n" -" f_test Test a region for othwer processes locks\n" -"\n" -" The lock is for a region from the current location for a length\n" -" of length.\n" -"\n" -" This is a simpler version of the interface provided by unix-fcntl.\n" -" " -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" -" times on a specified file. NIL and an error number is\n" -" returned if the call is unsuccessful." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Don't block waiting." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Report status of stopped children." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Wait for cloned process." -msgstr "" - -#: src/code/unix-glibc2.lisp msgid "" "Unix-ioctl performs a variety of operations on open i/o\n" " descriptors. See the UNIX Programmer's Manual for more\n" @@ -1169,867 +1043,48 @@ msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"Change uid used for file access control to UID, without affecting\n" -" other priveledges (such as who can send signals at the process)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Change gid used for file access control to GID, without affecting\n" -" other priveledges (such as who can send signals at the process)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "There is data to read." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "There is urgent data to read." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Writing now will not block." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Error condition." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Hung up." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid polling request." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Canonical number of polling requests to read\n" -"in at a time in poll." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -" Poll the file descriptors described by the NFDS structures starting at\n" -" FDS. If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for\n" -" an event to occur; if TIMEOUT is -1, block until an event occurs.\n" -" Returns the number of file descriptors with events, zero if timed out,\n" -" or -1 for errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Get the soft and hard limits for RESOURCE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Set the current soft and hard maximum limits for RESOURCE.\n" -" Only the super-user can increase hard limits." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Like call getrusage, but return only the system and user time, and returns\n" -" the seconds and microseconds as separate values." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-getrusage returns information about the resource usage\n" -" of the process specified by who. Who can be either the\n" -" current process (rusage_self) or all of the terminated\n" -" child processes (rusage_children). NIL and an error number\n" -" is returned if the call fails." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Function depends on CMD:\n" -" 1 = Return the limit on the size of a file, in units of 512 bytes.\n" -" 2 = Set the limit on the size of a file to NEWLIMIT. Only the\n" -" super-user can increase the limit.\n" -" 3 = Return the maximum possible address of the data segment.\n" -" 4 = Return the maximum number of files that the calling process can open.\n" -" Returns -1 on errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return the highest priority of any process specified by WHICH and WHO\n" -" (see above); if WHO is zero, the current process, process group, or user\n" -" (as specified by WHO) is used. A lower priority number means higher\n" -" priority. Priorities range from PRIO_MIN to PRIO_MAX (above)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Set the priority of all processes specified by WHICH and WHO (see above)\n" -" to PRIO. Returns 0 on success, -1 on errors." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Perform the UNIX select(2) system call." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-select examines the sets of descriptors passed as arguments\n" -" to see if they are ready for reading and writing. See the UNIX\n" -" Programmers Manual for more information." +"Unix-mkdir creates a new directory with the specified name and mode.\n" +" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" +" NIL and an error number." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-STAT retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." +"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). On success,\n" +" unix-getitimer returns 5 values,\n" +" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." msgstr "" #: src/code/unix-glibc2.lisp msgid "" -"UNIX-FSTAT is similar to UNIX-STAT except the file is specified\n" -" by the file descriptor FD." +" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). A SIGALRM signal\n" +" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" +" when non-zero, is <seconds+microseconds> to be loaded each time\n" +" the timer expires. Setting INTERVAL and VALUE to zero disables\n" +" the timer. See the Unix man page for more details. On success,\n" +" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" +" slots as in unix-getitimer." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"UNIX-LSTAT is similar to UNIX-STAT except the specified\n" -" file must be a symbolic link." +msgid "Size of control character vector." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given a file path string and a constant mode, unix-chmod changes the\n" -" permission mode for that file to the one specified. The new mode\n" -" can be created by logically OR'ing the following:\n" -"\n" -" setuidexec Set user ID on execution.\n" -" setgidexec Set group ID on execution.\n" -" savetext Save text image after execution.\n" -" readown Read by owner.\n" -" writeown Write by owner.\n" -" execown Execute (search directory) by owner.\n" -" readgrp Read by group.\n" -" writegrp Write by group.\n" -" execgrp Execute (search directory) by group.\n" -" readoth Read by others.\n" -" writeoth Write by others.\n" -" execoth Execute (search directory) by others.\n" -"\n" -" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" -" are equivalent for 'mode. The octal-base is familar to Unix users.\n" -" \n" -" It returns T on successfully completion; NIL and an error number\n" -" otherwise." +msgid "Get terminal attributes." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Given an integer file descriptor and a mode (the same as those\n" -" used for unix-chmod), unix-fchmod changes the permission mode\n" -" for that file to the one specified. T is returned if the call\n" -" was successful." +msgid "Set terminal attributes." msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Set the file creation mask of the current process to MASK,\n" -" and return the old creation mask." +msgid "Write by owner" msgstr "" #: src/code/unix-glibc2.lisp -msgid "" -"Unix-mkdir creates a new directory with the specified name and mode.\n" -" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" -" NIL and an error number." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Create a device file named PATH, with permission and special bits MODE\n" -" and device number DEV (which can be constructed from major and minor\n" -" device numbers with the `makedev' macro above)." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Create a new FIFO named PATH, with permission bits MODE." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return information about the filesystem on which FILE resides." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make the block special device PATH available to the system for swapping.\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Make the block special device PATH unavailable to the system for swapping.\n" -" This call is restricted to the super-user." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read or write system parameters." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Time used by the program so far (user time + system time).\n" -" The result / CLOCKS_PER_SECOND is program time in seconds." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Return the current time and put it in *TIMER if TIMER is not NULL." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" -" microseconds of the current time of day, the timezone (in minutes west\n" -" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" -" returns NIL and the errno." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). On success,\n" -" unix-getitimer returns 5 values,\n" -" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). A SIGALRM signal\n" -" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" -" when non-zero, is <seconds+microseconds> to be loaded each time\n" -" the timer expires. Setting INTERVAL and VALUE to zero disables\n" -" the timer. See the Unix man page for more details. On success,\n" -" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" -" slots as in unix-getitimer." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Fill in TIMEBUF with information about the current time." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Store the CPU time used by this process and all its\n" -" dead children (and their dead children) in BUFFER.\n" -" Return the elapsed real time, or (clock_t) -1 for errors.\n" -" All times are in CLK_TCKths of a second." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Wait for a child to die. When one does, put its status in *STAT_LOC\n" -" and return its process ID. For errors, return (pid_t) -1." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Wait for a child matching PID to die.\n" -" If PID is greater than 0, match any process whose process ID is PID.\n" -" If PID is (pid_t) -1, match any process.\n" -" If PID is (pid_t) 0, match any process with the\n" -" same process group as the current process.\n" -" If PID is less than -1, match any process whose\n" -" process group is the absolute value of PID.\n" -" If the WNOHANG bit is set in OPTIONS, and that child\n" -" is not already dead, return (pid_t) 0. If successful,\n" -" return PID and store the dead child's status in STAT_LOC.\n" -" Return (pid_t) -1 for errors. If the WUNTRACED bit is\n" -" set in OPTIONS, return status for stopped children; otherwise don't." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Successful" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation not permitted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such file or directory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such process" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Interrupted system call" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "I/O error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such device or address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Arg list too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Exec format error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad file number" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No children" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Try again" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Out of memory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Permission denied" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Block device required" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Device or resource busy" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File exists" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cross-device link" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No such device" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a director" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Is a directory" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid argument" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File table overflow" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many open files" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a typewriter" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Text file busy" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File too large" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No space left on device" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Illegal seek" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read-only file system" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many links" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Broken pipe" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Math argument out of domain" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Math result not representable" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Resource deadlock would occur" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File name too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No record locks available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Function not implemented" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Directory not empty" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many symbolic links encountered" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation would block" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No message of desired type" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Identifier removed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Channel number out of range" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 2 not synchronized" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 3 halted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 3 reset" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Link number out of range" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol driver not attached" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No CSI structure available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Level 2 halted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid exchange" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid request descriptor" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Exchange full" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No anode" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid request code" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Invalid slot" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File locking deadlock error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Bad font file format" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Device not a stream" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No data available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Timer expired" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Out of streams resources" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Machine is not on the network" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Package not installed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Object is remote" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Link has been severed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Advertise error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Srmount error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Communication error on send" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Multihop attempted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "RFS specific error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a data message" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Value too large for defined data type" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Name not unique on network" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "File descriptor in bad state" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Remote address changed" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Can not access a needed shared library" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Accessing a corrupted shared library" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid ".lib section in a.out corrupted" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Attempting to link in too many shared libraries" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot exec a shared library directly" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Illegal byte sequence" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Interrupted system call should be restarted _N" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Streams pipe error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many users" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Socket operation on non-socket" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Destination address required" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Message too long" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol wrong type for socket" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol not available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Socket type not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation not supported on transport endpoint" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Protocol family not supported" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Address family not supported by protocol" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Address already in use" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot assign requested address" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network is down" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network is unreachable" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Network dropped connection because of reset" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Software caused connection abort" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection reset by peer" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No buffer space available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Transport endpoint is already connected" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Transport endpoint is not connected" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Cannot send after transport endpoint shutdown" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Too many references: cannot splice" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection timed out" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Connection refused" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Host is down" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No route to host" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation already in progress" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Operation now in progress" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Stale NFS file handle" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Structure needs cleaning" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Not a XENIX named type file" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "No XENIX semaphores available" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Is a named type file" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Remote I/O error" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Quota exceeded" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" -" then ioctl argument size and direction are included as for ioctls defined\n" -" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" -" is the characters code, else DEV may be an integer giving the type." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set the socket process-group for the unix file-descriptor FD to PGRP." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set user ID on execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Set group ID on execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Save text image after execution" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by owner" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by owner" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by group" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Read by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Write by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Execute (search directory) by others" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Returns either :file, :directory, :link, :special, or NIL." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Returns the pathname with all symbolic links resolved." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "Error reading link ~S: ~S" -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a USER-INFO structure for the user identified by LOGIN, or NIL if " -"not found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a USER-INFO structure for the user identified by UID, or NIL if not " -"found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by NAME, or NIL if " -"not found." -msgstr "" - -#: src/code/unix-glibc2.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by GID, or NIL if " -"not found." +msgid "Get terminal output speed." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0f59b9a32ebf2d210386bd30c…

1 0

[cmucl/cmucl][rtoy-unix-core] 3 commits: Remove utsname and unix-uname.
by Raymond Toy 17 May '15

17 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: a08b9be0 by Raymond Toy at 2015-05-16T22:16:15Z Remove utsname and unix-uname. - - - - - 68001f49 by Raymond Toy at 2015-05-17T07:45:18Z Add some comments from unix/unix.lisp. - - - - - a85043ac by Raymond Toy at 2015-05-17T07:45:34Z Remove items that are in code/unix.lisp - - - - - 2 changed files: - src/code/unix.lisp - src/contrib/unix/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -2435,6 +2435,9 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) +;;; Getrusage is not provided in the C library on Solaris 2.4, and is +;;; rather slow on later versions so the "times" system call is +;;; provided. #+(and sparc svr4) (progn (def-alien-type nil @@ -2458,6 +2461,8 @@ (slot usage 'tms-cstime)))) ) ; end progn +;; Requires call to tzset() in main. +;; Don't use this now: we #+(or linux svr4) (progn (def-alien-variable ("daylight" unix-daylight) int) @@ -2512,4 +2517,3 @@ (cast (slot names 'machine) c-string)) #+freebsd 256 (addr names)))) - ===================================== src/contrib/unix/unix.lisp ===================================== --- a/src/contrib/unix/unix.lisp +++ b/src/contrib/unix/unix.lisp @@ -221,20 +221,8 @@ (def-alien-type ino64-t u-int64-t) (def-alien-type blkcnt64-t u-int64-t)) -(def-alien-type nlink-t - #-(or svr4 netbsd) unsigned-short - #+netbsd unsigned-long - #+svr4 unsigned-long) - ;;; From sys/time.h -#+(or linux svr4) -; High-res time. Actually posix definition under svr4 name. -(def-alien-type nil - (struct timestruc-t - (tv-sec time-t) - (tv-nsec long))) - ;;; From ioctl.h @@ -287,61 +275,6 @@ (st-gen unsigned-long) (st-spare (array unsigned-long 2)))) -#+(or linux svr4) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-pad1 #-linux (array long 3) #+linux unsigned-short) - (st-ino ino-t) - (st-mode #-linux unsigned-long #+linux unsigned-short) - (st-nlink #-linux short #+linux unsigned-short) - (st-uid #-linux uid-t #+linux unsigned-short) - (st-gid #-linux gid-t #+linux unsigned-short) - (st-rdev dev-t) - (st-pad2 #-linux (array long 2) #+linux unsigned-short) - (st-size off-t) - #-linux (st-pad3 long) - #+linux (st-blksize unsigned-long) - #+linux (st-blocks unsigned-long) - #-linux (st-atime (struct timestruc-t)) - #+linux (st-atime unsigned-long) - #+linux (unused-1 unsigned-long) - #-linux (st-mtime (struct timestruc-t)) - #+linux (st-mtime unsigned-long) - #+linux (unused-2 unsigned-long) - #-linux (st-ctime (struct timestruc-t)) - #+linux (st-ctime unsigned-long) - #+linux (unused-3 unsigned-long) - #+linux (unused-4 unsigned-long) - #+linux (unused-5 unsigned-long) - #-linux(st-blksize long) - #-linux (st-blocks long) - #-linux (st-fstype (array char 16)) - #-linux (st-pad4 (array long 8)))) - -;;; 64-bit stat for Solaris -#+solaris -(def-alien-type nil - (struct stat64 - (st-dev dev-t) - (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned - (st-ino ino64-t) - (st-mode unsigned-long) - (st-nlink short) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned - (st-size off64-t) - (st-atime (struct timestruc-t)) - (st-mtime (struct timestruc-t)) - (st-ctime (struct timestruc-t)) - (st-blksize long) - (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned - (st-blocks blkcnt64-t) - (st-fstype (array char 16)) - (st-pad4 (array long 8)))) - ;;; From sys/resource.h (def-alien-type nil @@ -642,107 +575,6 @@ siocspgrp (alien:alien-sap (alien:addr alien-pgrp))))) -;;; STAT and friends. - -;;; 64-bit versions of stat and friends -#+solaris -(progn -(defun unix-stat (name) - _N"Unix-stat retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat64))) - (syscall ("stat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-lstat (name) - _N"Unix-lstat is similar to unix-stat except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat64))) - (syscall ("lstat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"Unix-fstat is similar to unix-stat except the file is specified - by the file descriptor fd." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat64))) - (syscall ("fstat64" int (* (struct stat64))) - (extract-stat-results buf) - fd (addr buf)))) -) - - -;;; Getrusage is not provided in the C library on Solaris 2.4, and is -;;; rather slow on later versions so the "times" system call is -;;; provided. -#+(and sparc svr4) -(progn -(def-alien-type nil - (struct tms - (tms-utime #-alpha long #+alpha int) ; user time used - (tms-stime #-alpha long #+alpha int) ; system time used. - (tms-cutime #-alpha long #+alpha int) ; user time, children - (tms-cstime #-alpha long #+alpha int))) ; system time, children - -(declaim (inline unix-times)) -(defun unix-times () - _N"Unix-times returns information about the cpu time usage of the process - and its children." - (with-alien ((usage (struct tms))) - (alien-funcall (extern-alien "times" (function int (* (struct tms)))) - (addr usage)) - (values t - (slot usage 'tms-utime) - (slot usage 'tms-stime) - (slot usage 'tms-cutime) - (slot usage 'tms-cstime)))) -) ; end progn - -;; Requires call to tzset() in main. -;; Don't use this now: we -#+(or linux svr4) -(progn - (def-alien-variable ("daylight" unix-daylight) int) - (def-alien-variable ("timezone" unix-timezone) time-t) - (def-alien-variable ("altzone" unix-altzone) time-t) - #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2)) - #+irix (defvar unix-tzname-addr nil) - #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil)) - ext:*after-save-initializations*) - #+irix (declaim (notinline fakeout-compiler)) - #+irix (defun fakeout-compiler (name dst) - (unless unix-tzname-addr - (setf unix-tzname-addr (system:foreign-symbol-address - name - :flavor :data))) - (deref (sap-alien unix-tzname-addr (array c-string 2)) dst)) - (def-alien-routine get-timezone c-call:void - (when c-call:long :in) - (minutes-west c-call:int :out) - (daylight-savings-p alien:boolean :out)) - (defun unix-get-minutes-west (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore dst)) - (values minutes)) - ) - (defun unix-get-timezone (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore minutes)) - (values #-irix (deref unix-tzname (if dst 1 0)) - #+irix (fakeout-compiler "tzname" (if dst 1 0))) - ) ) -) - - ;;; Unix-setreuid sets the real and effective user-id's of the current ;;; process to the arguments "ruid" and "euid", respectively. Usage is ;;; restricted for anyone but the super-user. Setting either "ruid" or @@ -1181,28 +1013,6 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) -(def-alien-type nil - (struct utsname - (sysname (array char #+svr4 257 #+bsd 256)) - (nodename (array char #+svr4 257 #+bsd 256)) - (release (array char #+svr4 257 #+bsd 256)) - (version (array char #+svr4 257 #+bsd 256)) - (machine (array char #+svr4 257 #+bsd 256)))) - -(defun unix-uname () - (with-alien ((names (struct utsname))) - (syscall* (#-(or freebsd (and x86 solaris)) "uname" - #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h - #+freebsd "__xuname" #+freebsd int - (* (struct utsname))) - (values (cast (slot names 'sysname) c-string) - (cast (slot names 'nodename) c-string) - (cast (slot names 'release) c-string) - (cast (slot names 'version) c-string) - (cast (slot names 'machine) c-string)) - #+freebsd 256 - (addr names)))) - #+(and solaris svr4) (export '(unix-sysinfo si-sysname si-hostname si-release si-version si-machine View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/c076d5501e7c12e8c9dcebbc…

1 0

[cmucl/cmucl][rtoy-unix-core] 2 commits: Export unix-uname. Used on linux and solaris.
by Raymond Toy 17 May '15

17 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: 42675559 by Raymond Toy at 2015-05-16T21:59:29Z Export unix-uname. Used on linux and solaris. - - - - - c076d550 by Raymond Toy at 2015-05-16T22:09:57Z Support for netbsd. From Robert Swindells. - - - - - 2 changed files: - src/code/exports.lisp - src/code/unix.lisp Changes: ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -248,6 +248,10 @@ "CLOSE-DIR" "OPEN-DIR" "READ-DIR" + + ;; linux-os, sunos-os. + "UNIX-UNAME" + ;; filesys.lisp "UNIX-GETPWUID" ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -1226,6 +1226,27 @@ (st-fstype (array char 16)) (st-pad4 (array long 8)))) +#+netbsd +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-mode mode-t) + (st-ino ino-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-atime (struct timespec-t)) + (st-mtime (struct timespec-t)) + (st-ctime (struct timespec-t)) + (st-birthtime (struct timespec-t)) + (st-size off-t) + (st-blocks off-t) + (st-blksize long) + (st-flags unsigned-long) + (st-gen unsigned-long) + (st-spare (array unsigned-long 2)))) + (defmacro extract-stat-results (buf) `(values T (slot ,buf 'st-dev) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/72afb878f276cef6b754ae2d…

1 0

[cmucl/cmucl][rtoy-unix-core] Add timestruc-t for solaris. Needed by stat and stat64.
by Raymond Toy 17 May '15

17 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: 72afb878 by Raymond Toy at 2015-05-16T21:33:11Z Add timestruc-t for solaris. Needed by stat and stat64. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -1111,6 +1111,14 @@ (d-type unsigned-char) (d-name (array char 512)))) +#+(or linux svr4) +; High-res time. Actually posix definition under svr4 name. +(def-alien-type nil + (struct timestruc-t + (tv-sec time-t) + (tv-nsec long))) + + ;;; Large file support for Solaris. Define some of the 64-bit types ;;; we need. Unlike unix-glibc's large file support, Solaris's ;;; version is a little simpler because all of the 64-bit versions of View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/72afb878f276cef6b754ae2d5…

1 0

[cmucl/cmucl][rtoy-unix-core] Add stat and friends for solaris.
by Raymond Toy 16 May '15

16 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: f4d7036b by Raymond Toy at 2015-05-16T13:50:01Z Add stat and friends for solaris. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -1241,6 +1241,8 @@ (slot ,buf 'st-blksize) (slot ,buf 'st-blocks))) +#-solaris +(progn (defun unix-stat (name) _N"Unix-stat retrieves information about the specified file returning them in the form of multiple values. @@ -1272,6 +1274,43 @@ (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat))) (extract-stat-results buf) fd (addr buf)))) +) + +;;; 64-bit versions of stat and friends +#+solaris +(progn +(defun unix-stat (name) + _N"Unix-stat retrieves information about the specified + file returning them in the form of multiple values. + See the UNIX Programmer's Manual for a description + of the values returned. If the call fails, then NIL + and an error number is returned instead." + (declare (type unix-pathname name)) + (when (string= name "") + (setf name ".")) + (with-alien ((buf (struct stat64))) + (syscall ("stat64" c-string (* (struct stat64))) + (extract-stat-results buf) + (%name->file name) (addr buf)))) + +(defun unix-lstat (name) + _N"Unix-lstat is similar to unix-stat except the specified + file must be a symbolic link." + (declare (type unix-pathname name)) + (with-alien ((buf (struct stat64))) + (syscall ("lstat64" c-string (* (struct stat64))) + (extract-stat-results buf) + (%name->file name) (addr buf)))) + +(defun unix-fstat (fd) + _N"Unix-fstat is similar to unix-stat except the file is specified + by the file descriptor fd." + (declare (type unix-fd fd)) + (with-alien ((buf (struct stat64))) + (syscall ("fstat64" int (* (struct stat64))) + (extract-stat-results buf) + fd (addr buf)))) +) (def-alien-type nil (struct rusage View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f4d7036b4f8b68c513f51cd38…

1 0

[cmucl/cmucl][rtoy-unix-core] unix-uname needs struct utsname.
by Raymond Toy 14 May '15

14 May '15

Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: 56dac608 by Raymond Toy at 2015-05-13T21:44:15Z unix-uname needs struct utsname. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -2423,6 +2423,14 @@ ) ) ) +(def-alien-type nil + (struct utsname + (sysname (array char #+svr4 257 #+bsd 256)) + (nodename (array char #+svr4 257 #+bsd 256)) + (release (array char #+svr4 257 #+bsd 256)) + (version (array char #+svr4 257 #+bsd 256)) + (machine (array char #+svr4 257 #+bsd 256)))) + (defun unix-uname () (with-alien ((names (struct utsname))) (syscall* (#-(or freebsd (and x86 solaris)) "uname" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/56dac6089a2f3d4e9b63c9a3b…

1 0