[cmucl/cmucl][master] 61 commits: First cut at simplifying unix.lisp.
Raymond Toy
rtoy at common-lisp.net
Tue May 19 01:53:11 UTC 2015
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 , at arg-types) (values result 0) , at 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 , at arg-types)))
+ (result (alien-funcall fn , at 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 (, at arg-types) int) ,success-form , at 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 , at arg-types))
+ , at 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 , at arg-types) (values t 0) , at 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 , at arg-types) (values result 0) , at 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) , at 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 , at arg-types)))
- (result (alien-funcall fn , at args)))
- (if (eql -1 result)
- (values nil (unix-errno))
- ,success-form)))
-
-(defmacro syscall ((name &rest arg-types) success-form &rest args)
- `(%syscall (,name (, at arg-types) int) ,success-form , at 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 , at arg-types))
- , at 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 , at arg-types) (values t 0) , at args))
-
-(defmacro int-syscall ((name &rest arg-types) &rest args)
- `(syscall (,name , at arg-types) (values result 0) , at args))
-
-(defmacro off-t-syscall ((name arg-types) &rest args)
- `(%syscall (,name ,arg-types off-t) (values result 0) , at 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/ea775196480fd9f029c2a701f1e2d96c66093f65...0e3ab8bd859358d3de2e97a5ac6edae81642cbdc
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20150519/2e5a4b5c/attachment-0001.html>
More information about the cmucl-cvs
mailing list