Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

11 changed files:

Changes:

  • bin/build.sh
    --- a/bin/build.sh
    +++ b/bin/build.sh
    @@ -251,7 +251,7 @@ buildit
     
     # Asdf and friends are part of the base install, so we need to build
     # them now.
    -$TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3
    +$TARGET/lisp/lisp -noinit -nositeinit -batch << EOF || exit 3
     (in-package :cl-user)
     (setf (ext:search-list "target:")
           '("$TARGET/" "src/"))
    @@ -260,6 +260,12 @@ $TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3
     
     (compile-file "modules:asdf/asdf")
     (compile-file "modules:defsystem/defsystem")
    +(intl::install)
    +(ext:without-package-locks
    +  (let ((path #-linux "modules:unix/unix"
    +              #+linux "modules:unix/unix-glibc2"))
    +    (ensure-directories-exist (compile-file-pathname path))
    +    (compile-file path)))
     EOF
     
     
    

  • bin/make-main-dist.sh
    --- a/bin/make-main-dist.sh
    +++ b/bin/make-main-dist.sh
    @@ -133,6 +133,14 @@ do
         install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f
     done
     
    +case `uname -s` in
    +  Linux*) UCONTRIB="unix-glibc2" ;;
    +  *) UCONTRIB="unix" ;;
    +esac
    +
    +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/unix
    +install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/lib/cmucl/lib/contrib/unix
    +
     # Copy the source files for asdf and defsystem
     for f in `(cd src; find contrib/asdf contrib/defsystem -type f -print | grep -v CVS)`
     do
    

  • src/code/exports.lisp
    --- a/src/code/exports.lisp
    +++ b/src/code/exports.lisp
    @@ -196,200 +196,349 @@
     	   "NEGATE-BIGNUM" "SUBTRACT-BIGNUM"))
     
     (defpackage "UNIX"
    -  (:export "CADDR-T" "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN"
    -	   "DADDR-T" "DEV-T" "DIRECT" "EXECGRP" "EXECOTH" "EXECOWN" "F-DUPFD"
    -	   "F-GETFD" "F-GETFL" "F-GETOWN" "F-SETFD" "F-SETFL" "F-SETOWN"
    -	   "FSFILCNT-T" "FSBLKCNT-T" "BLKCNT-T"
    -	   "FAPPEND" "FASYNC" "FCREAT" "FEXCL" "FIONREAD" "FNDELAY" "FTRUNC"
    -	   "F_TEST" "F_TLOCK" "UNIX-LOCKF" "F_LOCK" "F_ULOCK"
    -	   "F_OK" "GET-UNIX-ERROR-MSG" "GID-T" "INO-T" "IT-INTERVAL"
    -	   "IT-VALUE" "ITIMERVAL" "UNIX-SETITIMER" "UNIX-GETITIMER"
    -	   "BLKCNT-T" "FSBLKCNT-T" "FSFILCNT-T"
    -	   "F_TEST" "F_TLOCK" "F_LOCK" "F_ULOCK" "UNIX-LOCKF"
    -	   "PROT_READ" "PROT_WRITE" "PROT_EXEC" "PROT_NONE"
    -	   "MAP_SHARED" "MAP_PRIVATE" "MAP_FIXED" "MAP_ANONYMOUS"
    -	   "MS_ASYNC" "MS_SYNC" "MS_INVALIDATE"
    -	   "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" "UNIX-MPROTECT"
    -	   "KBDCGET" "KBDCRESET" "KBDCRST" "KBDCSET"
    -	   "KBDCSSTD" "KBDGCLICK" "KBDSCLICK" "KBDSGET" "L_INCR" "L_SET"
    -	   "L_XTND" "OFF-T" "O_APPEND" "O_CREAT" "O_EXCL" "O_RDONLY" "O_RDWR"
    -	   "O_TRUNC" "O_WRONLY" "READGRP" "READOTH" "READOWN" "RLIM-CUR"
    -	   "RLIM-MAX" "RLIMIT" "RU-IDRSS" "RU-INBLOCK" "RU-ISRSS" "RU-IXRSS"
    -	   "RU-MAJFLT" "RU-MAXRSS" "RU-MINFLT" "RU-MSGRCV" "RU-MSGSND"
    -	   "RU-NIVCSW" "RU-NSIGNALS" "RU-NSWAP" "RU-NVCSW" "RU-OUBLOCK"
    -	   "RU-STIME" "RU-UTIME" "RUSAGE_CHILDREN" "RUSAGE_SELF" "RUSEAGE"
    -	   "R_OK" "S-IEXEC" "S-IFBLK" "S-IFCHR" "S-IFDIR" "S-IFLNK" "S-IFMT"
    -	   "S-IFREG" "S-IFSOCK" "S-IREAD" "S-ISGID" "S-ISUID" "S-ISVTX"
    -	   "S-IWRITE" "SAVETEXT" "SC-MASK" "SC-ONSTACK" "SC-PC" "SETGIDEXEC"
    -	   "SETUIDEXEC" "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL"
    -	   "SG-OSPEED" "SGTTYB" "SIGCONTEXT" "SIZE-T" "ST-ATIME" "ST-BLKSIZE"
    -	   "ST-BLOCKS" "ST-CTIME" "ST-DEV" "ST-GID" "ST-MODE" "ST-MTIME"
    -	   "ST-NLINK" "ST-RDEV" "ST-SIZE" "ST-UID" "STAT" "SWBLK-T" "T-BRKC"
    -	   "T-DSUSPC" "T-EOFC" "T-FLUSHC" "T-INTRC" "T-LNEXTC" "T-QUITC"
    -	   "T-RPRNTC" "T-STARTC" "T-STOPC" "T-SUSPC" "T-WERASC" "TCHARS"
    -	   "TERMINAL-SPEEDS" "TIME-T" "TIMEVAL" "TIMEZONE" "TIOCFLUSH"
    -	   "TIOCGETC" "TIOCGETP" "TIOCGLTC" "TIOCGPGRP" "TIOCGWINSZ"
    -	   "TIOCNOTTY" "TIOCSETC" "TIOCSETP" "TIOCSLTC" "TIOCSPGRP"
    -	   "TIOCSWINSZ" "TTY-CBREAK" "TTY-CRMOD" "TTY-LCASE"
    -	   "TTY-RAW" "TTY-TANDEM" "TV-SEC" "TV-USEC" "TZ-DSTTIME"
    -	   "TZ-MINUTESWEST" "UID-T" "UNIX-ACCEPT" "UNIX-ACCESS" "UNIX-BIND"
    -	   "UNIX-CHDIR" "UNIX-CHMOD" "UNIX-CHOWN" "UNIX-CLOSE" "UNIX-CONNECT"
    -	   "UNIX-CREAT" "UNIX-CURRENT-DIRECTORY" "UNIX-DUP" "UNIX-DUP2"
    -	   "UNIX-ERRNO" "UNIX-EXECVE" "UNIX-EXIT" "UNIX-FCHMOD" "UNIX-FCHOWN"
    -	   "UNIX-FCNTL" "UNIX-FD" "UNIX-FILE-MODE" "UNIX-FORK" "UNIX-FSTAT"
    -	   "UNIX-FSYNC" "UNIX-FTRUNCATE" "UNIX-GETDTABLESIZE" "UNIX-GETEGID"
    -	   "UNIX-GETGID" "UNIX-GETHOSTID" "UNIX-GETHOSTNAME"
    -	   "UNIX-GETPAGESIZE"  "UNIX-GETPEERNAME" "UNIX-GETPGRP"
    -	   "UNIX-GETPID" "UNIX-GETPPID" "UNIX-GETRUSAGE" "UNIX-GETSOCKNAME"
    -	   "UNIX-GETSOCKOPT" "UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID"
    -	   "UNIX-IOCTL" "UNIX-ISATTY" "UNIX-LINK" "UNIX-LISTEN" "UNIX-LSEEK"
    -	   "UNIX-LSTAT" "UNIX-MKDIR" "UNIX-OPEN" "UNIX-PATHNAME" "UNIX-PID"
    -	   "UNIX-PIPE" "UNIX-READ" "UNIX-READLINK" "UNIX-RECV" "UNIX-RENAME"
    -	   "UNIX-RMDIR" "UNIX-SCHED-YIELD" "UNIX-SELECT"
    -	   "UNIX-SEND" "UNIX-SETPGID" "UNIX-SETPGRP"
    -	   "UNIX-SETREGID" "UNIX-SETREUID" "UNIX-SETSOCKOPT" "UNIX-SOCKET"
    -           "UNIX-SETUID" "UNIX-SETGID"
    -	   "UNIX-STAT" "UNIX-SYMLINK" "UNIX-SYNC"
    -	   "UNIX-TIMES" "UNIX-TRUNCATE" "UNIX-TTYNAME" "UNIX-UID"
    -	   "UNIX-UNAME" "UNIX-UNLINK" "UNIX-UTIMES" "UNIX-WRITE" "WINSIZE"
    -	   "WRITEGRP" "WRITEOTH" "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL"
    -	   "WS-YPIXEL" "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO"
    -	   "SIGEMSG" "SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2"
    -	   "EALREADY" "SIGPIPE" "EACCES" "SIGXCPU" "EOPNOTSUPP"
    -	   "SIGFPE" "SIGHUP" "ENOTSOCK" "OPEN-DIR" "SIGMASK" "EINTR"
    -	   "SIGCONT" "UNIX-RESOLVE-LINKS" "SIGKILL" "EMSGSIZE" "ERANGE"
    -	   "EPROTOTYPE" "UNIX-SIGNAL-NUMBER" "EPFNOSUPPORT" "SIGILL"
    -	   "EDOM" "UNIX-SIGPAUSE" "EDQUOT" "FD-SETSIZE" "SIGTSTP"
    -	   "EAFNOSUPPORT" "TCGETPGRP" "EMFILE" "ECONNRESET"
    -	   "EADDRNOTAVAIL" "SIGALRM" "ENETDOWN" "EVICEOP"
    -	   "UNIX-FAST-GETRUSAGE" "EPERM" "SIGINT" "EXDEV" "EDEADLK"
    -	   "ENOSPC" "ECONNREFUSED" "SIGWINCH" "ENOPROTOOPT" "ESRCH"
    -	   "EUSERS" "SIGVTALRM" "ENOTCONN" "ESUCCESS" "EPIPE"
    -	   "UNIX-SIMPLIFY-PATHNAME" "EISCONN" "FD-ISSET" "SIGMSG"
    -	   "ESHUTDOWN" "EBUSY" "SIGTERM" "ENAMETOOLONG" "EMLINK"
    -	   "EADDRINUSE" "SIGBUS" "ERESTART" "TTY-PROCESS-GROUP"
    -	   "UNIX-SIGNAL-NAME" "ETIMEDOUT" "ECHILD" "EFBIG" "SIGTRAP"
    -	   "UNIX-KILLPG" "ENOTBLK" "SIGIOT" "SIGUSR1" "ECONNABORTED"
    -	   "EHOSTUNREACH" "EBADF" "EINVAL" "FD-SET" "CLOSE-DIR" "EISDIR"
    -	   "SIGTTIN" "UNIX-KILL" "ENOTDIR" "EHOSTDOWN" "E2BIG" "ESPIPE"
    -	   "UNIX-FAST-SELECT" "ENXIO" "ENOTTY" "ELOOP" "LTCHARS"
    -	   "UNIX-SIGNAL-DESCRIPTION" "SIGXFSZ" "EINPROGRESS" "ENOENT"
    -	   "EPROTONOSUPPORT" "UNIX-SIGBLOCK" "SIGIO" "ENOMEM" "SIGEMT"
    -	   "EFAULT" "ENODEV" "EIO" "EVICEERR" "ETXTBSY" "EWOULDBLOCK"
    -	   "EAGAIN" "EDESTADDRREQ" "ENOEXEC" "ENETUNREACH" "ENOTEMPTY"
    -	   "READ-DIR" "UNIX-MAYBE-PREPEND-CURRENT-DIRECTORY" "ENFILE"
    -	   "SIGTTOU" "EEXIST" "SIGPROF" "SIGSTOP" "ENETRESET" "SIGURG"
    -	   "ENOBUFS" "EPROCLIM" "EROFS" "ETOOMANYREFS" "UNIX-FILE-KIND"
    -	   "ELOCAL" "UNIX-SIGSETMASK" "EREMOTE" "ESOCKTNOSUPPORT"
    -	   "TIOCSIGSEND" "SIGWAITING" "SIGABRT"
    -	   "C-IFLAG" "UNIX-TCGETATTR" "C-LFLAG" "C-OFLAG" "C-CFLAG"
    -	   "TCSAFLUSH" "C-CC" "C-ISPEED" "C-OSPEED" "SIOCSPGRP" "TERMIOS"
    -	   "UNIX-TCSETATTR" "O_NDELAY" "O_NOCTTY"
    -	   "O_NONBLOCK" "TCSANOW" "TCSADRAIN" "TCIFLUSH" "TCOFLUSH"
    -	   "TCIOFLUSH" "UNIX-CFGETOSPEED" "UNIX-CFSETOSPEED"
    -	   "UNIX-CFGETISPEED" "UNIX-CFSETISPEED"
    -	   "TTY-IGNBRK" "TTY-BRKINT" "TTY-IGNPAR" "TTY-PARMRK"
    -	   "TTY-INPCK" "TTY-ISTRIP" "TTY-INLCR" "TTY-IGNCR" "TTY-ICRNL"
    -	   "TTY-IUCLC" "TTY-IXON" "TTY-IXANY" "TTY-IXOFF" "TTY-IENQAK"
    -	   "TTY-IMAXBEL" "TTY-OPOST" "TTY-OLCUC" "TTY-ONLCR" "TTY-OCRNL"
    -	   "TTY-ONOCR" "TTY-ONLRET" "TTY-OFILL" "TTY-OFDEL" "TTY-ISIG"
    -	   "TTY-ICANON" "TTY-XCASE" "TTY-ECHO" "TTY-ECHOE" "TTY-ECHOK"
    -	   "TTY-ECHONL" "TTY-NOFLSH" "TTY-IEXTEN" "TTY-TOSTOP" "TTY-ECHOCTL"
    -	   "TTY-ECHOPRT" "TTY-ECHOKE"  "TTY-DEFECHO" "TTY-FLUSHO"
    -	   "TTY-PENDIN" "TTY-CSTOPB" "TTY-CREAD" "TTY-PARENB" "TTY-PARODD"
    -	   "TTY-HUPCL" "TTY-CLOCAL" "RCV1EN" "XMT1EN" "TTY-LOBLK" "VINTR"
    -	   "VQUIT" "VERASE" "VKILL" "VEOF" "VEOL" "VEOL2" "TTY-CBAUD"
    -	   "TTY-CSIZE" "TTY-CS5" "TTY-CS6" "TTY-CS7" "TTY-CS8" "VMIN" "VTIME"
    -	   "VSUSP" "VSTART" "VSTOP" "VDSUSP" "UNIX-TCSENDBREAK"
    -	   "UNIX-TCDRAIN" "UNIX-TCFLUSH" "UNIX-TCFLOW"
    -	   "UNIX-GETENV" "UNIX-SETENV" "UNIX-PUTENV" "UNIX-UNSETENV"
    -
    -	   #+(or svr4 bsd linux) "O_NDELAY"
    -	   "CHECK"
    -
    -	   "UNIX-RECVFROM" "UNIX-SENDTO" "UNIX-SHUTDOWN"
    -	   "UNIX-OPENPTY")
    -  #+(or svr4 linux)
    -  (:export "EADDRINUSE" "EADDRNOTAVAIL" "EADV" "EAFNOSUPPORT"
    -	   "EALREADY" "EBADE" "EBADFD" "EBADMSG" "EBADR" "EBADRQC"
    -	   "EBADSLT" "EBFONT" #+svr4 "ECANCELED" "ECHRNG" "ECOMM"
    -	   "ECONNABORTED" "ECONNREFUSED" "ECONNRESET" "EDEADLK"
    -	   "EDEADLOCK" "EDESTADDRREQ" #+linux "EDOTDOT" #+linux "EDQUOT"
    -	   "EHOSTDOWN" "EHOSTUNREACH" "EIDRM" "EILSEQ" "EINPROGRESS"
    -	   "EISCONN" #+linux "EISNAM" "EL2HLT" "EL2NSYNC" "EL3HLT"
    -	   "EL3RST" "ELIBACC" "ELIBBAD" "ELIBEXEC" "ELIBMAX" "ELIBSCN"
    -	   "ELNRNG" "ELOOP" "EMSGSIZE" "EMULTIHOP" "ENAMETOOLONG"
    -	   #+linux "ENAVAIL" "ENETDOWN" "ENETRESET" "ENETUNREACH" "ENOANO"
    -	   "ENOBUFS" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET"
    -	   "ENOPKG" "ENOPROTOOPT" "ENOSR" "ENOSTR" "ENOSYS" "ENOTCONN"
    -	   "ENOTEMPTY" #+linux "ENOTNAM" "ENOTSOCK" #+svr4 "ENOTSUP"
    -	   "ENOTUNIQ" "EOPNOTSUPP" "EOVERFLOW" "EPFNOSUPPORT" "EPROTO"
    -	   "EPROTONOSUPPORT" "EPROTOTYPE" "EREMCHG" "EREMOTE"
    -	   #+linux "EREMOTEIO" "ERESTART" "ESHUTDOWN" "ESOCKTNOSUPPORT"
    -	   "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" "ETIMEDOUT" "ETOOMANYREFS"
    -	   #+linux "EUCLEAN" "EUNATCH" "EUSERS" "EWOULDBLOCK" "EXFULL"
    -	   "UTSNAME"
    -	   #+linux "SIGSTKFLT"
    -	   "UNIX-GETPWNAM" "UNIX-GETPWUID" "UNIX-GETGRNAM" "UNIX-GETGRGID"
    -	   "USER-INFO" "USER-INFO-NAME" "USER-INFO-PASSWORD" "USER-INFO-UID"
    -	   "USER-INFO-GID" "USER-INFO-GECOS" "USER-INFO-DIR" "USER-INFO-SHELL"
    -	   "GROUP-INFO" "GROUP-INFO-NAME" "GROUP-INFO-GID" "GROUP-INFO-MEMBERS")
    -  #+freebsd
    -  (:export "GROUP-INFO"
    -	   "GROUP-INFO-GID"
    -	   "GROUP-INFO-MEMBERS"
    -	   "GROUP-INFO-NAME"
    -	   "UNIX-GETGRGID"
    -	   "UNIX-GETGRNAM"
    -	   "UNIX-GETPWNAM"
    -	   "UNIX-GETPWUID"
    -	   "USER-INFO"
    -	   "USER-INFO-DIR"
    -	   "USER-INFO-GECOS"
    -	   "USER-INFO-GID"
    -	   "USER-INFO-NAME"
    -	   "USER-INFO-PASSWORD"
    -	   "USER-INFO-SHELL"
    -	   "USER-INFO-UID")
    -  #+ppc
    -  (:export "UNIX-GETPWUID"
    -	   "USER-INFO"
    -	   "USER-INFO-SHELL"
    -	   "USER-INFO-GECOS"
    -	   "UNIX-GETPWNAM"
    -	   "GROUP-INFO-NAME"
    -	   "GROUP-INFO-MEMBERS"
    +  (:export "UNIX-CURRENT-DIRECTORY"
    +	   "UNIX-OPEN"
    +	   "UNIX-READ"
    +	   "UNIX-WRITE"
    +	   "UNIX-GETPAGESIZE"
    +	   "UNIX-ERRNO"
    +	   "UNIX-MAYBE-PREPEND-CURRENT-DIRECTORY"
    +	   "UNIX-RESOLVE-LINKS"
    +	   "UNIX-SIMPLIFY-PATHNAME"
    +	   "UNIX-CLOSE"
    +	   "UNIX-STAT"
    +	   "UNIX-LSTAT"
    +	   "UNIX-FSTAT"
    +	   "UNIX-GETHOSTNAME"
    +	   "UNIX-LSEEK"
    +	   "UNIX-EXIT"
    +	   "UNIX-CHDIR"
    +	   "UNIX-ACCESS"
    +	   "UNIX-DUP"
    +	   "UNIX-CHMOD"
    +	   "UNIX-READLINK"
    +	   "UNIX-RENAME"
    +	   "UNIX-SELECT"
    +	   "UNIX-FAST-GETRUSAGE"
    +	   "UNIX-GETRUSAGE"
    +	   "UNIX-GETTIMEOFDAY"
    +	   "UNIX-ISATTY"
    +	   "UNIX-MKDIR"
    +	   "UNIX-RMDIR"
    +	   "UNIX-UNLINK"
    +	   "TIMEZONE"
    +	   "TIMEVAL"
    +	   "SIZE-T"
    +	   "OFF-T"
    +	   "INO-T"
    +	   "DEV-T"
    +	   "TIME-T"
     	   "USER-INFO-NAME"
    -	   "USER-INFO-PASSWORD"
    -	   "GROUP-INFO"
    -	   "USER-INFO-UID"
    -	   "USER-INFO-DIR"
    -	   "USER-INFO-GID"
    -	   "GROUP-INFO-GID"
    -	   "UNIX-GETGRNAM"
    -	   "UNIX-GETGRGID")
    -  #+(and solaris svr4)
    -  (:export "UNIX-SYSINFO"
    -	   "SI-SYSNAME" "SI-HOSTNAME" "SI-RELEASE" "SI-VERSION" "SI-MACHINE"
    -	   "SI-ARCHITECTURE" "SI-HW-SERIAL" "SI-HW-PROVIDER" "SI-SRPC-DOMAIN"
    -	   "SI-PLATFORM" "SI-ISALIST" "SI-DHCP-CACHE"
    -
    -	   "UNIX-GETRLIMIT"
    -	    "RLIMIT_CPU" "RLIMIT_FSIZE" "RLIMIT_DATA" "RLIMIT_STACK" "RLIMIT_CORE"
    -	    "RLIMIT_AS" "RLIMIT_VMEM" "RLIMIT_NOFILE")
    -  ;; Should this be conditionalized on glibc2?  These come from
    -  ;; unix-glibc2.lisp.
    -  #+(and darwin x86)
    -  (:export  "GROUP-INFO" "UNIX-GETPWUID" "USER-INFO-DIR" "UNIX-GETPWNAM"
    -	    "USER-INFO-SHELL" "USER-INFO-PASSWORD" "USER-INFO-UID"
    -	    "GROUP-INFO-GID" "USER-INFO" "USER-INFO-NAME" "USER-INFO-GID"
    -	    "GROUP-INFO-MEMBERS" "UNIX-GETGRGID" "USER-INFO-GECOS"
    -	    "GROUP-INFO-NAME"
    -	    "UNIX-GETGRNAM"
    -	    
    -	    "UNIX-GETRLIMIT"
    -	    "RLIMIT_CPU" "RLIMIT_FSIZE" "RLIMIT_DATA" "RLIMIT_STACK" "RLIMIT_CORE"
    -	    "RLIMIT_AS" "RLIMIT_RSS" "RLIMIT_MEMLOCK" "RLIMIT_NPROC" "RLIMIT_NOFILE"))
    +	   "INT64-T"
    +	   "MODE-T"
    +	   "UNIX-FAST-SELECT"
    +	   "UNIX-PIPE"
    +	   "UNIX-GETPID"
    +	   "UNIX-GETHOSTID"
    +	   "UNIX-UID"
    +	   "UNIX-GID"
    +	   "GET-UNIX-ERROR-MSG"
    +	   "WINSIZE"
    +	   "TIMEVAL"
    +	   "CLOSE-DIR"
    +	   "OPEN-DIR"
    +	   "READ-DIR"
    +
    +	   ;; linux-os, sunos-os.
    +	   "UNIX-UNAME"
    +
    +	   ;; filesys.lisp
    +	   "UNIX-GETPWUID"
    +
    +	   ;; multi-proc.lisp
    +	   "UNIX-SETITIMER"
    +
    +	   ;; run-program.lisp
    +	   "UNIX-TTYNAME"
    +	   "UNIX-IOCTL"
    +	   "UNIX-OPENPTY"
    +
    +	   ;; alien-callback.lisp
    +	   "UNIX-MPROTECT"
    +
    +	   ;; internet.lisp
    +	   "UNIX-SOCKET"
    +	   "UNIX-CONNECT"
    +	   "UNIX-BIND"
    +	   "UNIX-LISTEN"
    +	   "UNIX-ACCEPT"
    +	   "UNIX-GETSOCKOPT"
    +	   "UNIX-SETSOCKOPT"
    +	   "UNIX-GETPEERNAME"
    +	   "UNIX-GETSOCKNAME"
    +	   "UNIX-RECV"
    +	   "UNIX-SEND"
    +	   "UNIX-RECVFROM"
    +	   "UNIX-SENDTO"
    +	   "UNIX-SHUTDOWN"
    +	   "UNIX-FCNTL"
    +
    +	   ;; serve-event.lisp
    +	   "FD-SETSIZE"
    +	   "FD-ISSET"
    +	   "FD-CLR"
    +
    +	   ;; Simple streams
    +	   "PROT_READ"
    +	   "UNIX-MMAP"
    +	   "UNIX-MUNMAP"
    +	   "UNIX-MSYNC"
    +
    +	   ;; Motif
    +	   "UNIX-GETUIO"
    +
    +	   ;; Hemlock
    +	   "UNIX-CFGETOSPEED"
    +	   "TERMIOS"
    +	   "UNIX-TCGETATTR"
    +	   "UNIX-TCSETATTR"
    +	   "UNIX-FCHMOD"
    +	   "UNIX-CREAT"
    +	   "UNIX-UTIMES"
    +
    +	   ;; Tests
    +	   "UNIX-SYMLINK"
    +
    +	   ;; Other symbols from structures, etc.
    +	   "C-CC" "C-CFLAG" "C-IFLAG" "C-ISPEED" "C-LFLAG" "C-OFLAG" "C-OSPEED"
    +	   "CHECK" "D-NAME" "D-RECLEN" "E2BIG" "EACCES" "EADDRINUSE" "EADDRNOTAVAIL"
    +	   "EAFNOSUPPORT" "EAGAIN" "EALREADY" "EBADF" "EBUSY" "ECHILD"
    +	   "ECONNABORTED" "ECONNREFUSED" "ECONNRESET" "EDEADLK" "EDESTADDRREQ"
    +	   "EDOM" "EDQUOT" "EEXIST" "EFAULT" "EFBIG" "EHOSTDOWN" "EHOSTUNREACH"
    +	   "EINPROGRESS" "EINTR" "EINVAL" "EIO" "EISCONN" "EISDIR" "ELOOP" "EMFILE"
    +	   "EMLINK" "EMSGSIZE" "ENAMETOOLONG" "ENETDOWN" "ENETRESET" "ENETUNREACH"
    +	   "ENFILE" "ENOBUFS" "ENODEV" "ENOENT" "ENOEXEC" "ENOMEM" "ENOPROTOOPT"
    +	   "ENOSPC" "ENOTBLK" "ENOTCONN" "ENOTDIR" "ENOTEMPTY" "ENOTSOCK" "ENOTTY"
    +	   "ENXIO" "EOPNOTSUPP" "EPERM" "EPFNOSUPPORT" "EPIPE" "EPROTONOSUPPORT"
    +	   "EPROTOTYPE" "ERANGE" "EREMOTE" "EROFS" "ESHUTDOWN" "ESOCKTNOSUPPORT"
    +	   "ESPIPE" "ESRCH" "ESUCCESS" "ETIMEDOUT" "ETOOMANYREFS" "ETXTBSY" "EUSERS"
    +	   "EWOULDBLOCK" "EXDEV" "F-GETFL" "F-GETOWN" "F-SETFL" "F-SETOWN" "FAPPEND"
    +	   "FASYNC" "FD-SET" "FD-ZERO" "FNDELAY" "F_OK" "GID-T" "IT-INTERVAL"
    +	   "IT-VALUE" "ITIMERVAL" "L_INCR" "L_SET" "L_XTND" "MAP_ANONYMOUS"
    +	   "MAP_FIXED" "MAP_PRIVATE" "MAP_SHARED" "MS_ASYNC" "MS_INVALIDATE"
    +	   "MS_SYNC" "O_APPEND" "O_CREAT" "O_EXCL" "O_NDELAY" "O_NONBLOCK"
    +	   "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PROT_EXEC" "PROT_NONE"
    +	   "PROT_WRITE" "RU-IDRSS" "RU-INBLOCK" "RU-ISRSS" "RU-IXRSS" "RU-MAJFLT"
    +	   "RU-MAXRSS" "RU-MINFLT" "RU-MSGRCV" "RU-MSGSND" "RU-NIVCSW" "RU-NSIGNALS"
    +	   "RU-NSWAP" "RU-NVCSW" "RU-OUBLOCK" "RU-STIME" "RU-UTIME"
    +	   "RUSAGE_CHILDREN" "RUSAGE_SELF" "R_OK" "S-IFBLK" "S-IFCHR" "S-IFDIR"
    +	   "S-IFLNK" "S-IFMT" "S-IFREG" "S-IFSOCK" "SIGABRT" "SIGALRM" "SIGBUS"
    +	   "SIGCHLD" "SIGCONT" "SIGCONTEXT" "SIGFPE" "SIGHUP" "SIGILL" "SIGINT"
    +	   "SIGIO" "SIGIOT" "SIGKILL" "SIGMASK" "SIGPIPE" "SIGPROF" "SIGQUIT"
    +	   "SIGSEGV" "SIGSTOP" "SIGTERM" "SIGTRAP" "SIGTSTP" "SIGTTIN" "SIGTTOU"
    +	   "SIGURG" "SIGUSR1" "SIGUSR2" "SIGVTALRM" "SIGWINCH" "SIGXCPU" "SIGXFSZ"
    +	   "ST-ATIME" "ST-BLKSIZE" "ST-BLOCKS" "ST-CTIME" "ST-DEV" "ST-GID"
    +	   "ST-MODE" "ST-MTIME" "ST-NLINK" "ST-RDEV" "ST-SIZE" "ST-UID" "STAT"
    +	   "TCSADRAIN" "TCSAFLUSH" "TCSANOW" "TIOCGPGRP" "TIOCGWINSZ" "TIOCNOTTY"
    +	   "TIOCSPGRP" "TIOCSWINSZ" "TTY-BRKINT" "TTY-ECHO" "TTY-ECHOCTL"
    +	   "TTY-ECHOE" "TTY-ECHOK" "TTY-ECHOKE" "TTY-ECHONL" "TTY-ECHOPRT"
    +	   "TTY-FLUSHO" "TTY-ICANON" "TTY-ICRNL" "TTY-IEXTEN" "TTY-IGNBRK"
    +	   "TTY-IGNCR" "TTY-IGNPAR" "TTY-IMAXBEL" "TTY-INLCR" "TTY-INPCK" "TTY-ISIG"
    +	   "TTY-ISTRIP" "TTY-IXANY" "TTY-IXOFF" "TTY-IXON" "TTY-NOFLSH" "TTY-ONLCR"
    +	   "TTY-OPOST" "TTY-PARMRK" "TTY-PENDIN" "TTY-TOSTOP" "TV-SEC" "TV-USEC"
    +	   "TZ-DSTTIME" "TZ-MINUTESWEST" "UID-T" "UNIX-FD" "UNIX-FILE-KIND"
    +	   "UNIX-FILE-MODE" "UNIX-GETUID" "UNIX-KILL" "UNIX-KILLPG" "UNIX-PATHNAME"
    +	   "UNIX-SIGBLOCK" "UNIX-SIGNAL-DESCRIPTION" "UNIX-SIGNAL-NAME"
    +	   "UNIX-SIGNAL-NUMBER" "UNIX-SIGPAUSE" "UNIX-SIGSETMASK" "USER-INFO"
    +	   "USER-INFO-DIR" "USER-INFO-GECOS" "USER-INFO-GID" "USER-INFO-PASSWORD"
    +	   "USER-INFO-SHELL" "USER-INFO-UID" "VDSUSP" "VEOF" "VEOL" "VEOL2" "VERASE"
    +	   "VINTR" "VKILL" "VMIN" "VQUIT" "VSTART" "VSTOP" "VSUSP" "VTIME"
    +	   "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL" "WS-YPIXEL" "W_OK" "X_OK"
    +	   "FIONREAD"
    +	   "TERMINAL-SPEEDS"
    +	   )
    +  #-(or linux solaris)
    +  (:export "TCHARS"
    +	   "LTCHARS"
    +	   "D-NAMLEN"
    +
    +	   
    +	   ;; run-program.lisp
    +	   "SGTTYB"
    +
    +	   ;; Other symbols from structures, etc.
    +	   "DIRECT" "ELOCAL" "EPROCLIM" "EVICEERR" "EVICEOP" "EXECGRP" "EXECOTH"
    +	   "EXECOWN" "F-DUPFD" "F-GETFD" "F-SETFD" "FCREAT" "FEXCL"
    +	   "FTRUNC" "READGRP" "READOTH" "READOWN" "S-IEXEC" "S-IREAD" "S-ISGID"
    +	   "S-ISUID" "S-ISVTX" "S-IWRITE" "SAVETEXT" "SETGIDEXEC" "SETUIDEXEC"
    +	   "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL" "SG-OSPEED" "SIGEMT" "SIGSYS"
    +	   "T-BRKC" "T-DSUSPC" "T-EOFC" "T-FLUSHC" "T-INTRC" "T-LNEXTC" "T-QUITC"
    +	   "T-RPRNTC" "T-STARTC" "T-STOPC" "T-SUSPC" "T-WERASC" "TCIFLUSH"
    +	   "TCIOFLUSH" "TCOFLUSH" "TIOCFLUSH" "TIOCGETC"
    +	   "TIOCGETP" "TIOCGLTC" "TIOCSETC" "TIOCSETP" "TIOCSLTC" "TTY-CBREAK"
    +	   "TTY-CLOCAL" "TTY-CREAD" "TTY-CRMOD" "TTY-CS5" "TTY-CS6" "TTY-CS7"
    +	   "TTY-CS8" "TTY-CSIZE" "TTY-CSTOPB" "TTY-HUPCL" "TTY-LCASE" "TTY-PARENB"
    +	   "TTY-PARODD" "TTY-RAW" "TTY-TANDEM" "WRITEGRP" "WRITEOTH"
    +	   )
    +  #+linux
    +  (:export "TCHARS"
    +	   "LTCHARS"
    +	   "D-NAMLEN"
    +
    +	   ;; Other symbols
    +	   "BLKCNT-T" "D-INO" "D-OFF" "EADV" "EBADE" "EBADFD" "EBADMSG" "EBADR"
    +	   "EBADRQC" "EBADSLT" "EBFONT" "ECHRNG" "ECOMM" "EDEADLOCK" "EDOTDOT"
    +	   "EIDRM" "EILSEQ" "EISNAM" "EL2HLT" "EL2NSYNC" "EL3HLT" "EL3RST" "ELIBACC"
    +	   "ELIBBAD" "ELIBEXEC" "ELIBMAX" "ELIBSCN" "ELNRNG" "EMULTIHOP" "ENAVAIL"
    +	   "ENOANO" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" "ENOPKG"
    +	   "ENOSR" "ENOSTR" "ENOSYS" "ENOTNAM" "ENOTUNIQ" "EOVERFLOW" "EPROTO"
    +	   "EREMCHG" "EREMOTEIO" "ERESTART" "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME"
    +	   "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" "TTY-IUCLC"
    +	   "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR"
    +	   "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME"
    +	   "UTSNAME"
    +	   )
    +  #+solaris
    +  (:export "D-INO"
    +	   "D-OFF"
    +	   "DIRECT"
    +	   "EADV"
    +	   "EBADE"
    +	   "EBADFD"
    +	   "EBADMSG"
    +	   "EBADR"
    +	   "EBADRQC"
    +	   "EBADSLT"
    +	   "EBFONT"
    +	   "ECANCELED"
    +	   "ECHRNG"
    +	   "ECOMM"
    +	   "EDEADLOCK"
    +	   "EIDRM"
    +	   "EILSEQ"
    +	   "EL2HLT"
    +	   "EL2NSYNC"
    +	   "EL3HLT"
    +	   "EL3RST"
    +	   "ELIBACC"
    +	   "ELIBBAD"
    +	   "ELIBEXEC"
    +	   "ELIBMAX"
    +	   "ELIBSCN"
    +	   "ELNRNG"
    +	   "EMULTIHOP"
    +	   "ENOANO"
    +	   "ENOCSI"
    +	   "ENODATA"
    +	   "ENOLCK"
    +	   "ENOLINK"
    +	   "ENOMSG"
    +	   "ENONET"
    +	   "ENOPKG"
    +	   "ENOSR"
    +	   "ENOSTR"
    +	   "ENOSYS"
    +	   "ENOTSUP"
    +	   "ENOTUNIQ"
    +	   "EOVERFLOW"
    +	   "EPROTO"
    +	   "EREMCHG"
    +	   "ERESTART"
    +	   "ESRMNT"
    +	   "ESTALE"
    +	   "ESTRPIPE"
    +	   "ETIME"
    +	   "EUNATCH"
    +	   "EXECGRP"
    +	   "EXECOTH"
    +	   "EXECOWN"
    +	   "EXFULL"
    +	   "F-DUPFD"
    +	   "F-GETFD"
    +	   "F-SETFD"
    +	   "FCREAT"
    +	   "FEXCL"
    +	   "FTRUNC"
    +	   "LTCHARS"
    +	   "O_NOCTTY"
    +	   "RCV1EN"
    +	   "READGRP"
    +	   "READOTH"
    +	   "READOWN"
    +	   "S-IEXEC"
    +	   "S-IREAD"
    +	   "S-ISGID"
    +	   "S-ISUID"
    +	   "S-ISVTX"
    +	   "S-IWRITE"
    +	   "SAVETEXT"
    +	   "SETGIDEXEC"
    +	   "SETUIDEXEC"
    +	   "SG-ERASE"
    +	   "SG-FLAGS"
    +	   "SG-ISPEED"
    +	   "SG-KILL"
    +	   "SG-OSPEED"
    +	   "SGTTYB"
    +	   "SIGEMT"
    +	   "SIGSYS"
    +	   "SIGWAITING"
    +	   "T-BRKC"
    +	   "T-DSUSPC"
    +	   "T-EOFC"
    +	   "T-FLUSHC"
    +	   "T-INTRC"
    +	   "T-LNEXTC"
    +	   "T-QUITC"
    +	   "T-RPRNTC"
    +	   "T-STARTC"
    +	   "T-STOPC"
    +	   "T-SUSPC"
    +	   "T-WERASC"
    +	   "TCHARS"
    +	   "TCIFLUSH"
    +	   "TCIOFLUSH"
    +	   "TCOFLUSH"
    +	   "TIOCFLUSH"
    +	   "TIOCGETC"
    +	   "TIOCGETP"
    +	   "TIOCGLTC"
    +	   "TIOCSETC"
    +	   "TIOCSETP"
    +	   "TIOCSLTC"
    +	   "TTY-CBAUD"
    +	   "TTY-CBREAK"
    +	   "TTY-CLOCAL"
    +	   "TTY-CREAD"
    +	   "TTY-CRMOD"
    +	   "TTY-CS5"
    +	   "TTY-CS6"
    +	   "TTY-CS7"
    +	   "TTY-CS8"
    +	   "TTY-CSIZE"
    +	   "TTY-CSTOPB"
    +	   "TTY-DEFECHO"
    +	   "TTY-HUPCL"
    +	   "TTY-IUCLC"
    +	   "TTY-LCASE"
    +	   "TTY-LOBLK"
    +	   "TTY-OCRNL"
    +	   "TTY-OFDEL"
    +	   "TTY-OFILL"
    +	   "TTY-OLCUC"
    +	   "TTY-ONLRET"
    +	   "TTY-ONOCR"
    +	   "TTY-PARENB"
    +	   "TTY-PARODD"
    +	   "TTY-RAW"
    +	   "TTY-TANDEM"
    +	   "TTY-XCASE"
    +	   "UNIX-TIMES"
    +	   "UTSNAME"
    +	   "WRITEGRP"
    +	   "WRITEOTH"
    +	   "XMT1EN"
    +	   ))
       
     (defpackage "FORMAT")
     
    

  • src/code/module.lisp
    --- a/src/code/module.lisp
    +++ b/src/code/module.lisp
    @@ -161,3 +161,6 @@
     
     (defmodule :cmu-contribs
         "modules:contrib")
    +
    +(defmodule :unix
    +  "modules:load-unix")
    

  • src/code/unix-glibc2.lisp
    --- a/src/code/unix-glibc2.lisp
    +++ b/src/code/unix-glibc2.lisp
    @@ -67,147 +67,11 @@
     ;; Must be set to NIL initially to enable building Lisp!
     (defvar *filename-encoding* nil)
     
    -(export '(
    -	  daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
    -          blkcnt-t fsblkcnt-t fsfilcnt-t
    -	  unix-lockf f_ulock f_lock f_tlock f_test
    -	  timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
    -	  itimerval it-interval it-value tchars t-intrc t-quitc t-startc
    -	  t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
    -	  t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
    -	  sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
    -	  direct d-off d-ino d-reclen  d-name
    -	  stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
    -	  st-atime st-mtime st-ctime st-blksize st-blocks
    -	  s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
    -	  s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
    -	  ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
    -	  ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
    -	  ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
    -	  rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
    -	  unix-errno get-unix-error-msg
    -	  prot_read prot_write prot_exec prot_none
    -	  map_shared map_private map_fixed map_anonymous
    -	  ms_async ms_sync ms_invalidate
    -	  unix-mmap unix-munmap unix-msync unix-mprotect
    -	  unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
    -	  unix-setitimer unix-getitimer
    -	  unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
    -	  setgidexec savetext readown writeown execown readgrp writegrp
    -	  execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
    -	  unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
    -	  unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
    -	  fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
    -	  l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
    -	  o_ndelay
    -	  o_noctty
    -	  o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
    -	  unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
    -	  fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
    -	  unix-ftruncate unix-symlink unix-unlink unix-write unix-ioctl
    -	  unix-uname utsname
    -	  tcsetpgrp tcgetpgrp tty-process-group
    -	  terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
    -	  tty-cbreak
    -	   termios
    -           c-lflag
    -	   c-iflag
    -           c-oflag
    -	   tty-icrnl
    -           tty-ocrnl
    -	   veof
    -	   vintr
    -           vquit
    -           vstart
    -	   vstop
    -           vsusp
    -	   c-cflag
    -	   c-cc
    -           tty-icanon
    -	   vmin
    -           vtime
    -	   tty-ixon
    -           tcsanow
    -           tcsadrain
    -           tciflush
    -           tcoflush
    -           tcioflush
    -	   tcsaflush
    -           unix-tcgetattr
    -           unix-tcsetattr
    -           tty-ignbrk
    -           tty-brkint
    -           tty-ignpar
    -           tty-parmrk
    -           tty-inpck
    -           tty-istrip
    -           tty-inlcr
    -           tty-igncr
    -           tty-iuclc
    -           tty-ixany
    -           tty-ixoff
    -	  tty-imaxbel
    -           tty-opost
    -           tty-olcuc
    -           tty-onlcr
    -           tty-onocr
    -           tty-onlret
    -           tty-ofill
    -           tty-ofdel
    -           tty-isig
    -           tty-xcase
    -           tty-echoe
    -           tty-echok
    -           tty-echonl
    -           tty-noflsh
    -           tty-iexten
    -           tty-tostop
    -           tty-echoctl
    -           tty-echoprt
    -           tty-echoke
    -           tty-pendin
    -           tty-cstopb
    -           tty-cread
    -           tty-parenb
    -           tty-parodd
    -           tty-hupcl
    -           tty-clocal
    -           vintr
    -           verase
    -           vkill
    -           veol
    -           veol2
    -	  TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
    -	  TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
    -	  TIOCSIGSEND
    -
    -	  KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
    -	  KBDSCLICK FIONREAD	  unix-exit unix-stat unix-lstat unix-fstat
    -	  unix-getrusage unix-fast-getrusage rusage_self rusage_children
    -	  unix-gettimeofday
    -	  unix-utimes unix-sched-yield unix-setreuid
    -	  unix-setregid
    -	  unix-getpid unix-getppid
    -	  unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
    -	  unix-getpagesize unix-gethostname unix-gethostid unix-fork
    -	  unix-getenv unix-setenv unix-putenv unix-unsetenv
    -	  unix-current-directory unix-isatty unix-ttyname unix-execve
    -	  unix-socket unix-connect unix-bind unix-listen unix-accept
    -	  unix-recv unix-send unix-getpeername unix-getsockname
    -	  unix-getsockopt unix-setsockopt unix-openpty
    -
    -	  unix-recvfrom unix-sendto unix-shutdown
    -
    -          unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid
    -          user-info user-info-name user-info-password user-info-uid
    -          user-info-gid user-info-gecos user-info-dir user-info-shell
    -          group-info group-info-name group-info-gid group-info-members))
    -
     (pushnew :unix *features*)
     (pushnew :glibc2 *features*)
     
     ;; needed for bootstrap
    -(eval-when (:compile-toplevel)
    +(eval-when (:compile-toplevel :load-toplevel :execute)
       (defmacro %name->file (string)
         `(if *filename-encoding*
     	 (string-encode ,string *filename-encoding*)
    @@ -217,8 +81,124 @@
     	 (string-decode ,string *filename-encoding*)
     	 ,string)))
     
    +(defconstant +max-u-long+ 4294967295)
    +
    +(def-alien-type size-t #-alpha unsigned-int #+alpha long)
    +(def-alien-type time-t long)
    +
    +(def-alien-type uquad-t #+alpha unsigned-long
    +		#-alpha (array unsigned-long 2))
    +(def-alien-type u-int32-t unsigned-int)
    +(def-alien-type int64-t (signed 64))
    +(def-alien-type u-int64-t (unsigned 64))
    +
    +(def-alien-type dev-t #-amd64 uquad-t #+amd64 u-int64-t)
    +(def-alien-type uid-t unsigned-int)
    +(def-alien-type gid-t unsigned-int)
    +(def-alien-type ino-t #-amd64 u-int32-t #+amd64 u-int64-t)
    +(def-alien-type ino64-t u-int64-t)
    +(def-alien-type mode-t u-int32-t)
    +(def-alien-type nlink-t #-amd64 unsigned-int #+amd64 u-int64-t)
    +(def-alien-type off-t int64-t)
    +(def-alien-type blkcnt-t u-int64-t)
    +
     ;;;; Common machine independent structures.
     
    +
    +;; Needed early in bootstrap.
    +(defun unix-current-directory ()
    +  _N"Put the absolute pathname of the current working directory in BUF.
    +   If successful, return BUF.  If not, put an error message in
    +   BUF and return NULL.  BUF should be at least PATH_MAX bytes long."
    +  ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
    +  (with-alien ((buf (array c-call:char 5120)))
    +    (let ((result (alien-funcall
    +		    (extern-alien "getcwd"
    +				  (function (* c-call:char)
    +					    (* c-call:char) c-call:int))
    +		    (cast buf (* c-call:char))
    +		    5120)))
    +      
    +      (values (not (zerop (sap-int (alien-sap result))))
    +	      (%file->name (cast buf c-call:c-string))))))
    +
    +;;; fcntlbits.h
    +(defconstant o_read    o_rdonly _N"Open for reading")
    +(defconstant o_write   o_wronly _N"Open for writing")
    +
    +(defconstant o_rdonly  0 _N"Read-only flag.") 
    +(defconstant o_wronly  1 _N"Write-only flag.")
    +(defconstant o_rdwr    2 _N"Read-write flag.")
    +(defconstant o_accmode 3 _N"Access mode mask.")
    +
    +#-alpha
    +(progn
    +  (defconstant o_creat   #o100 _N"Create if nonexistant flag. (not fcntl)") 
    +  (defconstant o_excl    #o200 _N"Error if already exists. (not fcntl)")
    +  (defconstant o_noctty  #o400 _N"Don't assign controlling tty. (not fcntl)")
    +  (defconstant o_trunc   #o1000 _N"Truncate flag. (not fcntl)")
    +  (defconstant o_append  #o2000 _N"Append flag.")
    +  (defconstant o_ndelay  #o4000 _N"Non-blocking I/O")
    +  (defconstant o_nonblock #o4000 _N"Non-blocking I/O")
    +  (defconstant o_ndelay  o_nonblock)
    +  (defconstant o_sync    #o10000 _N"Synchronous writes (on ext2)")
    +  (defconstant o_fsync    o_sync)
    +  (defconstant o_async   #o20000 _N"Asynchronous I/O"))
    +#+alpha
    +(progn
    +  (defconstant o_creat   #o1000 _N"Create if nonexistant flag. (not fcntl)") 
    +  (defconstant o_trunc   #o2000 _N"Truncate flag. (not fcntl)")
    +  (defconstant o_excl    #o4000 _N"Error if already exists. (not fcntl)")
    +  (defconstant o_noctty  #o10000 _N"Don't assign controlling tty. (not fcntl)")
    +  (defconstant o_nonblock #o4 _N"Non-blocking I/O")
    +  (defconstant o_append  #o10 _N"Append flag.")
    +  (defconstant o_ndelay  o_nonblock)
    +  (defconstant o_sync    #o40000 _N"Synchronous writes (on ext2)")
    +  (defconstant o_fsync    o_sync)
    +  (defconstant o_async   #o20000 _N"Asynchronous I/O"))
    +
    +#-alpha
    +(progn
    +  (defconstant f-getlk    5   _N"Get lock")
    +  (defconstant f-setlk    6   _N"Set lock")
    +  (defconstant f-setlkw   7   _N"Set lock, wait for release")
    +  (defconstant f-setown   8  _N"Set owner (for sockets)")
    +  (defconstant f-getown   9  _N"Get owner (for sockets)"))
    +#+alpha
    +(progn
    +  (defconstant f-getlk    7   _N"Get lock")
    +  (defconstant f-setlk    8   _N"Set lock")
    +  (defconstant f-setlkw   9   _N"Set lock, wait for release")
    +  (defconstant f-setown   5  _N"Set owner (for sockets)")
    +  (defconstant f-getown   6  _N"Get owner (for sockets)"))
    +
    +(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl")
    +(defun unix-open (path flags mode)
    +  _N"Unix-open opens the file whose pathname is specified by PATH
    +   for reading and/or writing as specified by the FLAGS argument.
    +   Returns an integer file descriptor.
    +   The flags argument can be:
    +
    +     o_rdonly        Read-only flag.
    +     o_wronly        Write-only flag.
    +     o_rdwr          Read-and-write flag.
    +     o_append        Append flag.
    +     o_creat         Create-if-nonexistant flag.
    +     o_trunc         Truncate-to-size-0 flag.
    +     o_excl          Error if the file already exists
    +     o_noctty        Don't assign controlling tty
    +     o_ndelay        Non-blocking I/O
    +     o_sync          Synchronous I/O
    +     o_async         Asynchronous I/O
    +
    +   If the o_creat flag is specified, then the file is created with
    +   a permission of argument MODE if the file doesn't exist."
    +  (declare (type unix-pathname path)
    +	   (type fixnum flags)
    +	   (type unix-file-mode mode))
    +  (int-syscall ("open64" c-string int int) (%name->file path) flags mode))
    +
    +;;; asm/errno.h
     (eval-when (compile eval)
     
     (defparameter *compiler-unix-errors* nil)
    @@ -241,97 +221,135 @@
     
     )
     
    -(defmacro def-enum (inc cur &rest names)
    -  (flet ((defform (name)
    -	     (prog1 (when name `(defconstant ,name ,cur))
    -	       (setf cur (funcall inc cur 1)))))
    -    `(progn ,@(mapcar #'defform names))))
    -
    -;;;; Memory-mapped files
    +(def-unix-error ESUCCESS 0 _N"Successful")
    +(def-unix-error EPERM 1 _N"Operation not permitted")
    +(def-unix-error ENOENT 2 _N"No such file or directory")
    +(def-unix-error ESRCH 3 _N"No such process")
    +(def-unix-error EINTR 4 _N"Interrupted system call")
    +(def-unix-error EIO 5 _N"I/O error")
    +(def-unix-error ENXIO 6 _N"No such device or address")
    +(def-unix-error E2BIG 7 _N"Arg list too long")
    +(def-unix-error ENOEXEC 8 _N"Exec format error")
    +(def-unix-error EBADF 9 _N"Bad file number")
    +(def-unix-error ECHILD 10 _N"No children")
    +(def-unix-error EAGAIN 11 _N"Try again")
    +(def-unix-error ENOMEM 12 _N"Out of memory")
    +(def-unix-error EACCES 13 _N"Permission denied")
    +(def-unix-error EFAULT 14 _N"Bad address")
    +(def-unix-error ENOTBLK 15 _N"Block device required")
    +(def-unix-error EBUSY 16 _N"Device or resource busy")
    +(def-unix-error EEXIST 17 _N"File exists")
    +(def-unix-error EXDEV 18 _N"Cross-device link")
    +(def-unix-error ENODEV 19 _N"No such device")
    +(def-unix-error ENOTDIR 20 _N"Not a director")
    +(def-unix-error EISDIR 21 _N"Is a directory")
    +(def-unix-error EINVAL 22 _N"Invalid argument")
    +(def-unix-error ENFILE 23 _N"File table overflow")
    +(def-unix-error EMFILE 24 _N"Too many open files")
    +(def-unix-error ENOTTY 25 _N"Not a typewriter")
    +(def-unix-error ETXTBSY 26 _N"Text file busy")
    +(def-unix-error EFBIG 27 _N"File too large")
    +(def-unix-error ENOSPC 28 _N"No space left on device")
    +(def-unix-error ESPIPE 29 _N"Illegal seek")
    +(def-unix-error EROFS 30 _N"Read-only file system")
    +(def-unix-error EMLINK 31 _N"Too many links")
    +(def-unix-error EPIPE 32 _N"Broken pipe")
    +;;; 
    +;;; Math
    +(def-unix-error EDOM 33 _N"Math argument out of domain")
    +(def-unix-error ERANGE 34 _N"Math result not representable")
    +;;; 
    +(def-unix-error  EDEADLK         35     _N"Resource deadlock would occur")
    +(def-unix-error  ENAMETOOLONG    36     _N"File name too long")
    +(def-unix-error  ENOLCK          37     _N"No record locks available")
    +(def-unix-error  ENOSYS          38     _N"Function not implemented")
    +(def-unix-error  ENOTEMPTY       39     _N"Directory not empty")
    +(def-unix-error  ELOOP           40     _N"Too many symbolic links encountered")
    +(def-unix-error  EWOULDBLOCK     11     _N"Operation would block")
    +(def-unix-error  ENOMSG          42     _N"No message of desired type")
    +(def-unix-error  EIDRM           43     _N"Identifier removed")
    +(def-unix-error  ECHRNG          44     _N"Channel number out of range")
    +(def-unix-error  EL2NSYNC        45     _N"Level 2 not synchronized")
    +(def-unix-error  EL3HLT          46     _N"Level 3 halted")
    +(def-unix-error  EL3RST          47     _N"Level 3 reset")
    +(def-unix-error  ELNRNG          48     _N"Link number out of range")
    +(def-unix-error  EUNATCH         49     _N"Protocol driver not attached")
    +(def-unix-error  ENOCSI          50     _N"No CSI structure available")
    +(def-unix-error  EL2HLT          51     _N"Level 2 halted")
    +(def-unix-error  EBADE           52     _N"Invalid exchange")
    +(def-unix-error  EBADR           53     _N"Invalid request descriptor")
    +(def-unix-error  EXFULL          54     _N"Exchange full")
    +(def-unix-error  ENOANO          55     _N"No anode")
    +(def-unix-error  EBADRQC         56     _N"Invalid request code")
    +(def-unix-error  EBADSLT         57     _N"Invalid slot")
    +(def-unix-error  EDEADLOCK       EDEADLK     _N"File locking deadlock error")
    +(def-unix-error  EBFONT          59     _N"Bad font file format")
    +(def-unix-error  ENOSTR          60     _N"Device not a stream")
    +(def-unix-error  ENODATA         61     _N"No data available")
    +(def-unix-error  ETIME           62     _N"Timer expired")
    +(def-unix-error  ENOSR           63     _N"Out of streams resources")
    +(def-unix-error  ENONET          64     _N"Machine is not on the network")
    +(def-unix-error  ENOPKG          65     _N"Package not installed")
    +(def-unix-error  EREMOTE         66     _N"Object is remote")
    +(def-unix-error  ENOLINK         67     _N"Link has been severed")
    +(def-unix-error  EADV            68     _N"Advertise error")
    +(def-unix-error  ESRMNT          69     _N"Srmount error")
    +(def-unix-error  ECOMM           70     _N"Communication error on send")
    +(def-unix-error  EPROTO          71     _N"Protocol error")
    +(def-unix-error  EMULTIHOP       72     _N"Multihop attempted")
    +(def-unix-error  EDOTDOT         73     _N"RFS specific error")
    +(def-unix-error  EBADMSG         74     _N"Not a data message")
    +(def-unix-error  EOVERFLOW       75     _N"Value too large for defined data type")
    +(def-unix-error  ENOTUNIQ        76     _N"Name not unique on network")
    +(def-unix-error  EBADFD          77     _N"File descriptor in bad state")
    +(def-unix-error  EREMCHG         78     _N"Remote address changed")
    +(def-unix-error  ELIBACC         79     _N"Can not access a needed shared library")
    +(def-unix-error  ELIBBAD         80     _N"Accessing a corrupted shared library")
    +(def-unix-error  ELIBSCN         81     _N".lib section in a.out corrupted")
    +(def-unix-error  ELIBMAX         82     _N"Attempting to link in too many shared libraries")
    +(def-unix-error  ELIBEXEC        83     _N"Cannot exec a shared library directly")
    +(def-unix-error  EILSEQ          84     _N"Illegal byte sequence")
    +(def-unix-error  ERESTART        85     _N"Interrupted system call should be restarted _N")
    +(def-unix-error  ESTRPIPE        86     _N"Streams pipe error")
    +(def-unix-error  EUSERS          87     _N"Too many users")
    +(def-unix-error  ENOTSOCK        88     _N"Socket operation on non-socket")
    +(def-unix-error  EDESTADDRREQ    89     _N"Destination address required")
    +(def-unix-error  EMSGSIZE        90     _N"Message too long")
    +(def-unix-error  EPROTOTYPE      91     _N"Protocol wrong type for socket")
    +(def-unix-error  ENOPROTOOPT     92     _N"Protocol not available")
    +(def-unix-error  EPROTONOSUPPORT 93     _N"Protocol not supported")
    +(def-unix-error  ESOCKTNOSUPPORT 94     _N"Socket type not supported")
    +(def-unix-error  EOPNOTSUPP      95     _N"Operation not supported on transport endpoint")
    +(def-unix-error  EPFNOSUPPORT    96     _N"Protocol family not supported")
    +(def-unix-error  EAFNOSUPPORT    97     _N"Address family not supported by protocol")
    +(def-unix-error  EADDRINUSE      98     _N"Address already in use")
    +(def-unix-error  EADDRNOTAVAIL   99     _N"Cannot assign requested address")
    +(def-unix-error  ENETDOWN        100    _N"Network is down")
    +(def-unix-error  ENETUNREACH     101    _N"Network is unreachable")
    +(def-unix-error  ENETRESET       102    _N"Network dropped connection because of reset")
    +(def-unix-error  ECONNABORTED    103    _N"Software caused connection abort")
    +(def-unix-error  ECONNRESET      104    _N"Connection reset by peer")
    +(def-unix-error  ENOBUFS         105    _N"No buffer space available")
    +(def-unix-error  EISCONN         106    _N"Transport endpoint is already connected")
    +(def-unix-error  ENOTCONN        107    _N"Transport endpoint is not connected")
    +(def-unix-error  ESHUTDOWN       108    _N"Cannot send after transport endpoint shutdown")
    +(def-unix-error  ETOOMANYREFS    109    _N"Too many references: cannot splice")
    +(def-unix-error  ETIMEDOUT       110    _N"Connection timed out")
    +(def-unix-error  ECONNREFUSED    111    _N"Connection refused")
    +(def-unix-error  EHOSTDOWN       112    _N"Host is down")
    +(def-unix-error  EHOSTUNREACH    113    _N"No route to host")
    +(def-unix-error  EALREADY        114    _N"Operation already in progress")
    +(def-unix-error  EINPROGRESS     115    _N"Operation now in progress")
    +(def-unix-error  ESTALE          116    _N"Stale NFS file handle")
    +(def-unix-error  EUCLEAN         117    _N"Structure needs cleaning")
    +(def-unix-error  ENOTNAM         118    _N"Not a XENIX named type file")
    +(def-unix-error  ENAVAIL         119    _N"No XENIX semaphores available")
    +(def-unix-error  EISNAM          120    _N"Is a named type file")
    +(def-unix-error  EREMOTEIO       121    _N"Remote I/O error")
    +(def-unix-error  EDQUOT          122    _N"Quota exceeded")
     
    -(defconstant +null+ (sys:int-sap 0))
    -
    -(defconstant prot_read 1)
    -(defconstant prot_write 2)
    -(defconstant prot_exec 4)
    -(defconstant prot_none 0)
    -
    -(defconstant map_shared 1)
    -(defconstant map_private 2)
    -(defconstant map_fixed 16)
    -(defconstant map_anonymous 32)
    -
    -(defconstant ms_async 1)
    -(defconstant ms_sync 4)
    -(defconstant ms_invalidate 2)
    -
    -;; The return value from mmap that means mmap failed.
    -(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
    -
    -(defun unix-mmap (addr length prot flags fd offset)
    -  (declare (type (or null system-area-pointer) addr)
    -	   (type (unsigned-byte 32) length)
    -           (type (integer 1 7) prot)
    -	   (type (unsigned-byte 32) flags)
    -	   (type (or null unix-fd) fd)
    -	   (type (signed-byte 32) offset))
    -  ;; Can't use syscall, because the address that is returned could be
    -  ;; "negative".  Hence we explicitly check for mmap returning
    -  ;; MAP_FAILED.
    -  (let ((result
    -	 (alien-funcall (extern-alien "mmap" (function system-area-pointer
    -						       system-area-pointer
    -						       size-t int int int off-t))
    -			(or addr +null+) length prot flags (or fd -1) offset)))
    -    (if (sap= result map_failed)
    -	(values nil (unix-errno))
    -	(values result 0))))
    -
    -(defun unix-munmap (addr length)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length))
    -  (syscall ("munmap" system-area-pointer size-t) t addr length))
    -
    -(defun unix-msync (addr length flags)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length)
    -	   (type (signed-byte 32) flags))
    -  (syscall ("msync" system-area-pointer size-t int) t addr length flags))
    -
    -(defun unix-mprotect (addr length prot)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length)
    -           (type (integer 1 7) prot))
    -  (syscall ("mprotect" system-area-pointer size-t int)
    -	   t addr length prot))
    -  
    -;;;; Lisp types used by syscalls.
    -
    -(deftype unix-pathname () 'simple-string)
    -(deftype unix-fd () `(integer 0 ,most-positive-fixnum))
    -
    -(deftype unix-file-mode () '(unsigned-byte 32))
    -(deftype unix-pid () '(unsigned-byte 32))
    -(deftype unix-uid () '(unsigned-byte 32))
    -(deftype unix-gid () '(unsigned-byte 32))
    -
    -
    -;;;; User and group database structures: <pwd.h> and <grp.h>
    -
    -(defstruct user-info
    -  (name "" :type string)
    -  (password "" :type string)
    -  (uid 0 :type unix-uid)
    -  (gid 0 :type unix-gid)
    -  (gecos "" :type string)
    -  (dir "" :type string)
    -  (shell "" :type string))
    -
    -(defstruct group-info
    -  (name "" :type string)
    -  (password "" :type string)
    -  (gid 0 :type unix-gid)
    -  (members nil :type list))             ; list of logins as strings
    +;;; And now for something completely different ...
    +(emit-unix-errors)
     
     (def-alien-type nil
         (struct passwd
    @@ -343,14 +361,6 @@
     	    (pw-dir (* char))           ; user's home directory
     	    (pw-shell (* char))))       ; user's login shell
     
    -(def-alien-type nil
    -  (struct group
    -      (gr-name (* char))                ; name of the group
    -      (gr-passwd (* char))              ; encrypted group password
    -      (gr-gid gid-t)                    ; numerical group ID
    -      (gr-mem (* (* char)))))           ; vector of pointers to member names
    -
    -
     ;;;; System calls.
     
     (def-alien-routine ("os_get_errno" unix-get-errno) int)
    @@ -393,213 +403,261 @@
     (defmacro int-syscall ((name &rest arg-types) &rest args)
       `(syscall (,name ,@arg-types) (values result 0) ,@args))
     
    -;;; From stdio.h
    -
    -;;; Unix-rename accepts two files names and renames the first to the second.
    -
    -(defun unix-rename (name1 name2)
    -  _N"Unix-rename renames the file with string name1 to the string
    -   name2.  NIL and an error code is returned if an error occured."
    -  (declare (type unix-pathname name1 name2))
    -  (void-syscall ("rename" c-string c-string)
    -		(%name->file name1) (%name->file name2)))
    -
    -;;; From sys/types.h
    -;;;         and
    -;;;      gnu/types.h
    +;;; Unix-write accepts a file descriptor, a buffer, an offset, and the
    +;;; length to write.  It attempts to write len bytes to the device
    +;;; associated with fd from the the buffer starting at offset.  It returns
    +;;; the actual number of bytes written.
     
    -(defconstant +max-s-long+ 2147483647)
    -(defconstant +max-u-long+ 4294967295)
    +(defun unix-write (fd buf offset len)
    +  _N"Unix-write attempts to write a character buffer (buf) of length
    +   len to the file described by the file descriptor fd.  NIL and an
    +   error is returned if the call is unsuccessful."
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 32) offset len))
    +  (int-syscall ("write" int (* char) int)
    +	       fd
    +	       (with-alien ((ptr (* char) (etypecase buf
    +					    ((simple-array * (*))
    +					     (vector-sap buf))
    +					    (system-area-pointer
    +					     buf))))
    +		 (addr (deref ptr offset)))
    +	       len))
     
    -(def-alien-type quad-t #+alpha long #-alpha (array long 2))
    -(def-alien-type uquad-t #+alpha unsigned-long
    -		#-alpha (array unsigned-long 2))
    -(def-alien-type qaddr-t (* quad-t))
    -(def-alien-type daddr-t int)
    -(def-alien-type caddr-t (* char))
    -(def-alien-type swblk-t long)
    -(def-alien-type size-t #-alpha unsigned-int #+alpha long)
    -(def-alien-type time-t long)
    -(def-alien-type clock-t long)
    -(def-alien-type uid-t unsigned-int)
    -(def-alien-type ssize-t #-alpha int #+alpha long)
    -(def-alien-type key-t int)
    -(def-alien-type int8-t char)
    -(def-alien-type u-int8-t unsigned-char)
    -(def-alien-type int16-t short)
    -(def-alien-type u-int16-t unsigned-short)
    -(def-alien-type int32-t int)
    -(def-alien-type u-int32-t unsigned-int)
    -(def-alien-type int64-t (signed 64))
    -(def-alien-type u-int64-t (unsigned 64))
    -(def-alien-type register-t #-alpha int #+alpha long)
    +(defun unix-pipe ()
    +  _N"Unix-pipe sets up a unix-piping mechanism consisting of
    +  an input pipe and an output pipe.  Unix-Pipe returns two
    +  values: if no error occurred the first value is the pipe
    +  to be read from and the second is can be written to.  If
    +  an error occurred the first value is NIL and the second
    +  the unix error code."
    +  (with-alien ((fds (array int 2)))
    +    (syscall ("pipe" (* int))
    +	     (values (deref fds 0) (deref fds 1))
    +	     (cast fds (* int)))))
     
    -(def-alien-type dev-t #-amd64 uquad-t #+amd64 u-int64-t)
    -(def-alien-type uid-t unsigned-int)
    -(def-alien-type gid-t unsigned-int)
    -(def-alien-type ino-t #-amd64 u-int32-t #+amd64 u-int64-t)
    -(def-alien-type ino64-t u-int64-t)
    -(def-alien-type mode-t u-int32-t)
    -(def-alien-type nlink-t #-amd64 unsigned-int #+amd64 u-int64-t)
    -(def-alien-type off-t int64-t)
    -(def-alien-type blkcnt-t u-int64-t)
    -(def-alien-type fsblkcnt-t u-int64-t)
    -(def-alien-type fsfilcnt-t u-int64-t)
    -(def-alien-type pid-t int)
    -;(def-alien-type ssize-t #-alpha int #+alpha long)
    +;;; UNIX-READ accepts a file descriptor, a buffer, and the length to read.
    +;;; It attempts to read len bytes from the device associated with fd
    +;;; and store them into the buffer.  It returns the actual number of
    +;;; bytes read.
     
    -(def-alien-type fsid-t (array int 2))
    +(defun unix-read (fd buf len)
    +  _N"UNIX-READ attempts to read from the file described by fd into
    +   the buffer buf until it is full.  Len is the length of the buffer.
    +   The number of bytes actually read is returned or NIL and an error
    +   number if an error occured."
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 32) len))
    +  #+gencgc
    +  ;; With gencgc, the collector tries to keep raw objects like strings
    +  ;; in separate pages that are not write-protected.  However, this
    +  ;; isn't always true.  Thus, BUF will sometimes be write-protected
    +  ;; and the kernel doesn't like writing to write-protected pages.  So
    +  ;; go through and touch each page to give the segv handler a chance
    +  ;; to unprotect the pages.  (This is taken from unix.lisp.)
    +  (without-gcing
    +   (let* ((page-size (get-page-size))
    +	  (1-page-size (1- page-size))
    +	  (sap (etypecase buf
    +		 (system-area-pointer buf)
    +		 (vector (vector-sap buf))))
    +	  (end (sap+ sap len)))
    +     (declare (type (and fixnum unsigned-byte) page-size 1-page-size)
    +	      (type system-area-pointer sap end)
    +	      (optimize (speed 3) (safety 0)))
    +     ;; Touch the beginning of every page
    +     (do ((sap (int-sap (logand (sap-int sap)
    +				(logxor 1-page-size (ldb (byte 32 0) -1))))
    +	       (sap+ sap page-size)))
    +	 ((sap>= sap end))
    +       (declare (type system-area-pointer sap))
    +       (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0)))))
    +  (int-syscall ("read" int (* char) int) fd buf len))
     
    -(def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int)
    +;;; Unix-getpagesize returns the number of bytes in the system page.
     
    -(defconstant fd-setsize 1024)
    -(defconstant nfdbits 32)
    -  
    -(def-alien-type nil
    -  (struct fd-set
    -	  (fds-bits (array fd-mask #.(/ fd-setsize nfdbits)))))
    +(defun unix-getpagesize ()
    +  _N"Unix-getpagesize returns the number of bytes in a system page."
    +  (int-syscall ("getpagesize")))
     
    -(def-alien-type key-t int)
    +;;; sys/stat.h
     
    -(def-alien-type ipc-pid-t unsigned-short)
    +(defmacro extract-stat-results (buf)
    +  `(values T
    +           #+(or alpha amd64)
    +	   (slot ,buf 'st-dev)
    +           #-(or alpha amd64)
    +           (+ (deref (slot ,buf 'st-dev) 0)
    +	      (* (+ +max-u-long+  1)
    +	         (deref (slot ,buf 'st-dev) 1)))   ;;; let's hope this works..
    +	   (slot ,buf 'st-ino)
    +	   (slot ,buf 'st-mode)
    +	   (slot ,buf 'st-nlink)
    +	   (slot ,buf 'st-uid)
    +	   (slot ,buf 'st-gid)
    +           #+(or alpha amd64)
    +	   (slot ,buf 'st-rdev)
    +           #-(or alpha amd64)
    +           (+ (deref (slot ,buf 'st-rdev) 0)
    +	      (* (+ +max-u-long+  1)
    +	         (deref (slot ,buf 'st-rdev) 1)))   ;;; let's hope this works..
    +	   (slot ,buf 'st-size)
    +	   (slot ,buf 'st-atime)
    +	   (slot ,buf 'st-mtime)
    +	   (slot ,buf 'st-ctime)
    +	   (slot ,buf 'st-blksize)
    +	   (slot ,buf 'st-blocks)))
     
    -;;; direntry.h
    +;;; bits/stat.h
     
     (def-alien-type nil
    -  (struct dirent
    -    #+glibc2.1
    -    (d-ino ino-t)                       ; inode number of entry
    -    #-glibc2.1
    -    (d-ino ino64-t)                     ; inode number of entry
    -    (d-off off-t)                       ; offset of next disk directory entry
    -    (d-reclen unsigned-short)		; length of this record
    -    (d_type unsigned-char)
    -    (d-name (array char 256))))		; name must be no longer than this
    -;;; dirent.h
    -
    -;;; Operations on Unix Directories.
    -
    -(export '(open-dir read-dir close-dir))
    +  (struct stat
    +    (st-dev dev-t)
    +    #-(or alpha amd64) (st-pad1 unsigned-short)
    +    (st-ino ino-t)
    +    #+alpha (st-pad1 unsigned-int)
    +    #-amd64 (st-mode mode-t)
    +    (st-nlink  nlink-t)
    +    #+amd64 (st-mode mode-t)
    +    (st-uid  uid-t)
    +    (st-gid  gid-t)
    +    (st-rdev dev-t)
    +    #-alpha (st-pad2  unsigned-short)
    +    (st-size off-t)
    +    #-alpha (st-blksize unsigned-long)
    +    #-alpha (st-blocks blkcnt-t)
    +    (st-atime time-t)
    +    #-alpha (unused-1 unsigned-long)
    +    (st-mtime time-t)
    +    #-alpha (unused-2 unsigned-long)
    +    (st-ctime time-t)
    +    #+alpha (st-blocks int)
    +    #+alpha (st-pad2 unsigned-int)
    +    #+alpha (st-blksize unsigned-int)
    +    #+alpha (st-flags unsigned-int)
    +    #+alpha (st-gen unsigned-int)
    +    #+alpha (st-pad3 unsigned-int)
    +    #+alpha (unused-1 unsigned-long)
    +    #+alpha (unused-2 unsigned-long)
    +    (unused-3 unsigned-long)
    +    (unused-4 unsigned-long)
    +    #-alpha (unused-5 unsigned-long)))
     
    -(defstruct (%directory
    -	     (:constructor make-directory)
    -	     (:conc-name directory-)
    -	     (:print-function %print-directory))
    -  name
    -  (dir-struct (required-argument) :type system-area-pointer))
    -
    -(defun %print-directory (dir stream depth)
    -  (declare (ignore depth))
    -  (format stream "#<Directory ~S>" (directory-name dir)))
    +(defun unix-stat (name)
    +  _N"UNIX-STAT retrieves information about the specified
    +   file returning them in the form of multiple values.
    +   See the UNIX Programmer's Manual for a description
    +   of the values returned.  If the call fails, then NIL
    +   and an error number is returned instead."
    +  (declare (type unix-pathname name))
    +  (when (string= name "")
    +    (setf name "."))
    +  (with-alien ((buf (struct stat)))
    +    (syscall ("stat64" c-string (* (struct stat)))
    +	     (extract-stat-results buf)
    +	     (%name->file name) (addr buf))))
     
    -(defun open-dir (pathname)
    -  (declare (type unix-pathname pathname))
    -  (when (string= pathname "")
    -    (setf pathname "."))
    -  (let ((kind (unix-file-kind pathname)))
    -    (case kind
    -      (:directory
    -       (let ((dir-struct
    -	      (alien-funcall (extern-alien "opendir"
    -					   (function system-area-pointer
    -						     c-string))
    -			     (%name->file pathname))))
    -	 (if (zerop (sap-int dir-struct))
    -	     (values nil (unix-errno))
    -	     (make-directory :name pathname :dir-struct dir-struct))))
    -      ((nil)
    -       (values nil enoent))
    -      (t
    -       (values nil enotdir)))))
    +(defun unix-fstat (fd)
    +  _N"UNIX-FSTAT is similar to UNIX-STAT except the file is specified
    +   by the file descriptor FD."
    +  (declare (type unix-fd fd))
    +  (with-alien ((buf (struct stat)))
    +    (syscall ("fstat64" int (* (struct stat)))
    +	     (extract-stat-results buf)
    +	     fd (addr buf))))
     
    -(defun read-dir (dir)
    -  (declare (type %directory dir))
    -  (let ((daddr (alien-funcall (extern-alien "readdir64"
    -					    (function system-area-pointer
    -						      system-area-pointer))
    -			      (directory-dir-struct dir))))
    -    (declare (type system-area-pointer daddr))
    -    (if (zerop (sap-int daddr))
    -	nil
    -	(with-alien ((dirent (* (struct dirent)) daddr))
    -	  (values (%file->name (cast (slot dirent 'd-name) c-string))
    -		  (slot dirent 'd-ino))))))
    +(defun unix-lstat (name)
    +  _N"UNIX-LSTAT is similar to UNIX-STAT except the specified
    +   file must be a symbolic link."
    +  (declare (type unix-pathname name))
    +  (with-alien ((buf (struct stat)))
    +    (syscall ("lstat64" c-string (* (struct stat)))
    +	     (extract-stat-results buf)
    +	     (%name->file name) (addr buf))))
     
    -(defun close-dir (dir)
    -  (declare (type %directory dir))
    -  (alien-funcall (extern-alien "closedir"
    -			       (function void system-area-pointer))
    -		 (directory-dir-struct dir))
    -  nil)
    +;; Encoding of the file mode.
     
    -;;; dlfcn.h -> in foreign.lisp
    +(defconstant s-ifmt   #o0170000 _N"These bits determine file type.")
     
    -;;; fcntl.h
    -;;;
    -;;; POSIX Standard: 6.5 File Control Operations	<fcntl.h>
    +;; File types.
     
    -(defconstant r_ok 4 _N"Test for read permission")
    -(defconstant w_ok 2 _N"Test for write permission")
    -(defconstant x_ok 1 _N"Test for execute permission")
    -(defconstant f_ok 0 _N"Test for presence of file")
    +(defconstant s-ififo  #o0010000 _N"FIFO")
    +(defconstant s-ifchr  #o0020000 _N"Character device")
    +(defconstant s-ifdir  #o0040000 _N"Directory")
    +(defconstant s-ifblk  #o0060000 _N"Block device")
    +(defconstant s-ifreg  #o0100000 _N"Regular file")
     
    -(defun unix-fcntl (fd cmd arg)
    -  _N"Unix-fcntl manipulates file descriptors accoridng to the
    -   argument CMD which can be one of the following:
    +;; These don't actually exist on System V, but having them doesn't hurt.
     
    -   F-DUPFD         Duplicate a file descriptor.
    -   F-GETFD         Get file descriptor flags.
    -   F-SETFD         Set file descriptor flags.
    -   F-GETFL         Get file flags.
    -   F-SETFL         Set file flags.
    -   F-GETOWN        Get owner.
    -   F-SETOWN        Set owner.
    +(defconstant s-iflnk  #o0120000 _N"Symbolic link.")
    +(defconstant s-ifsock #o0140000 _N"Socket.")
    +(defun unix-file-kind (name &optional check-for-links)
    +  _N"Returns either :file, :directory, :link, :special, or NIL."
    +  (declare (simple-string name))
    +  (multiple-value-bind (res dev ino mode)
    +		       (if check-for-links
    +			   (unix-lstat name)
    +			   (unix-stat name))
    +    (declare (type (or fixnum null) mode)
    +	     (ignore dev ino))
    +    (when res
    +      (let ((kind (logand mode s-ifmt)))
    +	(cond ((eql kind s-ifdir) :directory)
    +	      ((eql kind s-ifreg) :file)
    +	      ((eql kind s-iflnk) :link)
    +	      (t :special))))))
     
    -   The flags that can be specified for F-SETFL are:
    +(defun unix-maybe-prepend-current-directory (name)
    +  (declare (simple-string name))
    +  (if (and (> (length name) 0) (char= (schar name 0) #\/))
    +      name
    +      (multiple-value-bind (win dir) (unix-current-directory)
    +	(if win
    +	    (concatenate 'simple-string dir "/" name)
    +	    name))))
     
    -   FNDELAY         Non-blocking reads.
    -   FAPPEND         Append on each write.
    -   FASYNC          Signal pgrp when data ready.
    -   FCREAT          Create if nonexistant.
    -   FTRUNC          Truncate to zero length.
    -   FEXCL           Error if already created.
    -   "
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 32) cmd)
    -	   (type (unsigned-byte 32) arg))
    -  (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))
    +;; Values for the second argument to access.
     
    -(defun unix-open (path flags mode)
    -  _N"Unix-open opens the file whose pathname is specified by PATH
    -   for reading and/or writing as specified by the FLAGS argument.
    -   Returns an integer file descriptor.
    -   The flags argument can be:
    +;;; Unix-access accepts a path and a mode.  It returns two values the
    +;;; first is T if the file is accessible and NIL otherwise.  The second
    +;;; only has meaning in the second case and is the unix errno value.
     
    -     o_rdonly        Read-only flag.
    -     o_wronly        Write-only flag.
    -     o_rdwr          Read-and-write flag.
    -     o_append        Append flag.
    -     o_creat         Create-if-nonexistant flag.
    -     o_trunc         Truncate-to-size-0 flag.
    -     o_excl          Error if the file already exists
    -     o_noctty        Don't assign controlling tty
    -     o_ndelay        Non-blocking I/O
    -     o_sync          Synchronous I/O
    -     o_async         Asynchronous I/O
    +(defun unix-access (path mode)
    +  _N"Given a file path (a string) and one of four constant modes,
    +   unix-access returns T if the file is accessible with that
    +   mode and NIL if not.  It also returns an errno value with
    +   NIL which determines why the file was not accessible.
     
    -   If the o_creat flag is specified, then the file is created with
    -   a permission of argument MODE if the file doesn't exist."
    +   The access modes are:
    +	r_ok     Read permission.
    +	w_ok     Write permission.
    +	x_ok     Execute permission.
    +	f_ok     Presence of file."
       (declare (type unix-pathname path)
    -	   (type fixnum flags)
    -	   (type unix-file-mode mode))
    -  (int-syscall ("open64" c-string int int) (%name->file path) flags mode))
    +	   (type (mod 8) mode))
    +  (void-syscall ("access" c-string int) (%name->file path) mode))
     
    -(defun unix-getdtablesize ()
    -  _N"Unix-getdtablesize returns the maximum size of the file descriptor
    -   table. (i.e. the maximum number of descriptors that can exist at
    -   one time.)"
    -  (int-syscall ("getdtablesize")))
    +(defconstant l_set 0 _N"set the file pointer")
    +(defconstant l_incr 1 _N"increment the file pointer")
    +(defconstant l_xtnd 2 _N"extend the file size")
    +
    +(defun unix-lseek (fd offset whence)
    +  _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead
    +   a certain OFFSET for that file.  WHENCE can be any of the following:
     
    +   l_set        Set the file pointer.
    +   l_incr       Increment the file pointer.
    +   l_xtnd       Extend the file size.
    +  "
    +  (declare (type unix-fd fd)
    +	   (type (signed-byte 64) offset)
    +	   (type (integer 0 2) whence))
    +  (let ((result (alien-funcall
    +                 (extern-alien "lseek64" (function off-t int off-t int))
    +                 fd offset whence)))
    +    (if (minusp result)
    +        (values nil (unix-errno))
    +        (values result 0))))
     ;;; Unix-close accepts a file descriptor and attempts to close the file
     ;;; associated with it.
     
    @@ -625,1511 +683,912 @@
     	   (type unix-file-mode mode))
       (int-syscall ("creat64" c-string int) (%name->file name) mode))
     
    -;;; fcntlbits.h
    -
    -(defconstant o_read    o_rdonly _N"Open for reading")
    -(defconstant o_write   o_wronly _N"Open for writing")
    -
    -(defconstant o_rdonly  0 _N"Read-only flag.") 
    -(defconstant o_wronly  1 _N"Write-only flag.")
    -(defconstant o_rdwr    2 _N"Read-write flag.")
    -(defconstant o_accmode 3 _N"Access mode mask.")
    -
    -#-alpha
    -(progn
    -  (defconstant o_creat   #o100 _N"Create if nonexistant flag. (not fcntl)") 
    -  (defconstant o_excl    #o200 _N"Error if already exists. (not fcntl)")
    -  (defconstant o_noctty  #o400 _N"Don't assign controlling tty. (not fcntl)")
    -  (defconstant o_trunc   #o1000 _N"Truncate flag. (not fcntl)")
    -  (defconstant o_append  #o2000 _N"Append flag.")
    -  (defconstant o_ndelay  #o4000 _N"Non-blocking I/O")
    -  (defconstant o_nonblock #o4000 _N"Non-blocking I/O")
    -  (defconstant o_ndelay  o_nonblock)
    -  (defconstant o_sync    #o10000 _N"Synchronous writes (on ext2)")
    -  (defconstant o_fsync    o_sync)
    -  (defconstant o_async   #o20000 _N"Asynchronous I/O"))
    -#+alpha
    -(progn
    -  (defconstant o_creat   #o1000 _N"Create if nonexistant flag. (not fcntl)") 
    -  (defconstant o_trunc   #o2000 _N"Truncate flag. (not fcntl)")
    -  (defconstant o_excl    #o4000 _N"Error if already exists. (not fcntl)")
    -  (defconstant o_noctty  #o10000 _N"Don't assign controlling tty. (not fcntl)")
    -  (defconstant o_nonblock #o4 _N"Non-blocking I/O")
    -  (defconstant o_append  #o10 _N"Append flag.")
    -  (defconstant o_ndelay  o_nonblock)
    -  (defconstant o_sync    #o40000 _N"Synchronous writes (on ext2)")
    -  (defconstant o_fsync    o_sync)
    -  (defconstant o_async   #o20000 _N"Asynchronous I/O"))
    -
    -(defconstant f-dupfd    0  _N"Duplicate a file descriptor")
    -(defconstant f-getfd    1  _N"Get file desc. flags")
    -(defconstant f-setfd    2  _N"Set file desc. flags")
    -(defconstant f-getfl    3  _N"Get file flags")
    -(defconstant f-setfl    4  _N"Set file flags")
    -
    -#-alpha
    -(progn
    -  (defconstant f-getlk    5   _N"Get lock")
    -  (defconstant f-setlk    6   _N"Set lock")
    -  (defconstant f-setlkw   7   _N"Set lock, wait for release")
    -  (defconstant f-setown   8  _N"Set owner (for sockets)")
    -  (defconstant f-getown   9  _N"Get owner (for sockets)"))
    -#+alpha
    -(progn
    -  (defconstant f-getlk    7   _N"Get lock")
    -  (defconstant f-setlk    8   _N"Set lock")
    -  (defconstant f-setlkw   9   _N"Set lock, wait for release")
    -  (defconstant f-setown   5  _N"Set owner (for sockets)")
    -  (defconstant f-getown   6  _N"Get owner (for sockets)"))
    -
    -
    -
    -(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl")
    -
    -#-alpha
    -(progn
    -  (defconstant F-RDLCK 0 _N"for fcntl and lockf")
    -  (defconstant F-WRLCK 1 _N"for fcntl and lockf")
    -  (defconstant F-UNLCK 2 _N"for fcntl and lockf")
    -  (defconstant F-EXLCK 4 _N"old bsd flock (depricated)")
    -  (defconstant F-SHLCK 8 _N"old bsd flock (depricated)"))
    -#+alpha
    -(progn
    -  (defconstant F-RDLCK 1 _N"for fcntl and lockf")
    -  (defconstant F-WRLCK 2 _N"for fcntl and lockf")
    -  (defconstant F-UNLCK 8 _N"for fcntl and lockf")
    -  (defconstant F-EXLCK 16 _N"old bsd flock (depricated)")
    -  (defconstant F-SHLCK 32 _N"old bsd flock (depricated)"))
    +(defun unix-resolve-links (pathname)
    +  _N"Returns the pathname with all symbolic links resolved."
    +  (declare (simple-string pathname))
    +  (let ((len (length pathname))
    +	(pending pathname))
    +    (declare (fixnum len) (simple-string pending))
    +    (if (zerop len)
    +	pathname
    +	(let ((result (make-string 100 :initial-element (code-char 0)))
    +	      (fill-ptr 0)
    +	      (name-start 0))
    +	  (loop
    +	    (let* ((name-end (or (position #\/ pending :start name-start) len))
    +		   (new-fill-ptr (+ fill-ptr (- name-end name-start))))
    +	      ;; grow the result string, if necessary.  the ">=" (instead of
    +	      ;; using ">") allows for the trailing "/" if we find this
    +	      ;; component is a directory.
    +	      (when (>= new-fill-ptr (length result))
    +		(let ((longer (make-string (* 3 (length result))
    +					   :initial-element (code-char 0))))
    +		  (replace longer result :end1 fill-ptr)
    +		  (setq result longer)))
    +	      (replace result pending
    +		       :start1 fill-ptr
    +		       :end1 new-fill-ptr
    +		       :start2 name-start
    +		       :end2 name-end)
    +	      (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t)))
    +		(unless kind (return nil))
    +		(cond ((eq kind :link)
    +		       (multiple-value-bind (link err) (unix-readlink result)
    +			 (unless link
    +			   (error (intl:gettext "Error reading link ~S: ~S")
    +				  (subseq result 0 fill-ptr)
    +				  (get-unix-error-msg err)))
    +			 (cond ((or (zerop (length link))
    +				    (char/= (schar link 0) #\/))
    +				;; It's a relative link
    +				(fill result (code-char 0)
    +				      :start fill-ptr
    +				      :end new-fill-ptr))
    +			       ((string= result "/../" :end1 4)
    +				;; It's across the super-root.
    +				(let ((slash (or (position #\/ result :start 4)
    +						 0)))
    +				  (fill result (code-char 0)
    +					:start slash
    +					:end new-fill-ptr)
    +				  (setf fill-ptr slash)))
    +			       (t
    +				;; It's absolute.
    +				(and (> (length link) 0)
    +				     (char= (schar link 0) #\/))
    +				(fill result (code-char 0) :end new-fill-ptr)
    +				(setf fill-ptr 0)))
    +			 (setf pending
    +			       (if (= name-end len)
    +				   link
    +				   (concatenate 'simple-string
    +						link
    +						(subseq pending name-end))))
    +			 (setf len (length pending))
    +			 (setf name-start 0)))
    +		      ((= name-end len)
    +		       (when (eq kind :directory)
    +			 (setf (schar result new-fill-ptr) #\/)
    +			 (incf new-fill-ptr))
    +		       (return (subseq result 0 new-fill-ptr)))
    +		      ((eq kind :directory)
    +		       (setf (schar result new-fill-ptr) #\/)
    +		       (setf fill-ptr (1+ new-fill-ptr))
    +		       (setf name-start (1+ name-end)))
    +		      (t
    +		       (return nil))))))))))
     
    -(defconstant F-LOCK-SH 1 _N"Shared lock for bsd flock")
    -(defconstant F-LOCK-EX 2 _N"Exclusive lock for bsd flock")
    -(defconstant F-LOCK-NB 4 _N"Don't block. Combine with F-LOCK-SH or F-LOCK-EX")
    -(defconstant F-LOCK-UN 8 _N"Remove lock for bsd flock")
    +(defun unix-simplify-pathname (src)
    +  (declare (simple-string src))
    +  (let* ((src-len (length src))
    +	 (dst (make-string src-len))
    +	 (dst-len 0)
    +	 (dots 0)
    +	 (last-slash nil))
    +    (macrolet ((deposit (char)
    +			`(progn
    +			   (setf (schar dst dst-len) ,char)
    +			   (incf dst-len))))
    +      (dotimes (src-index src-len)
    +	(let ((char (schar src src-index)))
    +	  (cond ((char= char #\.)
    +		 (when dots
    +		   (incf dots))
    +		 (deposit char))
    +		((char= char #\/)
    +		 (case dots
    +		   (0
    +		    ;; Either ``/...' or ``...//...'
    +		    (unless last-slash
    +		      (setf last-slash dst-len)
    +		      (deposit char)))
    +		   (1
    +		    ;; Either ``./...'' or ``..././...''
    +		    (decf dst-len))
    +		   (2
    +		    ;; We've found ..
    +		    (cond
    +		     ((and last-slash (not (zerop last-slash)))
    +		      ;; There is something before this ..
    +		      (let ((prev-prev-slash
    +			     (position #\/ dst :end last-slash :from-end t)))
    +			(cond ((and (= (+ (or prev-prev-slash 0) 2)
    +				       last-slash)
    +				    (char= (schar dst (- last-slash 2)) #\.)
    +				    (char= (schar dst (1- last-slash)) #\.))
    +			       ;; The something before this .. is another ..
    +			       (deposit char)
    +			       (setf last-slash dst-len))
    +			      (t
    +			       ;; The something is some random dir.
    +			       (setf dst-len
    +				     (if prev-prev-slash
    +					 (1+ prev-prev-slash)
    +					 0))
    +			       (setf last-slash prev-prev-slash)))))
    +		     (t
    +		      ;; There is nothing before this .., so we need to keep it
    +		      (setf last-slash dst-len)
    +		      (deposit char))))
    +		   (t
    +		    ;; Something other than a dot between slashes.
    +		    (setf last-slash dst-len)
    +		    (deposit char)))
    +		 (setf dots 0))
    +		(t
    +		 (setf dots nil)
    +		 (setf (schar dst dst-len) char)
    +		 (incf dst-len))))))
    +    (when (and last-slash (not (zerop last-slash)))
    +      (case dots
    +	(1
    +	 ;; We've got  ``foobar/.''
    +	 (decf dst-len))
    +	(2
    +	 ;; We've got ``foobar/..''
    +	 (unless (and (>= last-slash 2)
    +		      (char= (schar dst (1- last-slash)) #\.)
    +		      (char= (schar dst (- last-slash 2)) #\.)
    +		      (or (= last-slash 2)
    +			  (char= (schar dst (- last-slash 3)) #\/)))
    +	   (let ((prev-prev-slash
    +		  (position #\/ dst :end last-slash :from-end t)))
    +	     (if prev-prev-slash
    +		 (setf dst-len (1+ prev-prev-slash))
    +		 (return-from unix-simplify-pathname "./")))))))
    +    (cond ((zerop dst-len)
    +	   "./")
    +	  ((= dst-len src-len)
    +	   dst)
    +	  (t
    +	   (subseq dst 0 dst-len)))))
     
    -(def-alien-type nil
    -    (struct flock
    -	    (l-type short)
    -	    (l-whence short)
    -	    (l-start off-t)
    -	    (l-len off-t)
    -	    (l-pid pid-t)))
    +(defun unix-gethostname ()
    +  _N"Unix-gethostname returns the name of the host machine as a string."
    +  (with-alien ((buf (array char 256)))
    +    (syscall* ("gethostname" (* char) int)
    +	      (cast buf c-string)
    +	      (cast buf (* char)) 256)))
     
    -;;; Define some more compatibility macros to be backward compatible with
    -;;; BSD systems which did not managed to hide these kernel macros. 
    +;;; Unix-dup returns a duplicate copy of the existing file-descriptor
    +;;; passed as an argument.
     
    -(defconstant FAPPEND  o_append _N"depricated stuff")
    -(defconstant FFSYNC   o_fsync  _N"depricated stuff")
    -(defconstant FASYNC   o_async  _N"depricated stuff")
    -(defconstant FNONBLOCK  o_nonblock _N"depricated stuff")
    -(defconstant FNDELAY  o_ndelay _N"depricated stuff")
    +(defun unix-dup (fd)
    +  _N"Unix-dup duplicates an existing file descriptor (given as the
    +   argument) and return it.  If FD is not a valid file descriptor, NIL
    +   and an error number are returned."
    +  (declare (type unix-fd fd))
    +  (int-syscall ("dup" int) fd))
     
    +;;; Unix-dup2 makes the second file-descriptor describe the same file
    +;;; as the first. If the second file-descriptor points to an open
    +;;; file, it is first closed. In any case, the second should have a 
    +;;; value which is a valid file-descriptor.
     
    -;;; grp.h 
    +(defun unix-dup2 (fd1 fd2)
    +  _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup
    +   does only the new value of the duplicate descriptor may be requested
    +   through the second argument.  If a file already exists with the
    +   requested descriptor number, it will be closed and the number
    +   assigned to the duplicate."
    +  (declare (type unix-fd fd1 fd2))
    +  (void-syscall ("dup2" int int) fd1 fd2))
     
    -;;;  POSIX Standard: 9.2.1 Group Database Access	<grp.h>
    +;;; Unix-exit terminates a program.
     
    -#+(or)
    -(defun unix-setgrend ()
    -  _N"Rewind the group-file stream."
    -  (void-syscall ("setgrend")))
    +(defun unix-exit (&optional (code 0))
    +  _N"Unix-exit terminates the current process with an optional
    +   error code.  If successful, the call doesn't return.  If
    +   unsuccessful, the call returns NIL and an error number."
    +  (declare (type (signed-byte 32) code))
    +  (void-syscall ("exit" int) code))
     
    -#+(or)
    -(defun unix-endgrent ()
    -  _N"Close the group-file stream."
    -  (void-syscall ("endgrent")))
    +(def-alien-routine ("getuid" unix-getuid) int
    +  _N"Unix-getuid returns the real user-id associated with the
    +   current process.")
     
    -#+(or)
    -(defun unix-getgrent ()
    -  _N"Read an entry from the group-file stream, opening it if necessary."
    -  
    -  (let ((result (alien-funcall (extern-alien "getgrent"
    -					     (function (* (struct group)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    +;;; Unix-chdir accepts a directory name and makes that the
    +;;; current working directory.
     
    -;;; ioctl-types.h
    +(defun unix-chdir (path)
    +  _N"Given a file path string, unix-chdir changes the current working 
    +   directory to the one specified."
    +  (declare (type unix-pathname path))
    +  (void-syscall ("chdir" c-string) (%name->file path)))
     
    -(def-alien-type nil
    -  (struct winsize
    -    (ws-row unsigned-short)		; rows, in characters
    -    (ws-col unsigned-short)		; columns, in characters
    -    (ws-xpixel unsigned-short)		; horizontal size, pixels
    -    (ws-ypixel unsigned-short)))	; veritical size, pixels
    +;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
     
    -(defconstant +NCC+ 8
    -  _N"Size of control character vector.")
    +(defun unix-chmod (path mode)
    +  _N"Given a file path string and a constant mode, unix-chmod changes the
    +   permission mode for that file to the one specified. The new mode
    +   can be created by logically OR'ing the following:
     
    -(def-alien-type nil
    -  (struct termio
    -    (c-iflag unsigned-int) ; input mode flags
    -    (c-oflag unsigned-int) ; output mode flags
    -    (c-cflag unsigned-int) ; control mode flags
    -    (c-lflag unsigned-int) ; local mode flags
    -    (c-line unsigned-char) ; line discipline
    -    (c-cc (array unsigned-char #.+NCC+)))) ; control characters
    -
    -;;; modem lines 
    -(defconstant tiocm-le  1)
    -(defconstant tiocm-dtr 2)
    -(defconstant tiocm-rts 4)
    -(defconstant tiocm-st  8)
    -(defconstant tiocm-sr  #x10)
    -(defconstant tiocm-cts #x20)
    -(defconstant tiocm-car #x40)
    -(defconstant tiocm-rng #x80)
    -(defconstant tiocm-dsr #x100)
    -(defconstant tiocm-cd  tiocm-car)
    -(defconstant tiocm-ri  #x80)
    -
    -;;; ioctl (fd, TIOCSERGETLSR, &result) where result may be as below 
    -
    -;;; line disciplines 
    -(defconstant N-TTY    0)
    -(defconstant N-SLIP   1)
    -(defconstant N-MOUSE  2)
    -(defconstant N-PPP    3)
    -(defconstant N-STRIP  4)
    -(defconstant N-AX25   5)
    -
    -
    -;;; ioctls.h
    -
    -;;; Routing table calls. 
    -(defconstant siocaddrt	#x890B) ;; add routing table entry	
    -(defconstant siocdelrt	#x890C) ;; delete routing table entry	
    -(defconstant siocrtmsg	#x890D) ;; call to routing system	
    -
    -;;; Socket configuration controls.
    -(defconstant siocgifname #x8910) ;; get iface name		
    -(defconstant siocsiflink #x8911) ;; set iface channel		
    -(defconstant siocgifconf #x8912) ;; get iface list		
    -(defconstant siocgifflags #x8913) ;; get flags			
    -(defconstant siocsifflags #x8914) ;; set flags			
    -(defconstant siocgifaddr #x8915) ;; get PA address		
    -(defconstant siocsifaddr #x8916) ;; set PA address		
    -(defconstant siocgifdstaddr #x8917  ) ;; get remote PA address 
    -(defconstant siocsifdstaddr #x8918  ) ;; set remote PA address 
    -(defconstant siocgifbrdaddr #x8919  ) ;; get broadcast PA address 
    -(defconstant siocsifbrdaddr #x891a  ) ;; set broadcast PA address 
    -(defconstant siocgifnetmask #x891b  ) ;; get network PA mask  
    -(defconstant siocsifnetmask #x891c  ) ;; set network PA mask  
    -(defconstant siocgifmetric #x891d  ) ;; get metric   
    -(defconstant siocsifmetric #x891e  ) ;; set metric   
    -(defconstant siocgifmem #x891f  ) ;; get memory address (BSD) 
    -(defconstant siocsifmem #x8920  ) ;; set memory address (BSD) 
    -(defconstant siocgifmtu #x8921  ) ;; get MTU size   
    -(defconstant siocsifmtu #x8922  ) ;; set MTU size   
    -(defconstant siocsifhwaddr #x8924  ) ;; set hardware address  
    -(defconstant siocgifencap #x8925  ) ;; get/set encapsulations       
    -(defconstant siocsifencap #x8926)
    -(defconstant siocgifhwaddr #x8927  ) ;; Get hardware address  
    -(defconstant siocgifslave #x8929  ) ;; Driver slaving support 
    -(defconstant siocsifslave #x8930)
    -(defconstant siocaddmulti #x8931  ) ;; Multicast address lists 
    -(defconstant siocdelmulti #x8932)
    -(defconstant siocgifindex #x8933  ) ;; name -> if_index mapping 
    -(defconstant siogifindex SIOCGIFINDEX ) ;; misprint compatibility :-) 
    -(defconstant siocsifpflags #x8934  ) ;; set/get extended flags set 
    -(defconstant siocgifpflags #x8935)
    -(defconstant siocdifaddr #x8936  ) ;; delete PA address  
    -(defconstant siocsifhwbroadcast #x8937 ) ;; set hardware broadcast addr 
    -(defconstant siocgifcount #x8938  ) ;; get number of devices 
    -
    -(defconstant siocgifbr #x8940  ) ;; Bridging support  
    -(defconstant siocsifbr #x8941  ) ;; Set bridging options  
    -
    -(defconstant siocgiftxqlen #x8942  ) ;; Get the tx queue length 
    -(defconstant siocsiftxqlen #x8943  ) ;; Set the tx queue length  
    -
    -
    -;;; ARP cache control calls. 
    -;;  0x8950 - 0x8952  * obsolete calls, don't re-use 
    -(defconstant siocdarp #x8953  ) ;; delete ARP table entry 
    -(defconstant siocgarp #x8954  ) ;; get ARP table entry  
    -(defconstant siocsarp #x8955  ) ;; set ARP table entry  
    -
    -;;; RARP cache control calls. 
    -(defconstant siocdrarp #x8960  ) ;; delete RARP table entry 
    -(defconstant siocgrarp #x8961  ) ;; get RARP table entry  
    -(defconstant siocsrarp #x8962  ) ;; set RARP table entry  
    -
    -;;; Driver configuration calls 
    -
    -(defconstant siocgifmap #x8970  ) ;; Get device parameters 
    -(defconstant siocsifmap #x8971  ) ;; Set device parameters 
    -
    -;;; DLCI configuration calls 
    -
    -(defconstant siocadddlci #x8980  ) ;; Create new DLCI device 
    -(defconstant siocdeldlci #x8981  ) ;; Delete DLCI device  
    -
    -;;; Device private ioctl calls. 
    -
    -;; These 16 ioctls are available to devices via the do_ioctl() device
    -;; vector.  Each device should include this file and redefine these
    -;; names as their own. Because these are device dependent it is a good
    -;; idea _NOT_ to issue them to random objects and hope. 
    -
    -(defconstant siocdevprivate	#x89F0	) ;; to 89FF 
    -
    -
    -;;; netdb.h
    -
    -;; All data returned by the network data base library are supplied in
    -;; host order and returned in network order (suitable for use in
    -;; system calls).
    -
    -;;; Absolute file name for network data base files.
    -(defconstant path-hequiv "/etc/hosts.equiv")
    -(defconstant path-hosts "/etc/hosts")
    -(defconstant path-networks "/etc/networks")
    -(defconstant path-nsswitch_conf "/etc/nsswitch.conf")
    -(defconstant path-protocols "/etc/protocols")
    -(defconstant path-services "/etc/services")
    -
    -
    -;;; Possible values left in `h_errno'.
    -(defconstant netdb-internal -1 _N"See errno.")
    -(defconstant netdb-success 0 _N"No problem.")
    -(defconstant host-not-found 1 _N"Authoritative Answer Host not found.")
    -(defconstant try-again 2 _N"Non-Authoritative Host not found,or SERVERFAIL.")
    -(defconstant no-recovery 3 _N"Non recoverable errors, FORMERR, REFUSED, NOTIMP.")
    -(defconstant no-data 4	"Valid name, no data record of requested type.")
    -(defconstant no-address	no-data	"No address, look for MX record.")
    -
    -;;; Description of data base entry for a single host.
    +      setuidexec        Set user ID on execution.
    +      setgidexec        Set group ID on execution.
    +      savetext          Save text image after execution.
    +      readown           Read by owner.
    +      writeown          Write by owner.
    +      execown           Execute (search directory) by owner.
    +      readgrp           Read by group.
    +      writegrp          Write by group.
    +      execgrp           Execute (search directory) by group.
    +      readoth           Read by others.
    +      writeoth          Write by others.
    +      execoth           Execute (search directory) by others.
     
    -(def-alien-type nil
    -    (struct hostent
    -	    (h-name c-string)        ; Official name of host.
    -	    (h-aliases (* c-string)) ; Alias list.
    -	    (h-addrtype int)         ; Host address type.
    -	    (h_length int)           ; Length of address.
    -	    (h-addr-list (* c-string)))) ; List of addresses from name server.
    -
    -#+(or)
    -(defun unix-sethostent (stay-open)
    -  _N"Open host data base files and mark them as staying open even after
    -a later search if STAY_OPEN is non-zero."
    -  (void-syscall ("sethostent" int) stay-open))
    -
    -#+(or)
    -(defun unix-endhostent ()
    -  _N"Close host data base files and clear `stay open' flag."
    -  (void-syscall ("endhostent")))
    -
    -#+(or)
    -(defun unix-gethostent ()
    -  _N"Get next entry from host data base file.  Open data base if
    -necessary."
    -    (let ((result (alien-funcall (extern-alien "gethostent"
    -					     (function (* (struct hostent)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-gethostbyaddr(addr length type)
    -  _N"Return entry from host data base which address match ADDR with
    -length LEN and type TYPE."
    -    (let ((result (alien-funcall (extern-alien "gethostbyaddr"
    -					     (function (* (struct hostent))
    -						       c-string int int))
    -				 addr len type)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-gethostbyname (name)
    -  _N"Return entry from host data base for host with NAME."
    -    (let ((result (alien-funcall (extern-alien "gethostbyname"
    -					     (function (* (struct hostent))
    -						       c-string))
    -				 name)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-gethostbyname2 (name af)
    -  _N"Return entry from host data base for host with NAME.  AF must be
    -   set to the address type which as `AF_INET' for IPv4 or `AF_INET6'
    -   for IPv6."
    -    (let ((result (alien-funcall (extern-alien "gethostbyname2"
    -					     (function (* (struct hostent))
    -						       c-string int))
    -				 name af)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    +  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
    +  are equivalent for 'mode.  The octal-base is familar to Unix users.
    +  
    +  It returns T on successfully completion; NIL and an error number
    +  otherwise."
    +  (declare (type unix-pathname path)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("chmod" c-string int) (%name->file path) mode))
     
    -;; Description of data base entry for a single network.  NOTE: here a
    -;; poor assumption is made.  The network number is expected to fit
    -;; into an unsigned long int variable.
    +;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
    +;;; ("mode") and changes the protection of the file described by "fd" to 
    +;;; "mode".
     
    -(def-alien-type nil
    -    (struct netent
    -	    (n-name c-string) ; Official name of network.
    -	    (n-aliases (* c-string)) ; Alias list.
    -	    (n-addrtype int) ;  Net address type.
    -	    (n-net unsigned-long))) ; Network number.
    -
    -#+(or)
    -(defun unix-setnetent (stay-open)
    -  _N"Open network data base files and mark them as staying open even
    -   after a later search if STAY_OPEN is non-zero."
    -  (void-syscall ("setnetent" int) stay-open))
    -
    -
    -#+(or)
    -(defun unix-endnetent ()
    -  _N"Close network data base files and clear `stay open' flag."
    -  (void-syscall ("endnetent")))
    -
    -
    -#+(or)
    -(defun unix-getnetent ()
    -  _N"Get next entry from network data base file.  Open data base if
    -   necessary."
    -    (let ((result (alien-funcall (extern-alien "getnetent"
    -					     (function (* (struct netent)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -
    -#+(or)
    -(defun unix-getnetbyaddr (net type)
    -  _N"Return entry from network data base which address match NET and
    -   type TYPE."
    -    (let ((result (alien-funcall (extern-alien "getnetbyaddr"
    -					     (function (* (struct netent))
    -						       unsigned-long int))
    -				 net type)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getnetbyname (name)
    -  _N"Return entry from network data base for network with NAME."
    -    (let ((result (alien-funcall (extern-alien "getnetbyname"
    -					     (function (* (struct netent))
    -						       c-string))
    -				 name)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -;; Description of data base entry for a single service.
    -(def-alien-type nil
    -    (struct servent
    -	    (s-name c-string) ; Official service name.
    -	    (s-aliases (* c-string)) ; Alias list.
    -	    (s-port int) ; Port number.
    -	    (s-proto c-string))) ; Protocol to use.
    -
    -#+(or)
    -(defun unix-setservent (stay-open)
    -  _N"Open service data base files and mark them as staying open even
    -   after a later search if STAY_OPEN is non-zero."
    -  (void-syscall ("setservent" int) stay-open))
    -
    -#+(or)
    -(defun unix-endservent (stay-open)
    -  _N"Close service data base files and clear `stay open' flag."
    -  (void-syscall ("endservent")))
    -
    -
    -#+(or)
    -(defun unix-getservent ()
    -  _N"Get next entry from service data base file.  Open data base if
    -   necessary."
    -    (let ((result (alien-funcall (extern-alien "getservent"
    -					     (function (* (struct servent)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getservbyname (name proto)
    -  _N"Return entry from network data base for network with NAME and
    -   protocol PROTO."
    -    (let ((result (alien-funcall (extern-alien "getservbyname"
    -					     (function (* (struct netent))
    -						       c-string (* char)))
    -				 name proto)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getservbyport (port proto)
    -  _N"Return entry from service data base which matches port PORT and
    -   protocol PROTO."
    -    (let ((result (alien-funcall (extern-alien "getservbyport"
    -					     (function (* (struct netent))
    -						       int (* char)))
    -				 port proto)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -;;  Description of data base entry for a single service.
    +(defun unix-fchmod (fd mode)
    +  _N"Given an integer file descriptor and a mode (the same as those
    +   used for unix-chmod), unix-fchmod changes the permission mode
    +   for that file to the one specified. T is returned if the call
    +   was successful."
    +  (declare (type unix-fd fd)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("fchmod" int int) fd mode))
     
    -(def-alien-type nil
    -    (struct protoent
    -	    (p-name c-string) ; Official protocol name.
    -	    (p-aliases (* c-string)) ; Alias list.
    -	    (p-proto int))) ; Protocol number.
    -
    -#+(or)
    -(defun unix-setprotoent (stay-open)
    -  _N"Open protocol data base files and mark them as staying open even
    -   after a later search if STAY_OPEN is non-zero."
    -  (void-syscall ("setprotoent" int) stay-open))
    -
    -#+(or)
    -(defun unix-endprotoent ()
    -  _N"Close protocol data base files and clear `stay open' flag."
    -  (void-syscall ("endprotoent")))
    -
    -#+(or)
    -(defun unix-getprotoent ()
    -  _N"Get next entry from protocol data base file.  Open data base if
    -   necessary."
    -    (let ((result (alien-funcall (extern-alien "getprotoent"
    -					     (function (* (struct protoent)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getprotobyname (name)
    -  _N"Return entry from protocol data base for network with NAME."
    -    (let ((result (alien-funcall (extern-alien "getprotobyname"
    -					     (function (* (struct protoent))
    -						       c-string))
    -				 name)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getprotobynumber (proto)
    -  _N"Return entry from protocol data base which number is PROTO."
    -    (let ((result (alien-funcall (extern-alien "getprotobynumber"
    -					     (function (* (struct protoent))
    -						       int))
    -				 proto)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-setnetgrent (netgroup)
    -  _N"Establish network group NETGROUP for enumeration."
    -  (int-syscall ("setservent" c-string) netgroup))
    -
    -#+(or)
    -(defun unix-endnetgrent ()
    -  _N"Free all space allocated by previous `setnetgrent' call."
    -  (void-syscall ("endnetgrent")))
    -
    -#+(or)
    -(defun unix-getnetgrent (hostp userp domainp)
    -  _N"Get next member of netgroup established by last `setnetgrent' call
    -   and return pointers to elements in HOSTP, USERP, and DOMAINP."
    -  (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string))
    -	       hostp userp domainp))
    -
    -#+(or)
    -(defun unix-innetgr (netgroup host user domain)
    -  _N"Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)."
    -  (int-syscall ("innetgr" c-string c-string c-string c-string)
    -	       netgroup host user domain))
    +(defun unix-readlink (path)
    +  _N"Unix-readlink invokes the readlink system call on the file name
    +  specified by the simple string path.  It returns up to two values:
    +  the contents of the symbolic link if the call is successful, or
    +  NIL and the Unix error number."
    +  (declare (type unix-pathname path))
    +  (with-alien ((buf (array char 1024)))
    +    (syscall ("readlink" c-string (* char) int)
    +	     (let ((string (make-string result)))
    +	       #-unicode
    +	       (kernel:copy-from-system-area
    +		(alien-sap buf) 0
    +		string (* vm:vector-data-offset vm:word-bits)
    +		(* result vm:byte-bits))
    +	       #+unicode
    +	       (let ((sap (alien-sap buf)))
    +		 (dotimes (k result)
    +		   (setf (aref string k) (code-char (sap-ref-8 sap k)))))
    +	       (%file->name string))
    +	     (%name->file path) (cast buf (* char)) 1024)))
     
    -(def-alien-type nil
    -    (struct addrinfo
    -	    (ai-flags int)    ; Input flags.
    -	    (ai-family int)   ; Protocol family for socket.
    -	    (ai-socktype int) ; Socket type.
    -	    (ai-protocol int) ; Protocol for socket.
    -	    (ai-addrlen int)  ; Length of socket address.
    -	    (ai-addr (* (struct sockaddr)))
    -	                      ; Socket address for socket.
    -	    (ai-cononname c-string)
    -	                      ; Canonical name for service location.
    -	    (ai-net (* (struct addrinfo))))) ; Pointer to next in list.
    -
    -;; Possible values for `ai_flags' field in `addrinfo' structure.
    -
    -(defconstant ai_passive 1 _N"Socket address is intended for `bind'.")
    -(defconstant ai_canonname 2 _N"Request for canonical name.")
    -
    -;; Error values for `getaddrinfo' function.
    -(defconstant eai_badflags -1 _N"Invalid value for `ai_flags' field.")
    -(defconstant eai_noname -2 _N"NAME or SERVICE is unknown.")
    -(defconstant eai_again -3 _N"Temporary failure in name resolution.")
    -(defconstant eai_fail -4 _N"Non-recoverable failure in name res.")
    -(defconstant eai_nodata -5 _N"No address associated with NAME.")
    -(defconstant eai_family -6 _N"ai_family not supported.")
    -(defconstant eai_socktype -7 _N"ai_socktype not supported.")
    -(defconstant eai_service -8 _N"SERVICE not supported for ai_socktype.")
    -(defconstant eai_addrfamily -9 _N"Address family for NAME not supported.")
    -(defconstant eai_memory -10 _N"Memory allocation failure.")
    -(defconstant eai_system -11 _N"System error returned in errno.")
    -
    -
    -#+(or)
    -(defun unix-getaddrinfo (name service req pai)
    -  _N"Translate name of a service location and/or a service name to set of
    -   socket addresses."
    -  (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo))
    -			      (* (* struct addrinfo)))
    -	       name service req pai))
    -
    -
    -#+(or)
    -(defun unix-freeaddrinfo (ai)
    -  _N"Free `addrinfo' structure AI including associated storage."
    -  (void-syscall ("freeaddrinfo" (* struct addrinfo))
    -		ai))
    +;;; Unix-unlink accepts a name and deletes the directory entry for that
    +;;; name and the file if this is the last link.
     
    +(defun unix-unlink (name)
    +  _N"Unix-unlink removes the directory entry for the named file.
    +   NIL and an error code is returned if the call fails."
    +  (declare (type unix-pathname name))
    +  (void-syscall ("unlink" c-string) (%name->file name)))
     
    -;;; pty.h
    +;;; fcntl.h
    +;;;
    +;;; POSIX Standard: 6.5 File Control Operations	<fcntl.h>
     
    -(defun unix-openpty (name termp winp)
    -  _N"Create pseudo tty master slave pair with NAME and set terminal
    -   attributes according to TERMP and WINP and return handles for both
    -   ends in AMASTER and ASLAVE."
    -  (with-alien ((amaster int)
    -	       (aslave int))
    -    (values
    -     (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))
    -			     (* (struct winsize)))
    -		  (addr amaster) (addr aslave) name termp winp)
    -     amaster aslave)))
    +(defconstant r_ok 4 _N"Test for read permission")
    +(defconstant w_ok 2 _N"Test for write permission")
    +(defconstant x_ok 1 _N"Test for execute permission")
    +(defconstant f_ok 0 _N"Test for presence of file")
     
    -#+(or)
    -(defun unix-forkpty (amaster name termp winp)
    -  _N"Create child process and establish the slave pseudo terminal as the
    -   child's controlling terminal."
    -  (int-syscall ("forkpty" (* int) c-string (* (struct termios))
    -			  (* (struct winsize)))
    -	       amaster name termp winp))
    -
    -
    -;; POSIX Standard: 9.2.2 User Database Access <pwd.h>
    -
    -#+(or)
    -(defun unix-setpwent ()
    -  _N"Rewind the password-file stream."
    -  (void-syscall ("setpwent")))
    -
    -#+(or)
    -(defun unix-endpwent ()
    -  _N"Close the password-file stream."
    -  (void-syscall ("endpwent")))
    -
    -#+(or)
    -(defun unix-getpwent ()
    -  _N"Read an entry from the password-file stream, opening it if necessary."
    -    (let ((result (alien-funcall (extern-alien "getpwent"
    -					     (function (* (struct passwd)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -	result)))
    +(defun unix-fcntl (fd cmd arg)
    +  _N"Unix-fcntl manipulates file descriptors accoridng to the
    +   argument CMD which can be one of the following:
     
    -;;; resourcebits.h
    +   F-DUPFD         Duplicate a file descriptor.
    +   F-GETFD         Get file descriptor flags.
    +   F-SETFD         Set file descriptor flags.
    +   F-GETFL         Get file flags.
    +   F-SETFL         Set file flags.
    +   F-GETOWN        Get owner.
    +   F-SETOWN        Set owner.
     
    -(def-alien-type nil
    -  (struct rlimit
    -    (rlim-cur long)	 ; current (soft) limit
    -    (rlim-max long))); maximum value for rlim-cur
    +   The flags that can be specified for F-SETFL are:
     
    -(defconstant rusage_self 0 _N"The calling process.")
    -(defconstant rusage_children -1 _N"Terminated child processes.")
    -(defconstant rusage_both -2)
    +   FNDELAY         Non-blocking reads.
    +   FAPPEND         Append on each write.
    +   FASYNC          Signal pgrp when data ready.
    +   FCREAT          Create if nonexistant.
    +   FTRUNC          Truncate to zero length.
    +   FEXCL           Error if already created.
    +   "
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 32) cmd)
    +	   (type (unsigned-byte 32) arg))
    +  (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))
     
    -(def-alien-type nil
    -  (struct rusage
    -    (ru-utime (struct timeval))		; user time used
    -    (ru-stime (struct timeval))		; system time used.
    -    (ru-maxrss long)                    ; Maximum resident set size (in kilobytes)
    -    (ru-ixrss long)			; integral shared memory size
    -    (ru-idrss long)			; integral unshared data "
    -    (ru-isrss long)			; integral unshared stack "
    -    (ru-minflt long)			; page reclaims
    -    (ru-majflt long)			; page faults
    -    (ru-nswap long)			; swaps
    -    (ru-inblock long)			; block input operations
    -    (ru-oublock long)			; block output operations
    -    (ru-msgsnd long)			; messages sent
    -    (ru-msgrcv long)			; messages received
    -    (ru-nsignals long)			; signals received
    -    (ru-nvcsw long)			; voluntary context switches
    -    (ru-nivcsw long)))			; involuntary "
    +;;;; Memory-mapped files
     
    -;; Priority limits.
    +(defconstant +null+ (sys:int-sap 0))
     
    -(defconstant prio-min -20 _N"Minimum priority a process can have")
    -(defconstant prio-max 20 _N"Maximum priority a process can have")
    +(defconstant prot_read 1)
    +(defconstant prot_write 2)
    +(defconstant prot_exec 4)
    +(defconstant prot_none 0)
     
    +(defconstant map_shared 1)
    +(defconstant map_private 2)
    +(defconstant map_fixed 16)
    +(defconstant map_anonymous 32)
     
    -;;; The type of the WHICH argument to `getpriority' and `setpriority',
    -;;; indicating what flavor of entity the WHO argument specifies.
    +(defconstant ms_async 1)
    +(defconstant ms_sync 4)
    +(defconstant ms_invalidate 2)
     
    -(defconstant priority-process 0 _N"WHO is a process ID")
    -(defconstant priority-pgrp 1 _N"WHO is a process group ID")
    -(defconstant priority-user 2 _N"WHO is a user ID")
    +;; The return value from mmap that means mmap failed.
    +(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
     
    -;;; sched.h
    +(defun unix-mmap (addr length prot flags fd offset)
    +  (declare (type (or null system-area-pointer) addr)
    +	   (type (unsigned-byte 32) length)
    +           (type (integer 1 7) prot)
    +	   (type (unsigned-byte 32) flags)
    +	   (type (or null unix-fd) fd)
    +	   (type (signed-byte 32) offset))
    +  ;; Can't use syscall, because the address that is returned could be
    +  ;; "negative".  Hence we explicitly check for mmap returning
    +  ;; MAP_FAILED.
    +  (let ((result
    +	 (alien-funcall (extern-alien "mmap" (function system-area-pointer
    +						       system-area-pointer
    +						       size-t int int int off-t))
    +			(or addr +null+) length prot flags (or fd -1) offset)))
    +    (if (sap= result map_failed)
    +	(values nil (unix-errno))
    +	(values result 0))))
     
    -#+(or)
    -(defun unix-sched_setparam (pid param)
    -  _N"Rewind the password-file stream."
    -  (int-syscall ("sched_setparam" pid-t (struct psched-param))
    -		pid param))
    +(defun unix-munmap (addr length)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length))
    +  (syscall ("munmap" system-area-pointer size-t) t addr length))
     
    -#+(or)
    -(defun unix-sched_getparam (pid param)
    -  _N"Rewind the password-file stream."
    -  (int-syscall ("sched_getparam" pid-t (struct psched-param))
    -		pid param))
    +(defun unix-msync (addr length flags)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length)
    +	   (type (signed-byte 32) flags))
    +  (syscall ("msync" system-area-pointer size-t int) t addr length flags))
     
    +;;; Unix-rename accepts two files names and renames the first to the second.
     
    -#+(or)
    -(defun unix-sched_setscheduler (pid policy param)
    -  _N"Set scheduling algorithm and/or parameters for a process."
    -  (int-syscall ("sched_setscheduler" pid-t int (struct psched-param))
    -		pid policy param))
    +(defun unix-rename (name1 name2)
    +  _N"Unix-rename renames the file with string name1 to the string
    +   name2.  NIL and an error code is returned if an error occured."
    +  (declare (type unix-pathname name1 name2))
    +  (void-syscall ("rename" c-string c-string)
    +		(%name->file name1) (%name->file name2)))
     
    -#+(or)
    -(defun unix-sched_getscheduler (pid)
    -  _N"Retrieve scheduling algorithm for a particular purpose."
    -  (int-syscall ("sched_getscheduler" pid-t)
    -		pid))
    +;;; Unix-rmdir accepts a name and removes the associated directory.
     
    -(defun unix-sched-yield ()
    -  _N"Retrieve scheduling algorithm for a particular purpose."
    -  (int-syscall ("sched_yield")))
    +(defun unix-rmdir (name)
    +  _N"Unix-rmdir attempts to remove the directory name.  NIL and
    +   an error number is returned if an error occured."
    +  (declare (type unix-pathname name))
    +  (void-syscall ("rmdir" c-string) (%name->file name)))
     
    -#+(or)
    -(defun unix-sched_get_priority_max (algorithm)
    -  _N"Get maximum priority value for a scheduler."
    -  (int-syscall ("sched_get_priority_max" int)
    -		algorithm))
    +(def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int)
     
    -#+(or)
    -(defun unix-sched_get_priority_min (algorithm)
    -  _N"Get minimum priority value for a scheduler."
    -  (int-syscall ("sched_get_priority_min" int)
    -		algorithm))
    +(defconstant fd-setsize 1024)
    +(defconstant nfdbits 32)
    +  
    +(def-alien-type nil
    +  (struct fd-set
    +	  (fds-bits (array fd-mask #.(/ fd-setsize nfdbits)))))
     
    +;; not checked for linux...
    +(defmacro fd-clr (offset fd-set)
    +  (let ((word (gensym))
    +	(bit (gensym)))
    +    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    +       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    +	     (logand (deref (slot ,fd-set 'fds-bits) ,word)
    +		     (32bit-logical-not
    +		      (truly-the (unsigned-byte 32) (ash 1 ,bit))))))))
     
    +;; not checked for linux...
    +(defmacro fd-isset (offset fd-set)
    +  (let ((word (gensym))
    +	(bit (gensym)))
    +    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    +       (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
     
    -#+(or)
    -(defun unix-sched_rr_get_interval (pid t)
    -  _N"Get the SCHED_RR interval for the named process."
    -  (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec)))
    -		pid t))
    +;; not checked for linux...
    +(defmacro fd-set (offset fd-set)
    +  (let ((word (gensym))
    +	(bit (gensym)))
    +    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    +       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    +	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
    +		     (deref (slot ,fd-set 'fds-bits) ,word))))))
     
    -;;; schedbits.h
    +;; not checked for linux...
    +(defmacro fd-zero (fd-set)
    +  `(progn
    +     ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    +	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
     
    -(defconstant scheduler-other 0)
    -(defconstant scheduler-fifo 1)
    -(defconstant scheduler-rr 2)
    +;;; TTY ioctl commands.
     
    +(eval-when (compile load eval)
     
    -;; Data structure to describe a process' schedulability.
    +(defconstant iocparm-mask #x3fff)
    +(defconstant ioc_void #x00000000)
    +(defconstant ioc_out #x40000000)
    +(defconstant ioc_in #x80000000)
    +(defconstant ioc_inout (logior ioc_in ioc_out))
     
    -(def-alien-type nil
    -    (struct sched_param
    -	    (sched-priority int)))
    +(defmacro define-ioctl-command (name dev cmd &optional arg parm-type)
    +  _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given
    +  then ioctl argument size and direction are included as for ioctls defined
    +  by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type
    +  is the characters code, else DEV may be an integer giving the type."
    +  (let* ((type (if (characterp dev)
    +		   (char-code dev)
    +		   dev))
    +	 (code (logior (ash type 8) cmd)))
    +    (when arg
    +      (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask)
    +			       16)
    +			  ,code)))
    +    (when parm-type
    +      (let ((dir (ecase parm-type
    +		   (:void ioc_void)
    +		   (:in ioc_in)
    +		   (:out ioc_out)
    +		   (:inout ioc_inout))))
    +	(setf code `(logior ,dir ,code))))
    +    `(eval-when (eval load compile)
    +       (defconstant ,name ,code))))
    +)
     
    -;; Cloning flags.
    -(defconstant csignal       #x000000ff _N"Signal mask to be sent at exit.")
    -(defconstant clone_vm      #x00000100 _N"Set if VM shared between processes.")
    -(defconstant clone_fs      #x00000200 _N"Set if fs info shared between processes")
    -(defconstant clone_files   #x00000400 _N"Set if open files shared between processe")
    -(defconstant clone_sighand #x00000800 _N"Set if signal handlers shared.")
    -(defconstant clone_pid     #x00001000 _N"Set if pid shared.")
    +;;; TTY ioctl commands.
     
    +(define-ioctl-command TIOCGWINSZ #\T #x13)
    +(define-ioctl-command TIOCSWINSZ #\T #x14)
    +(define-ioctl-command TIOCNOTTY  #\T #x22)
    +(define-ioctl-command TIOCSPGRP  #\T #x10)
    +(define-ioctl-command TIOCGPGRP  #\T #x0F)
     
    -;;; shadow.h
    +;;; File ioctl commands.
    +(define-ioctl-command FIONREAD #\T #x1B)
     
    -;; Structure of the password file.
    +;;; ioctl-types.h
     
     (def-alien-type nil
    -    (struct spwd
    -	    (sp-namp c-string) ; Login name.
    -	    (sp-pwdp c-string) ; Encrypted password.
    -	    (sp-lstchg long)   ; Date of last change.
    -	    (sp-min long)      ; Minimum number of days between changes.
    -	    (sp-max long)      ; Maximum number of days between changes.
    -	    (sp-warn long)     ; Number of days to warn user to change the password.
    -	    (sp-inact long)    ; Number of days the account may be inactive.
    -	    (sp-expire long)   ; Number of days since 1970-01-01 until account expires.
    -	    (sp-flags long)))  ; Reserved.
    -
    -#+(or)
    -(defun unix-setspent ()
    -  _N"Open database for reading."
    -  (void-syscall ("setspent")))
    -
    -#+(or)
    -(defun unix-endspent ()
    -  _N"Close database."
    -  (void-syscall ("endspent")))
    -
    -#+(or)
    -(defun unix-getspent ()
    -  _N"Get next entry from database, perhaps after opening the file."
    -    (let ((result (alien-funcall (extern-alien "getspent"
    -					     (function (* (struct spwd)))))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-getspnam (name)
    -  _N"Get shadow entry matching NAME."
    -    (let ((result (alien-funcall (extern-alien "getspnam"
    -					     (function (* (struct spwd))
    -						       c-string))
    -				 name)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -#+(or)
    -(defun unix-sgetspent (string)
    -  _N"Read shadow entry from STRING."
    -    (let ((result (alien-funcall (extern-alien "sgetspent"
    -					     (function (* (struct spwd))
    -						       c-string))
    -				 string)))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    -
    -;; 
    -
    -#+(or)
    -(defun unix-lckpwdf ()
    -  _N"Protect password file against multi writers."
    -  (void-syscall ("lckpwdf")))
    +  (struct winsize
    +    (ws-row unsigned-short)		; rows, in characters
    +    (ws-col unsigned-short)		; columns, in characters
    +    (ws-xpixel unsigned-short)		; horizontal size, pixels
    +    (ws-ypixel unsigned-short)))	; veritical size, pixels
     
    +(defconstant f-getfl    3  _N"Get file flags")
    +(defconstant f-setfl    4  _N"Set file flags")
     
    -#+(or)
    -(defun unix-ulckpwdf ()
    -  _N"Unlock password file."
    -  (void-syscall ("ulckpwdf")))
    +;;; Define some more compatibility macros to be backward compatible with
    +;;; BSD systems which did not managed to hide these kernel macros. 
     
    -;;; bits/stat.h
    -
    -(def-alien-type nil
    -  (struct stat
    -    (st-dev dev-t)
    -    #-(or alpha amd64) (st-pad1 unsigned-short)
    -    (st-ino ino-t)
    -    #+alpha (st-pad1 unsigned-int)
    -    #-amd64 (st-mode mode-t)
    -    (st-nlink  nlink-t)
    -    #+amd64 (st-mode mode-t)
    -    (st-uid  uid-t)
    -    (st-gid  gid-t)
    -    (st-rdev dev-t)
    -    #-alpha (st-pad2  unsigned-short)
    -    (st-size off-t)
    -    #-alpha (st-blksize unsigned-long)
    -    #-alpha (st-blocks blkcnt-t)
    -    (st-atime time-t)
    -    #-alpha (unused-1 unsigned-long)
    -    (st-mtime time-t)
    -    #-alpha (unused-2 unsigned-long)
    -    (st-ctime time-t)
    -    #+alpha (st-blocks int)
    -    #+alpha (st-pad2 unsigned-int)
    -    #+alpha (st-blksize unsigned-int)
    -    #+alpha (st-flags unsigned-int)
    -    #+alpha (st-gen unsigned-int)
    -    #+alpha (st-pad3 unsigned-int)
    -    #+alpha (unused-1 unsigned-long)
    -    #+alpha (unused-2 unsigned-long)
    -    (unused-3 unsigned-long)
    -    (unused-4 unsigned-long)
    -    #-alpha (unused-5 unsigned-long)))
    -
    -;; Encoding of the file mode.
    +(defconstant FAPPEND  o_append _N"depricated stuff")
    +(defconstant FFSYNC   o_fsync  _N"depricated stuff")
    +(defconstant FASYNC   o_async  _N"depricated stuff")
    +(defconstant FNONBLOCK  o_nonblock _N"depricated stuff")
    +(defconstant FNDELAY  o_ndelay _N"depricated stuff")
     
    -(defconstant s-ifmt   #o0170000 _N"These bits determine file type.")
    +(defun unix-mprotect (addr length prot)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length)
    +           (type (integer 1 7) prot))
    +  (syscall ("mprotect" system-area-pointer size-t int)
    +	   t addr length prot))
    +  
    +;;;; Lisp types used by syscalls.
     
    -;; File types.
    +(deftype unix-pathname () 'simple-string)
    +(deftype unix-fd () `(integer 0 ,most-positive-fixnum))
     
    -(defconstant s-ififo  #o0010000 _N"FIFO")
    -(defconstant s-ifchr  #o0020000 _N"Character device")
    -(defconstant s-ifdir  #o0040000 _N"Directory")
    -(defconstant s-ifblk  #o0060000 _N"Block device")
    -(defconstant s-ifreg  #o0100000 _N"Regular file")
    +(deftype unix-file-mode () '(unsigned-byte 32))
    +(deftype unix-pid () '(unsigned-byte 32))
    +(deftype unix-uid () '(unsigned-byte 32))
    +(deftype unix-gid () '(unsigned-byte 32))
     
    -;; These don't actually exist on System V, but having them doesn't hurt.
    +;;; Operations on Unix Directories.
     
    -(defconstant s-iflnk  #o0120000 _N"Symbolic link.")
    -(defconstant s-ifsock #o0140000 _N"Socket.")
    +;;; direntry.h
     
    -;; Protection bits.
    +(def-alien-type nil
    +  (struct dirent
    +    #+glibc2.1
    +    (d-ino ino-t)                       ; inode number of entry
    +    #-glibc2.1
    +    (d-ino ino64-t)                     ; inode number of entry
    +    (d-off off-t)                       ; offset of next disk directory entry
    +    (d-reclen unsigned-short)		; length of this record
    +    (d_type unsigned-char)
    +    (d-name (array char 256))))		; name must be no longer than this
     
    -(defconstant s-isuid #o0004000 _N"Set user ID on execution.")
    -(defconstant s-isgid #o0002000 _N"Set group ID on execution.")
    -(defconstant s-isvtx #o0001000 _N"Save swapped text after use (sticky).")
    -(defconstant s-iread #o0000400 _N"Read by owner")
    -(defconstant s-iwrite #o0000200 _N"Write by owner.")
    -(defconstant s-iexec #o0000100 _N"Execute by owner.")
    +(export '(open-dir read-dir close-dir))
     
    -;;; statfsbuf.h
    +(defstruct (%directory
    +	     (:constructor make-directory)
    +	     (:conc-name directory-)
    +	     (:print-function %print-directory))
    +  name
    +  (dir-struct (required-argument) :type system-area-pointer))
     
    -(def-alien-type nil
    -    (struct statfs
    -	    (f-type int)
    -	    (f-bsize int)
    -	    (f-blocks fsblkcnt-t)
    -	    (f-bfree fsblkcnt-t)
    -	    (f-bavail fsblkcnt-t)
    -	    (f-files fsfilcnt-t)
    -	    (f-ffree fsfilcnt-t)
    -	    (f-fsid fsid-t)
    -	    (f-namelen int)
    -	    (f-spare (array int 6))))
    +(defun %print-directory (dir stream depth)
    +  (declare (ignore depth))
    +  (format stream "#<Directory ~S>" (directory-name dir)))
     
    +(defun open-dir (pathname)
    +  (declare (type unix-pathname pathname))
    +  (when (string= pathname "")
    +    (setf pathname "."))
    +  (let ((kind (unix-file-kind pathname)))
    +    (case kind
    +      (:directory
    +       (let ((dir-struct
    +	      (alien-funcall (extern-alien "opendir"
    +					   (function system-area-pointer
    +						     c-string))
    +			     (%name->file pathname))))
    +	 (if (zerop (sap-int dir-struct))
    +	     (values nil (unix-errno))
    +	     (make-directory :name pathname :dir-struct dir-struct))))
    +      ((nil)
    +       (values nil enoent))
    +      (t
    +       (values nil enotdir)))))
     
    -;;; termbits.h
    +(defun read-dir (dir)
    +  (declare (type %directory dir))
    +  (let ((daddr (alien-funcall (extern-alien "readdir64"
    +					    (function system-area-pointer
    +						      system-area-pointer))
    +			      (directory-dir-struct dir))))
    +    (declare (type system-area-pointer daddr))
    +    (if (zerop (sap-int daddr))
    +	nil
    +	(with-alien ((dirent (* (struct dirent)) daddr))
    +	  (values (%file->name (cast (slot dirent 'd-name) c-string))
    +		  (slot dirent 'd-ino))))))
     
    -(def-alien-type cc-t unsigned-char)
    -(def-alien-type speed-t  unsigned-int)
    -(def-alien-type tcflag-t unsigned-int)
    +(defun close-dir (dir)
    +  (declare (type %directory dir))
    +  (alien-funcall (extern-alien "closedir"
    +			       (function void system-area-pointer))
    +		 (directory-dir-struct dir))
    +  nil)
     
    -(defconstant +NCCS+ 32
    -  _N"Size of control character vector.")
    +(defconstant rusage_self 0 _N"The calling process.")
    +(defconstant rusage_children -1 _N"Terminated child processes.")
    +(defconstant rusage_both -2)
     
     (def-alien-type nil
    -  (struct termios
    -    (c-iflag tcflag-t)
    -    (c-oflag tcflag-t)
    -    (c-cflag tcflag-t)
    -    (c-lflag tcflag-t)
    -    (c-line cc-t)
    -    (c-cc (array cc-t #.+NCCS+))
    -    (c-ispeed speed-t)
    -    (c-ospeed speed-t)))
    +  (struct rusage
    +    (ru-utime (struct timeval))		; user time used
    +    (ru-stime (struct timeval))		; system time used.
    +    (ru-maxrss long)                    ; Maximum resident set size (in kilobytes)
    +    (ru-ixrss long)			; integral shared memory size
    +    (ru-idrss long)			; integral unshared data "
    +    (ru-isrss long)			; integral unshared stack "
    +    (ru-minflt long)			; page reclaims
    +    (ru-majflt long)			; page faults
    +    (ru-nswap long)			; swaps
    +    (ru-inblock long)			; block input operations
    +    (ru-oublock long)			; block output operations
    +    (ru-msgsnd long)			; messages sent
    +    (ru-msgrcv long)			; messages received
    +    (ru-nsignals long)			; signals received
    +    (ru-nvcsw long)			; voluntary context switches
    +    (ru-nivcsw long)))
     
    -;; c_cc characters
    +(declaim (inline unix-fast-getrusage))
    +(defun unix-fast-getrusage (who)
    +  _N"Like call getrusage, but return only the system and user time, and returns
    +   the seconds and microseconds as separate values."
    +  (declare (values (member t)
    +		   (unsigned-byte 31) (mod 1000000)
    +		   (unsigned-byte 31) (mod 1000000)))
    +  (with-alien ((usage (struct rusage)))
    +    (syscall* ("getrusage" int (* (struct rusage)))
    +	      (values t
    +		      (slot (slot usage 'ru-utime) 'tv-sec)
    +		      (slot (slot usage 'ru-utime) 'tv-usec)
    +		      (slot (slot usage 'ru-stime) 'tv-sec)
    +		      (slot (slot usage 'ru-stime) 'tv-usec))
    +	      who (addr usage))))
     
    -(def-enum + 0 vintr vquit verase
    -	  vkill veof vtime
    -	  vmin vswtc vstart
    -	  vstop vsusp veol
    -	  vreprint vdiscard vwerase
    -	  vlnext veol2)
    -(defvar vdsusp vsusp)
    +(defun unix-getrusage (who)
    +  _N"Unix-getrusage returns information about the resource usage
    +   of the process specified by who.  Who can be either the
    +   current process (rusage_self) or all of the terminated
    +   child processes (rusage_children).  NIL and an error number
    +   is returned if the call fails."
    +  (with-alien ((usage (struct rusage)))
    +    (syscall ("getrusage" int (* (struct rusage)))
    +	      (values t
    +		      (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000)
    +			 (slot (slot usage 'ru-utime) 'tv-usec))
    +		      (+ (* (slot (slot usage 'ru-stime) 'tv-sec) 1000000)
    +			 (slot (slot usage 'ru-stime) 'tv-usec))
    +		      (slot usage 'ru-maxrss)
    +		      (slot usage 'ru-ixrss)
    +		      (slot usage 'ru-idrss)
    +		      (slot usage 'ru-isrss)
    +		      (slot usage 'ru-minflt)
    +		      (slot usage 'ru-majflt)
    +		      (slot usage 'ru-nswap)
    +		      (slot usage 'ru-inblock)
    +		      (slot usage 'ru-oublock)
    +		      (slot usage 'ru-msgsnd)
    +		      (slot usage 'ru-msgrcv)
    +		      (slot usage 'ru-nsignals)
    +		      (slot usage 'ru-nvcsw)
    +		      (slot usage 'ru-nivcsw))
    +	      who (addr usage))))
     
    -(def-enum + 0 tciflush tcoflush tcioflush)
    +;;;; Socket support.
     
    -(def-enum + 0 tcsanow tcsadrain tcsaflush)
    +;;; Looks a bit naked.
     
    -;; c_iflag bits
    -(def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck
    -	  tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc
    -	  tty-ixon tty-ixany tty-ixoff 
    -	  tty-imaxbel)
    +(def-alien-routine ("socket" unix-socket) int
    +  (domain int)
    +  (type int)
    +  (protocol int))
     
    -;; c_oflag bits
    -(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr
    -	  tty-onlret tty-ofill tty-ofdel tty-nldly)
    +(def-alien-routine ("connect" unix-connect) int
    +  (socket int)
    +  (sockaddr (* t))
    +  (len int))
     
    -(defconstant tty-nl0 0)
    -(defconstant tty-nl1 #o400)
    -
    -(defconstant tty-crdly	#o0003000)
    -(defconstant   tty-cr0	#o0000000)
    -(defconstant   tty-cr1	#o0001000)
    -(defconstant   tty-cr2	#o0002000)
    -(defconstant   tty-cr3	#o0003000)
    -(defconstant tty-tabdly	#o0014000)
    -(defconstant   tty-tab0	#o0000000)
    -(defconstant   tty-tab1	#o0004000)
    -(defconstant   tty-tab2	#o0010000)
    -(defconstant   tty-tab3	#o0014000)
    -(defconstant   tty-xtabs	#o0014000)
    -(defconstant tty-bsdly	#o0020000)
    -(defconstant   tty-bs0	#o0000000)
    -(defconstant   tty-bs1	#o0020000)
    -(defconstant tty-vtdly	#o0040000)
    -(defconstant   tty-vt0	#o0000000)
    -(defconstant   tty-vt1	#o0040000)
    -(defconstant tty-ffdly	#o0100000)
    -(defconstant   tty-ff0	#o0000000)
    -(defconstant   tty-ff1	#o0100000)
    -
    -;; c-cflag bit meaning
    -(defconstant tty-cbaud	#o0010017)
    -(defconstant tty-b0	#o0000000) ;; hang up
    -(defconstant tty-b50	#o0000001)
    -(defconstant tty-b75	#o0000002)
    -(defconstant tty-b110	#o0000003)
    -(defconstant tty-b134	#o0000004)
    -(defconstant tty-b150	#o0000005)
    -(defconstant tty-b200	#o0000006)
    -(defconstant tty-b300	#o0000007)
    -(defconstant tty-b600	#o0000010)
    -(defconstant tty-b1200	#o0000011)
    -(defconstant tty-b1800	#o0000012)
    -(defconstant tty-b2400	#o0000013)
    -(defconstant tty-b4800	#o0000014)
    -(defconstant tty-b9600	#o0000015)
    -(defconstant tty-b19200	#o0000016)
    -(defconstant tty-b38400	#o0000017)
    -(defconstant tty-exta tty-b19200)
    -(defconstant tty-extb tty-b38400)
    -(defconstant tty-csize	#o0000060)
    -(defconstant tty-cs5	#o0000000)
    -(defconstant tty-cs6	#o0000020)
    -(defconstant tty-cs7	#o0000040)
    -(defconstant tty-cs8	#o0000060)
    -(defconstant tty-cstopb	#o0000100)
    -(defconstant tty-cread	#o0000200)
    -(defconstant tty-parenb	#o0000400)
    -(defconstant tty-parodd	#o0001000)
    -(defconstant tty-hupcl	#o0002000)
    -(defconstant tty-clocal	#o0004000)
    -(defconstant tty-cbaudex #o0010000)
    -(defconstant tty-b57600  #o0010001)
    -(defconstant tty-b115200 #o0010002)
    -(defconstant tty-b230400 #o0010003)
    -(defconstant tty-b460800 #o0010004)
    -(defconstant tty-cibaud	  #o002003600000) ; input baud rate (not used)
    -(defconstant tty-crtscts	  #o020000000000) ;flow control 
    +(def-alien-routine ("bind" unix-bind) int
    +  (socket int)
    +  (sockaddr (* t))
    +  (len int))
     
    -;; c_lflag bits
    -(def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe
    -	  tty-echok tty-echonl tty-noflsh
    -	  tty-tostop tty-echoctl tty-echoprt
    -	  tty-echoke tty-flusho
    -	  tty-pendin tty-iexten)
    +(def-alien-routine ("listen" unix-listen) int
    +  (socket int)
    +  (backlog int))
     
    -;;; tcflow() and TCXONC use these 
    -(def-enum + 0 tty-tcooff tty-tcoon tty-tcioff tty-tcion)
    +(def-alien-routine ("accept" unix-accept) int
    +  (socket int)
    +  (sockaddr (* t))
    +  (len int :in-out))
     
    -;; tcflush() and TCFLSH use these */
    -(def-enum + 0 tty-tciflush tty-tcoflush tty-tcioflush)
    +(def-alien-routine ("recv" unix-recv) int
    +  (fd int)
    +  (buffer c-string)
    +  (length int)
    +  (flags int))
     
    -;; tcsetattr uses these
    -(def-enum + 0 tty-tcsanow tty-tcsadrain tty-tcsaflush)
    +(def-alien-routine ("send" unix-send) int
    +  (fd int)
    +  (buffer c-string)
    +  (length int)
    +  (flags int))
     
    -;;; termios.h
    -
    -(defun unix-cfgetospeed (termios)
    -  _N"Get terminal output speed."
    -  (multiple-value-bind (speed errno)
    -      (int-syscall ("cfgetospeed" (* (struct termios))) termios)
    -    (if speed
    -	(values (svref terminal-speeds speed) 0)
    -      (values speed errno))))
    +(def-alien-routine ("getpeername" unix-getpeername) int
    +  (socket int)
    +  (sockaddr (* t))
    +  (len (* unsigned)))
     
    -(defun unix-cfsetospeed (termios speed)
    -  _N"Set terminal output speed."
    -  (let ((baud (or (position speed terminal-speeds)
    -		  (error _"Bogus baud rate ~S" speed))))
    -    (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
    +(def-alien-routine ("getsockname" unix-getsockname) int
    +  (socket int)
    +  (sockaddr (* t))
    +  (len (* unsigned)))
     
    -(defun unix-cfgetispeed (termios)
    -  _N"Get terminal input speed."
    -  (multiple-value-bind (speed errno)
    -      (int-syscall ("cfgetispeed" (* (struct termios))) termios)
    -    (if speed
    -	(values (svref terminal-speeds speed) 0)
    -      (values speed errno))))
    +(def-alien-routine ("getsockopt" unix-getsockopt) int
    +  (socket int)
    +  (level int)
    +  (optname int)
    +  (optval (* t))
    +  (optlen unsigned :in-out))
     
    -(defun unix-cfsetispeed (termios speed)
    -  _N"Set terminal input speed."
    -  (let ((baud (or (position speed terminal-speeds)
    -		  (error _"Bogus baud rate ~S" speed))))
    -    (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
    +(def-alien-routine ("setsockopt" unix-setsockopt) int
    +  (socket int)
    +  (level int)
    +  (optname int)
    +  (optval (* t))
    +  (optlen unsigned))
     
    -(defun unix-tcgetattr (fd termios)
    -  _N"Get terminal attributes."
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
    +;; Datagram support
     
    -(defun unix-tcsetattr (fd opt termios)
    -  _N"Set terminal attributes."
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
    +(def-alien-routine ("recvfrom" unix-recvfrom) int
    +  (fd int)
    +  (buffer c-string)
    +  (length int)
    +  (flags int)
    +  (sockaddr (* t))
    +  (len int :in-out))
     
    -(defun unix-tcsendbreak (fd duration)
    -  _N"Send break"
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcsendbreak" int int) fd duration))
    +(def-alien-routine ("sendto" unix-sendto) int
    +  (fd int)
    +  (buffer c-string)
    +  (length int)
    +  (flags int)
    +  (sockaddr (* t))
    +  (len int))
     
    -(defun unix-tcdrain (fd)
    -  _N"Wait for output for finish"
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcdrain" int) fd))
    +(def-alien-routine ("shutdown" unix-shutdown) int
    +  (socket int)
    +  (level int))
     
    -(defun unix-tcflush (fd selector)
    -  _N"See tcflush(3)"
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcflush" int int) fd selector))
    +;;; sys/select.h
     
    -(defun unix-tcflow (fd action)
    -  _N"Flow control"
    -  (declare (type unix-fd fd))
    -  (void-syscall ("tcflow" int int) fd action))
    +;;; UNIX-FAST-SELECT -- public.
    +;;;
    +(defmacro unix-fast-select (num-descriptors
    +			    read-fds write-fds exception-fds
    +			    timeout-secs &optional (timeout-usecs 0))
    +  _N"Perform the UNIX select(2) system call."
    +  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) 
    +	   (type (or (alien (* (struct fd-set))) null) 
    +		 read-fds write-fds exception-fds) 
    +	   (type (or null (unsigned-byte 31)) timeout-secs) 
    +	   (type (unsigned-byte 31) timeout-usecs) 
    +	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    +  `(let ((timeout-secs ,timeout-secs))
    +     (with-alien ((tv (struct timeval)))
    +       (when timeout-secs
    +	 (setf (slot tv 'tv-sec) timeout-secs)
    +	 (setf (slot tv 'tv-usec) ,timeout-usecs))
    +       (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
    +		     (* (struct fd-set)) (* (struct timeval)))
    +		    ,num-descriptors ,read-fds ,write-fds ,exception-fds
    +		    (if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
     
    -;;; timebits.h
     
    -;; A time value that is accurate to the nearest
    -;; microsecond but also has a range of years.  
    -(def-alien-type nil
    -  (struct timeval
    -	  (tv-sec time-t)	; seconds
    -	  (tv-usec time-t)))	; and microseconds
    +;;; Unix-select accepts sets of file descriptors and waits for an event
    +;;; to happen on one of them or to time out.
     
    -;;; unistd.h
    -
    -(defun sub-unix-execve (program arg-list env-list)
    -  (let ((argv nil)
    -	(argv-bytes 0)
    -	(envp nil)
    -	(envp-bytes 0)
    -	result error-code)
    -    (unwind-protect
    -	(progn
    -	  ;; Blast the stuff into the proper format
    -	  (multiple-value-setq
    -	      (argv argv-bytes)
    -	    (string-list-to-c-strvec arg-list))
    -	  (multiple-value-setq
    -	      (envp envp-bytes)
    -	    (string-list-to-c-strvec env-list))
    -	  ;;
    -	  ;; Now do the system call
    -	  (multiple-value-setq
    -	      (result error-code)
    -	    (int-syscall ("execve"
    -			  c-string system-area-pointer system-area-pointer)
    -			 program argv envp)))
    -      ;; 
    -      ;; Deallocate memory
    -      (when argv
    -	(system:deallocate-system-memory argv argv-bytes))
    -      (when envp
    -	(system:deallocate-system-memory envp envp-bytes)))
    -    (values result error-code)))
    -
    -;;;; UNIX-EXECVE
    -
    -(defun unix-execve (program &optional arg-list
    -			    (environment *environment-list*))
    -  _N"Executes the Unix execve system call.  If the system call suceeds, lisp
    -   will no longer be running in this process.  If the system call fails this
    -   function returns two values: NIL and an error code.  Arg-list should be a
    -   list of simple-strings which are passed as arguments to the exec'ed program.
    -   Environment should be an a-list mapping symbols to simple-strings which this
    -   function bashes together to form the environment for the exec'ed program."
    -  (check-type program simple-string)
    -  (let ((env-list (let ((envlist nil))
    -		    (dolist (cons environment)
    -		      (push (if (cdr cons)
    -				(concatenate 'simple-string
    -					     (string (car cons)) "="
    -					     (cdr cons))
    -				(car cons))
    -			    envlist))
    -		    envlist)))
    -    (sub-unix-execve (%name->file program) arg-list env-list)))
    -
    -
    -(defmacro round-bytes-to-words (n)
    -  `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
    +(defmacro num-to-fd-set (fdset num)
    +  `(if (fixnump ,num)
    +       (progn
    +	 (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
    +	 ,@(loop for index upfrom 1 below (/ fd-setsize nfdbits)
    +	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
    +       (progn
    +	 ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    +	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
    +			    (ldb (byte nfdbits ,(* index nfdbits)) ,num))))))
     
    -;; Values for the second argument to access.
    +(defmacro fd-set-to-num (nfds fdset)
    +  `(if (<= ,nfds nfdbits)
    +       (deref (slot ,fdset 'fds-bits) 0)
    +       (+ ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    +	      collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
    +			    ,(* index nfdbits))))))
     
    -;;; Unix-access accepts a path and a mode.  It returns two values the
    -;;; first is T if the file is accessible and NIL otherwise.  The second
    -;;; only has meaning in the second case and is the unix errno value.
    +(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
    +  _N"Unix-select examines the sets of descriptors passed as arguments
    +   to see if they are ready for reading and writing.  See the UNIX
    +   Programmers Manual for more information."
    +  (declare (type (integer 0 #.FD-SETSIZE) nfds)
    +	   (type unsigned-byte rdfds wrfds xpfds)
    +	   (type (or (unsigned-byte 31) null) to-secs)
    +	   (type (unsigned-byte 31) to-usecs)
    +	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    +  (with-alien ((tv (struct timeval))
    +	       (rdf (struct fd-set))
    +	       (wrf (struct fd-set))
    +	       (xpf (struct fd-set)))
    +    (when to-secs
    +      (setf (slot tv 'tv-sec) to-secs)
    +      (setf (slot tv 'tv-usec) to-usecs))
    +    (num-to-fd-set rdf rdfds)
    +    (num-to-fd-set wrf wrfds)
    +    (num-to-fd-set xpf xpfds)
    +    (macrolet ((frob (lispvar alienvar)
    +		 `(if (zerop ,lispvar)
    +		      (int-sap 0)
    +		      (alien-sap (addr ,alienvar)))))
    +      (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
    +		(* (struct fd-set)) (* (struct timeval)))
    +	       (values result
    +		       (fd-set-to-num nfds rdf)
    +		       (fd-set-to-num nfds wrf)
    +		       (fd-set-to-num nfds xpf))
    +	       nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
    +	       (if to-secs (alien-sap (addr tv)) (int-sap 0))))))
     
    -(defun unix-access (path mode)
    -  _N"Given a file path (a string) and one of four constant modes,
    -   unix-access returns T if the file is accessible with that
    -   mode and NIL if not.  It also returns an errno value with
    -   NIL which determines why the file was not accessible.
    +(defun unix-symlink (name1 name2)
    +  _N"Unix-symlink creates a symbolic link named name2 to the file
    +   named name1.  NIL and an error number is returned if the call
    +   is unsuccessful."
    +  (declare (type unix-pathname name1 name2))
    +  (void-syscall ("symlink" c-string c-string)
    +		(%name->file name1) (%name->file name2)))
     
    -   The access modes are:
    -	r_ok     Read permission.
    -	w_ok     Write permission.
    -	x_ok     Execute permission.
    -	f_ok     Presence of file."
    -  (declare (type unix-pathname path)
    -	   (type (mod 8) mode))
    -  (void-syscall ("access" c-string int) (%name->file path) mode))
    +(def-alien-routine ("gethostid" unix-gethostid) unsigned-long
    +  _N"Unix-gethostid returns a 32-bit integer which provides unique
    +   identification for the host machine.")
     
    -(defconstant l_set 0 _N"set the file pointer")
    -(defconstant l_incr 1 _N"increment the file pointer")
    -(defconstant l_xtnd 2 _N"extend the file size")
    +(def-alien-routine ("getpid" unix-getpid) int
    +  _N"Unix-getpid returns the process-id of the current process.")
     
    -(defun unix-lseek (fd offset whence)
    -  _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead
    -   a certain OFFSET for that file.  WHENCE can be any of the following:
    +;;;; User and group database structures: <pwd.h> and <grp.h>
    +(defstruct user-info
    +  (name "" :type string)
    +  (password "" :type string)
    +  (uid 0 :type unix-uid)
    +  (gid 0 :type unix-gid)
    +  (gecos "" :type string)
    +  (dir "" :type string)
    +  (shell "" :type string))
     
    -   l_set        Set the file pointer.
    -   l_incr       Increment the file pointer.
    -   l_xtnd       Extend the file size.
    -  "
    -  (declare (type unix-fd fd)
    -	   (type (signed-byte 64) offset)
    -	   (type (integer 0 2) whence))
    -  (let ((result (alien-funcall
    -                 (extern-alien "lseek64" (function off-t int off-t int))
    -                 fd offset whence)))
    -    (if (minusp result)
    -        (values nil (unix-errno))
    -        (values result 0))))
    +(defun unix-getpwuid (uid)
    +  _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
    +  (declare (type unix-uid uid))
    +  (with-alien ((buf (array c-call:char 1024))
    +	       (user-info (struct passwd))
    +               (result (* (struct passwd))))
    +    (let ((returned
    +	   (alien-funcall
    +	    (extern-alien "getpwuid_r"
    +			  (function c-call:int
    +                                    c-call:unsigned-int
    +                                    (* (struct passwd))
    +                                    (* c-call:char)
    +                                    c-call:unsigned-int
    +                                    (* (* (struct passwd)))))
    +	    uid
    +	    (addr user-info)
    +	    (cast buf (* c-call:char))
    +	    1024
    +            (addr result))))
    +      (when (zerop returned)
    +        (make-user-info
    +         :name (string (cast (slot result 'pw-name) c-call:c-string))
    +         :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    +         :uid (slot result 'pw-uid)
    +         :gid (slot result 'pw-gid)
    +         :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    +         :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    +         :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
     
    +(declaim (inline unix-gettimeofday))
    +(defun unix-gettimeofday ()
    +  _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and
    +   microseconds of the current time of day, the timezone (in minutes west
    +   of Greenwich), and a daylight-savings flag.  If it doesn't work, it
    +   returns NIL and the errno."
    +  (with-alien ((tv (struct timeval))
    +	       (tz (struct timezone)))
    +    (syscall* ("gettimeofday" (* (struct timeval)) 
    +			      (* (struct timezone)))
    +	      (values T
    +		      (slot tv 'tv-sec)
    +		      (slot tv 'tv-usec)
    +		      (slot tz 'tz-minuteswest)
    +		      (slot tz 'tz-dsttime))
    +	      (addr tv)
    +	      (addr tz))))
     
    -;;; UNIX-READ accepts a file descriptor, a buffer, and the length to read.
    -;;; It attempts to read len bytes from the device associated with fd
    -;;; and store them into the buffer.  It returns the actual number of
    -;;; bytes read.
    +;;; Unix-utimes changes the accessed and updated times on UNIX
    +;;; files.  The first argument is the filename (a string) and
    +;;; the second argument is a list of the 4 times- accessed and
    +;;; updated seconds and microseconds.
     
    -(defun unix-read (fd buf len)
    -  _N"UNIX-READ attempts to read from the file described by fd into
    -   the buffer buf until it is full.  Len is the length of the buffer.
    -   The number of bytes actually read is returned or NIL and an error
    -   number if an error occured."
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 32) len))
    -  #+gencgc
    -  ;; With gencgc, the collector tries to keep raw objects like strings
    -  ;; in separate pages that are not write-protected.  However, this
    -  ;; isn't always true.  Thus, BUF will sometimes be write-protected
    -  ;; and the kernel doesn't like writing to write-protected pages.  So
    -  ;; go through and touch each page to give the segv handler a chance
    -  ;; to unprotect the pages.  (This is taken from unix.lisp.)
    -  (without-gcing
    -   (let* ((page-size (get-page-size))
    -	  (1-page-size (1- page-size))
    -	  (sap (etypecase buf
    -		 (system-area-pointer buf)
    -		 (vector (vector-sap buf))))
    -	  (end (sap+ sap len)))
    -     (declare (type (and fixnum unsigned-byte) page-size 1-page-size)
    -	      (type system-area-pointer sap end)
    -	      (optimize (speed 3) (safety 0)))
    -     ;; Touch the beginning of every page
    -     (do ((sap (int-sap (logand (sap-int sap)
    -				(logxor 1-page-size (ldb (byte 32 0) -1))))
    -	       (sap+ sap page-size)))
    -	 ((sap>= sap end))
    -       (declare (type system-area-pointer sap))
    -       (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0)))))
    -  (int-syscall ("read" int (* char) int) fd buf len))
    -
    -
    -;;; Unix-write accepts a file descriptor, a buffer, an offset, and the
    -;;; length to write.  It attempts to write len bytes to the device
    -;;; associated with fd from the the buffer starting at offset.  It returns
    -;;; the actual number of bytes written.
    -
    -(defun unix-write (fd buf offset len)
    -  _N"Unix-write attempts to write a character buffer (buf) of length
    -   len to the file described by the file descriptor fd.  NIL and an
    -   error is returned if the call is unsuccessful."
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 32) offset len))
    -  (int-syscall ("write" int (* char) int)
    -	       fd
    -	       (with-alien ((ptr (* char) (etypecase buf
    -					    ((simple-array * (*))
    -					     (vector-sap buf))
    -					    (system-area-pointer
    -					     buf))))
    -		 (addr (deref ptr offset)))
    -	       len))
    -
    -(defun unix-pipe ()
    -  _N"Unix-pipe sets up a unix-piping mechanism consisting of
    -  an input pipe and an output pipe.  Unix-Pipe returns two
    -  values: if no error occurred the first value is the pipe
    -  to be read from and the second is can be written to.  If
    -  an error occurred the first value is NIL and the second
    -  the unix error code."
    -  (with-alien ((fds (array int 2)))
    -    (syscall ("pipe" (* int))
    -	     (values (deref fds 0) (deref fds 1))
    -	     (cast fds (* int)))))
    -
    -
    -(defun unix-chown (path uid gid)
    -  _N"Given a file path, an integer user-id, and an integer group-id,
    -   unix-chown changes the owner of the file and the group of the
    -   file to those specified.  Either the owner or the group may be
    -   left unchanged by specifying them as -1.  Note: Permission will
    -   fail if the caller is not the superuser."
    -  (declare (type unix-pathname path)
    -	   (type (or unix-uid (integer -1 -1)) uid)
    -	   (type (or unix-gid (integer -1 -1)) gid))
    -  (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
    -
    -;;; Unix-fchown is exactly the same as unix-chown except that the file
    -;;; is specified by a file-descriptor ("fd") instead of a pathname.
    -
    -(defun unix-fchown (fd uid gid)
    -  _N"Unix-fchown is like unix-chown, except that it accepts an integer
    -   file descriptor instead of a file path name."
    -  (declare (type unix-fd fd)
    -	   (type (or unix-uid (integer -1 -1)) uid)
    -	   (type (or unix-gid (integer -1 -1)) gid))
    -  (void-syscall ("fchown" int int int) fd uid gid))
    -
    -;;; Unix-chdir accepts a directory name and makes that the
    -;;; current working directory.
    -
    -(defun unix-chdir (path)
    -  _N"Given a file path string, unix-chdir changes the current working 
    -   directory to the one specified."
    -  (declare (type unix-pathname path))
    -  (void-syscall ("chdir" c-string) (%name->file path)))
    -
    -(defun unix-current-directory ()
    -  _N"Put the absolute pathname of the current working directory in BUF.
    -   If successful, return BUF.  If not, put an error message in
    -   BUF and return NULL.  BUF should be at least PATH_MAX bytes long."
    -  ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
    -  (with-alien ((buf (array c-call:char 5120)))
    -    (let ((result (alien-funcall
    -		    (extern-alien "getcwd"
    -				  (function (* c-call:char)
    -					    (* c-call:char) c-call:int))
    -		    (cast buf (* c-call:char))
    -		    5120)))
    -      
    -      (values (not (zerop (sap-int (alien-sap result))))
    -	      (%file->name (cast buf c-call:c-string))))))
    -
    -
    -;;; Unix-dup returns a duplicate copy of the existing file-descriptor
    -;;; passed as an argument.
    -
    -(defun unix-dup (fd)
    -  _N"Unix-dup duplicates an existing file descriptor (given as the
    -   argument) and return it.  If FD is not a valid file descriptor, NIL
    -   and an error number are returned."
    -  (declare (type unix-fd fd))
    -  (int-syscall ("dup" int) fd))
    -
    -;;; Unix-dup2 makes the second file-descriptor describe the same file
    -;;; as the first. If the second file-descriptor points to an open
    -;;; file, it is first closed. In any case, the second should have a 
    -;;; value which is a valid file-descriptor.
    -
    -(defun unix-dup2 (fd1 fd2)
    -  _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup
    -   does only the new value of the duplicate descriptor may be requested
    -   through the second argument.  If a file already exists with the
    -   requested descriptor number, it will be closed and the number
    -   assigned to the duplicate."
    -  (declare (type unix-fd fd1 fd2))
    -  (void-syscall ("dup2" int int) fd1 fd2))
    -
    -;;; Unix-exit terminates a program.
    -
    -(defun unix-exit (&optional (code 0))
    -  _N"Unix-exit terminates the current process with an optional
    -   error code.  If successful, the call doesn't return.  If
    -   unsuccessful, the call returns NIL and an error number."
    -  (declare (type (signed-byte 32) code))
    -  (void-syscall ("exit" int) code))
    -
    -#+(or)
    -(defun unix-pathconf (path name)
    -  _N"Get file-specific configuration information about PATH."
    -  (int-syscall ("pathconf" c-string int) (%name->file path) name))
    -
    -#+(or)
    -(defun unix-sysconf (name)
    -  _N"Get the value of the system variable NAME."
    -  (int-syscall ("sysconf" int) name))
    -
    -#+(or)
    -(defun unix-confstr (name)
    -  _N"Get the value of the string-valued system variable NAME."
    -  (with-alien ((buf (array char 1024)))
    -    (values (not (zerop (alien-funcall (extern-alien "confstr"
    -						     (function int
    -							       c-string
    -							       size-t))
    -				       name buf 1024)))
    -	    (cast buf c-string))))
    -
    -
    -(def-alien-routine ("getpid" unix-getpid) int
    -  _N"Unix-getpid returns the process-id of the current process.")
    -
    -(def-alien-routine ("getppid" unix-getppid) int
    -  _N"Unix-getppid returns the process-id of the parent of the current process.")
    -
    -;;; Unix-getpgrp returns the group-id associated with the
    -;;; current process.
    -
    -(defun unix-getpgrp ()
    -  _N"Unix-getpgrp returns the group-id of the calling process."
    -  (int-syscall ("getpgrp")))
    -
    -;;; Unix-setpgid sets the group-id of the process specified by 
    -;;; "pid" to the value of "pgrp".  The process must either have
    -;;; the same effective user-id or be a super-user process.
    -
    -;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
    -;;; for backward compatibility. setpgrp(void)[solaris] is being phased
    -;;; out in favor of setsid().
    -
    -(defun unix-setpgrp (pid pgrp)
    -  _N"Unix-setpgrp sets the process group on the process pid to
    -   pgrp.  NIL and an error number are returned upon failure."
    -  (void-syscall ("setpgid" int int) pid pgrp))
    -
    -(defun unix-setpgid (pid pgrp)
    -  _N"Unix-setpgid sets the process group of the process pid to
    -   pgrp. If pgid is equal to pid, the process becomes a process
    -   group leader. NIL and an error number are returned upon failure."
    -  (void-syscall ("setpgid" int int) pid pgrp))
    -
    -#+(or)
    -(defun unix-setsid ()
    -  _N"Create a new session with the calling process as its leader.
    -   The process group IDs of the session and the calling process
    -   are set to the process ID of the calling process, which is returned."
    -  (void-syscall ( "setsid")))
    -
    -#+(or)
    -(defun unix-getsid ()
    -  _N"Return the session ID of the given process."
    -  (int-syscall ( "getsid")))
    -
    -(def-alien-routine ("getuid" unix-getuid) int
    -  _N"Unix-getuid returns the real user-id associated with the
    -   current process.")
    -
    -#+(or)
    -(def-alien-routine ("geteuid" unix-getuid) int
    -  _N"Get the effective user ID of the calling process.")
    -
    -(def-alien-routine ("getgid" unix-getgid) int
    -  _N"Unix-getgid returns the real group-id of the current process.")
    -
    -(def-alien-routine ("getegid" unix-getegid) int
    -  _N"Unix-getegid returns the effective group-id of the current process.")
    -
    -;/* If SIZE is zero, return the number of supplementary groups
    -;   the calling process is in.  Otherwise, fill in the group IDs
    -;   of its supplementary groups in LIST and return the number written.  */
    -;extern int getgroups __P ((int __size, __gid_t __list[]));
    -
    -#+(or)
    -(defun unix-group-member (gid)
    -  _N"Return nonzero iff the calling process is in group GID."
    -  (int-syscall ( "group-member" gid-t) gid))
    -
    -
    -(defun unix-setuid (uid)
    -  _N"Set the user ID of the calling process to UID.
    -   If the calling process is the super-user, set the real
    -   and effective user IDs, and the saved set-user-ID to UID;
    -   if not, the effective user ID is set to UID."
    -  (int-syscall ("setuid" uid-t) uid))
    -
    -;;; Unix-setreuid sets the real and effective user-id's of the current
    -;;; process to the arguments "ruid" and "euid", respectively.  Usage is
    -;;; restricted for anyone but the super-user.  Setting either "ruid" or
    -;;; "euid" to -1 makes the system use the current id instead.
    -
    -(defun unix-setreuid (ruid euid)
    -  _N"Unix-setreuid sets the real and effective user-id's of the current
    -   process to the specified ones.  NIL and an error number is returned
    -   if the call fails."
    -  (void-syscall ("setreuid" int int) ruid euid))
    -
    -(defun unix-setgid (gid)
    -  _N"Set the group ID of the calling process to GID.
    -   If the calling process is the super-user, set the real
    -   and effective group IDs, and the saved set-group-ID to GID;
    -   if not, the effective group ID is set to GID."
    -  (int-syscall ("setgid" gid-t) gid))
    -
    -
    -;;; Unix-setregid sets the real and effective group-id's of the current
    -;;; process to the arguments "rgid" and "egid", respectively.  Usage is
    -;;; restricted for anyone but the super-user.  Setting either "rgid" or
    -;;; "egid" to -1 makes the system use the current id instead.
    -
    -(defun unix-setregid (rgid egid)
    -  _N"Unix-setregid sets the real and effective group-id's of the current
    -   process process to the specified ones.  NIL and an error number is
    -   returned if the call fails."
    -  (void-syscall ("setregid" int int) rgid egid))
    -
    -(defun unix-fork ()
    -  _N"Executes the unix fork system call.  Returns 0 in the child and the pid
    -   of the child in the parent if it works, or NIL and an error number if it
    -   doesn't work."
    -  (int-syscall ("fork")))
    -
    -;; Environment maninpulation; man getenv(3)
    -(def-alien-routine ("getenv" unix-getenv) c-call:c-string
    -  (name c-call:c-string) 
    -  _N"Get the value of the environment variable named Name.  If no such
    -  variable exists, Nil is returned.")
    -
    -(def-alien-routine ("setenv" unix-setenv) c-call:int
    -  (name c-call:c-string)
    -  (value c-call:c-string)
    -  (overwrite c-call:int)
    -  _N"Adds the environment variable named Name to the environment with
    -  the given Value if Name does not already exist. If Name does exist,
    -  the value is changed to Value if Overwrite is non-zero.  Otherwise,
    -  the value is not changed.")
    -
    -(def-alien-routine ("putenv" unix-putenv) c-call:int
    -  (name c-call:c-string)
    -  _N"Adds or changes the environment.  Name-value must be a string of
    -  the form \"name=value\".  If the name does not exist, it is added.
    -  If name does exist, the value is updated to the given value.")
    -
    -(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int
    -  (name c-call:c-string)
    -  _N"Removes the variable Name from the environment")
    +(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
    +  _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
    +   times on a specified file.  NIL and an error number is
    +   returned if the call is unsuccessful."
    +  (declare (type unix-pathname file)
    +	   (type (alien unsigned-long)
    +		 atime-sec atime-usec
    +		 mtime-sec mtime-usec))
    +  (with-alien ((tvp (array (struct timeval) 2)))
    +    (setf (slot (deref tvp 0) 'tv-sec) atime-sec)
    +    (setf (slot (deref tvp 0) 'tv-usec) atime-usec)
    +    (setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
    +    (setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
    +    (void-syscall ("utimes" c-string (* (struct timeval)))
    +		  file
    +		  (cast tvp (* (struct timeval))))))
     
     (def-alien-routine ("ttyname" unix-ttyname) c-string
       (fd int))
    @@ -2139,127 +1598,19 @@ length LEN and type TYPE."
       associated with it is a terminal."
       (fd int))
     
    -;;; Unix-link creates a hard link from name2 to name1.
    -
    -(defun unix-link (name1 name2)
    -  _N"Unix-link creates a hard link from the file with name1 to the
    -   file with name2."
    -  (declare (type unix-pathname name1 name2))
    -  (void-syscall ("link" c-string c-string)
    -		(%name->file name1) (%name->file name2)))
    -
    -(defun unix-symlink (name1 name2)
    -  _N"Unix-symlink creates a symbolic link named name2 to the file
    -   named name1.  NIL and an error number is returned if the call
    -   is unsuccessful."
    -  (declare (type unix-pathname name1 name2))
    -  (void-syscall ("symlink" c-string c-string)
    -		(%name->file name1) (%name->file name2)))
    -
    -(defun unix-readlink (path)
    -  _N"Unix-readlink invokes the readlink system call on the file name
    -  specified by the simple string path.  It returns up to two values:
    -  the contents of the symbolic link if the call is successful, or
    -  NIL and the Unix error number."
    -  (declare (type unix-pathname path))
    -  (with-alien ((buf (array char 1024)))
    -    (syscall ("readlink" c-string (* char) int)
    -	     (let ((string (make-string result)))
    -	       #-unicode
    -	       (kernel:copy-from-system-area
    -		(alien-sap buf) 0
    -		string (* vm:vector-data-offset vm:word-bits)
    -		(* result vm:byte-bits))
    -	       #+unicode
    -	       (let ((sap (alien-sap buf)))
    -		 (dotimes (k result)
    -		   (setf (aref string k) (code-char (sap-ref-8 sap k)))))
    -	       (%file->name string))
    -	     (%name->file path) (cast buf (* char)) 1024)))
    -
    -;;; Unix-unlink accepts a name and deletes the directory entry for that
    -;;; name and the file if this is the last link.
    -
    -(defun unix-unlink (name)
    -  _N"Unix-unlink removes the directory entry for the named file.
    -   NIL and an error code is returned if the call fails."
    -  (declare (type unix-pathname name))
    -  (void-syscall ("unlink" c-string) (%name->file name)))
    -
    -;;; Unix-rmdir accepts a name and removes the associated directory.
    -
    -(defun unix-rmdir (name)
    -  _N"Unix-rmdir attempts to remove the directory name.  NIL and
    -   an error number is returned if an error occured."
    -  (declare (type unix-pathname name))
    -  (void-syscall ("rmdir" c-string) (%name->file name)))
    +;;; pty.h
     
    -(defun tcgetpgrp (fd)
    -  _N"Get the tty-process-group for the unix file-descriptor FD."
    -  (alien:with-alien ((alien-pgrp c-call:int))
    -    (multiple-value-bind (ok err)
    -	(unix-ioctl fd
    -		     tiocgpgrp
    -		     (alien:alien-sap (alien:addr alien-pgrp)))
    -      (if ok
    -	  (values alien-pgrp nil)
    -	  (values nil err)))))
    -
    -(defun tty-process-group (&optional fd)
    -  _N"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,
    -  FD defaults to /dev/tty."
    -  (if fd
    -      (tcgetpgrp fd)
    -      (multiple-value-bind (tty-fd errno)
    -	  (unix-open "/dev/tty" o_rdwr 0)
    -	(cond (tty-fd
    -	       (multiple-value-prog1
    -		   (tcgetpgrp tty-fd)
    -		 (unix-close tty-fd)))
    -	      (t
    -	       (values nil errno))))))
    -
    -(defun tcsetpgrp (fd pgrp)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP."
    -  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    -    (unix-ioctl fd
    -		tiocspgrp
    -		(alien:alien-sap (alien:addr alien-pgrp)))))
    -
    -(defun %set-tty-process-group (pgrp &optional fd)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    -  supplied, FD defaults to /dev/tty."
    -  (let ((old-sigs
    -	 (unix-sigblock
    -	  (sigmask :sigttou :sigttin :sigtstp :sigchld))))
    -    (declare (type (unsigned-byte 32) old-sigs))
    -    (unwind-protect
    -	(if fd
    -	    (tcsetpgrp fd pgrp)
    -	    (multiple-value-bind (tty-fd errno)
    -		(unix-open "/dev/tty" o_rdwr 0)
    -	      (cond (tty-fd
    -		     (multiple-value-prog1
    -			 (tcsetpgrp tty-fd pgrp)
    -		       (unix-close tty-fd)))
    -		    (t
    -		     (values nil errno)))))
    -      (unix-sigsetmask old-sigs))))
    -  
    -(defsetf tty-process-group (&optional fd) (pgrp)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    -  supplied, FD defaults to /dev/tty."
    -  `(%set-tty-process-group ,pgrp ,fd))
    -
    -#+(or)
    -(defun unix-getlogin ()
    -  _N"Return the login name of the user."
    -    (let ((result (alien-funcall (extern-alien "getlogin"
    -					     (function c-string)))))
    -    (declare (type system-area-pointer result))
    -    (if (zerop (sap-int result))
    -	nil
    -      result)))
    +(defun unix-openpty (name termp winp)
    +  _N"Create pseudo tty master slave pair with NAME and set terminal
    +   attributes according to TERMP and WINP and return handles for both
    +   ends in AMASTER and ASLAVE."
    +  (with-alien ((amaster int)
    +	       (aslave int))
    +    (values
    +     (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))
    +			     (* (struct winsize)))
    +		  (addr amaster) (addr aslave) name termp winp)
    +     amaster aslave)))
     
     (def-alien-type nil
       (struct utsname
    @@ -2284,1516 +1635,190 @@ length LEN and type TYPE."
     		     (cast (slot utsname 'domainname) c-string))
     	      (addr utsname))))
     
    -(defun unix-gethostname ()
    -  _N"Unix-gethostname returns the name of the host machine as a string."
    -  (with-alien ((buf (array char 256)))
    -    (syscall* ("gethostname" (* char) int)
    -	      (cast buf c-string)
    -	      (cast buf (* char)) 256)))
    -
    -#+(or)
    -(defun unix-sethostname (name len)
    -  (int-syscall ("sethostname" c-string size-t) name len))
    -
    -#+(or)
    -(defun unix-sethostid (id)
    -  (int-syscall ("sethostid" long) id))
    -
    -#+(or)
    -(defun unix-getdomainname (name len)
    -  (int-syscall ("getdomainname" c-string size-t) name len))
    +;;; sys/ioctl.h
     
    -#+(or)
    -(defun unix-setdomainname (name len)
    -  (int-syscall ("setdomainname" c-string size-t) name len))
    +(defun unix-ioctl (fd cmd arg)
    +  _N"Unix-ioctl performs a variety of operations on open i/o
    +   descriptors.  See the UNIX Programmer's Manual for more
    +   information."
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 32) cmd))
    +  (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))
     
    -;;; Unix-fsync writes the core-image of the file described by "fd" to
    -;;; permanent storage (i.e. disk).
     
    -(defun unix-fsync (fd)
    -  _N"Unix-fsync writes the core image of the file described by
    -   fd to disk."
    -  (declare (type unix-fd fd))
    -  (void-syscall ("fsync" int) fd))
    +;;; Unix-mkdir accepts a name and a mode and attempts to create the
    +;;; corresponding directory with mode mode.
     
    +(defun unix-mkdir (name mode)
    +  _N"Unix-mkdir creates a new directory with the specified name and mode.
    +   (Same as those for unix-chmod.)  It returns T upon success, otherwise
    +   NIL and an error number."
    +  (declare (type unix-pathname name)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("mkdir" c-string int) (%name->file name) mode))
     
    -#+(or)
    -(defun unix-vhangup ()
    - _N"Revoke access permissions to all processes currently communicating
    -  with the control terminal, and then send a SIGHUP signal to the process
    -  group of the control terminal." 
    - (int-syscall ("vhangup")))
    -
    -#+(or)
    -(defun unix-revoke (file)
    - _N"Revoke the access of all descriptors currently open on FILE."
    - (int-syscall ("revoke" c-string) (%name->file file)))
    -
    -
    -#+(or)
    -(defun unix-chroot (path)
    - _N"Make PATH be the root directory (the starting point for absolute paths).
    -   This call is restricted to the super-user."
    - (int-syscall ("chroot" c-string) (%name->file path)))
    -
    -(def-alien-routine ("gethostid" unix-gethostid) unsigned-long
    -  _N"Unix-gethostid returns a 32-bit integer which provides unique
    -   identification for the host machine.")
    -
    -;;; Unix-sync writes all information in core memory which has been modified
    -;;; to permanent storage (i.e. disk).
    -
    -(defun unix-sync ()
    -  _N"Unix-sync writes all information in core memory which has been
    -   modified to disk.  It returns NIL and an error code if an error
    -   occured."
    -  (void-syscall ("sync")))
    -
    -;;; Unix-getpagesize returns the number of bytes in the system page.
    -
    -(defun unix-getpagesize ()
    -  _N"Unix-getpagesize returns the number of bytes in a system page."
    -  (int-syscall ("getpagesize")))
    -
    -;;; Unix-truncate accepts a file name and a new length.  The file is
    -;;; truncated to the new length.
    -
    -(defun unix-truncate (name length)
    -  _N"Unix-truncate truncates the named file to the length (in
    -   bytes) specified by LENGTH.  NIL and an error number is returned
    -   if the call is unsuccessful."
    -  (declare (type unix-pathname name)
    -	   (type (unsigned-byte 64) length))
    -  (void-syscall ("truncate64" c-string off-t) (%name->file name) length))
    -
    -(defun unix-ftruncate (fd length)
    -  _N"Unix-ftruncate is similar to unix-truncate except that the first
    -   argument is a file descriptor rather than a file name."
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 64) length))
    -  (void-syscall ("ftruncate64" int off-t) fd length))
    -
    -#+(or)
    -(defun unix-getdtablesize ()
    -  _N"Return the maximum number of file descriptors
    -   the current process could possibly have."
    -  (int-syscall ("getdtablesize")))
    -
    -(defconstant f_ulock 0 _N"Unlock a locked region")
    -(defconstant f_lock 1 _N"Lock a region for exclusive use")
    -(defconstant f_tlock 2 _N"Test and lock a region for exclusive use")
    -(defconstant f_test 3 _N"Test a region for othwer processes locks")
    -
    -(defun unix-lockf (fd cmd length)
    -  _N"Unix-locks can lock, unlock and test files according to the cmd
    -   which can be one of the following:
    -
    -   f_ulock  Unlock a locked region
    -   f_lock   Lock a region for exclusive use
    -   f_tlock  Test and lock a region for exclusive use
    -   f_test   Test a region for othwer processes locks
    -
    -   The lock is for a region from the current location for a length
    -   of length.
    -
    -   This is a simpler version of the interface provided by unix-fcntl.
    -   "
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 64) length)
    -	   (type (integer 0 3) cmd))
    -  (int-syscall ("lockf64" int int off-t) fd cmd length))
    -
    -;;; utime.h
    -
    -;; Structure describing file times.
    +;;; timebits.h
     
    +;; A time value that is accurate to the nearest
    +;; microsecond but also has a range of years.  
     (def-alien-type nil
    -    (struct utimbuf
    -	    (actime time-t) ; Access time. 
    -	    (modtime time-t))) ; Modification time.
    -
    -;;; Unix-utimes changes the accessed and updated times on UNIX
    -;;; files.  The first argument is the filename (a string) and
    -;;; the second argument is a list of the 4 times- accessed and
    -;;; updated seconds and microseconds.
    +  (struct timeval
    +	  (tv-sec time-t)	; seconds
    +	  (tv-usec time-t)))	; and microseconds
     
    -(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
    -  _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
    -   times on a specified file.  NIL and an error number is
    -   returned if the call is unsuccessful."
    -  (declare (type unix-pathname file)
    -	   (type (alien unsigned-long)
    -		 atime-sec atime-usec
    -		 mtime-sec mtime-usec))
    -  (with-alien ((tvp (array (struct timeval) 2)))
    -    (setf (slot (deref tvp 0) 'tv-sec) atime-sec)
    -    (setf (slot (deref tvp 0) 'tv-usec) atime-usec)
    -    (setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
    -    (setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
    -    (void-syscall ("utimes" c-string (* (struct timeval)))
    -		  file
    -		  (cast tvp (* (struct timeval))))))
    -;;; waitflags.h
    +;;; sys/time.h
     
    -;; Bits in the third argument to `waitpid'.
    +;; Structure crudely representing a timezone.
    +;;   This is obsolete and should never be used. 
    +(def-alien-type nil
    +  (struct timezone
    +    (tz-minuteswest int)		; minutes west of Greenwich
    +    (tz-dsttime	int)))			; type of dst correction
     
    -(defconstant waitpid-wnohang 1 _N"Don't block waiting.")
    -(defconstant waitpid-wuntranced 2 _N"Report status of stopped children.")
    +;; Type of the second argument to `getitimer' and
    +;; the second and third arguments `setitimer'. 
    +(def-alien-type nil
    +  (struct itimerval
    +    (it-interval (struct timeval))	; timer interval
    +    (it-value (struct timeval))))	; current value
     
    -(defconstant waitpid-wclone #x80000000 _N"Wait for cloned process.")
    +(defconstant ITIMER-REAL 0)
    +(defconstant ITIMER-VIRTUAL 1)
    +(defconstant ITIMER-PROF 2)
     
    -;;; sys/ioctl.h
    +(defun unix-getitimer (which)
    +  _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of
    +   three system timers (:real :virtual or :profile). On success,
    +   unix-getitimer returns 5 values,
    +   T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
    +  (declare (type (member :real :virtual :profile) which)
    +	   (values t
    +		   (unsigned-byte 29)(mod 1000000)
    +		   (unsigned-byte 29)(mod 1000000)))
    +  (let ((which (ecase which
    +		 (:real ITIMER-REAL)
    +		 (:virtual ITIMER-VIRTUAL)
    +		 (:profile ITIMER-PROF))))
    +    (with-alien ((itv (struct itimerval)))
    +      (syscall* ("getitimer" int (* (struct itimerval)))
    +		(values T
    +			(slot (slot itv 'it-interval) 'tv-sec)
    +			(slot (slot itv 'it-interval) 'tv-usec)
    +			(slot (slot itv 'it-value) 'tv-sec)
    +			(slot (slot itv 'it-value) 'tv-usec))
    +		which (alien-sap (addr itv))))))
     
    -(defun unix-ioctl (fd cmd arg)
    -  _N"Unix-ioctl performs a variety of operations on open i/o
    -   descriptors.  See the UNIX Programmer's Manual for more
    -   information."
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte 32) cmd))
    -  (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))
    +(defun unix-setitimer (which int-secs int-usec val-secs val-usec)
    +  _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of
    +   three system timers (:real :virtual or :profile). A SIGALRM signal
    +   will be delivered VALUE <seconds+microseconds> from now. INTERVAL,
    +   when non-zero, is <seconds+microseconds> to be loaded each time
    +   the timer expires. Setting INTERVAL and VALUE to zero disables
    +   the timer. See the Unix man page for more details. On success,
    +   unix-setitimer returns the old contents of the INTERVAL and VALUE
    +   slots as in unix-getitimer."
    +  (declare (type (member :real :virtual :profile) which)
    +	   (type (unsigned-byte 29) int-secs val-secs)
    +	   (type (integer 0 (1000000)) int-usec val-usec)
    +	   (values t
    +		   (unsigned-byte 29)(mod 1000000)
    +		   (unsigned-byte 29)(mod 1000000)))
    +  (let ((which (ecase which
    +		 (:real ITIMER-REAL)
    +		 (:virtual ITIMER-VIRTUAL)
    +		 (:profile ITIMER-PROF))))
    +    (with-alien ((itvn (struct itimerval))
    +		 (itvo (struct itimerval)))
    +      (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs
    +	    (slot (slot itvn 'it-interval) 'tv-usec) int-usec
    +	    (slot (slot itvn 'it-value   ) 'tv-sec ) val-secs
    +	    (slot (slot itvn 'it-value   ) 'tv-usec) val-usec)
    +      (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval)))
    +		(values T
    +			(slot (slot itvo 'it-interval) 'tv-sec)
    +			(slot (slot itvo 'it-interval) 'tv-usec)
    +			(slot (slot itvo 'it-value) 'tv-sec)
    +			(slot (slot itvo 'it-value) 'tv-usec))
    +		which (alien-sap (addr itvn))(alien-sap (addr itvo))))))
     
    +
    +;;; termbits.h
     
    -;;; sys/fsuid.h
    +(def-alien-type cc-t unsigned-char)
    +(def-alien-type speed-t  unsigned-int)
    +(def-alien-type tcflag-t unsigned-int)
     
    -#+(or)
    -(defun unix-setfsuid (uid)
    -  _N"Change uid used for file access control to UID, without affecting
    -   other priveledges (such as who can send signals at the process)."
    -  (int-syscall ("setfsuid" uid-t) uid))
    +(defconstant +NCCS+ 32
    +  _N"Size of control character vector.")
     
    -#+(or)
    -(defun unix-setfsgid (gid)
    -  _N"Change gid used for file access control to GID, without affecting
    -   other priveledges (such as who can send signals at the process)."
    -  (int-syscall ("setfsgid" gid-t) gid))
    +(def-alien-type nil
    +  (struct termios
    +    (c-iflag tcflag-t)
    +    (c-oflag tcflag-t)
    +    (c-cflag tcflag-t)
    +    (c-lflag tcflag-t)
    +    (c-line cc-t)
    +    (c-cc (array cc-t #.+NCCS+))
    +    (c-ispeed speed-t)
    +    (c-ospeed speed-t)))
     
    -;;; sys/poll.h
    +;; c_cc characters
     
    -;; Data structure describing a polling request.
    +(defmacro def-enum (inc cur &rest names)
    +  (flet ((defform (name)
    +	     (prog1 (when name `(defconstant ,name ,cur))
    +	       (setf cur (funcall inc cur 1)))))
    +    `(progn ,@(mapcar #'defform names))))
     
    -(def-alien-type nil
    -    (struct pollfd
    -	    (fd int)       ; File descriptor to poll.
    -	    (events short) ; Types of events poller cares about.
    -	    (revents short))) ; Types of events that actually occurred.
    -
    -;; Event types that can be polled for.  These bits may be set in `events'
    -;; to indicate the interesting event types; they will appear in `revents'
    -;; to indicate the status of the file descriptor.  
    -
    -(defconstant POLLIN  #o1 _N"There is data to read.")
    -(defconstant POLLPRI #o2 _N"There is urgent data to read.")
    -(defconstant POLLOUT #o4 _N"Writing now will not block.")
    -
    -;; Event types always implicitly polled for.  These bits need not be set in
    -;;`events', but they will appear in `revents' to indicate the status of
    -;; the file descriptor.  */
    -
    -
    -(defconstant POLLERR  #o10 _N"Error condition.")
    -(defconstant POLLHUP  #o20 _N"Hung up.")
    -(defconstant POLLNVAL #o40 _N"Invalid polling request.")
    -
    -
    -(defconstant +npollfile+ 30 _N"Canonical number of polling requests to read
    -in at a time in poll.")
    -
    -#+(or)
    -(defun unix-poll (fds nfds timeout)
    - _N" Poll the file descriptors described by the NFDS structures starting at
    -   FDS.  If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for
    -   an event to occur; if TIMEOUT is -1, block until an event occurs.
    -   Returns the number of file descriptors with events, zero if timed out,
    -   or -1 for errors."
    - (int-syscall ("poll" (* (struct pollfd)) long int)
    -	      fds nfds timeout))
    -
    -;;; sys/resource.h
    -
    -(defun unix-getrlimit (resource)
    -  _N"Get the soft and hard limits for RESOURCE."
    -  (with-alien ((rlimits (struct rlimit)))
    -    (syscall ("getrlimit" int (* (struct rlimit)))
    -	     (values t
    -		     (slot rlimits 'rlim-cur)
    -		     (slot rlimits 'rlim-max))
    -	     resource (addr rlimits))))
    -
    -(defun unix-setrlimit (resource current maximum)
    -  _N"Set the current soft and hard maximum limits for RESOURCE.
    -   Only the super-user can increase hard limits."
    -  (with-alien ((rlimits (struct rlimit)))
    -    (setf (slot rlimits 'rlim-cur) current)
    -    (setf (slot rlimits 'rlim-max) maximum)
    -    (void-syscall ("setrlimit" int (* (struct rlimit)))
    -		  resource (addr rlimits))))
    +(def-enum + 0 vintr vquit verase
    +	  vkill veof vtime
    +	  vmin vswtc vstart
    +	  vstop vsusp veol
    +	  vreprint vdiscard vwerase
    +	  vlnext veol2)
    +(defvar vdsusp vsusp)
     
    -(declaim (inline unix-fast-getrusage))
    -(defun unix-fast-getrusage (who)
    -  _N"Like call getrusage, but return only the system and user time, and returns
    -   the seconds and microseconds as separate values."
    -  (declare (values (member t)
    -		   (unsigned-byte 31) (mod 1000000)
    -		   (unsigned-byte 31) (mod 1000000)))
    -  (with-alien ((usage (struct rusage)))
    -    (syscall* ("getrusage" int (* (struct rusage)))
    -	      (values t
    -		      (slot (slot usage 'ru-utime) 'tv-sec)
    -		      (slot (slot usage 'ru-utime) 'tv-usec)
    -		      (slot (slot usage 'ru-stime) 'tv-sec)
    -		      (slot (slot usage 'ru-stime) 'tv-usec))
    -	      who (addr usage))))
    +(def-enum + 0 tcsanow tcsadrain tcsaflush)
     
    -(defun unix-getrusage (who)
    -  _N"Unix-getrusage returns information about the resource usage
    -   of the process specified by who.  Who can be either the
    -   current process (rusage_self) or all of the terminated
    -   child processes (rusage_children).  NIL and an error number
    -   is returned if the call fails."
    -  (with-alien ((usage (struct rusage)))
    -    (syscall ("getrusage" int (* (struct rusage)))
    -	      (values t
    -		      (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000)
    -			 (slot (slot usage 'ru-utime) 'tv-usec))
    -		      (+ (* (slot (slot usage 'ru-stime) 'tv-sec) 1000000)
    -			 (slot (slot usage 'ru-stime) 'tv-usec))
    -		      (slot usage 'ru-maxrss)
    -		      (slot usage 'ru-ixrss)
    -		      (slot usage 'ru-idrss)
    -		      (slot usage 'ru-isrss)
    -		      (slot usage 'ru-minflt)
    -		      (slot usage 'ru-majflt)
    -		      (slot usage 'ru-nswap)
    -		      (slot usage 'ru-inblock)
    -		      (slot usage 'ru-oublock)
    -		      (slot usage 'ru-msgsnd)
    -		      (slot usage 'ru-msgrcv)
    -		      (slot usage 'ru-nsignals)
    -		      (slot usage 'ru-nvcsw)
    -		      (slot usage 'ru-nivcsw))
    -	      who (addr usage))))
    +;; c_iflag bits
    +(def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck
    +	  tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc
    +	  tty-ixon tty-ixany tty-ixoff 
    +	  tty-imaxbel)
     
    -#+(or)
    -(defun unix-ulimit (cmd newlimit)
    - _N"Function depends on CMD:
    -  1 = Return the limit on the size of a file, in units of 512 bytes.
    -  2 = Set the limit on the size of a file to NEWLIMIT.  Only the
    -      super-user can increase the limit.
    -  3 = Return the maximum possible address of the data segment.
    -  4 = Return the maximum number of files that the calling process can open.
    -  Returns -1 on errors."
    - (int-syscall ("ulimit" int long) cmd newlimit))
    -
    -#+(or)
    -(defun unix-getpriority (which who)
    -  _N"Return the highest priority of any process specified by WHICH and WHO
    -   (see above); if WHO is zero, the current process, process group, or user
    -   (as specified by WHO) is used.  A lower priority number means higher
    -   priority.  Priorities range from PRIO_MIN to PRIO_MAX (above)."
    -  (int-syscall ("getpriority" int int)
    -	       which who))
    -
    -#+(or)
    -(defun unix-setpriority (which who)
    -  _N"Set the priority of all processes specified by WHICH and WHO (see above)
    -   to PRIO.  Returns 0 on success, -1 on errors."
    -  (int-syscall ("setpriority" int int)
    -	       which who))
    -
    -;;; sys/socket.h
    +;; c_oflag bits
    +(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr
    +	  tty-onlret tty-ofill tty-ofdel tty-nldly)
     
    -;;;; Socket support.
    +;; c_lflag bits
    +(def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe
    +	  tty-echok tty-echonl tty-noflsh
    +	  tty-tostop tty-echoctl tty-echoprt
    +	  tty-echoke tty-flusho
    +	  tty-pendin tty-iexten)
     
    -;;; Looks a bit naked.
    +(defun unix-tcgetattr (fd termios)
    +  _N"Get terminal attributes."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
     
    -(def-alien-routine ("socket" unix-socket) int
    -  (domain int)
    -  (type int)
    -  (protocol int))
    +(defun unix-tcsetattr (fd opt termios)
    +  _N"Set terminal attributes."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
     
    -(def-alien-routine ("connect" unix-connect) int
    -  (socket int)
    -  (sockaddr (* t))
    -  (len int))
    +(defconstant writeown #o200 _N"Write by owner")
     
    -(def-alien-routine ("bind" unix-bind) int
    -  (socket int)
    -  (sockaddr (* t))
    -  (len int))
    +;;; termios.h
     
    -(def-alien-routine ("listen" unix-listen) int
    -  (socket int)
    -  (backlog int))
    +(defconstant terminal-speeds
    +  '#(0 50 75 110 134 150 200 300 600 1200 1800 2400
    +     4800 9600 19200 38400 57600 115200 230400))
     
    -(def-alien-routine ("accept" unix-accept) int
    -  (socket int)
    -  (sockaddr (* t))
    -  (len int :in-out))
    -
    -(def-alien-routine ("recv" unix-recv) int
    -  (fd int)
    -  (buffer c-string)
    -  (length int)
    -  (flags int))
    -
    -(def-alien-routine ("send" unix-send) int
    -  (fd int)
    -  (buffer c-string)
    -  (length int)
    -  (flags int))
    -
    -(def-alien-routine ("getpeername" unix-getpeername) int
    -  (socket int)
    -  (sockaddr (* t))
    -  (len (* unsigned)))
    -
    -(def-alien-routine ("getsockname" unix-getsockname) int
    -  (socket int)
    -  (sockaddr (* t))
    -  (len (* unsigned)))
    -
    -(def-alien-routine ("getsockopt" unix-getsockopt) int
    -  (socket int)
    -  (level int)
    -  (optname int)
    -  (optval (* t))
    -  (optlen unsigned :in-out))
    -
    -(def-alien-routine ("setsockopt" unix-setsockopt) int
    -  (socket int)
    -  (level int)
    -  (optname int)
    -  (optval (* t))
    -  (optlen unsigned))
    -
    -;; Datagram support
    -
    -(def-alien-routine ("recvfrom" unix-recvfrom) int
    -  (fd int)
    -  (buffer c-string)
    -  (length int)
    -  (flags int)
    -  (sockaddr (* t))
    -  (len int :in-out))
    -
    -(def-alien-routine ("sendto" unix-sendto) int
    -  (fd int)
    -  (buffer c-string)
    -  (length int)
    -  (flags int)
    -  (sockaddr (* t))
    -  (len int))
    -
    -(def-alien-routine ("shutdown" unix-shutdown) int
    -  (socket int)
    -  (level int))
    -
    -;;; sys/select.h
    -
    -;;; UNIX-FAST-SELECT -- public.
    -;;;
    -(defmacro unix-fast-select (num-descriptors
    -			    read-fds write-fds exception-fds
    -			    timeout-secs &optional (timeout-usecs 0))
    -  _N"Perform the UNIX select(2) system call."
    -  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) 
    -	   (type (or (alien (* (struct fd-set))) null) 
    -		 read-fds write-fds exception-fds) 
    -	   (type (or null (unsigned-byte 31)) timeout-secs) 
    -	   (type (unsigned-byte 31) timeout-usecs) 
    -	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    -  `(let ((timeout-secs ,timeout-secs))
    -     (with-alien ((tv (struct timeval)))
    -       (when timeout-secs
    -	 (setf (slot tv 'tv-sec) timeout-secs)
    -	 (setf (slot tv 'tv-usec) ,timeout-usecs))
    -       (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
    -		     (* (struct fd-set)) (* (struct timeval)))
    -		    ,num-descriptors ,read-fds ,write-fds ,exception-fds
    -		    (if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
    -
    -
    -;;; Unix-select accepts sets of file descriptors and waits for an event
    -;;; to happen on one of them or to time out.
    -
    -(defmacro num-to-fd-set (fdset num)
    -  `(if (fixnump ,num)
    -       (progn
    -	 (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
    -	 ,@(loop for index upfrom 1 below (/ fd-setsize nfdbits)
    -	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
    -       (progn
    -	 ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    -	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
    -			    (ldb (byte nfdbits ,(* index nfdbits)) ,num))))))
    -
    -(defmacro fd-set-to-num (nfds fdset)
    -  `(if (<= ,nfds nfdbits)
    -       (deref (slot ,fdset 'fds-bits) 0)
    -       (+ ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    -	      collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
    -			    ,(* index nfdbits))))))
    -
    -(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
    -  _N"Unix-select examines the sets of descriptors passed as arguments
    -   to see if they are ready for reading and writing.  See the UNIX
    -   Programmers Manual for more information."
    -  (declare (type (integer 0 #.FD-SETSIZE) nfds)
    -	   (type unsigned-byte rdfds wrfds xpfds)
    -	   (type (or (unsigned-byte 31) null) to-secs)
    -	   (type (unsigned-byte 31) to-usecs)
    -	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    -  (with-alien ((tv (struct timeval))
    -	       (rdf (struct fd-set))
    -	       (wrf (struct fd-set))
    -	       (xpf (struct fd-set)))
    -    (when to-secs
    -      (setf (slot tv 'tv-sec) to-secs)
    -      (setf (slot tv 'tv-usec) to-usecs))
    -    (num-to-fd-set rdf rdfds)
    -    (num-to-fd-set wrf wrfds)
    -    (num-to-fd-set xpf xpfds)
    -    (macrolet ((frob (lispvar alienvar)
    -		 `(if (zerop ,lispvar)
    -		      (int-sap 0)
    -		      (alien-sap (addr ,alienvar)))))
    -      (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
    -		(* (struct fd-set)) (* (struct timeval)))
    -	       (values result
    -		       (fd-set-to-num nfds rdf)
    -		       (fd-set-to-num nfds wrf)
    -		       (fd-set-to-num nfds xpf))
    -	       nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
    -	       (if to-secs (alien-sap (addr tv)) (int-sap 0))))))
    -
    -;;; sys/stat.h
    -
    -(defmacro extract-stat-results (buf)
    -  `(values T
    -           #+(or alpha amd64)
    -	   (slot ,buf 'st-dev)
    -           #-(or alpha amd64)
    -           (+ (deref (slot ,buf 'st-dev) 0)
    -	      (* (+ +max-u-long+  1)
    -	         (deref (slot ,buf 'st-dev) 1)))   ;;; let's hope this works..
    -	   (slot ,buf 'st-ino)
    -	   (slot ,buf 'st-mode)
    -	   (slot ,buf 'st-nlink)
    -	   (slot ,buf 'st-uid)
    -	   (slot ,buf 'st-gid)
    -           #+(or alpha amd64)
    -	   (slot ,buf 'st-rdev)
    -           #-(or alpha amd64)
    -           (+ (deref (slot ,buf 'st-rdev) 0)
    -	      (* (+ +max-u-long+  1)
    -	         (deref (slot ,buf 'st-rdev) 1)))   ;;; let's hope this works..
    -	   (slot ,buf 'st-size)
    -	   (slot ,buf 'st-atime)
    -	   (slot ,buf 'st-mtime)
    -	   (slot ,buf 'st-ctime)
    -	   (slot ,buf 'st-blksize)
    -	   (slot ,buf 'st-blocks)))
    -
    -(defun unix-stat (name)
    -  _N"UNIX-STAT retrieves information about the specified
    -   file returning them in the form of multiple values.
    -   See the UNIX Programmer's Manual for a description
    -   of the values returned.  If the call fails, then NIL
    -   and an error number is returned instead."
    -  (declare (type unix-pathname name))
    -  (when (string= name "")
    -    (setf name "."))
    -  (with-alien ((buf (struct stat)))
    -    (syscall ("stat64" c-string (* (struct stat)))
    -	     (extract-stat-results buf)
    -	     (%name->file name) (addr buf))))
    -
    -(defun unix-fstat (fd)
    -  _N"UNIX-FSTAT is similar to UNIX-STAT except the file is specified
    -   by the file descriptor FD."
    -  (declare (type unix-fd fd))
    -  (with-alien ((buf (struct stat)))
    -    (syscall ("fstat64" int (* (struct stat)))
    -	     (extract-stat-results buf)
    -	     fd (addr buf))))
    -
    -(defun unix-lstat (name)
    -  _N"UNIX-LSTAT is similar to UNIX-STAT except the specified
    -   file must be a symbolic link."
    -  (declare (type unix-pathname name))
    -  (with-alien ((buf (struct stat)))
    -    (syscall ("lstat64" c-string (* (struct stat)))
    -	     (extract-stat-results buf)
    -	     (%name->file name) (addr buf))))
    -
    -;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
    -
    -(defun unix-chmod (path mode)
    -  _N"Given a file path string and a constant mode, unix-chmod changes the
    -   permission mode for that file to the one specified. The new mode
    -   can be created by logically OR'ing the following:
    -
    -      setuidexec        Set user ID on execution.
    -      setgidexec        Set group ID on execution.
    -      savetext          Save text image after execution.
    -      readown           Read by owner.
    -      writeown          Write by owner.
    -      execown           Execute (search directory) by owner.
    -      readgrp           Read by group.
    -      writegrp          Write by group.
    -      execgrp           Execute (search directory) by group.
    -      readoth           Read by others.
    -      writeoth          Write by others.
    -      execoth           Execute (search directory) by others.
    -
    -  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
    -  are equivalent for 'mode.  The octal-base is familar to Unix users.
    -  
    -  It returns T on successfully completion; NIL and an error number
    -  otherwise."
    -  (declare (type unix-pathname path)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("chmod" c-string int) (%name->file path) mode))
    -
    -;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
    -;;; ("mode") and changes the protection of the file described by "fd" to 
    -;;; "mode".
    -
    -(defun unix-fchmod (fd mode)
    -  _N"Given an integer file descriptor and a mode (the same as those
    -   used for unix-chmod), unix-fchmod changes the permission mode
    -   for that file to the one specified. T is returned if the call
    -   was successful."
    -  (declare (type unix-fd fd)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("fchmod" int int) fd mode))
    -
    -
    -(defun unix-umask (mask)
    -  _N"Set the file creation mask of the current process to MASK,
    -   and return the old creation mask."
    -  (int-syscall ("umask" mode-t) mask))
    -
    -;;; Unix-mkdir accepts a name and a mode and attempts to create the
    -;;; corresponding directory with mode mode.
    -
    -(defun unix-mkdir (name mode)
    -  _N"Unix-mkdir creates a new directory with the specified name and mode.
    -   (Same as those for unix-chmod.)  It returns T upon success, otherwise
    -   NIL and an error number."
    -  (declare (type unix-pathname name)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("mkdir" c-string int) (%name->file name) mode))
    -
    -#+(or)
    -(defun unix-makedev (path mode dev)
    - _N"Create a device file named PATH, with permission and special bits MODE
    -  and device number DEV (which can be constructed from major and minor
    -  device numbers with the `makedev' macro above)."
    -  (declare (type unix-pathname path)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev))
    -
    -
    -#+(or)
    -(defun unix-fifo (name mode)
    -  _N"Create a new FIFO named PATH, with permission bits MODE."
    -  (declare (type unix-pathname name)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("mkfifo" c-string int) (%name->file name) mode))
    -
    -;;; sys/statfs.h
    -
    -#+(or)
    -(defun unix-statfs (file buf)
    -  _N"Return information about the filesystem on which FILE resides."
    -  (int-syscall ("statfs64" c-string (* (struct statfs)))
    -	       (%name->file file) buf))
    -
    -;;; sys/swap.h
    -
    -#+(or)
    -(defun unix-swapon (path flags)
    - _N"Make the block special device PATH available to the system for swapping.
    -  This call is restricted to the super-user."
    - (int-syscall ("swapon" c-string int) (%name->file path) flags))
    -
    -#+(or)
    -(defun unix-swapoff (path)
    - _N"Make the block special device PATH unavailable to the system for swapping.
    -  This call is restricted to the super-user."
    - (int-syscall ("swapoff" c-string) (%name->file path)))
    -
    -;;; sys/sysctl.h
    -
    -#+(or)
    -(defun unix-sysctl (name nlen oldval oldlenp newval newlen)
    -  _N"Read or write system parameters."
    -  (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t)
    -	       name nlen oldval oldlenp newval newlen))
    -
    -;;; time.h
    -
    -;; POSIX.4 structure for a time value.  This is like a `struct timeval' but
    -;; has nanoseconds instead of microseconds.
    -
    -(def-alien-type nil
    -    (struct timespec
    -	    (tv-sec long)   ;Seconds
    -	    (tv-nsec long))) ;Nanoseconds
    -
    -;; Used by other time functions. 
    -
    -(def-alien-type nil
    -    (struct tm
    -	    (tm-sec int)   ; Seconds.	[0-60] (1 leap second)
    -	    (tm-min int)   ; Minutes.	[0-59]
    -	    (tm-hour int)  ; Hours.	[0-23]
    -	    (tm-mday int)  ; Day.		[1-31]
    -	    (tm-mon int)   ;  Month.	[0-11]
    -	    (tm-year int)  ; Year	- 1900.
    -	    (tm-wday int)  ; Day of week.	[0-6]
    -	    (tm-yday int)  ; Days in year.[0-365]
    -	    (tm-isdst int) ;  DST.		[-1/0/1]
    -	    (tm-gmtoff long) ;  Seconds east of UTC.
    -	    (tm-zone c-string))) ; Timezone abbreviation.  
    -
    -#+(or)
    -(defun unix-clock ()
    -  _N"Time used by the program so far (user time + system time).
    -   The result / CLOCKS_PER_SECOND is program time in seconds."
    -  (int-syscall ("clock")))
    -
    -#+(or)
    -(defun unix-time (timer)
    -  _N"Return the current time and put it in *TIMER if TIMER is not NULL."
    -  (int-syscall ("time" time-t) timer))
    -
    -;; Requires call to tzset() in main.
    -
    -(def-alien-variable ("daylight" unix-daylight) int)
    -(def-alien-variable ("timezone" unix-timezone) time-t)
    -;(def-alien-variable ("altzone" unix-altzone) time-t) doesn't exist
    -(def-alien-variable ("tzname" unix-tzname) (array c-string 2))
    -
    -(def-alien-routine get-timezone c-call:void
    -  (when c-call:long :in)
    -  (minutes-west c-call:int :out)
    -  (daylight-savings-p alien:boolean :out))
    -
    -(defun unix-get-minutes-west (secs)
    -  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    -    (declare (ignore ignore) (ignore dst))
    -    (values minutes)))
    -  
    -(defun unix-get-timezone (secs)
    -  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    -    (declare (ignore ignore) (ignore minutes))
    -    (values (deref unix-tzname (if dst 1 0)))))
    -
    -;;; sys/time.h
    -
    -;; Structure crudely representing a timezone.
    -;;   This is obsolete and should never be used. 
    -(def-alien-type nil
    -  (struct timezone
    -    (tz-minuteswest int)		; minutes west of Greenwich
    -    (tz-dsttime	int)))			; type of dst correction
    -     
    -
    -(declaim (inline unix-gettimeofday))
    -(defun unix-gettimeofday ()
    -  _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and
    -   microseconds of the current time of day, the timezone (in minutes west
    -   of Greenwich), and a daylight-savings flag.  If it doesn't work, it
    -   returns NIL and the errno."
    -  (with-alien ((tv (struct timeval))
    -	       (tz (struct timezone)))
    -    (syscall* ("gettimeofday" (* (struct timeval)) 
    -			      (* (struct timezone)))
    -	      (values T
    -		      (slot tv 'tv-sec)
    -		      (slot tv 'tv-usec)
    -		      (slot tz 'tz-minuteswest)
    -		      (slot tz 'tz-dsttime))
    -	      (addr tv)
    -	      (addr tz))))
    -
    -
    -;/* Set the current time of day and timezone information.
    -;   This call is restricted to the super-user.  */
    -;extern int __settimeofday __P ((__const struct timeval *__tv,
    -;    __const struct timezone *__tz));
    -;extern int settimeofday __P ((__const struct timeval *__tv,
    -;         __const struct timezone *__tz));
    -
    -;/* Adjust the current time of day by the amount in DELTA.
    -;   If OLDDELTA is not NULL, it is filled in with the amount
    -;   of time adjustment remaining to be done from the last `adjtime' call.
    -;   This call is restricted to the super-user.  */
    -;extern int __adjtime __P ((__const struct timeval *__delta,
    -;      struct timeval *__olddelta));
    -;extern int adjtime __P ((__const struct timeval *__delta,
    -;    struct timeval *__olddelta));
    -
    -
    -;; Type of the second argument to `getitimer' and
    -;; the second and third arguments `setitimer'. 
    -(def-alien-type nil
    -  (struct itimerval
    -    (it-interval (struct timeval))	; timer interval
    -    (it-value (struct timeval))))	; current value
    -
    -(defconstant ITIMER-REAL 0)
    -(defconstant ITIMER-VIRTUAL 1)
    -(defconstant ITIMER-PROF 2)
    -
    -(defun unix-getitimer (which)
    -  _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of
    -   three system timers (:real :virtual or :profile). On success,
    -   unix-getitimer returns 5 values,
    -   T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
    -  (declare (type (member :real :virtual :profile) which)
    -	   (values t
    -		   (unsigned-byte 29)(mod 1000000)
    -		   (unsigned-byte 29)(mod 1000000)))
    -  (let ((which (ecase which
    -		 (:real ITIMER-REAL)
    -		 (:virtual ITIMER-VIRTUAL)
    -		 (:profile ITIMER-PROF))))
    -    (with-alien ((itv (struct itimerval)))
    -      (syscall* ("getitimer" int (* (struct itimerval)))
    -		(values T
    -			(slot (slot itv 'it-interval) 'tv-sec)
    -			(slot (slot itv 'it-interval) 'tv-usec)
    -			(slot (slot itv 'it-value) 'tv-sec)
    -			(slot (slot itv 'it-value) 'tv-usec))
    -		which (alien-sap (addr itv))))))
    -
    -(defun unix-setitimer (which int-secs int-usec val-secs val-usec)
    -  _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of
    -   three system timers (:real :virtual or :profile). A SIGALRM signal
    -   will be delivered VALUE <seconds+microseconds> from now. INTERVAL,
    -   when non-zero, is <seconds+microseconds> to be loaded each time
    -   the timer expires. Setting INTERVAL and VALUE to zero disables
    -   the timer. See the Unix man page for more details. On success,
    -   unix-setitimer returns the old contents of the INTERVAL and VALUE
    -   slots as in unix-getitimer."
    -  (declare (type (member :real :virtual :profile) which)
    -	   (type (unsigned-byte 29) int-secs val-secs)
    -	   (type (integer 0 (1000000)) int-usec val-usec)
    -	   (values t
    -		   (unsigned-byte 29)(mod 1000000)
    -		   (unsigned-byte 29)(mod 1000000)))
    -  (let ((which (ecase which
    -		 (:real ITIMER-REAL)
    -		 (:virtual ITIMER-VIRTUAL)
    -		 (:profile ITIMER-PROF))))
    -    (with-alien ((itvn (struct itimerval))
    -		 (itvo (struct itimerval)))
    -      (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs
    -	    (slot (slot itvn 'it-interval) 'tv-usec) int-usec
    -	    (slot (slot itvn 'it-value   ) 'tv-sec ) val-secs
    -	    (slot (slot itvn 'it-value   ) 'tv-usec) val-usec)
    -      (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval)))
    -		(values T
    -			(slot (slot itvo 'it-interval) 'tv-sec)
    -			(slot (slot itvo 'it-interval) 'tv-usec)
    -			(slot (slot itvo 'it-value) 'tv-sec)
    -			(slot (slot itvo 'it-value) 'tv-usec))
    -		which (alien-sap (addr itvn))(alien-sap (addr itvo))))))
    -
    -;;; sys/timeb.h
    -
    -;; Structure returned by the `ftime' function.
    -
    -(def-alien-type nil
    -    (struct timeb
    -	    (time time-t)      ; Seconds since epoch, as from `time'.
    -	    (millitm short)    ; Additional milliseconds.
    -	    (timezone int)     ; Minutes west of GMT.
    -	    (dstflag short)))  ; Nonzero if Daylight Savings Time used. 
    -
    -#+(or)
    -(defun unix-fstime (timebuf)
    -  _N"Fill in TIMEBUF with information about the current time."
    -  (int-syscall ("ftime" (* (struct timeb))) timebuf))
    -
    -
    -;;; sys/times.h
    -
    -;; Structure describing CPU time used by a process and its children.
    -
    -(def-alien-type nil
    -    (struct tms
    -	    (tms-utime clock-t) ; User CPU time.
    -	    (tms-stime clock-t) ; System CPU time.
    -	    (tms-cutime clock-t) ; User CPU time of dead children.
    -	    (tms-cstime clock-t))) ; System CPU time of dead children.
    -
    -#+(or)
    -(defun unix-times (buffer)
    -  _N"Store the CPU time used by this process and all its
    -   dead children (and their dead children) in BUFFER.
    -   Return the elapsed real time, or (clock_t) -1 for errors.
    -   All times are in CLK_TCKths of a second."
    -  (int-syscall ("times" (* (struct tms))) buffer))
    -
    -;;; sys/wait.h
    -
    -#+(or)
    -(defun unix-wait (status)
    -  _N"Wait for a child to die.  When one does, put its status in *STAT_LOC
    -   and return its process ID.  For errors, return (pid_t) -1."
    -  (int-syscall ("wait" (* int)) status))
    -
    -#+(or)
    -(defun unix-waitpid (pid status options)
    -  _N"Wait for a child matching PID to die.
    -   If PID is greater than 0, match any process whose process ID is PID.
    -   If PID is (pid_t) -1, match any process.
    -   If PID is (pid_t) 0, match any process with the
    -   same process group as the current process.
    -   If PID is less than -1, match any process whose
    -   process group is the absolute value of PID.
    -   If the WNOHANG bit is set in OPTIONS, and that child
    -   is not already dead, return (pid_t) 0.  If successful,
    -   return PID and store the dead child's status in STAT_LOC.
    -   Return (pid_t) -1 for errors.  If the WUNTRACED bit is
    -   set in OPTIONS, return status for stopped children; otherwise don't."
    -  (int-syscall ("waitpit" pid-t (* int) int)
    -	       pid status options))
    -
    -;;; asm/errno.h
    -
    -(def-unix-error ESUCCESS 0 _N"Successful")
    -(def-unix-error EPERM 1 _N"Operation not permitted")
    -(def-unix-error ENOENT 2 _N"No such file or directory")
    -(def-unix-error ESRCH 3 _N"No such process")
    -(def-unix-error EINTR 4 _N"Interrupted system call")
    -(def-unix-error EIO 5 _N"I/O error")
    -(def-unix-error ENXIO 6 _N"No such device or address")
    -(def-unix-error E2BIG 7 _N"Arg list too long")
    -(def-unix-error ENOEXEC 8 _N"Exec format error")
    -(def-unix-error EBADF 9 _N"Bad file number")
    -(def-unix-error ECHILD 10 _N"No children")
    -(def-unix-error EAGAIN 11 _N"Try again")
    -(def-unix-error ENOMEM 12 _N"Out of memory")
    -(def-unix-error EACCES 13 _N"Permission denied")
    -(def-unix-error EFAULT 14 _N"Bad address")
    -(def-unix-error ENOTBLK 15 _N"Block device required")
    -(def-unix-error EBUSY 16 _N"Device or resource busy")
    -(def-unix-error EEXIST 17 _N"File exists")
    -(def-unix-error EXDEV 18 _N"Cross-device link")
    -(def-unix-error ENODEV 19 _N"No such device")
    -(def-unix-error ENOTDIR 20 _N"Not a director")
    -(def-unix-error EISDIR 21 _N"Is a directory")
    -(def-unix-error EINVAL 22 _N"Invalid argument")
    -(def-unix-error ENFILE 23 _N"File table overflow")
    -(def-unix-error EMFILE 24 _N"Too many open files")
    -(def-unix-error ENOTTY 25 _N"Not a typewriter")
    -(def-unix-error ETXTBSY 26 _N"Text file busy")
    -(def-unix-error EFBIG 27 _N"File too large")
    -(def-unix-error ENOSPC 28 _N"No space left on device")
    -(def-unix-error ESPIPE 29 _N"Illegal seek")
    -(def-unix-error EROFS 30 _N"Read-only file system")
    -(def-unix-error EMLINK 31 _N"Too many links")
    -(def-unix-error EPIPE 32 _N"Broken pipe")
    -;;; 
    -;;; Math
    -(def-unix-error EDOM 33 _N"Math argument out of domain")
    -(def-unix-error ERANGE 34 _N"Math result not representable")
    -;;; 
    -(def-unix-error  EDEADLK         35     _N"Resource deadlock would occur")
    -(def-unix-error  ENAMETOOLONG    36     _N"File name too long")
    -(def-unix-error  ENOLCK          37     _N"No record locks available")
    -(def-unix-error  ENOSYS          38     _N"Function not implemented")
    -(def-unix-error  ENOTEMPTY       39     _N"Directory not empty")
    -(def-unix-error  ELOOP           40     _N"Too many symbolic links encountered")
    -(def-unix-error  EWOULDBLOCK     11     _N"Operation would block")
    -(def-unix-error  ENOMSG          42     _N"No message of desired type")
    -(def-unix-error  EIDRM           43     _N"Identifier removed")
    -(def-unix-error  ECHRNG          44     _N"Channel number out of range")
    -(def-unix-error  EL2NSYNC        45     _N"Level 2 not synchronized")
    -(def-unix-error  EL3HLT          46     _N"Level 3 halted")
    -(def-unix-error  EL3RST          47     _N"Level 3 reset")
    -(def-unix-error  ELNRNG          48     _N"Link number out of range")
    -(def-unix-error  EUNATCH         49     _N"Protocol driver not attached")
    -(def-unix-error  ENOCSI          50     _N"No CSI structure available")
    -(def-unix-error  EL2HLT          51     _N"Level 2 halted")
    -(def-unix-error  EBADE           52     _N"Invalid exchange")
    -(def-unix-error  EBADR           53     _N"Invalid request descriptor")
    -(def-unix-error  EXFULL          54     _N"Exchange full")
    -(def-unix-error  ENOANO          55     _N"No anode")
    -(def-unix-error  EBADRQC         56     _N"Invalid request code")
    -(def-unix-error  EBADSLT         57     _N"Invalid slot")
    -(def-unix-error  EDEADLOCK       EDEADLK     _N"File locking deadlock error")
    -(def-unix-error  EBFONT          59     _N"Bad font file format")
    -(def-unix-error  ENOSTR          60     _N"Device not a stream")
    -(def-unix-error  ENODATA         61     _N"No data available")
    -(def-unix-error  ETIME           62     _N"Timer expired")
    -(def-unix-error  ENOSR           63     _N"Out of streams resources")
    -(def-unix-error  ENONET          64     _N"Machine is not on the network")
    -(def-unix-error  ENOPKG          65     _N"Package not installed")
    -(def-unix-error  EREMOTE         66     _N"Object is remote")
    -(def-unix-error  ENOLINK         67     _N"Link has been severed")
    -(def-unix-error  EADV            68     _N"Advertise error")
    -(def-unix-error  ESRMNT          69     _N"Srmount error")
    -(def-unix-error  ECOMM           70     _N"Communication error on send")
    -(def-unix-error  EPROTO          71     _N"Protocol error")
    -(def-unix-error  EMULTIHOP       72     _N"Multihop attempted")
    -(def-unix-error  EDOTDOT         73     _N"RFS specific error")
    -(def-unix-error  EBADMSG         74     _N"Not a data message")
    -(def-unix-error  EOVERFLOW       75     _N"Value too large for defined data type")
    -(def-unix-error  ENOTUNIQ        76     _N"Name not unique on network")
    -(def-unix-error  EBADFD          77     _N"File descriptor in bad state")
    -(def-unix-error  EREMCHG         78     _N"Remote address changed")
    -(def-unix-error  ELIBACC         79     _N"Can not access a needed shared library")
    -(def-unix-error  ELIBBAD         80     _N"Accessing a corrupted shared library")
    -(def-unix-error  ELIBSCN         81     _N".lib section in a.out corrupted")
    -(def-unix-error  ELIBMAX         82     _N"Attempting to link in too many shared libraries")
    -(def-unix-error  ELIBEXEC        83     _N"Cannot exec a shared library directly")
    -(def-unix-error  EILSEQ          84     _N"Illegal byte sequence")
    -(def-unix-error  ERESTART        85     _N"Interrupted system call should be restarted _N")
    -(def-unix-error  ESTRPIPE        86     _N"Streams pipe error")
    -(def-unix-error  EUSERS          87     _N"Too many users")
    -(def-unix-error  ENOTSOCK        88     _N"Socket operation on non-socket")
    -(def-unix-error  EDESTADDRREQ    89     _N"Destination address required")
    -(def-unix-error  EMSGSIZE        90     _N"Message too long")
    -(def-unix-error  EPROTOTYPE      91     _N"Protocol wrong type for socket")
    -(def-unix-error  ENOPROTOOPT     92     _N"Protocol not available")
    -(def-unix-error  EPROTONOSUPPORT 93     _N"Protocol not supported")
    -(def-unix-error  ESOCKTNOSUPPORT 94     _N"Socket type not supported")
    -(def-unix-error  EOPNOTSUPP      95     _N"Operation not supported on transport endpoint")
    -(def-unix-error  EPFNOSUPPORT    96     _N"Protocol family not supported")
    -(def-unix-error  EAFNOSUPPORT    97     _N"Address family not supported by protocol")
    -(def-unix-error  EADDRINUSE      98     _N"Address already in use")
    -(def-unix-error  EADDRNOTAVAIL   99     _N"Cannot assign requested address")
    -(def-unix-error  ENETDOWN        100    _N"Network is down")
    -(def-unix-error  ENETUNREACH     101    _N"Network is unreachable")
    -(def-unix-error  ENETRESET       102    _N"Network dropped connection because of reset")
    -(def-unix-error  ECONNABORTED    103    _N"Software caused connection abort")
    -(def-unix-error  ECONNRESET      104    _N"Connection reset by peer")
    -(def-unix-error  ENOBUFS         105    _N"No buffer space available")
    -(def-unix-error  EISCONN         106    _N"Transport endpoint is already connected")
    -(def-unix-error  ENOTCONN        107    _N"Transport endpoint is not connected")
    -(def-unix-error  ESHUTDOWN       108    _N"Cannot send after transport endpoint shutdown")
    -(def-unix-error  ETOOMANYREFS    109    _N"Too many references: cannot splice")
    -(def-unix-error  ETIMEDOUT       110    _N"Connection timed out")
    -(def-unix-error  ECONNREFUSED    111    _N"Connection refused")
    -(def-unix-error  EHOSTDOWN       112    _N"Host is down")
    -(def-unix-error  EHOSTUNREACH    113    _N"No route to host")
    -(def-unix-error  EALREADY        114    _N"Operation already in progress")
    -(def-unix-error  EINPROGRESS     115    _N"Operation now in progress")
    -(def-unix-error  ESTALE          116    _N"Stale NFS file handle")
    -(def-unix-error  EUCLEAN         117    _N"Structure needs cleaning")
    -(def-unix-error  ENOTNAM         118    _N"Not a XENIX named type file")
    -(def-unix-error  ENAVAIL         119    _N"No XENIX semaphores available")
    -(def-unix-error  EISNAM          120    _N"Is a named type file")
    -(def-unix-error  EREMOTEIO       121    _N"Remote I/O error")
    -(def-unix-error  EDQUOT          122    _N"Quota exceeded")
    -
    -;;; And now for something completely different ...
    -(emit-unix-errors)
    -
    -;;; the ioctl's.
    -;;;
    -;;; I've deleted all the stuff that wasn't in the header files.
    -;;; This is what survived.
    -
    -;; 0x54 is just a magic number to make these relatively unique ('T')
    -
    -(eval-when (compile load eval)
    -
    -(defconstant iocparm-mask #x3fff)
    -(defconstant ioc_void #x00000000)
    -(defconstant ioc_out #x40000000)
    -(defconstant ioc_in #x80000000)
    -(defconstant ioc_inout (logior ioc_in ioc_out))
    -
    -(defmacro define-ioctl-command (name dev cmd &optional arg parm-type)
    -  _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given
    -  then ioctl argument size and direction are included as for ioctls defined
    -  by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type
    -  is the characters code, else DEV may be an integer giving the type."
    -  (let* ((type (if (characterp dev)
    -		   (char-code dev)
    -		   dev))
    -	 (code (logior (ash type 8) cmd)))
    -    (when arg
    -      (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask)
    -			       16)
    -			  ,code)))
    -    (when parm-type
    -      (let ((dir (ecase parm-type
    -		   (:void ioc_void)
    -		   (:in ioc_in)
    -		   (:out ioc_out)
    -		   (:inout ioc_inout))))
    -	(setf code `(logior ,dir ,code))))
    -    `(eval-when (eval load compile)
    -       (defconstant ,name ,code))))
    -
    -)
    -
    -;;; TTY ioctl commands.
    -
    -(define-ioctl-command TIOCGWINSZ #\T #x13)
    -(define-ioctl-command TIOCSWINSZ #\T #x14)
    -(define-ioctl-command TIOCNOTTY  #\T #x22)
    -(define-ioctl-command TIOCSPGRP  #\T #x10)
    -(define-ioctl-command TIOCGPGRP  #\T #x0F)
    -
    -;;; File ioctl commands.
    -(define-ioctl-command FIONREAD #\T #x1B)
    -
    -;;; asm/sockios.h
    -
    -;;; Socket options.
    -
    -(define-ioctl-command SIOCSPGRP #x89 #x02)
    -
    -(defun siocspgrp (fd pgrp)
    -  _N"Set the socket process-group for the unix file-descriptor FD to PGRP."
    -  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    -    (unix-ioctl fd
    -		siocspgrp
    -		(alien:alien-sap (alien:addr alien-pgrp)))))
    -
    -;;; A few random constants and functions
    -
    -(defconstant setuidexec #o4000 _N"Set user ID on execution")
    -(defconstant setgidexec #o2000 _N"Set group ID on execution")
    -(defconstant savetext #o1000 _N"Save text image after execution")
    -(defconstant readown #o400 _N"Read by owner")
    -(defconstant writeown #o200 _N"Write by owner")
    -(defconstant execown #o100 _N"Execute (search directory) by owner")
    -(defconstant readgrp #o40 _N"Read by group")
    -(defconstant writegrp #o20 _N"Write by group")
    -(defconstant execgrp #o10 _N"Execute (search directory) by group")
    -(defconstant readoth #o4 _N"Read by others")
    -(defconstant writeoth #o2 _N"Write by others")
    -(defconstant execoth #o1 _N"Execute (search directory) by others")
    -
    -(defconstant terminal-speeds
    -  '#(0 50 75 110 134 150 200 300 600 1200 1800 2400
    -     4800 9600 19200 38400 57600 115200 230400))
    -
    -;;;; Support routines for dealing with unix pathnames.
    -
    -(export '(unix-file-kind unix-maybe-prepend-current-directory
    -	  unix-resolve-links unix-simplify-pathname))
    -
    -(defun unix-file-kind (name &optional check-for-links)
    -  _N"Returns either :file, :directory, :link, :special, or NIL."
    -  (declare (simple-string name))
    -  (multiple-value-bind (res dev ino mode)
    -		       (if check-for-links
    -			   (unix-lstat name)
    -			   (unix-stat name))
    -    (declare (type (or fixnum null) mode)
    -	     (ignore dev ino))
    -    (when res
    -      (let ((kind (logand mode s-ifmt)))
    -	(cond ((eql kind s-ifdir) :directory)
    -	      ((eql kind s-ifreg) :file)
    -	      ((eql kind s-iflnk) :link)
    -	      (t :special))))))
    -
    -(defun unix-maybe-prepend-current-directory (name)
    -  (declare (simple-string name))
    -  (if (and (> (length name) 0) (char= (schar name 0) #\/))
    -      name
    -      (multiple-value-bind (win dir) (unix-current-directory)
    -	(if win
    -	    (concatenate 'simple-string dir "/" name)
    -	    name))))
    -
    -(defun unix-resolve-links (pathname)
    -  _N"Returns the pathname with all symbolic links resolved."
    -  (declare (simple-string pathname))
    -  (let ((len (length pathname))
    -	(pending pathname))
    -    (declare (fixnum len) (simple-string pending))
    -    (if (zerop len)
    -	pathname
    -	(let ((result (make-string 100 :initial-element (code-char 0)))
    -	      (fill-ptr 0)
    -	      (name-start 0))
    -	  (loop
    -	    (let* ((name-end (or (position #\/ pending :start name-start) len))
    -		   (new-fill-ptr (+ fill-ptr (- name-end name-start))))
    -	      ;; grow the result string, if necessary.  the ">=" (instead of
    -	      ;; using ">") allows for the trailing "/" if we find this
    -	      ;; component is a directory.
    -	      (when (>= new-fill-ptr (length result))
    -		(let ((longer (make-string (* 3 (length result))
    -					   :initial-element (code-char 0))))
    -		  (replace longer result :end1 fill-ptr)
    -		  (setq result longer)))
    -	      (replace result pending
    -		       :start1 fill-ptr
    -		       :end1 new-fill-ptr
    -		       :start2 name-start
    -		       :end2 name-end)
    -	      (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t)))
    -		(unless kind (return nil))
    -		(cond ((eq kind :link)
    -		       (multiple-value-bind (link err) (unix-readlink result)
    -			 (unless link
    -			   (error (intl:gettext "Error reading link ~S: ~S")
    -				  (subseq result 0 fill-ptr)
    -				  (get-unix-error-msg err)))
    -			 (cond ((or (zerop (length link))
    -				    (char/= (schar link 0) #\/))
    -				;; It's a relative link
    -				(fill result (code-char 0)
    -				      :start fill-ptr
    -				      :end new-fill-ptr))
    -			       ((string= result "/../" :end1 4)
    -				;; It's across the super-root.
    -				(let ((slash (or (position #\/ result :start 4)
    -						 0)))
    -				  (fill result (code-char 0)
    -					:start slash
    -					:end new-fill-ptr)
    -				  (setf fill-ptr slash)))
    -			       (t
    -				;; It's absolute.
    -				(and (> (length link) 0)
    -				     (char= (schar link 0) #\/))
    -				(fill result (code-char 0) :end new-fill-ptr)
    -				(setf fill-ptr 0)))
    -			 (setf pending
    -			       (if (= name-end len)
    -				   link
    -				   (concatenate 'simple-string
    -						link
    -						(subseq pending name-end))))
    -			 (setf len (length pending))
    -			 (setf name-start 0)))
    -		      ((= name-end len)
    -		       (when (eq kind :directory)
    -			 (setf (schar result new-fill-ptr) #\/)
    -			 (incf new-fill-ptr))
    -		       (return (subseq result 0 new-fill-ptr)))
    -		      ((eq kind :directory)
    -		       (setf (schar result new-fill-ptr) #\/)
    -		       (setf fill-ptr (1+ new-fill-ptr))
    -		       (setf name-start (1+ name-end)))
    -		      (t
    -		       (return nil))))))))))
    -
    -(defun unix-simplify-pathname (src)
    -  (declare (simple-string src))
    -  (let* ((src-len (length src))
    -	 (dst (make-string src-len))
    -	 (dst-len 0)
    -	 (dots 0)
    -	 (last-slash nil))
    -    (macrolet ((deposit (char)
    -			`(progn
    -			   (setf (schar dst dst-len) ,char)
    -			   (incf dst-len))))
    -      (dotimes (src-index src-len)
    -	(let ((char (schar src src-index)))
    -	  (cond ((char= char #\.)
    -		 (when dots
    -		   (incf dots))
    -		 (deposit char))
    -		((char= char #\/)
    -		 (case dots
    -		   (0
    -		    ;; Either ``/...' or ``...//...'
    -		    (unless last-slash
    -		      (setf last-slash dst-len)
    -		      (deposit char)))
    -		   (1
    -		    ;; Either ``./...'' or ``..././...''
    -		    (decf dst-len))
    -		   (2
    -		    ;; We've found ..
    -		    (cond
    -		     ((and last-slash (not (zerop last-slash)))
    -		      ;; There is something before this ..
    -		      (let ((prev-prev-slash
    -			     (position #\/ dst :end last-slash :from-end t)))
    -			(cond ((and (= (+ (or prev-prev-slash 0) 2)
    -				       last-slash)
    -				    (char= (schar dst (- last-slash 2)) #\.)
    -				    (char= (schar dst (1- last-slash)) #\.))
    -			       ;; The something before this .. is another ..
    -			       (deposit char)
    -			       (setf last-slash dst-len))
    -			      (t
    -			       ;; The something is some random dir.
    -			       (setf dst-len
    -				     (if prev-prev-slash
    -					 (1+ prev-prev-slash)
    -					 0))
    -			       (setf last-slash prev-prev-slash)))))
    -		     (t
    -		      ;; There is nothing before this .., so we need to keep it
    -		      (setf last-slash dst-len)
    -		      (deposit char))))
    -		   (t
    -		    ;; Something other than a dot between slashes.
    -		    (setf last-slash dst-len)
    -		    (deposit char)))
    -		 (setf dots 0))
    -		(t
    -		 (setf dots nil)
    -		 (setf (schar dst dst-len) char)
    -		 (incf dst-len))))))
    -    (when (and last-slash (not (zerop last-slash)))
    -      (case dots
    -	(1
    -	 ;; We've got  ``foobar/.''
    -	 (decf dst-len))
    -	(2
    -	 ;; We've got ``foobar/..''
    -	 (unless (and (>= last-slash 2)
    -		      (char= (schar dst (1- last-slash)) #\.)
    -		      (char= (schar dst (- last-slash 2)) #\.)
    -		      (or (= last-slash 2)
    -			  (char= (schar dst (- last-slash 3)) #\/)))
    -	   (let ((prev-prev-slash
    -		  (position #\/ dst :end last-slash :from-end t)))
    -	     (if prev-prev-slash
    -		 (setf dst-len (1+ prev-prev-slash))
    -		 (return-from unix-simplify-pathname "./")))))))
    -    (cond ((zerop dst-len)
    -	   "./")
    -	  ((= dst-len src-len)
    -	   dst)
    -	  (t
    -	   (subseq dst 0 dst-len)))))
    -
    -;;;
    -;;; STRING-LIST-TO-C-STRVEC	-- Internal
    -;;; 
    -;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of
    -;;; simple-strings and constructs a C-style string vector (strvec) --
    -;;; a null-terminated array of pointers to null-terminated strings.
    -;;; This function returns two values: a sap and a byte count.  When the
    -;;; memory is no longer needed it should be deallocated with
    -;;; vm_deallocate.
    -;;; 
    -(defun string-list-to-c-strvec (string-list)
    -  ;;
    -  ;; Make a pass over string-list to calculate the amount of memory
    -  ;; needed to hold the strvec.
    -  (let ((string-bytes 0)
    -	(vec-bytes (* 4 (1+ (length string-list)))))
    -    (declare (fixnum string-bytes vec-bytes))
    -    (dolist (s string-list)
    -      (check-type s simple-string)
    -      (incf string-bytes (round-bytes-to-words (1+ (length s)))))
    -    ;;
    -    ;; Now allocate the memory and fill it in.
    -    (let* ((total-bytes (+ string-bytes vec-bytes))
    -	   (vec-sap (system:allocate-system-memory total-bytes))
    -	   (string-sap (sap+ vec-sap vec-bytes))
    -	   (i 0))
    -      (declare (type (and unsigned-byte fixnum) total-bytes i)
    -	       (type system:system-area-pointer vec-sap string-sap))
    -      (dolist (s string-list)
    -	(declare (simple-string s))
    -	(let ((n (length s)))
    -	  ;; 
    -	  ;; Blast the string into place
    -	  #-unicode
    -	  (kernel:copy-to-system-area (the simple-string s)
    -				      (* vm:vector-data-offset vm:word-bits)
    -				      string-sap 0
    -				      (* (1+ n) vm:byte-bits))
    -	  #+unicode
    -	  (progn
    -	    ;; FIXME: Do we need to apply some kind of transformation
    -	    ;; to convert Lisp unicode strings to C strings?  Utf-8?
    -	    (dotimes (k n)
    -	      (setf (sap-ref-8 string-sap k)
    -		    (logand #xff (char-code (aref s k)))))
    -	    (setf (sap-ref-8 string-sap n) 0))
    -	  ;; 
    -	  ;; Blast the pointer to the string into place
    -	  (setf (sap-ref-sap vec-sap i) string-sap)
    -	  (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
    -	  (incf i 4)))
    -      ;; Blast in last null pointer
    -      (setf (sap-ref-sap vec-sap i) (int-sap 0))
    -      (values vec-sap total-bytes))))
    -
    -;;; Stuff not yet found in the header files...
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    -;;; Abandon all hope who enters here...
    -
    -
    -;; not checked for linux...
    -(defmacro fd-set (offset fd-set)
    -  (let ((word (gensym))
    -	(bit (gensym)))
    -    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    -       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    -	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
    -		     (deref (slot ,fd-set 'fds-bits) ,word))))))
    -
    -;; not checked for linux...
    -(defmacro fd-clr (offset fd-set)
    -  (let ((word (gensym))
    -	(bit (gensym)))
    -    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    -       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    -	     (logand (deref (slot ,fd-set 'fds-bits) ,word)
    -		     (32bit-logical-not
    -		      (truly-the (unsigned-byte 32) (ash 1 ,bit))))))))
    -
    -;; not checked for linux...
    -(defmacro fd-isset (offset fd-set)
    -  (let ((word (gensym))
    -	(bit (gensym)))
    -    `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
    -       (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
    -
    -;; not checked for linux...
    -(defmacro fd-zero (fd-set)
    -  `(progn
    -     ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
    -	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
    -
    -
    -
    -
    -;;;; User and group database access, POSIX Standard 9.2.2
    -
    -(defun unix-getpwnam (login)
    -  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    -  (declare (type simple-string login))
    -  (with-alien ((buf (array c-call:char 1024))
    -	       (user-info (struct passwd))
    -               (result (* (struct passwd))))
    -    (let ((returned
    -	   (alien-funcall
    -	    (extern-alien "getpwnam_r"
    -			  (function c-call:int
    -                                    c-call:c-string
    -                                    (* (struct passwd))
    -				    (* c-call:char)
    -                                    c-call:unsigned-int
    -                                    (* (* (struct passwd)))))
    -	    login
    -	    (addr user-info)
    -	    (cast buf (* c-call:char))
    -	    1024
    -            (addr result))))
    -      (when (zerop returned)
    -        (make-user-info
    -         :name (string (cast (slot result 'pw-name) c-call:c-string))
    -         :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    -         :uid (slot result 'pw-uid)
    -         :gid (slot result 'pw-gid)
    -         :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    -         :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    -         :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    -
    -(defun unix-getpwuid (uid)
    -  _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
    -  (declare (type unix-uid uid))
    -  (with-alien ((buf (array c-call:char 1024))
    -	       (user-info (struct passwd))
    -               (result (* (struct passwd))))
    -    (let ((returned
    -	   (alien-funcall
    -	    (extern-alien "getpwuid_r"
    -			  (function c-call:int
    -                                    c-call:unsigned-int
    -                                    (* (struct passwd))
    -                                    (* c-call:char)
    -                                    c-call:unsigned-int
    -                                    (* (* (struct passwd)))))
    -	    uid
    -	    (addr user-info)
    -	    (cast buf (* c-call:char))
    -	    1024
    -            (addr result))))
    -      (when (zerop returned)
    -        (make-user-info
    -         :name (string (cast (slot result 'pw-name) c-call:c-string))
    -         :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    -         :uid (slot result 'pw-uid)
    -         :gid (slot result 'pw-gid)
    -         :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    -         :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    -         :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    -
    -(defun unix-getgrnam (name)
    -  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    -  (declare (type simple-string name))
    -  (with-alien ((buf (array c-call:char 2048))
    -	       (group-info (struct group))
    -               (result (* (struct group))))
    -    (let ((returned
    -	   (alien-funcall
    -	    (extern-alien "getgrnam_r"
    -			  (function c-call:int
    -                                    c-call:c-string
    -                                    (* (struct group))
    -                                    (* c-call:char)
    -                                    c-call:unsigned-int
    -                                    (* (* (struct group)))))
    -	    name
    -	    (addr group-info)
    -	    (cast buf (* c-call:char))
    -	    2048
    -            (addr result))))
    -      (when (zerop returned)
    -        (make-group-info
    -         :name (string (cast (slot result 'gr-name) c-call:c-string))
    -         :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -         :gid (slot result 'gr-gid)
    -         :members (loop :with members = (slot result 'gr-mem)
    -                        :for i :from 0
    -                        :for member = (deref members i)
    -                        :until (zerop (sap-int (alien-sap member)))
    -                        :collect (string (cast member c-call:c-string))))))))
    -
    -(defun unix-getgrgid (gid)
    -  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    -  (declare (type unix-gid gid))
    -  (with-alien ((buf (array c-call:char 2048))
    -	       (group-info (struct group))
    -               (result (* (struct group))))
    -    (let ((returned
    -	   (alien-funcall
    -	    (extern-alien "getgrgid_r"
    -			  (function c-call:int
    -                                    c-call:unsigned-int
    -                                    (* (struct group))
    -                                    (* c-call:char)
    -                                    c-call:unsigned-int
    -                                    (* (* (struct group)))))
    -	    gid
    -	    (addr group-info)
    -	    (cast buf (* c-call:char))
    -	    2048
    -            (addr result))))
    -      (when (zerop returned)
    -        (make-group-info
    -         :name (string (cast (slot result 'gr-name) c-call:c-string))
    -         :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -         :gid (slot result 'gr-gid)
    -         :members (loop :with members = (slot result 'gr-mem)
    -                        :for i :from 0
    -                        :for member = (deref members i)
    -                        :until (zerop (sap-int (alien-sap member)))
    -                        :collect (string (cast member c-call:c-string))))))))
    -
    -
    -;; EOF
    +(defun unix-cfgetospeed (termios)
    +  _N"Get terminal output speed."
    +  (multiple-value-bind (speed errno)
    +      (int-syscall ("cfgetospeed" (* (struct termios))) termios)
    +    (if speed
    +	(values (svref terminal-speeds speed) 0)
    +      (values speed errno))))
    

  • src/code/unix.lisp
    --- a/src/code/unix.lisp
    +++ b/src/code/unix.lisp
    @@ -9,15 +9,15 @@
     ;;;
     ;;; **********************************************************************
     ;;;
    -;;; This file contains the UNIX low-level support.
    +;;; This file contains the UNIX low-level support, just enough to run
    +;;; CMUCL.
     ;;;
     (in-package "UNIX")
    -(use-package "ALIEN")
    -(use-package "C-CALL")
    -(use-package "SYSTEM")
    -(use-package "EXT")
    +
     (intl:textdomain "cmucl-unix")
     
    +(pushnew :unix *features*)
    +
     ;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding
     ;; is locale-dependent...else use :utf-8 on Unicode Lisps.  On 8 bit Lisps
     ;; it must be set to :iso8859-1 (or left as NIL), making files with
    @@ -25,172 +25,7 @@
     ;; Must be set to NIL initially to enable building Lisp!
     (defvar *filename-encoding* nil)
     
    -(export '(daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
    -	  timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
    -	  itimerval it-interval it-value tchars t-intrc t-quitc t-startc
    -	  t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
    -	  t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
    -	  sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
    -	  direct d-off d-ino d-reclen #-(or linux svr4) d-namlen d-name
    -	  stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
    -	  st-atime st-mtime st-ctime st-blksize st-blocks
    -	  s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
    -	  s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
    -	  ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
    -	  ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
    -	  ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
    -	  rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
    -
    -	  unix-errno get-unix-error-msg
    -
    -	  prot_read prot_write prot_exec prot_none
    -	  map_shared map_private map_fixed map_anonymous
    -	  ms_async ms_sync ms_invalidate
    -	  unix-mmap unix-munmap unix-msync
    -	  unix-mprotect
    -
    -	  unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
    -	  unix-setitimer unix-getitimer
    -	  unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
    -	  setgidexec savetext readown writeown execown readgrp writegrp
    -	  execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
    -	  unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
    -	  unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
    -	  fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
    -	  l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
    -	  #+(or hpux svr4 bsd linux) o_ndelay
    -	  #+(or hpux svr4 bsd linux) o_noctty #+(or hpux svr4 bsd) o_nonblock
    -	  o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
    -	  unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
    -	  fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
    -	  unix-ftruncate unix-symlink
    -	  #+(and sparc svr4) unix-times
    -	  unix-unlink unix-write unix-ioctl
    -	  tcsetpgrp tcgetpgrp tty-process-group
    -	  terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
    -	  #-hpux tty-cbreak #-(or hpux linux) tty-tandem
    -	  #+(or hpux svr4 linux bsd) termios
    -          #+(or hpux svr4 linux bsd) c-lflag
    -	  #+(or hpux svr4 linux bsd) c-iflag
    -          #+(or hpux svr4 linux bsd) c-oflag
    -	  #+(or hpux svr4 linux bsd) tty-icrnl
    -          #+(or hpux svr4 linux) tty-ocrnl
    -	  #+(or hpux svr4 bsd) vdsusp #+(or hpux svr4 linux bsd) veof
    -	  #+(or hpux svr4 linux bsd) vintr
    -          #+(or hpux svr4 linux bsd) vquit
    -          #+(or hpux svr4 linux bsd) vstart
    -	  #+(or hpux svr4 linux bsd) vstop
    -          #+(or hpux svr4 linux bsd) vsusp
    -	  #+(or hpux svr4 linux bsd) c-cflag
    -	  #+(or hpux svr4 linux bsd) c-cc
    -	  #+(or bsd osf1) c-ispeed
    -	  #+(or bsd osf1) c-ospeed
    -          #+(or hpux svr4 linux bsd) tty-icanon
    -	  #+(or hpux svr4 linux bsd) vmin
    -          #+(or hpux svr4 linux bsd) vtime
    -	  #+(or hpux svr4 linux bsd) tty-ixon
    -          #+(or hpux svr4 linux bsd) tcsanow
    -          #+(or hpux svr4 linux bsd) tcsadrain
    -          #+(or hpux svr4 linux bsd) tciflush
    -          #+(or hpux svr4 linux bsd) tcoflush
    -          #+(or hpux svr4 linux bsd) tcioflush
    -	  #+(or hpux svr4 linux bsd) tcsaflush
    -          #+(or hpux svr4 linux bsd) unix-tcgetattr
    -          #+(or hpux svr4 linux bsd) unix-tcsetattr
    -          #+(or hpux svr4 bsd) unix-cfgetospeed
    -          #+(or hpux svr4 bsd) unix-cfsetospeed
    -          #+(or hpux svr4 bsd) unix-cfgetispeed
    -          #+(or hpux svr4 bsd) unix-cfsetispeed
    -          #+(or hpux svr4 linux bsd) tty-ignbrk
    -          #+(or hpux svr4 linux bsd) tty-brkint
    -          #+(or hpux svr4 linux bsd) tty-ignpar
    -          #+(or hpux svr4 linux bsd) tty-parmrk
    -          #+(or hpux svr4 linux bsd) tty-inpck
    -          #+(or hpux svr4 linux bsd) tty-istrip
    -          #+(or hpux svr4 linux bsd) tty-inlcr
    -          #+(or hpux svr4 linux bsd) tty-igncr
    -          #+(or hpux svr4 linux) tty-iuclc
    -          #+(or hpux svr4 linux bsd) tty-ixany
    -          #+(or hpux svr4 linux bsd) tty-ixoff
    -          #+hpux tty-ienqak
    -          #+(or hpux irix solaris linux bsd) tty-imaxbel
    -          #+(or hpux svr4 linux bsd) tty-opost
    -          #+(or hpux svr4 linux) tty-olcuc
    -          #+(or hpux svr4 linux bsd) tty-onlcr
    -          #+(or hpux svr4 linux) tty-onocr
    -          #+(or hpux svr4 linux) tty-onlret
    -          #+(or hpux svr4 linux) tty-ofill
    -          #+(or hpux svr4 linux) tty-ofdel
    -          #+(or hpux svr4 linux bsd) tty-isig
    -          #+(or hpux svr4 linux) tty-xcase
    -          #+(or hpux svr4 linux bsd) tty-echoe
    -          #+(or hpux svr4 linux bsd) tty-echok
    -          #+(or hpux svr4 linux bsd) tty-echonl
    -          #+(or hpux svr4 linux bsd) tty-noflsh
    -          #+(or hpux svr4 linux bsd) tty-iexten
    -          #+(or hpux svr4 linux bsd) tty-tostop
    -          #+(or hpux irix solaris linux bsd) tty-echoctl
    -          #+(or hpux irix solaris linux bsd) tty-echoprt
    -          #+(or hpux irix solaris linux bsd) tty-echoke
    -          #+(or hpux irix solaris) tty-defecho
    -          #+(or hpux irix solaris bsd) tty-flusho
    -          #+(or hpux irix solaris linux bsd) tty-pendin
    -          #+(or hpux svr4 linux bsd) tty-cstopb
    -          #+(or hpux svr4 linux bsd) tty-cread
    -          #+(or hpux svr4 linux bsd) tty-parenb
    -          #+(or hpux svr4 linux bsd) tty-parodd
    -          #+(or hpux svr4 linux bsd) tty-hupcl
    -          #+(or hpux svr4 linux bsd) tty-clocal
    -          #+(or irix solaris) rcv1en
    -          #+(or irix solaris) xmt1en
    -          #+(or hpux irix solaris) tty-loblk
    -          #+(or hpux svr4 linux bsd) vintr
    -          #+(or hpux svr4 linux bsd) verase
    -          #+(or hpux svr4 linux bsd) vkill
    -          #+(or hpux svr4 linux bsd) veol
    -          #+(or hpux irix solaris linux bsd) veol2
    -          #+(or hpux irix solaris) tty-cbaud
    -          #+(or hpux svr4 bsd) tty-csize #+(or hpux svr4 bsd) tty-cs5
    -          #+(or hpux svr4 bsd) tty-cs6 #+(or hpux svr4 bsd) tty-cs7
    -          #+(or hpux svr4 bsd) tty-cs8
    -          #+(or hpux svr4 bsd) unix-tcsendbreak
    -          #+(or hpux svr4 bsd) unix-tcdrain
    -          #+(or hpux svr4 bsd) unix-tcflush
    -          #+(or hpux svr4 bsd) unix-tcflow
    -          
    -	  TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
    -	  TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
    -	  TIOCSIGSEND
    -
    -	  KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
    -	  KBDSCLICK FIONREAD #+(or hpux bsd) siocspgrp
    -	  unix-exit unix-stat unix-lstat unix-fstat
    -	  unix-getrusage unix-fast-getrusage rusage_self rusage_children
    -	  unix-gettimeofday
    -	  #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid
    -	  #-(or svr4 hpux) unix-setregid
    -	  unix-getpid unix-getppid
    -	  #+(or svr4 bsd)unix-setpgid
    -	  unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
    -	  unix-getpagesize unix-gethostname unix-gethostid unix-fork
    -	  unix-getenv unix-setenv unix-putenv unix-unsetenv
    -	  unix-current-directory unix-isatty unix-ttyname unix-execve
    -	  unix-socket unix-connect unix-bind unix-listen unix-accept
    -	  unix-recv unix-send unix-getpeername unix-getsockname
    -	  unix-getsockopt unix-setsockopt unix-openpty
    -
    -	  unix-recvfrom unix-sendto unix-shutdown
    -	  
    -          unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid
    -          user-info user-info-name user-info-password user-info-uid
    -          user-info-gid user-info-gecos user-info-dir user-info-shell
    -          group-info group-info-name group-info-gid group-info-members
    -
    -	  unix-uname))
    -
    -(pushnew :unix *features*)
    -
    -(eval-when (:compile-toplevel)
    +(eval-when (:compile-toplevel :load-toplevel :execute)
       (defmacro %name->file (string)
         `(if *filename-encoding*
     	 (string-encode ,string *filename-encoding*)
    @@ -203,24 +38,15 @@
     
     ;;;; Common machine independent structures.
     
    -;;; From sys/types.h
    -
     (def-alien-type int64-t (signed 64))
    -(def-alien-type u-int64-t (unsigned 64))
    -
    -(def-alien-type daddr-t
    -    #-(or linux alpha) long
    -    #+(or linux alpha) int)
     
    -(def-alien-type caddr-t (* char))
    +(def-alien-type u-int64-t (unsigned 64))
     
     (def-alien-type ino-t
         #+netbsd u-int64-t
         #+alpha unsigned-int
         #-(or alpha netbsd) unsigned-long)
     
    -(def-alien-type swblk-t long)
    -
     (def-alien-type size-t
         #-(or linux alpha) long
         #+linux unsigned-int 
    @@ -262,55 +88,11 @@
       (def-alien-type uid-t unsigned-long)
       (def-alien-type gid-t unsigned-long))
     
    -;;; Large file support for Solaris.  Define some of the 64-bit types
    -;;; we need.  Unlike unix-glibc's large file support, Solaris's
    -;;; version is a little simpler because all of the 64-bit versions of
    -;;; the functions actually exist as functions.  So instead of calling
    -;;; the 32-bit versions of the functions, we call the 64-bit versions.
    -;;;
    -;;; These functions are: creat64, open64, truncate64, ftruncate64,
    -;;; stat64, lstat64, fstat64, readdir64.
    -;;;
    -;;; There are also some new structures for large file support:
    -;;; dirent64, stat64.
    -;;;
    -;;; FIXME: We should abstract this better, but I (rtoy) don't have any
    -;;; other system to test this out on, so it's a Solaris hack for now.
    -#+solaris
    -(progn
    -  (deftype file-offset64 () '(signed-byte 64))
    -  (def-alien-type off64-t int64-t)
    -  (def-alien-type ino64-t u-int64-t)
    -  (def-alien-type blkcnt64-t u-int64-t))
    -
     (def-alien-type mode-t
         #-(or alpha svr4) unsigned-short
         #+alpha unsigned-int
         #+svr4 unsigned-long)
     
    -(def-alien-type nlink-t
    -    #-(or svr4 netbsd) unsigned-short
    -    #+netbsd unsigned-long
    -    #+svr4 unsigned-long)
    -
    -(defconstant FD-SETSIZE
    -  #-(or hpux alpha linux FreeBSD) 256
    -  #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024)
    -
    -;; not checked for linux...
    -(def-alien-type nil
    -  (struct fd-set
    -    (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32)))))
    -
    -;; not checked for linux...
    -(defmacro fd-set (offset fd-set)
    -  (let ((word (gensym))
    -	(bit (gensym)))
    -    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
    -       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    -	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
    -		     (deref (slot ,fd-set 'fds-bits) ,word))))))
    -
     ;; not checked for linux...
     (defmacro fd-clr (offset fd-set)
       (let ((word (gensym))
    @@ -328,38 +110,25 @@
         `(multiple-value-bind (,word ,bit) (floor ,offset 32)
            (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
     
    -;; not checked for linux...
    -(defmacro fd-zero (fd-set)
    -  `(progn
    -     ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    -	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
    +(def-alien-type nlink-t
    +    #-(or svr4 netbsd) unsigned-short
    +    #+netbsd unsigned-long
    +    #+svr4 unsigned-long)
    +
    +(defconstant fd-setsize
    +  #-(or hpux alpha linux FreeBSD) 256
    +  #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024)
     
    -;;; From sys/time.h
    +;; not checked for linux...
    +(def-alien-type nil
    +  (struct fd-set
    +    (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32)))))
     
     (def-alien-type nil
       (struct timeval
         (tv-sec #-linux time-t #+linux int)		; seconds
         (tv-usec int)))				; and microseconds
     
    -(def-alien-type nil
    -  (struct timezone
    -    (tz-minuteswest int)		; minutes west of Greenwich
    -    (tz-dsttime				; type of dst correction
    -     #-linux (enum nil :none :usa :aust :wet :met :eet :can)
    -     #+linux int)))
    -
    -(def-alien-type nil
    -  (struct itimerval
    -    (it-interval (struct timeval))	; timer interval
    -    (it-value (struct timeval))))	; current value
    -
    -#+(or linux svr4)
    -; High-res time.  Actually posix definition under svr4 name.
    -(def-alien-type nil
    -  (struct timestruc-t
    -    (tv-sec time-t)
    -    (tv-nsec long)))
    -
     #+(or linux BSD)
     (def-alien-type nil
       (struct timespec-t
    @@ -388,7 +157,6 @@
         #-linux (t-werasc char)			; word erase
         (t-lnextc char)))			; literal next character
     
    -
     (def-alien-type nil
       (struct sgttyb
         #+linux (sg-flags #+mach short #-mach int) ; mode flags 	  
    @@ -408,932 +176,413 @@
         (ws-xpixel unsigned-short)		; horizontal size, pixels
         (ws-ypixel unsigned-short)))	; veritical size, pixels
     
    +
    +;;;; System calls.
     
    -;;; From sys/termios.h
    -
    -;;; NOTE: There is both a  termio (SYSV) and termios (POSIX)
    -;;; structure with similar but incompatible definitions. It may be that
    -;;; the non-BSD variant of termios below is really a termio but I (pw)
    -;;; can't verify. The BSD variant uses the Posix termios def. Some systems
    -;;; (Ultrix and OSF1) seem to support both if used independently.
    -;;; The 17f version of this seems a bit confused wrt the conditionals.
    -;;; Please check these defs for your system.
    -
    -;;; TSM: from what I can tell looking at the 17f definition, my guess is that it
    -;;; was originally a termio for sunos (nonsolaris) (because it had the c-line
    -;;; member for sunos only), and then was mutated into the termios definition for
    -;;; later systems. The definition here is definitely not an IRIX termio because
    -;;; it doesn't have c-line. In any case, the functions tcgetattr, etc.,
    -;;; definitely take a termios, and termios seems to be the more standard
    -;;; standard now, so my suggestion is to just go with termios and forget about
    -;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've
    -;;; changed it (which means you need to bootstrap it to avoid a reader error).
    -
    -;;; On top of all that, SGI decided to change the termios structure on irix
    -;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library,
    -;;; but introduced static functions in termios.h to redirect new calls to the
    -;;; new library--which means it's important not to #include termios.h before
    -;;; undefineds.h when building lisp.
    -
    -(defconstant +NCCS+
    -  #+hpux 16
    -  #+irix 23
    -  #+(or linux solaris) 19
    -  #+(or bsd osf1) 20
    -  #+(and sunos (not svr4)) 17
    -  _N"Size of control character vector.")
    +(defmacro %syscall ((name (&rest arg-types) result-type)
    +		    success-form &rest args)
    +  `(let* ((fn (extern-alien ,name (function ,result-type ,@arg-types)))
    +	  (result (alien-funcall fn ,@args)))
    +     (if (eql -1 result)
    +	 (values nil (unix-errno))
    +	 ,success-form)))
     
    -(def-alien-type nil
    -  (struct termios
    -    (c-iflag unsigned-int)
    -    (c-oflag unsigned-int)
    -    (c-cflag unsigned-int)
    -    (c-lflag unsigned-int)
    -    #+(or linux hpux (and sunos (not svr4)))
    -    (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int
    -		#+(or linux (and sunos (not svr4))) unsigned-char)
    -    (c-cc (array unsigned-char #.+NCCS+))
    -    #+(or bsd osf1) (c-ispeed unsigned-int)
    -    #+(or bsd osf1) (c-ospeed unsigned-int)))
    +(defmacro syscall ((name &rest arg-types) success-form &rest args)
    +  `(%syscall (,name (,@arg-types) int) ,success-form ,@args))
     
    -;;; From sys/dir.h
    +;;; Like syscall, but if it fails, signal an error instead of returing error
    +;;; codes.  Should only be used for syscalls that will never really get an
    +;;; error.
     ;;;
    -;;; (For Solaris, this is not struct direct, but struct dirent!)
    -#-bsd
    -(def-alien-type nil
    -  (struct direct
    -    #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry
    -    (d-ino ino-t); inode number of entry
    -    #+(or linux svr4) (d-off long)
    -    (d-reclen unsigned-short)		; length of this record
    -    #-(or linux svr4)
    -    (d-namlen unsigned-short)		; length of string in d-name
    -    (d-name (array char 256))))		; name must be no longer than this
    +(defmacro syscall* ((name &rest arg-types) success-form &rest args)
    +  `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
    +				,@args)))
    +     (if (eql -1 result)
    +	 (error _"Syscall ~A failed: ~A" ,name (get-unix-error-msg))
    +	 ,success-form)))
     
    -#+(and bsd (not netbsd))
    -(def-alien-type nil
    -  (struct direct
    -    (d-fileno unsigned-long)
    -    (d-reclen unsigned-short)
    -    (d-type unsigned-char)
    -    (d-namlen unsigned-char)		; length of string in d-name
    -    (d-name (array char 256))))		; name must be no longer than this
    +(defmacro void-syscall ((name &rest arg-types) &rest args)
    +  `(syscall (,name ,@arg-types) (values t 0) ,@args))
     
    -#+netbsd
    -(def-alien-type nil
    -  (struct direct
    -    (d-fileno ino-t)
    -    (d-reclen unsigned-short)
    -    (d-namlen unsigned-short)
    -    (d-type unsigned-char)
    -    (d-name (array char 512))))
    +(defmacro int-syscall ((name &rest arg-types) &rest args)
    +  `(syscall (,name ,@arg-types) (values result 0) ,@args))
     
    -;;; The 64-bit version of struct dirent.
    -#+solaris
    -(def-alien-type nil
    -  (struct dirent64
    -    (d-ino ino64-t); inode number of entry
    -    (d-off off64-t) ; offset of next disk directory entry
    -    (d-reclen unsigned-short)		; length of this record
    -    (d-name (array char 256))))		; name must be no longer than this
    +(defmacro off-t-syscall ((name arg-types) &rest args)
    +  `(%syscall (,name ,arg-types off-t) (values result 0) ,@args))
     
    +
    +;;; Operations on Unix Directories.
     
    -;;; From sys/stat.h
    -;; oh boy, in linux-> 2 stat(s)!!
    +(export '(open-dir read-dir close-dir))
     
    -#-(or svr4 bsd linux)		; eg hpux and alpha
    -(def-alien-type nil
    -  (struct stat
    -    (st-dev dev-t)
    -    (st-ino ino-t)
    -    (st-mode mode-t)
    -    (st-nlink nlink-t)
    -    (st-uid uid-t)
    -    (st-gid gid-t)
    -    (st-rdev dev-t)
    -    (st-size off-t)
    -    (st-atime time-t)
    -    (st-spare1 int)
    -    (st-mtime time-t)
    -    (st-spare2 int)
    -    (st-ctime time-t)
    -    (st-spare3 int)
    -    (st-blksize #-alpha long #+alpha unsigned-int)
    -    (st-blocks #-alpha long #+alpha int)
    -    (st-spare4 (array long 2))))
    +(defstruct (%directory
    +	     (:conc-name directory-)
    +	     (:constructor make-directory)
    +	     (:print-function %print-directory))
    +  name
    +  (dir-struct (required-argument) :type system-area-pointer))
     
    -#+(and bsd (not netbsd))
    -(def-alien-type nil
    -  (struct stat
    -    (st-dev dev-t)
    -    (st-ino ino-t)
    -    (st-mode mode-t)
    -    (st-nlink nlink-t)
    -    (st-uid uid-t)
    -    (st-gid gid-t)
    -    (st-rdev dev-t)
    -    (st-atime (struct timespec-t))
    -    (st-mtime (struct timespec-t))
    -    (st-ctime (struct timespec-t))
    -    (st-size off-t)
    -    (st-blocks off-t)
    -    (st-blksize unsigned-long)
    -    (st-flags   unsigned-long)
    -    (st-gen     unsigned-long)
    -    (st-lspare  long)
    -    (st-qspare (array long 4))))
    +(defun %print-directory (dir stream depth)
    +  (declare (ignore depth))
    +  (format stream "#<Directory ~S>" (directory-name dir)))
     
    -#+netbsd
    -(def-alien-type nil
    -  (struct stat
    -    (st-dev dev-t)
    -    (st-mode mode-t)
    -    (st-ino ino-t)
    -    (st-nlink nlink-t)
    -    (st-uid uid-t)
    -    (st-gid gid-t)
    -    (st-rdev dev-t)
    -    (st-atime (struct timespec-t))
    -    (st-mtime (struct timespec-t))
    -    (st-ctime (struct timespec-t))
    -    (st-birthtime (struct timespec-t))
    -    (st-size off-t)
    -    (st-blocks off-t)
    -    (st-blksize long)
    -    (st-flags   unsigned-long)
    -    (st-gen     unsigned-long)
    -    (st-spare (array unsigned-long 2))))
    +(defun open-dir (pathname)
    +  (declare (type unix-pathname pathname))
    +  (when (string= pathname "")
    +    (setf pathname "."))
    +  (let ((kind (unix-file-kind pathname)))
    +    (case kind
    +      (:directory
    +       (let ((dir-struct
    +	      (alien-funcall (extern-alien "opendir"
    +					   (function system-area-pointer
    +						     c-string))
    +			     (%name->file pathname))))
    +	 (if (zerop (sap-int dir-struct))
    +	     (values nil (unix-errno))
    +	     (make-directory :name pathname :dir-struct dir-struct))))
    +      ((nil)
    +       (values nil enoent))
    +      (t
    +       (values nil enotdir)))))
     
    -#+(or linux svr4)
    -(def-alien-type nil
    -  (struct stat
    -    (st-dev dev-t)
    -    (st-pad1 #-linux (array long 3) #+linux unsigned-short)
    -    (st-ino ino-t)
    -    (st-mode #-linux unsigned-long #+linux unsigned-short)
    -    (st-nlink #-linux short #+linux unsigned-short)
    -    (st-uid #-linux uid-t #+linux unsigned-short)
    -    (st-gid #-linux gid-t #+linux unsigned-short)
    -    (st-rdev dev-t)
    -    (st-pad2 #-linux (array long 2) #+linux unsigned-short)
    -    (st-size off-t)
    -    #-linux (st-pad3 long)
    -    #+linux (st-blksize unsigned-long)
    -    #+linux (st-blocks unsigned-long)
    -    #-linux (st-atime (struct timestruc-t))
    -    #+linux (st-atime unsigned-long)
    -    #+linux (unused-1 unsigned-long)
    -    #-linux (st-mtime (struct timestruc-t))
    -    #+linux (st-mtime unsigned-long)
    -    #+linux (unused-2 unsigned-long)
    -    #-linux (st-ctime (struct timestruc-t))
    -    #+linux (st-ctime unsigned-long)
    -    #+linux (unused-3 unsigned-long)
    -    #+linux (unused-4 unsigned-long)
    -    #+linux (unused-5 unsigned-long)
    -    #-linux(st-blksize long)
    -    #-linux (st-blocks long)
    -    #-linux (st-fstype (array char 16))
    -    #-linux (st-pad4 (array long 8))))
    +#-(and bsd (not solaris))
    +(defun read-dir (dir)
    +  (declare (type %directory dir))
    +  (let ((daddr (alien-funcall (extern-alien "readdir"
    +					    (function system-area-pointer
    +						      system-area-pointer))
    +			      (directory-dir-struct dir))))
    +    (declare (type system-area-pointer daddr))
    +    (if (zerop (sap-int daddr))
    +	nil
    +	(with-alien ((direct (* (struct direct)) daddr))
    +	  #-(or linux svr4)
    +	  (let ((nlen (slot direct 'd-namlen))
    +		(ino (slot direct 'd-ino)))
    +	    (declare (type (unsigned-byte 16) nlen))
    +	    (let ((string (make-string nlen)))
    +	      #-unicode
    +	      (kernel:copy-from-system-area
    +	       (alien-sap (addr (slot direct 'd-name))) 0
    +	       string (* vm:vector-data-offset vm:word-bits)
    +	       (* nlen vm:byte-bits))
    +	      #+unicode
    +	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    +		(dotimes (k nlen)
    +		  (setf (aref string k)
    +			(code-char (sap-ref-8 sap k)))))
    +	      (values (%file->name string) ino)))
    +	  #+(or linux svr4)
    +	  (values (%file->name (cast (slot direct 'd-name) c-string))
    +		  (slot direct 'd-ino))))))
     
    -;;; 64-bit stat for Solaris
    +;;; 64-bit readdir for Solaris
     #+solaris
    -(def-alien-type nil
    -  (struct stat64
    -    (st-dev dev-t)
    -    (st-pad1 (array long 3))		; Pad so ino is 64-bit aligned
    -    (st-ino ino64-t)
    -    (st-mode unsigned-long)
    -    (st-nlink short)
    -    (st-uid uid-t)
    -    (st-gid gid-t)
    -    (st-rdev dev-t)
    -    (st-pad2 (array long 3))		; Pad so size is 64-bit aligned
    -    (st-size off64-t)
    -    (st-atime (struct timestruc-t))
    -    (st-mtime (struct timestruc-t))
    -    (st-ctime (struct timestruc-t))
    -    (st-blksize long)
    -    (st-pad3 (array long 1))		; Pad so blocks is 64-bit aligned
    -    (st-blocks blkcnt64-t)
    -    (st-fstype (array char 16))
    -    (st-pad4 (array long 8))))
    +(defun read-dir (dir)
    +  (declare (type %directory dir))
    +  (let ((daddr (alien-funcall (extern-alien "readdir64"
    +					    (function system-area-pointer
    +						      system-area-pointer))
    +			      (directory-dir-struct dir))))
    +    (declare (type system-area-pointer daddr))
    +    (if (zerop (sap-int daddr))
    +	nil
    +	(with-alien ((direct (* (struct dirent64)) daddr))
    +	  #-(or linux svr4)
    +	  (let ((nlen (slot direct 'd-namlen))
    +		(ino (slot direct 'd-ino)))
    +	    (declare (type (unsigned-byte 16) nlen))
    +	    (let ((string (make-string nlen)))
    +	      #-unicode
    +	      (kernel:copy-from-system-area
    +	       (alien-sap (addr (slot direct 'd-name))) 0
    +	       string (* vm:vector-data-offset vm:word-bits)
    +	       (* nlen vm:byte-bits))
    +	      #+unicode
    +	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    +		(dotimes (k nlen)
    +		  (setf (aref string k)
    +			(code-char (sap-ref-8 sap k)))))
    +	      (values (%file->name string) ino)))
    +	  #+(or linux svr4)
    +	  (values (%file->name (cast (slot direct 'd-name) c-string))
    +		  (slot direct 'd-ino))))))
     
    -(defconstant s-ifmt   #o0170000)
    -(defconstant s-ifdir  #o0040000)
    -(defconstant s-ifchr  #o0020000)
    -#+linux (defconstant s-ififo #x0010000)
    -(defconstant s-ifblk  #o0060000)
    -(defconstant s-ifreg  #o0100000)
    -(defconstant s-iflnk  #o0120000)
    -(defconstant s-ifsock #o0140000)
    -(defconstant s-isuid #o0004000)
    -(defconstant s-isgid #o0002000)
    -(defconstant s-isvtx #o0001000)
    -(defconstant s-iread #o0000400)
    -(defconstant s-iwrite #o0000200)
    -(defconstant s-iexec #o0000100)
    +#+(and bsd (not solaris))
    +(defun read-dir (dir)
    +  (declare (type %directory dir))
    +  (let ((daddr (alien-funcall (extern-alien "readdir"
    +					    (function system-area-pointer
    +						      system-area-pointer))
    +			      (directory-dir-struct dir))))
    +    (declare (type system-area-pointer daddr))
    +    (if (zerop (sap-int daddr))
    +	nil
    +	(with-alien ((direct (* (struct direct)) daddr))
    +	  (let ((nlen (slot direct 'd-namlen))
    +		(fino (slot direct 'd-fileno)))
    +	    (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen)
    +		     (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino))
    +	    (let ((string (make-string nlen)))
    +	      #-unicode
    +	      (kernel:copy-from-system-area
    +	       (alien-sap (addr (slot direct 'd-name))) 0
    +	       string (* vm:vector-data-offset vm:word-bits)
    +	       (* nlen vm:byte-bits))
    +	      #+unicode
    +	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    +		(dotimes (k nlen)
    +		  (setf (aref string k)
    +			(code-char (sap-ref-8 sap k)))))
    +	      (values (%file->name string) fino)))))))
     
    -;;; From sys/resource.h
     
    -(def-alien-type nil
    -  (struct rusage
    -    (ru-utime (struct timeval))		; user time used
    -    (ru-stime (struct timeval))		; system time used.
    -    (ru-maxrss long)
    -    (ru-ixrss long)			; integral sharded memory size
    -    (ru-idrss long)			; integral unsharded data "
    -    (ru-isrss long)			; integral unsharded stack "
    -    (ru-minflt long)			; page reclaims
    -    (ru-majflt long)			; page faults
    -    (ru-nswap long)			; swaps
    -    (ru-inblock long)			; block input operations
    -    (ru-oublock long)			; block output operations
    -    (ru-msgsnd long)			; messages sent
    -    (ru-msgrcv long)			; messages received
    -    (ru-nsignals long)			; signals received
    -    (ru-nvcsw long)			; voluntary context switches
    -    (ru-nivcsw long)))			; involuntary "
    +(defun close-dir (dir)
    +  (declare (type %directory dir))
    +  (alien-funcall (extern-alien "closedir"
    +			       (function void system-area-pointer))
    +		 (directory-dir-struct dir))
    +  nil)
     
    -(def-alien-type nil
    -  (struct rlimit
    -    (rlim-cur #-(or linux alpha) int #+linux long #+alpha unsigned-int)	 ; current (soft) limit
    -    (rlim-max #-(or linux alpha) int #+linux long #+alpha unsigned-int))); maximum value for rlim-cur
     
    +;; Use getcwd instead of getwd.  But what should we do if the path
    +;; won't fit?  Try again with a larger size?  We don't do that right
    +;; now.
    +(defun unix-current-directory ()
    +  ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
    +  (with-alien ((buf (array c-call:char 5120)))
    +    (let ((result
    +	   (alien-funcall 
    +	    (extern-alien "getcwd"
    +				(function (* c-call:char)
    +					  (* c-call:char) c-call:int))
    +	    (cast buf (* c-call:char))
    +	    5120)))
    +	
    +      (values (not (zerop
    +		    (sap-int (alien-sap result))))
    +	      (%file->name (cast buf c-call:c-string))))))
     
    -
    -;;;; Errno stuff.
    +;;; Unix-access accepts a path and a mode.  It returns two values the
    +;;; first is T if the file is accessible and NIL otherwise.  The second
    +;;; only has meaning in the second case and is the unix errno value.
     
    -(eval-when (compile eval)
    +(defconstant r_ok 4 _N"Test for read permission")
    +(defconstant w_ok 2 _N"Test for write permission")
    +(defconstant x_ok 1 _N"Test for execute permission")
    +(defconstant f_ok 0 _N"Test for presence of file")
     
    -(defparameter *compiler-unix-errors* nil)
    +(defun unix-access (path mode)
    +  _N"Given a file path (a string) and one of four constant modes,
    +   unix-access returns T if the file is accessible with that
    +   mode and NIL if not.  It also returns an errno value with
    +   NIL which determines why the file was not accessible.
     
    -(defmacro def-unix-error (name number description)
    -  `(progn
    -     (eval-when (compile eval)
    -       (push (cons ,number ,description) *compiler-unix-errors*))
    -     (defconstant ,name ,number ,description)
    -     (export ',name)))
    +   The access modes are:
    +	r_ok     Read permission.
    +	w_ok     Write permission.
    +	x_ok     Execute permission.
    +	f_ok     Presence of file."
    +  (declare (type unix-pathname path)
    +	   (type (mod 8) mode))
    +  (void-syscall ("access" c-string int) (%name->file path) mode))
     
    -(defmacro emit-unix-errors ()
    -  (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*)))
    -	 (array (make-array (1+ max) :initial-element nil)))
    -    (dolist (error *compiler-unix-errors*)
    -      (setf (svref array (car error)) (cdr error)))
    -    `(progn
    -       (defvar *unix-errors* ',array)
    -       (declaim (simple-vector *unix-errors*)))))
    +;;; Unix-chdir accepts a directory name and makes that the
    +;;; current working directory.
     
    -) ;eval-when
    +(defun unix-chdir (path)
    +  _N"Given a file path string, unix-chdir changes the current working 
    +   directory to the one specified."
    +  (declare (type unix-pathname path))
    +  (void-syscall ("chdir" c-string) (%name->file path)))
     
    -;;; 
    -;;; From <errno.h>
    -;;; 
    -(def-unix-error ESUCCESS 0 _N"Successful")
    -(def-unix-error EPERM 1 _N"Operation not permitted")
    -(def-unix-error ENOENT 2 _N"No such file or directory")
    -(def-unix-error ESRCH 3 _N"No such process")
    -(def-unix-error EINTR 4 _N"Interrupted system call")
    -(def-unix-error EIO 5 _N"I/O error")
    -(def-unix-error ENXIO 6 _N"Device not configured")
    -(def-unix-error E2BIG 7 _N"Arg list too long")
    -(def-unix-error ENOEXEC 8 _N"Exec format error")
    -(def-unix-error EBADF 9 _N"Bad file descriptor")
    -(def-unix-error ECHILD 10 _N"No child process")
    -#+bsd(def-unix-error EDEADLK 11 _N"Resource deadlock avoided")
    -#-bsd(def-unix-error EAGAIN 11 #-linux _N"No more processes" #+linux _N"Try again")
    -(def-unix-error ENOMEM 12 _N"Out of memory")
    -(def-unix-error EACCES 13 _N"Permission denied")
    -(def-unix-error EFAULT 14 _N"Bad address")
    -(def-unix-error ENOTBLK 15 _N"Block device required")
    -(def-unix-error EBUSY 16 _N"Device or resource busy")
    -(def-unix-error EEXIST 17 _N"File exists")
    -(def-unix-error EXDEV 18 _N"Cross-device link")
    -(def-unix-error ENODEV 19 _N"No such device")
    -(def-unix-error ENOTDIR 20 _N"Not a director")
    -(def-unix-error EISDIR 21 _N"Is a directory")
    -(def-unix-error EINVAL 22 _N"Invalid argument")
    -(def-unix-error ENFILE 23 _N"File table overflow")
    -(def-unix-error EMFILE 24 _N"Too many open files")
    -(def-unix-error ENOTTY 25 _N"Inappropriate ioctl for device")
    -(def-unix-error ETXTBSY 26 _N"Text file busy")
    -(def-unix-error EFBIG 27 _N"File too large")
    -(def-unix-error ENOSPC 28 _N"No space left on device")
    -(def-unix-error ESPIPE 29 _N"Illegal seek")
    -(def-unix-error EROFS 30 _N"Read-only file system")
    -(def-unix-error EMLINK 31 _N"Too many links")
    -(def-unix-error EPIPE 32 _N"Broken pipe")
    -;;; 
    -;;; Math
    -(def-unix-error EDOM 33 _N"Numerical argument out of domain")
    -(def-unix-error ERANGE 34 #-linux _N"Result too large" #+linux _N"Math result not representable")
    -;;; 
    -#-(or linux svr4)
    +;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
    +
    +(defconstant setuidexec #o4000 _N"Set user ID on execution")
    +(defconstant setgidexec #o2000 _N"Set group ID on execution")
    +(defconstant savetext #o1000 _N"Save text image after execution")
    +(defconstant readown #o400 _N"Read by owner")
    +(defconstant writeown #o200 _N"Write by owner")
    +(defconstant execown #o100 _N"Execute (search directory) by owner")
    +(defconstant readgrp #o40 _N"Read by group")
    +(defconstant writegrp #o20 _N"Write by group")
    +(defconstant execgrp #o10 _N"Execute (search directory) by group")
    +(defconstant readoth #o4 _N"Read by others")
    +(defconstant writeoth #o2 _N"Write by others")
    +(defconstant execoth #o1 _N"Execute (search directory) by others")
    +
    +(defun unix-chmod (path mode)
    +  _N"Given a file path string and a constant mode, unix-chmod changes the
    +   permission mode for that file to the one specified. The new mode
    +   can be created by logically OR'ing the following:
    +
    +      setuidexec        Set user ID on execution.
    +      setgidexec        Set group ID on execution.
    +      savetext          Save text image after execution.
    +      readown           Read by owner.
    +      writeown          Write by owner.
    +      execown           Execute (search directory) by owner.
    +      readgrp           Read by group.
    +      writegrp          Write by group.
    +      execgrp           Execute (search directory) by group.
    +      readoth           Read by others.
    +      writeoth          Write by others.
    +      execoth           Execute (search directory) by others.
    +  
    +  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
    +  are equivalent for 'mode.  The octal-base is familar to Unix users.
    +
    +  It returns T on successfully completion; NIL and an error number
    +  otherwise."
    +  (declare (type unix-pathname path)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("chmod" c-string int) (%name->file path) mode))
    +
    +;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
    +;;; ("mode") and changes the protection of the file described by "fd" to 
    +;;; "mode".
    +
    +(defun unix-fchmod (fd mode)
    +  _N"Given an integer file descriptor and a mode (the same as those
    +   used for unix-chmod), unix-fchmod changes the permission mode
    +   for that file to the one specified. T is returned if the call
    +   was successful."
    +  (declare (type unix-fd fd)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("fchmod" int int) fd mode))
    +
    +;;; Unix-lseek accepts a file descriptor, an offset, and whence value.
    +
    +(defconstant l_set 0 _N"set the file pointer")
    +(defconstant l_incr 1 _N"increment the file pointer")
    +(defconstant l_xtnd 2 _N"extend the file size")
    +
    +(defun unix-lseek (fd offset whence)
    +  _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead
    +   a certain offset for that file.  Whence can be any of the following:
    +
    +   l_set        Set the file pointer.
    +   l_incr       Increment the file pointer.
    +   l_xtnd       Extend the file size.
    +  _N"
    +  (declare (type unix-fd fd)
    +	   (type file-offset offset)
    +	   (type (integer 0 2) whence))
    +  (off-t-syscall ("lseek" (int off-t int)) fd offset whence))
    +
    +;;; Unix-mkdir accepts a name and a mode and attempts to create the
    +;;; corresponding directory with mode mode.
    +
    +(defun unix-mkdir (name mode)
    +  _N"Unix-mkdir creates a new directory with the specified name and mode.
    +   (Same as those for unix-chmod.)  It returns T upon success, otherwise
    +   NIL and an error number."
    +  (declare (type unix-pathname name)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("mkdir" c-string int) (%name->file name) mode))
    +
    +;;; Unix-unlink accepts a name and deletes the directory entry for that
    +;;; name and the file if this is the last link.
    +
    +(defun unix-unlink (name)
    +  _N"Unix-unlink removes the directory entry for the named file.
    +   NIL and an error code is returned if the call fails."
    +  (declare (type unix-pathname name))
    +  (void-syscall ("unlink" c-string) (%name->file name)))
    +
    +;;; Unix-open accepts a pathname (a simple string), flags, and mode and
    +;;; attempts to open file with name pathname.
    +
    +(defconstant o_rdonly 0 _N"Read-only flag.") 
    +(defconstant o_wronly 1 _N"Write-only flag.")
    +(defconstant o_rdwr 2   _N"Read-write flag.")
    +#+(or hpux linux svr4)
    +(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O")
    +(defconstant o_append #-linux #o10 #+linux #o2000   _N"Append flag.")
    +#+(or hpux svr4 linux)
     (progn
    -;;; non-blocking and interrupt i/o
    -(def-unix-error EWOULDBLOCK 35 _N"Operation would block")
    -#-bsd(def-unix-error EDEADLK 35 _N"Operation would block") ; Ditto
    -#+bsd(def-unix-error EAGAIN 35 _N"Resource temporarily unavailable")
    -(def-unix-error EINPROGRESS 36 _N"Operation now in progress")
    -(def-unix-error EALREADY 37 _N"Operation already in progress")
    -;;;
    -;;; ipc/network software
    -(def-unix-error ENOTSOCK 38 _N"Socket operation on non-socket")
    -(def-unix-error EDESTADDRREQ 39 _N"Destination address required")
    -(def-unix-error EMSGSIZE 40 _N"Message too long")
    -(def-unix-error EPROTOTYPE 41 _N"Protocol wrong type for socket")
    -(def-unix-error ENOPROTOOPT 42 _N"Protocol not available")
    -(def-unix-error EPROTONOSUPPORT 43 _N"Protocol not supported")
    -(def-unix-error ESOCKTNOSUPPORT 44 _N"Socket type not supported")
    -(def-unix-error EOPNOTSUPP 45 _N"Operation not supported on socket")
    -(def-unix-error EPFNOSUPPORT 46 _N"Protocol family not supported")
    -(def-unix-error EAFNOSUPPORT 47 _N"Address family not supported by protocol family")
    -(def-unix-error EADDRINUSE 48 _N"Address already in use")
    -(def-unix-error EADDRNOTAVAIL 49 _N"Can't assign requested address")
    -;;;
    -;;; operational errors
    -(def-unix-error ENETDOWN 50 _N"Network is down")
    -(def-unix-error ENETUNREACH 51 _N"Network is unreachable")
    -(def-unix-error ENETRESET 52 _N"Network dropped connection on reset")
    -(def-unix-error ECONNABORTED 53 _N"Software caused connection abort")
    -(def-unix-error ECONNRESET 54 _N"Connection reset by peer")
    -(def-unix-error ENOBUFS 55 _N"No buffer space available")
    -(def-unix-error EISCONN 56 _N"Socket is already connected")
    -(def-unix-error ENOTCONN 57 _N"Socket is not connected")
    -(def-unix-error ESHUTDOWN 58 _N"Can't send after socket shutdown")
    -(def-unix-error ETOOMANYREFS 59 _N"Too many references: can't splice")
    -(def-unix-error ETIMEDOUT 60 _N"Connection timed out")
    -(def-unix-error ECONNREFUSED 61 _N"Connection refused")
    -;;; 
    -(def-unix-error ELOOP 62 _N"Too many levels of symbolic links")
    -(def-unix-error ENAMETOOLONG 63 _N"File name too long")
    -;;; 
    -(def-unix-error EHOSTDOWN 64 _N"Host is down")
    -(def-unix-error EHOSTUNREACH 65 _N"No route to host")
    -(def-unix-error ENOTEMPTY 66 _N"Directory not empty")
    -;;; 
    -;;; quotas & resource 
    -(def-unix-error EPROCLIM 67 _N"Too many processes")
    -(def-unix-error EUSERS 68 _N"Too many users")
    -(def-unix-error EDQUOT 69 _N"Disc quota exceeded")
    -;;;
    -;;; CMU RFS
    -(def-unix-error ELOCAL 126 _N"namei should continue locally")
    -(def-unix-error EREMOTE 127 _N"namei was handled remotely")
    -;;;
    -;;; VICE
    -(def-unix-error EVICEERR 70 _N"Remote file system error _N")
    -(def-unix-error EVICEOP 71 _N"syscall was handled by Vice")
    -)
    -#+svr4
    +  (defconstant o_creat #-linux #o400 #+linux #o100 _N"Create if nonexistant flag.") 
    +  (defconstant o_trunc #o1000  _N"Truncate flag.")
    +  (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.")
    +  (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800
    +               _N"Don't assign controlling tty"))
    +#+(or hpux svr4 BSD)
    +(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04
    +  _N"Non-blocking mode")
    +#+BSD
    +(defconstant o_ndelay o_nonblock) ; compatibility
    +#+linux
     (progn
    -(def-unix-error ENOMSG 35 _N"No message of desired type")
    -(def-unix-error EIDRM 36 _N"Identifier removed")
    -(def-unix-error ECHRNG 37 _N"Channel number out of range")
    -(def-unix-error EL2NSYNC 38 _N"Level 2 not synchronized")
    -(def-unix-error EL3HLT 39 _N"Level 3 halted")
    -(def-unix-error EL3RST 40 _N"Level 3 reset")
    -(def-unix-error ELNRNG 41 _N"Link number out of range")
    -(def-unix-error EUNATCH 42 _N"Protocol driver not attached")
    -(def-unix-error ENOCSI 43 _N"No CSI structure available")
    -(def-unix-error EL2HLT 44 _N"Level 2 halted")
    -(def-unix-error EDEADLK 45 _N"Deadlock situation detected/avoided")
    -(def-unix-error ENOLCK 46 _N"No record locks available")
    -(def-unix-error ECANCELED 47 _N"Error 47")
    -(def-unix-error ENOTSUP 48 _N"Error 48")
    -(def-unix-error EBADE 50 _N"Bad exchange descriptor")
    -(def-unix-error EBADR 51 _N"Bad request descriptor")
    -(def-unix-error EXFULL 52 _N"Message tables full")
    -(def-unix-error ENOANO 53 _N"Anode table overflow")
    -(def-unix-error EBADRQC 54 _N"Bad request code")
    -(def-unix-error EBADSLT 55 _N"Invalid slot")
    -(def-unix-error EDEADLOCK 56 _N"File locking deadlock")
    -(def-unix-error EBFONT 57 _N"Bad font file format")
    -(def-unix-error ENOSTR 60 _N"Not a stream device")
    -(def-unix-error ENODATA 61 _N"No data available")
    -(def-unix-error ETIME 62 _N"Timer expired")
    -(def-unix-error ENOSR 63 _N"Out of stream resources")
    -(def-unix-error ENONET 64 _N"Machine is not on the network")
    -(def-unix-error ENOPKG 65 _N"Package not installed")
    -(def-unix-error EREMOTE 66 _N"Object is remote")
    -(def-unix-error ENOLINK 67 _N"Link has been severed")
    -(def-unix-error EADV 68 _N"Advertise error")
    -(def-unix-error ESRMNT 69 _N"Srmount error")
    -(def-unix-error ECOMM 70 _N"Communication error on send")
    -(def-unix-error EPROTO 71 _N"Protocol error")
    -(def-unix-error EMULTIHOP 74 _N"Multihop attempted")
    -(def-unix-error EBADMSG 77 _N"Not a data message")
    -(def-unix-error ENAMETOOLONG 78 _N"File name too long")
    -(def-unix-error EOVERFLOW 79 _N"Value too large for defined data type")
    -(def-unix-error ENOTUNIQ 80 _N"Name not unique on network")
    -(def-unix-error EBADFD 81 _N"File descriptor in bad state")
    -(def-unix-error EREMCHG 82 _N"Remote address changed")
    -(def-unix-error ELIBACC 83 _N"Can not access a needed shared library")
    -(def-unix-error ELIBBAD 84 _N"Accessing a corrupted shared library")
    -(def-unix-error ELIBSCN 85 _N".lib section in a.out corrupted")
    -(def-unix-error ELIBMAX 86 _N"Attempting to link in more shared libraries than system limit")
    -(def-unix-error ELIBEXEC 87 _N"Can not exec a shared library directly")
    -(def-unix-error EILSEQ 88 _N"Error 88")
    -(def-unix-error ENOSYS 89 _N"Operation not applicable")
    -(def-unix-error ELOOP 90 _N"Number of symbolic links encountered during path name traversal exceeds MAXSYMLINKS")
    -(def-unix-error ERESTART 91 _N"Error 91")
    -(def-unix-error ESTRPIPE 92 _N"Error 92")
    -(def-unix-error ENOTEMPTY 93 _N"Directory not empty")
    -(def-unix-error EUSERS 94 _N"Too many users")
    -(def-unix-error ENOTSOCK 95 _N"Socket operation on non-socket")
    -(def-unix-error EDESTADDRREQ 96 _N"Destination address required")
    -(def-unix-error EMSGSIZE 97 _N"Message too long")
    -(def-unix-error EPROTOTYPE 98 _N"Protocol wrong type for socket")
    -(def-unix-error ENOPROTOOPT 99 _N"Option not supported by protocol")
    -(def-unix-error EPROTONOSUPPORT 120 _N"Protocol not supported")
    -(def-unix-error ESOCKTNOSUPPORT 121 _N"Socket type not supported")
    -(def-unix-error EOPNOTSUPP 122 _N"Operation not supported on transport endpoint")
    -(def-unix-error EPFNOSUPPORT 123 _N"Protocol family not supported")
    -(def-unix-error EAFNOSUPPORT 124 _N"Address family not supported by protocol family")
    -(def-unix-error EADDRINUSE 125 _N"Address already in use")
    -(def-unix-error EADDRNOTAVAIL 126 _N"Cannot assign requested address")
    -(def-unix-error ENETDOWN 127 _N"Network is down")
    -(def-unix-error ENETUNREACH 128 _N"Network is unreachable")
    -(def-unix-error ENETRESET 129 _N"Network dropped connection because of reset")
    -(def-unix-error ECONNABORTED 130 _N"Software caused connection abort")
    -(def-unix-error ECONNRESET 131 _N"Connection reset by peer")
    -(def-unix-error ENOBUFS 132 _N"No buffer space available")
    -(def-unix-error EISCONN 133 _N"Transport endpoint is already connected")
    -(def-unix-error ENOTCONN 134 _N"Transport endpoint is not connected")
    -(def-unix-error ESHUTDOWN 143 _N"Cannot send after socket shutdown")
    -(def-unix-error ETOOMANYREFS 144 _N"Too many references: cannot splice")
    -(def-unix-error ETIMEDOUT 145 _N"Connection timed out")
    -(def-unix-error ECONNREFUSED 146 _N"Connection refused")
    -(def-unix-error EHOSTDOWN 147 _N"Host is down")
    -(def-unix-error EHOSTUNREACH 148 _N"No route to host")
    -(def-unix-error EWOULDBLOCK 11 _N"Resource temporarily unavailable")
    -(def-unix-error EALREADY 149 _N"Operation already in progress")
    -(def-unix-error EINPROGRESS 150 _N"Operation now in progress")
    -(def-unix-error ESTALE 151 _N"Stale NFS file handle")
    -)
    -#+linux
    +   (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)"))
    +
    +#-(or hpux svr4 linux)
     (progn
    -(def-unix-error  EDEADLK         35     _N"Resource deadlock would occur")
    -(def-unix-error  ENAMETOOLONG    36     _N"File name too long")
    -(def-unix-error  ENOLCK          37     _N"No record locks available")
    -(def-unix-error  ENOSYS          38     _N"Function not implemented")
    -(def-unix-error  ENOTEMPTY       39     _N"Directory not empty")
    -(def-unix-error  ELOOP           40     _N"Too many symbolic links encountered")
    -(def-unix-error  EWOULDBLOCK     11     _N"Operation would block")
    -(def-unix-error  ENOMSG          42     _N"No message of desired type")
    -(def-unix-error  EIDRM           43     _N"Identifier removed")
    -(def-unix-error  ECHRNG          44     _N"Channel number out of range")
    -(def-unix-error  EL2NSYNC        45     _N"Level 2 not synchronized")
    -(def-unix-error  EL3HLT          46     _N"Level 3 halted")
    -(def-unix-error  EL3RST          47     _N"Level 3 reset")
    -(def-unix-error  ELNRNG          48     _N"Link number out of range")
    -(def-unix-error  EUNATCH         49     _N"Protocol driver not attached")
    -(def-unix-error  ENOCSI          50     _N"No CSI structure available")
    -(def-unix-error  EL2HLT          51     _N"Level 2 halted")
    -(def-unix-error  EBADE           52     _N"Invalid exchange")
    -(def-unix-error  EBADR           53     _N"Invalid request descriptor")
    -(def-unix-error  EXFULL          54     _N"Exchange full")
    -(def-unix-error  ENOANO          55     _N"No anode")
    -(def-unix-error  EBADRQC         56     _N"Invalid request code")
    -(def-unix-error  EBADSLT         57     _N"Invalid slot")
    -(def-unix-error  EDEADLOCK       EDEADLK     _N"File locking deadlock error")
    -(def-unix-error  EBFONT          59     _N"Bad font file format")
    -(def-unix-error  ENOSTR          60     _N"Device not a stream")
    -(def-unix-error  ENODATA         61     _N"No data available")
    -(def-unix-error  ETIME           62     _N"Timer expired")
    -(def-unix-error  ENOSR           63     _N"Out of streams resources")
    -(def-unix-error  ENONET          64     _N"Machine is not on the network")
    -(def-unix-error  ENOPKG          65     _N"Package not installed")
    -(def-unix-error  EREMOTE         66     _N"Object is remote")
    -(def-unix-error  ENOLINK         67     _N"Link has been severed")
    -(def-unix-error  EADV            68     _N"Advertise error")
    -(def-unix-error  ESRMNT          69     _N"Srmount error")
    -(def-unix-error  ECOMM           70     _N"Communication error on send")
    -(def-unix-error  EPROTO          71     _N"Protocol error")
    -(def-unix-error  EMULTIHOP       72     _N"Multihop attempted")
    -(def-unix-error  EDOTDOT         73     _N"RFS specific error")
    -(def-unix-error  EBADMSG         74     _N"Not a data message")
    -(def-unix-error  EOVERFLOW       75     _N"Value too large for defined data type")
    -(def-unix-error  ENOTUNIQ        76     _N"Name not unique on network")
    -(def-unix-error  EBADFD          77     _N"File descriptor in bad state")
    -(def-unix-error  EREMCHG         78     _N"Remote address changed")
    -(def-unix-error  ELIBACC         79     _N"Can not access a needed shared library")
    -(def-unix-error  ELIBBAD         80     _N"Accessing a corrupted shared library")
    -(def-unix-error  ELIBSCN         81     _N".lib section in a.out corrupted")
    -(def-unix-error  ELIBMAX         82     _N"Attempting to link in too many shared libraries")
    -(def-unix-error  ELIBEXEC        83     _N"Cannot exec a shared library directly")
    -(def-unix-error  EILSEQ          84     _N"Illegal byte sequence")
    -(def-unix-error  ERESTART        85     _N"Interrupted system call should be restarted _N")
    -(def-unix-error  ESTRPIPE        86     _N"Streams pipe error")
    -(def-unix-error  EUSERS          87     _N"Too many users")
    -(def-unix-error  ENOTSOCK        88     _N"Socket operation on non-socket")
    -(def-unix-error  EDESTADDRREQ    89     _N"Destination address required")
    -(def-unix-error  EMSGSIZE        90     _N"Message too long")
    -(def-unix-error  EPROTOTYPE      91     _N"Protocol wrong type for socket")
    -(def-unix-error  ENOPROTOOPT     92     _N"Protocol not available")
    -(def-unix-error  EPROTONOSUPPORT 93     _N"Protocol not supported")
    -(def-unix-error  ESOCKTNOSUPPORT 94     _N"Socket type not supported")
    -(def-unix-error  EOPNOTSUPP      95     _N"Operation not supported on transport endpoint")
    -(def-unix-error  EPFNOSUPPORT    96     _N"Protocol family not supported")
    -(def-unix-error  EAFNOSUPPORT    97     _N"Address family not supported by protocol")
    -(def-unix-error  EADDRINUSE      98     _N"Address already in use")
    -(def-unix-error  EADDRNOTAVAIL   99     _N"Cannot assign requested address")
    -(def-unix-error  ENETDOWN        100    _N"Network is down")
    -(def-unix-error  ENETUNREACH     101    _N"Network is unreachable")
    -(def-unix-error  ENETRESET       102    _N"Network dropped connection because of reset")
    -(def-unix-error  ECONNABORTED    103    _N"Software caused connection abort")
    -(def-unix-error  ECONNRESET      104    _N"Connection reset by peer")
    -(def-unix-error  ENOBUFS         105    _N"No buffer space available")
    -(def-unix-error  EISCONN         106    _N"Transport endpoint is already connected")
    -(def-unix-error  ENOTCONN        107    _N"Transport endpoint is not connected")
    -(def-unix-error  ESHUTDOWN       108    _N"Cannot send after transport endpoint shutdown")
    -(def-unix-error  ETOOMANYREFS    109    _N"Too many references: cannot splice")
    -(def-unix-error  ETIMEDOUT       110    _N"Connection timed out")
    -(def-unix-error  ECONNREFUSED    111    _N"Connection refused")
    -(def-unix-error  EHOSTDOWN       112    _N"Host is down")
    -(def-unix-error  EHOSTUNREACH    113    _N"No route to host")
    -(def-unix-error  EALREADY        114    _N"Operation already in progress")
    -(def-unix-error  EINPROGRESS     115    _N"Operation now in progress")
    -(def-unix-error  ESTALE          116    _N"Stale NFS file handle")
    -(def-unix-error  EUCLEAN         117    _N"Structure needs cleaning")
    -(def-unix-error  ENOTNAM         118    _N"Not a XENIX named type file")
    -(def-unix-error  ENAVAIL         119    _N"No XENIX semaphores available")
    -(def-unix-error  EISNAM          120    _N"Is a named type file")
    -(def-unix-error  EREMOTEIO       121    _N"Remote I/O error")
    -(def-unix-error  EDQUOT          122    _N"Quota exceeded")
    -)
    +  (defconstant o_creat #o1000  _N"Create if nonexistant flag.") 
    +  (defconstant o_trunc #o2000  _N"Truncate flag.")
    +  (defconstant o_excl #o4000  _N"Error if already exists."))
     
    -;;;
    -;;; And now for something completely different ...
    -(emit-unix-errors)
    +(defun unix-open (path flags mode)
    +  _N"Unix-open opens the file whose pathname is specified by path
    +   for reading and/or writing as specified by the flags argument.
    +   The flags argument can be:
     
    -(def-alien-routine ("os_get_errno" unix-get-errno) int)
    -(def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int))
    -(defun unix-errno () (unix-get-errno))
    -(defun (setf unix-errno) (newvalue) (unix-set-errno newvalue))
    +     o_rdonly        Read-only flag.
    +     o_wronly        Write-only flag.
    +     o_rdwr          Read-and-write flag.
    +     o_append        Append flag.
    +     o_creat         Create-if-nonexistant flag.
    +     o_trunc         Truncate-to-size-0 flag.
     
    -;;; GET-UNIX-ERROR-MSG -- public.
    -;;; 
    -(defun get-unix-error-msg (&optional (error-number (unix-errno)))
    -  _N"Returns a string describing the error number which was returned by a
    -  UNIX system call."
    -  (declare (type integer error-number))
    -  (if (array-in-bounds-p *unix-errors* error-number)
    -      (svref *unix-errors* error-number)
    -      (format nil _"Unknown error [~d]" error-number)))
    +   If the o_creat flag is specified, then the file is created with
    +   a permission of argument mode if the file doesn't exist.  An
    +   integer file descriptor is returned by unix-open."
    +  (declare (type unix-pathname path)
    +	   (type fixnum flags)
    +	   (type unix-file-mode mode))
    +  (int-syscall (#+solaris "open64" #-solaris "open" c-string int int)
    +	       (%name->file path) flags mode))
     
    -
    -;;;; Lisp types used by syscalls.
    +;;; Unix-close accepts a file descriptor and attempts to close the file
    +;;; associated with it.
     
    -(deftype unix-pathname () 'simple-string)
    -(deftype unix-fd () `(integer 0 ,most-positive-fixnum))
    +(defun unix-close (fd)
    +  _N"Unix-close takes an integer file descriptor as an argument and
    +   closes the file associated with it.  T is returned upon successful
    +   completion, otherwise NIL and an error number."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("close" int) fd))
     
    -(deftype unix-file-mode () '(unsigned-byte 32))
    -(deftype unix-pid () '(unsigned-byte 32))
    -(deftype unix-uid () '(unsigned-byte 32))
    -(deftype unix-gid () '(unsigned-byte 32))
    +;;; Unix-creat accepts a file name and a mode.  It creates a new file
    +;;; with name and sets it mode to mode (as for chmod).
     
    +(defun unix-creat (name mode)
    +  _N"Unix-creat accepts a file name and a mode (same as those for
    +   unix-chmod) and creates a file by that name with the specified
    +   permission mode.  It returns a file descriptor on success,
    +   or NIL and an error  number otherwise.
     
    -
    -;;;; User and group database structures
    +   This interface is made obsolete by UNIX-OPEN."
    +  
    +  (declare (type unix-pathname name)
    +	   (type unix-file-mode mode))
    +  (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int)
    +	       (%name->file name) mode))
     
    -(defstruct user-info
    -  (name "" :type string)
    -  (password "" :type string)
    -  (uid 0 :type unix-uid)
    -  (gid 0 :type unix-gid)
    -  #+solaris (age "" :type string)
    -  #+solaris (comment "" :type string)
    -  #+freebsd (change -1 :type fixnum)
    -  (gecos "" :type string)
    -  (dir "" :type string)
    -  (shell "" :type string))
    +;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
    +;;; It attempts to read len bytes from the device associated with fd
    +;;; and store them into the buffer.  It returns the actual number of
    +;;; bytes read.
     
    -(defstruct group-info
    -  (name "" :type string)
    -  (password "" :type string)
    -  (gid 0 :type unix-gid)
    -  (members nil :type list))             ; list of logins as strings
    +;;; Unix-dup returns a duplicate copy of the existing file-descriptor
    +;;; passed as an argument.
     
    -;; see <pwd.h>
    -#+solaris
    -(def-alien-type nil
    -    (struct passwd
    -	    (pw-name (* char))          ; user's login name
    -	    (pw-passwd (* char))        ; no longer used
    -	    (pw-uid uid-t)              ; user id
    -	    (pw-gid gid-t)              ; group id
    -	    (pw-age (* char))           ; password age (not used)
    -	    (pw-comment (* char))       ; not used
    -	    (pw-gecos (* char))         ; typically user's full name
    -	    (pw-dir (* char))           ; user's home directory
    -	    (pw-shell (* char))))       ; user's login shell
    -
    -#+bsd
    -(def-alien-type nil
    -    (struct passwd
    -	    (pw-name (* char))          ; user's login name
    -	    (pw-passwd (* char))        ; no longer used
    -	    (pw-uid uid-t)              ; user id
    -	    (pw-gid gid-t)              ; group id
    -            (pw-change int)             ; password change time
    -            (pw-class (* char))         ; user access class
    -	    (pw-gecos (* char))         ; typically user's full name
    -	    (pw-dir (* char))           ; user's home directory
    -	    (pw-shell (* char))         ; user's login shell
    -            (pw-expire int)             ; account expiration
    -            #+(or freebsd darwin)
    -	    (pw-fields int)))           ; internal
    -
    -;; see <grp.h>
    -(def-alien-type nil
    -  (struct group
    -      (gr-name (* char))                ; name of the group
    -      (gr-passwd (* char))              ; encrypted group password
    -      (gr-gid gid-t)                    ; numerical group ID
    -      (gr-mem (* (* char)))))           ; vector of pointers to member names
    -
    -
    -;;;; System calls.
    -
    -(defmacro %syscall ((name (&rest arg-types) result-type)
    -		    success-form &rest args)
    -  `(let* ((fn (extern-alien ,name (function ,result-type ,@arg-types)))
    -	  (result (alien-funcall fn ,@args)))
    -     (if (eql -1 result)
    -	 (values nil (unix-errno))
    -	 ,success-form)))
    -
    -(defmacro syscall ((name &rest arg-types) success-form &rest args)
    -  `(%syscall (,name (,@arg-types) int) ,success-form ,@args))
    -
    -;;; Like syscall, but if it fails, signal an error instead of returing error
    -;;; codes.  Should only be used for syscalls that will never really get an
    -;;; error.
    -;;;
    -(defmacro syscall* ((name &rest arg-types) success-form &rest args)
    -  `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
    -				,@args)))
    -     (if (eql -1 result)
    -	 (error _"Syscall ~A failed: ~A" ,name (get-unix-error-msg))
    -	 ,success-form)))
    -
    -(defmacro void-syscall ((name &rest arg-types) &rest args)
    -  `(syscall (,name ,@arg-types) (values t 0) ,@args))
    -
    -(defmacro int-syscall ((name &rest arg-types) &rest args)
    -  `(syscall (,name ,@arg-types) (values result 0) ,@args))
    -
    -(defmacro off-t-syscall ((name arg-types) &rest args)
    -  `(%syscall (,name ,arg-types off-t) (values result 0) ,@args))
    -
    -
    -;;;; Memory-mapped files
    -
    -(defconstant +null+ (sys:int-sap 0))
    -
    -(defconstant prot_read 1)		; Readable
    -(defconstant prot_write 2)		; Writable
    -(defconstant prot_exec 4)		; Executable
    -(defconstant prot_none 0)		; No access
    -
    -(defconstant map_shared 1)		; Changes are shared
    -(defconstant map_private 2)		; Changes are private
    -(defconstant map_fixed 16)		; Fixed, user-defined address
    -(defconstant map_noreserve #x40)	; Don't reserve swap space
    -(defconstant map_anonymous
    -  #+solaris #x100			; Solaris
    -  #+linux 32				; Linux
    -  #+bsd #x1000)
    -
    -(defconstant ms_async 1)
    -(defconstant ms_sync 4)
    -(defconstant ms_invalidate 2)
    -
    -;; The return value from mmap that means mmap failed.
    -(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
    -
    -(defun unix-mmap (addr length prot flags fd offset)
    -  (declare (type (or null system-area-pointer) addr)
    -	   (type (unsigned-byte 32) length)
    -           (type (integer 1 7) prot)
    -	   (type (unsigned-byte 32) flags)
    -	   (type (or null unix-fd) fd)
    -	   (type file-offset offset))
    -  ;; Can't use syscall, because the address that is returned could be
    -  ;; "negative".  Hence we explicitly check for mmap returning
    -  ;; MAP_FAILED.
    -  (let ((result
    -	 (alien-funcall (extern-alien "mmap" (function system-area-pointer
    -						       system-area-pointer
    -						       size-t int int int off-t))
    -			(or addr +null+) length prot flags (or fd -1) offset)))
    -    (if (sap= result map_failed)
    -	(values nil (unix-errno))
    -	(values result 0))))
    -
    -(defun unix-munmap (addr length)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length))
    -  (syscall ("munmap" system-area-pointer size-t) t addr length))
    -
    -(defun unix-mprotect (addr length prot)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length)
    -           (type (integer 1 7) prot))
    -  (syscall ("mprotect" system-area-pointer size-t int)
    -	   t addr length prot))
    -  
    -(defun unix-setuid (uid)
    -  _N"Set the user ID of the calling process to UID.
    -   If the calling process is the super-user, set the real
    -   and effective user IDs, and the saved set-user-ID to UID;
    -   if not, the effective user ID is set to UID."
    -  (int-syscall ("setuid" uid-t) uid))
    -
    -(defun unix-setgid (gid)
    -  _N"Set the group ID of the calling process to GID.
    -   If the calling process is the super-user, set the real
    -   and effective group IDs, and the saved set-group-ID to GID;
    -   if not, the effective group ID is set to GID."
    -  (int-syscall ("setgid" gid-t) gid))
    -
    -
    -
    -(defun unix-msync (addr length flags)
    -  (declare (type system-area-pointer addr)
    -	   (type (unsigned-byte 32) length)
    -	   (type (signed-byte 32) flags))
    -  (syscall ("msync" system-area-pointer size-t int) t addr length flags))
    -
    -;;; Unix-access accepts a path and a mode.  It returns two values the
    -;;; first is T if the file is accessible and NIL otherwise.  The second
    -;;; only has meaning in the second case and is the unix errno value.
    -
    -(defconstant r_ok 4 _N"Test for read permission")
    -(defconstant w_ok 2 _N"Test for write permission")
    -(defconstant x_ok 1 _N"Test for execute permission")
    -(defconstant f_ok 0 _N"Test for presence of file")
    -
    -(defun unix-access (path mode)
    -  _N"Given a file path (a string) and one of four constant modes,
    -   unix-access returns T if the file is accessible with that
    -   mode and NIL if not.  It also returns an errno value with
    -   NIL which determines why the file was not accessible.
    -
    -   The access modes are:
    -	r_ok     Read permission.
    -	w_ok     Write permission.
    -	x_ok     Execute permission.
    -	f_ok     Presence of file."
    -  (declare (type unix-pathname path)
    -	   (type (mod 8) mode))
    -  (void-syscall ("access" c-string int) (%name->file path) mode))
    -
    -;;; Unix-chdir accepts a directory name and makes that the
    -;;; current working directory.
    -
    -(defun unix-chdir (path)
    -  _N"Given a file path string, unix-chdir changes the current working 
    -   directory to the one specified."
    -  (declare (type unix-pathname path))
    -  (void-syscall ("chdir" c-string) (%name->file path)))
    -
    -;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
    -
    -(defconstant setuidexec #o4000 _N"Set user ID on execution")
    -(defconstant setgidexec #o2000 _N"Set group ID on execution")
    -(defconstant savetext #o1000 _N"Save text image after execution")
    -(defconstant readown #o400 _N"Read by owner")
    -(defconstant writeown #o200 _N"Write by owner")
    -(defconstant execown #o100 _N"Execute (search directory) by owner")
    -(defconstant readgrp #o40 _N"Read by group")
    -(defconstant writegrp #o20 _N"Write by group")
    -(defconstant execgrp #o10 _N"Execute (search directory) by group")
    -(defconstant readoth #o4 _N"Read by others")
    -(defconstant writeoth #o2 _N"Write by others")
    -(defconstant execoth #o1 _N"Execute (search directory) by others")
    -
    -(defun unix-chmod (path mode)
    -  _N"Given a file path string and a constant mode, unix-chmod changes the
    -   permission mode for that file to the one specified. The new mode
    -   can be created by logically OR'ing the following:
    -
    -      setuidexec        Set user ID on execution.
    -      setgidexec        Set group ID on execution.
    -      savetext          Save text image after execution.
    -      readown           Read by owner.
    -      writeown          Write by owner.
    -      execown           Execute (search directory) by owner.
    -      readgrp           Read by group.
    -      writegrp          Write by group.
    -      execgrp           Execute (search directory) by group.
    -      readoth           Read by others.
    -      writeoth          Write by others.
    -      execoth           Execute (search directory) by others.
    -  
    -  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
    -  are equivalent for 'mode.  The octal-base is familar to Unix users.
    -
    -  It returns T on successfully completion; NIL and an error number
    -  otherwise."
    -  (declare (type unix-pathname path)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("chmod" c-string int) (%name->file path) mode))
    -
    -;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
    -;;; ("mode") and changes the protection of the file described by "fd" to 
    -;;; "mode".
    -
    -(defun unix-fchmod (fd mode)
    -  _N"Given an integer file descriptor and a mode (the same as those
    -   used for unix-chmod), unix-fchmod changes the permission mode
    -   for that file to the one specified. T is returned if the call
    -   was successful."
    -  (declare (type unix-fd fd)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("fchmod" int int) fd mode))
    -
    -(defun unix-chown (path uid gid)
    -  _N"Given a file path, an integer user-id, and an integer group-id,
    -   unix-chown changes the owner of the file and the group of the
    -   file to those specified.  Either the owner or the group may be
    -   left unchanged by specifying them as -1.  Note: Permission will
    -   fail if the caller is not the superuser."
    -  (declare (type unix-pathname path)
    -	   (type (or unix-uid (integer -1 -1)) uid)
    -	   (type (or unix-gid (integer -1 -1)) gid))
    -  (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
    -
    -;;; Unix-fchown is exactly the same as unix-chown except that the file
    -;;; is specified by a file-descriptor ("fd") instead of a pathname.
    -
    -(defun unix-fchown (fd uid gid)
    -  _N"Unix-fchown is like unix-chown, except that it accepts an integer
    -   file descriptor instead of a file path name."
    -  (declare (type unix-fd fd)
    -	   (type (or unix-uid (integer -1 -1)) uid)
    -	   (type (or unix-gid (integer -1 -1)) gid))
    -  (void-syscall ("fchown" int int int) fd uid gid))
    -
    -;;; Returns the maximum size (i.e. the number of array elements
    -;;; of the file descriptor table.
    -
    -(defun unix-getdtablesize ()
    -  _N"Unix-getdtablesize returns the maximum size of the file descriptor
    -   table. (i.e. the maximum number of descriptors that can exist at
    -   one time.)"
    -  (int-syscall ("getdtablesize")))
    -
    -;;; Unix-close accepts a file descriptor and attempts to close the file
    -;;; associated with it.
    -
    -(defun unix-close (fd)
    -  _N"Unix-close takes an integer file descriptor as an argument and
    -   closes the file associated with it.  T is returned upon successful
    -   completion, otherwise NIL and an error number."
    -  (declare (type unix-fd fd))
    -  (void-syscall ("close" int) fd))
    -
    -;;; Unix-creat accepts a file name and a mode.  It creates a new file
    -;;; with name and sets it mode to mode (as for chmod).
    -
    -(defun unix-creat (name mode)
    -  _N"Unix-creat accepts a file name and a mode (same as those for
    -   unix-chmod) and creates a file by that name with the specified
    -   permission mode.  It returns a file descriptor on success,
    -   or NIL and an error  number otherwise.
    -
    -   This interface is made obsolete by UNIX-OPEN."
    -  
    -  (declare (type unix-pathname name)
    -	   (type unix-file-mode mode))
    -  (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int)
    -	       (%name->file name) mode))
    -
    -;;; Unix-dup returns a duplicate copy of the existing file-descriptor
    -;;; passed as an argument.
    -
    -(defun unix-dup (fd)
    -  _N"Unix-dup duplicates an existing file descriptor (given as the
    -   argument) and return it.  If FD is not a valid file descriptor, NIL
    -   and an error number are returned."
    -  (declare (type unix-fd fd))
    -  (int-syscall ("dup" int) fd))
    -
    -;;; Unix-dup2 makes the second file-descriptor describe the same file
    -;;; as the first. If the second file-descriptor points to an open
    -;;; file, it is first closed. In any case, the second should have a 
    -;;; value which is a valid file-descriptor.
    -
    -(defun unix-dup2 (fd1 fd2)
    -  _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup
    -   does only the new value of the duplicate descriptor may be requested
    -   through the second argument.  If a file already exists with the
    -   requested descriptor number, it will be closed and the number
    -   assigned to the duplicate."
    -  (declare (type unix-fd fd1 fd2))
    -  (void-syscall ("dup2" int int) fd1 fd2))
    +(defun unix-dup (fd)
    +  _N"Unix-dup duplicates an existing file descriptor (given as the
    +   argument) and return it.  If FD is not a valid file descriptor, NIL
    +   and an error number are returned."
    +  (declare (type unix-fd fd))
    +  (int-syscall ("dup" int) fd))
     
     ;;; Unix-fcntl takes a file descriptor, an integer command
     ;;; number, and optional command arguments.  It performs
    @@ -1404,134 +653,17 @@
     	   (type (unsigned-byte 32) arg))
       (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))
     
    -;;; Unix-link creates a hard link from name2 to name1.
    -
    -(defun unix-link (name1 name2)
    -  _N"Unix-link creates a hard link from the file with name1 to the
    -   file with name2."
    -  (declare (type unix-pathname name1 name2))
    -  (void-syscall ("link" c-string c-string)
    -		(%name->file name1) (%name->file name2)))
    -
    -;;; Unix-lseek accepts a file descriptor, an offset, and whence value.
    -
    -(defconstant l_set 0 _N"set the file pointer")
    -(defconstant l_incr 1 _N"increment the file pointer")
    -(defconstant l_xtnd 2 _N"extend the file size")
    -
    -#-solaris
    -(defun unix-lseek (fd offset whence)
    -  _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead
    -   a certain offset for that file.  Whence can be any of the following:
    -
    -   l_set        Set the file pointer.
    -   l_incr       Increment the file pointer.
    -   l_xtnd       Extend the file size.
    -  _N"
    -  (declare (type unix-fd fd)
    -	   (type file-offset offset)
    -	   (type (integer 0 2) whence))
    -  (off-t-syscall ("lseek" (int off-t int)) fd offset whence))
    -
    -#+solaris
    -(defun unix-lseek (fd offset whence)
    -  _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead
    -   a certain offset for that file.  Whence can be any of the following:
    -
    -   l_set        Set the file pointer.
    -   l_incr       Increment the file pointer.
    -   l_xtnd       Extend the file size.
    -  _N"
    -  (declare (type unix-fd fd)
    -	   (type file-offset64 offset)
    -	   (type (integer 0 2) whence))
    -  (let ((result (alien-funcall
    -                 (extern-alien "lseek64" (function off64-t int off64-t int))
    -                 fd offset whence)))
    -    (if (minusp result)
    -        (progn
    -          (values nil (unix-errno)))
    -        (values result 0))))
    -
    -;;; Unix-mkdir accepts a name and a mode and attempts to create the
    -;;; corresponding directory with mode mode.
    -
    -(defun unix-mkdir (name mode)
    -  _N"Unix-mkdir creates a new directory with the specified name and mode.
    -   (Same as those for unix-chmod.)  It returns T upon success, otherwise
    -   NIL and an error number."
    -  (declare (type unix-pathname name)
    -	   (type unix-file-mode mode))
    -  (void-syscall ("mkdir" c-string int) (%name->file name) mode))
    -
    -;;; Unix-open accepts a pathname (a simple string), flags, and mode and
    -;;; attempts to open file with name pathname.
    -
    -(defconstant o_rdonly 0 _N"Read-only flag.") 
    -(defconstant o_wronly 1 _N"Write-only flag.")
    -(defconstant o_rdwr 2   _N"Read-write flag.")
    -#+(or hpux linux svr4)
    -(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O")
    -(defconstant o_append #-linux #o10 #+linux #o2000   _N"Append flag.")
    -#+(or hpux svr4 linux)
    -(progn
    -  (defconstant o_creat #-linux #o400 #+linux #o100 _N"Create if nonexistant flag.") 
    -  (defconstant o_trunc #o1000  _N"Truncate flag.")
    -  (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.")
    -  (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800
    -               _N"Don't assign controlling tty"))
    -#+(or hpux svr4 BSD)
    -(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04
    -  _N"Non-blocking mode")
    -#+BSD
    -(defconstant o_ndelay o_nonblock) ; compatibility
    -#+linux
    -(progn
    -   (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)"))
    -
    -#-(or hpux svr4 linux)
    -(progn
    -  (defconstant o_creat #o1000  _N"Create if nonexistant flag.") 
    -  (defconstant o_trunc #o2000  _N"Truncate flag.")
    -  (defconstant o_excl #o4000  _N"Error if already exists."))
    -
    -(defun unix-open (path flags mode)
    -  _N"Unix-open opens the file whose pathname is specified by path
    -   for reading and/or writing as specified by the flags argument.
    -   The flags argument can be:
    -
    -     o_rdonly        Read-only flag.
    -     o_wronly        Write-only flag.
    -     o_rdwr          Read-and-write flag.
    -     o_append        Append flag.
    -     o_creat         Create-if-nonexistant flag.
    -     o_trunc         Truncate-to-size-0 flag.
    -
    -   If the o_creat flag is specified, then the file is created with
    -   a permission of argument mode if the file doesn't exist.  An
    -   integer file descriptor is returned by unix-open."
    -  (declare (type unix-pathname path)
    -	   (type fixnum flags)
    -	   (type unix-file-mode mode))
    -  (int-syscall (#+solaris "open64" #-solaris "open" c-string int int)
    -	       (%name->file path) flags mode))
    -
    -(defun unix-pipe ()
    -  _N"Unix-pipe sets up a unix-piping mechanism consisting of
    -  an input pipe and an output pipe.  Unix-Pipe returns two
    -  values: if no error occurred the first value is the pipe
    -  to be read from and the second is can be written to.  If
    -  an error occurred the first value is NIL and the second
    -  the unix error code."
    -  (with-alien ((fds (array int 2)))
    -    (syscall ("pipe" (* int))
    -	     (values (deref fds 0) (deref fds 1))
    -	     (cast fds (* int)))))
    -
    -;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
    -;;; It attempts to read len bytes from the device associated with fd
    -;;; and store them into the buffer.  It returns the actual number of
    -;;; bytes read.
    +(defun unix-pipe ()
    +  _N"Unix-pipe sets up a unix-piping mechanism consisting of
    +  an input pipe and an output pipe.  Unix-Pipe returns two
    +  values: if no error occurred the first value is the pipe
    +  to be read from and the second is can be written to.  If
    +  an error occurred the first value is NIL and the second
    +  the unix error code."
    +  (with-alien ((fds (array int 2)))
    +    (syscall ("pipe" (* int))
    +	     (values (deref fds 0) (deref fds 1))
    +	     (cast fds (* int)))))
     
     (defun unix-read (fd buf len)
       _N"Unix-read attempts to read from the file described by fd into
    @@ -1613,143 +745,6 @@
       (declare (type unix-pathname name))
       (void-syscall ("rmdir" c-string) (%name->file name)))
     
    -
    -;;; UNIX-FAST-SELECT -- public.
    -;;;
    -(defmacro unix-fast-select (num-descriptors
    -			    read-fds write-fds exception-fds
    -			    timeout-secs &optional (timeout-usecs 0))
    -  _N"Perform the UNIX select(2) system call.
    -  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)
    -	   (type (or (alien (* (struct fd-set))) null)
    -		 read-fds write-fds exception-fds)
    -	   (type (or null (unsigned-byte 31)) timeout-secs)
    -	   (type (unsigned-byte 31) timeout-usecs)
    -	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))"
    -  `(let ((timeout-secs ,timeout-secs))
    -     (with-alien ((tv (struct timeval)))
    -       (when timeout-secs
    -	 (setf (slot tv 'tv-sec) timeout-secs)
    -	 (setf (slot tv 'tv-usec) ,timeout-usecs))
    -       (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
    -		     (* (struct fd-set)) (* (struct timeval)))
    -		    ,num-descriptors ,read-fds ,write-fds ,exception-fds
    -		    (if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
    -
    -
    -;;; Unix-select accepts sets of file descriptors and waits for an event
    -;;; to happen on one of them or to time out.
    -
    -(defmacro num-to-fd-set (fdset num)
    -  `(if (fixnump ,num)
    -       (progn
    -	 (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
    -	 ,@(loop for index upfrom 1 below (/ fd-setsize 32)
    -	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
    -       (progn
    -	 ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    -	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
    -			    (ldb (byte 32 ,(* index 32)) ,num))))))
    -
    -(defmacro fd-set-to-num (nfds fdset)
    -  `(if (<= ,nfds 32)
    -       (deref (slot ,fdset 'fds-bits) 0)
    -       (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    -	      collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
    -			    ,(* index 32))))))
    -
    -(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
    -  _N"Unix-select examines the sets of descriptors passed as arguments
    -   to see if they are ready for reading and writing.  See the UNIX
    -   Programmers Manual for more information."
    -  (declare (type (integer 0 #.FD-SETSIZE) nfds)
    -	   (type unsigned-byte rdfds wrfds xpfds)
    -	   (type (or (unsigned-byte 31) null) to-secs)
    -	   (type (unsigned-byte 31) to-usecs)
    -	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    -  (with-alien ((tv (struct timeval))
    -	       (rdf (struct fd-set))
    -	       (wrf (struct fd-set))
    -	       (xpf (struct fd-set)))
    -    (when to-secs
    -      (setf (slot tv 'tv-sec) to-secs)
    -      (setf (slot tv 'tv-usec) to-usecs))
    -    (num-to-fd-set rdf rdfds)
    -    (num-to-fd-set wrf wrfds)
    -    (num-to-fd-set xpf xpfds)
    -    (macrolet ((frob (lispvar alienvar)
    -		 `(if (zerop ,lispvar)
    -		      (int-sap 0)
    -		      (alien-sap (addr ,alienvar)))))
    -      (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
    -		(* (struct fd-set)) (* (struct timeval)))
    -	       (values result
    -		       (fd-set-to-num nfds rdf)
    -		       (fd-set-to-num nfds wrf)
    -		       (fd-set-to-num nfds xpf))
    -	       nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
    -	       (if to-secs (alien-sap (addr tv)) (int-sap 0))))))
    -
    -
    -;;; Unix-sync writes all information in core memory which has been modified
    -;;; to permanent storage (i.e. disk).
    -
    -(defun unix-sync ()
    -  _N"Unix-sync writes all information in core memory which has been
    -   modified to disk.  It returns NIL and an error code if an error
    -   occured."
    -  (void-syscall ("sync")))
    -
    -;;; Unix-fsync writes the core-image of the file described by "fd" to
    -;;; permanent storage (i.e. disk).
    -
    -(defun unix-fsync (fd)
    -  _N"Unix-fsync writes the core image of the file described by
    -   fd to disk."
    -  (declare (type unix-fd fd))
    -  (void-syscall ("fsync" int) fd))
    -
    -;;; Unix-truncate accepts a file name and a new length.  The file is
    -;;; truncated to the new length.
    -
    -(defun unix-truncate (name len)
    -  _N"Unix-truncate truncates the named file to the length (in
    -   bytes) specified by len.  NIL and an error number is returned
    -   if the call is unsuccessful."
    -  (declare (type unix-pathname name)
    -	   (type (unsigned-byte #+solaris 64 #-solaris 32) len))
    -  #-(and bsd x86)
    -  (void-syscall (#+solaris "truncate64" #-solaris "truncate" c-string int) name len)
    -  #+(and bsd x86)
    -  (void-syscall ("truncate" c-string unsigned-long unsigned-long) name len 0))
    -
    -(defun unix-ftruncate (fd len)
    -  _N"Unix-ftruncate is similar to unix-truncate except that the first
    -   argument is a file descriptor rather than a file name."
    -  (declare (type unix-fd fd)
    -	   (type (unsigned-byte #+solaris 64 #-solaris 32) len))
    -  #-(and bsd x86)
    -  (void-syscall (#+solaris "ftruncate64" #-solaris "ftruncate" int int) fd len)
    -  #+(and bsd x86)
    -  (void-syscall ("ftruncate" int unsigned-long unsigned-long) fd len 0))
    -
    -(defun unix-symlink (name1 name2)
    -  _N"Unix-symlink creates a symbolic link named name2 to the file
    -   named name1.  NIL and an error number is returned if the call
    -   is unsuccessful."
    -  (declare (type unix-pathname name1 name2))
    -  (void-syscall ("symlink" c-string c-string)
    -		(%name->file name1) (%name->file name2)))
    -
    -;;; Unix-unlink accepts a name and deletes the directory entry for that
    -;;; name and the file if this is the last link.
    -
    -(defun unix-unlink (name)
    -  _N"Unix-unlink removes the directory entry for the named file.
    -   NIL and an error code is returned if the call fails."
    -  (declare (type unix-pathname name))
    -  (void-syscall ("unlink" c-string) (%name->file name)))
    -
     ;;; Unix-write accepts a file descriptor, a buffer, an offset, and the
     ;;; length to write.  It attempts to write len bytes to the device
     ;;; associated with fd from the buffer starting at offset.  It returns
    @@ -1981,165 +976,52 @@
     	   (type (unsigned-byte 32) cmd))
       (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))
     
    -#+(or svr4 hpux bsd linux)
    -(progn
    -  (defun unix-tcgetattr (fd termios)
    -    _N"Get terminal attributes."
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
    -
    -  (defun unix-tcsetattr (fd opt termios)
    -    _N"Set terminal attributes."
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
    -
    -  ;; XXX rest of functions in this progn probably are present in linux, but
    -  ;; not verified.
    -  #-bsd
    -  (defun unix-cfgetospeed (termios)
    -    _N"Get terminal output speed."
    -    (multiple-value-bind (speed errno)
    -        (int-syscall ("cfgetospeed" (* (struct termios))) termios)
    -      (if speed
    -          (values (svref terminal-speeds speed) 0)
    -          (values speed errno))))
    -
    -  #+bsd
    -  (defun unix-cfgetospeed (termios)
    -    _N"Get terminal output speed."
    -    (int-syscall ("cfgetospeed" (* (struct termios))) termios))
    -
    -  #-bsd
    -  (defun unix-cfsetospeed (termios speed)
    -    _N"Set terminal output speed."
    -    (let ((baud (or (position speed terminal-speeds)
    -                    (error _"Bogus baud rate ~S" speed))))
    -      (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
    -  
    -  #+bsd
    -  (defun unix-cfsetospeed (termios speed)
    -    _N"Set terminal output speed."
    -    (void-syscall ("cfsetospeed" (* (struct termios)) int) termios speed))
    -  
    -  #-bsd
    -  (defun unix-cfgetispeed (termios)
    -    _N"Get terminal input speed."
    -    (multiple-value-bind (speed errno)
    -        (int-syscall ("cfgetispeed" (* (struct termios))) termios)
    -      (if speed
    -          (values (svref terminal-speeds speed) 0)
    -          (values speed errno))))
    -
    -  #+bsd
    -  (defun unix-cfgetispeed (termios)
    -    _N"Get terminal input speed."
    -    (int-syscall ("cfgetispeed" (* (struct termios))) termios))
    -  
    -  #-bsd
    -  (defun unix-cfsetispeed (termios speed)
    -    _N"Set terminal input speed."
    -    (let ((baud (or (position speed terminal-speeds)
    -                    (error _"Bogus baud rate ~S" speed))))
    -      (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
    -
    -  #+bsd
    -  (defun unix-cfsetispeed (termios speed)
    -    _N"Set terminal input speed."
    -    (void-syscall ("cfsetispeed" (* (struct termios)) int) termios speed))
    -
    -  (defun unix-tcsendbreak (fd duration)
    -    _N"Send break"
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcsendbreak" int int) fd duration))
    -
    -  (defun unix-tcdrain (fd)
    -    _N"Wait for output for finish"
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcdrain" int) fd))
    -
    -  (defun unix-tcflush (fd selector)
    -    _N"See tcflush(3)"
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcflush" int int) fd selector))
    -
    -  (defun unix-tcflow (fd action)
    -    _N"Flow control"
    -    (declare (type unix-fd fd))
    -    (void-syscall ("tcflow" int int) fd action)))
    -
    -(defun tcsetpgrp (fd pgrp)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP."
    -  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    -    (unix-ioctl fd
    -		tiocspgrp
    -		(alien:alien-sap (alien:addr alien-pgrp)))))
    -
    -(defun tcgetpgrp (fd)
    -  _N"Get the tty-process-group for the unix file-descriptor FD."
    -  (alien:with-alien ((alien-pgrp c-call:int))
    -    (multiple-value-bind (ok err)
    -	(unix-ioctl fd
    -		     tiocgpgrp
    -		     (alien:alien-sap (alien:addr alien-pgrp)))
    -      (if ok
    -	  (values alien-pgrp nil)
    -	  (values nil err)))))
    -
    -(defun tty-process-group (&optional fd)
    -  _N"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,
    -  FD defaults to /dev/tty."
    -  (if fd
    -      (tcgetpgrp fd)
    -      (multiple-value-bind (tty-fd errno)
    -	  (unix-open "/dev/tty" o_rdwr 0)
    -	(cond (tty-fd
    -	       (multiple-value-prog1
    -		   (tcgetpgrp tty-fd)
    -		 (unix-close tty-fd)))
    -	      (t
    -	       (values nil errno))))))
    -
    -(defun %set-tty-process-group (pgrp &optional fd)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    -  supplied, FD defaults to /dev/tty."
    -  (let ((old-sigs
    -	 (unix-sigblock
    -	  (sigmask :sigttou :sigttin :sigtstp :sigchld))))
    -    (declare (type (unsigned-byte 32) old-sigs))
    -    (unwind-protect
    -	(if fd
    -	    (tcsetpgrp fd pgrp)
    -	    (multiple-value-bind (tty-fd errno)
    -		(unix-open "/dev/tty" o_rdwr 0)
    -	      (cond (tty-fd
    -		     (multiple-value-prog1
    -			 (tcsetpgrp tty-fd pgrp)
    -		       (unix-close tty-fd)))
    -		    (t
    -		     (values nil errno)))))
    -      (unix-sigsetmask old-sigs))))
    -  
    -(defsetf tty-process-group (&optional fd) (pgrp)
    -  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    -  supplied, FD defaults to /dev/tty."
    -  `(%set-tty-process-group ,pgrp ,fd))
    +(defun unix-tcgetattr (fd termios)
    +  _N"Get terminal attributes."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
     
    +(defun unix-tcsetattr (fd opt termios)
    +  _N"Set terminal attributes."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
     
    -;;; Socket options.
    +;; XXX rest of functions in this progn probably are present in linux, but
    +;; not verified.
    +#-bsd
    +(defun unix-cfgetospeed (termios)
    +  _N"Get terminal output speed."
    +  (multiple-value-bind (speed errno)
    +      (int-syscall ("cfgetospeed" (* (struct termios))) termios)
    +    (if speed
    +        (values (svref terminal-speeds speed) 0)
    +        (values speed errno))))
     
    -#+(or hpux bsd)
    -(define-ioctl-command SIOCSPGRP #\s 8 int :in)
    +#+bsd
    +(defun unix-cfgetospeed (termios)
    +  _N"Get terminal output speed."
    +  (int-syscall ("cfgetospeed" (* (struct termios))) termios))
     
    -#+linux
    -(define-ioctl-command SIOCSPGRP #\s #x8904 int :in)
    +(def-alien-routine ("getuid" unix-getuid) int
    +  _N"Unix-getuid returns the real user-id associated with the
    +   current process.")
     
    -#+(or hpux bsd linux)
    -(defun siocspgrp (fd pgrp)
    -  _N"Set the socket process-group for the unix file-descriptor FD to PGRP."
    -  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    -    (unix-ioctl fd
    -		siocspgrp
    -		(alien:alien-sap (alien:addr alien-pgrp)))))
    +;;; Unix-getpagesize returns the number of bytes in the system page.
    +
    +(defun unix-getpagesize ()
    +  _N"Unix-getpagesize returns the number of bytes in a system page."
    +  (int-syscall ("getpagesize")))
    +
    +(defun unix-gethostname ()
    +  _N"Unix-gethostname returns the name of the host machine as a string."
    +  (with-alien ((buf (array char 256)))
    +    (syscall* ("gethostname" (* char) int)
    +	      (cast buf c-string)
    +	      (cast buf (* char)) 256)))
    +
    +(def-alien-routine ("gethostid" unix-gethostid) unsigned-long
    +  _N"Unix-gethostid returns a 32-bit integer which provides unique
    +   identification for the host machine.")
     
     ;;; Unix-exit terminates a program.
     
    @@ -2150,14 +1032,227 @@
       (declare (type (signed-byte 32) code))
       (void-syscall ("exit" int) code))
     
    -;;; STAT and friends.
    +;;; From sys/termios.h
     
    -(defmacro extract-stat-results (buf)
    -  `(values T
    -	   (slot ,buf 'st-dev)
    -	   (slot ,buf 'st-ino)
    -	   (slot ,buf 'st-mode)
    -	   (slot ,buf 'st-nlink)
    +;;; NOTE: There is both a  termio (SYSV) and termios (POSIX)
    +;;; structure with similar but incompatible definitions. It may be that
    +;;; the non-BSD variant of termios below is really a termio but I (pw)
    +;;; can't verify. The BSD variant uses the Posix termios def. Some systems
    +;;; (Ultrix and OSF1) seem to support both if used independently.
    +;;; The 17f version of this seems a bit confused wrt the conditionals.
    +;;; Please check these defs for your system.
    +
    +;;; TSM: from what I can tell looking at the 17f definition, my guess is that it
    +;;; was originally a termio for sunos (nonsolaris) (because it had the c-line
    +;;; member for sunos only), and then was mutated into the termios definition for
    +;;; later systems. The definition here is definitely not an IRIX termio because
    +;;; it doesn't have c-line. In any case, the functions tcgetattr, etc.,
    +;;; definitely take a termios, and termios seems to be the more standard
    +;;; standard now, so my suggestion is to just go with termios and forget about
    +;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've
    +;;; changed it (which means you need to bootstrap it to avoid a reader error).
    +
    +;;; On top of all that, SGI decided to change the termios structure on irix
    +;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library,
    +;;; but introduced static functions in termios.h to redirect new calls to the
    +;;; new library--which means it's important not to #include termios.h before
    +;;; undefineds.h when building lisp.
    +
    +(defconstant +NCCS+
    +  #+hpux 16
    +  #+irix 23
    +  #+(or linux solaris) 19
    +  #+(or bsd osf1) 20
    +  #+(and sunos (not svr4)) 17
    +  _N"Size of control character vector.")
    +
    +(def-alien-type nil
    +  (struct termios
    +    (c-iflag unsigned-int)
    +    (c-oflag unsigned-int)
    +    (c-cflag unsigned-int)
    +    (c-lflag unsigned-int)
    +    #+(or linux hpux (and sunos (not svr4)))
    +    (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int
    +		#+(or linux (and sunos (not svr4))) unsigned-char)
    +    (c-cc (array unsigned-char #.+NCCS+))
    +    #+(or bsd osf1) (c-ispeed unsigned-int)
    +    #+(or bsd osf1) (c-ospeed unsigned-int)))
    +
    +;;; From sys/dir.h
    +;;;
    +;;; (For Solaris, this is not struct direct, but struct dirent!)
    +#-bsd
    +(def-alien-type nil
    +  (struct direct
    +    #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry
    +    (d-ino ino-t); inode number of entry
    +    #+(or linux svr4) (d-off long)
    +    (d-reclen unsigned-short)		; length of this record
    +    #-(or linux svr4)
    +    (d-namlen unsigned-short)		; length of string in d-name
    +    (d-name (array char 256))))		; name must be no longer than this
    +
    +#+(and bsd (not netbsd))
    +(def-alien-type nil
    +  (struct direct
    +    (d-fileno unsigned-long)
    +    (d-reclen unsigned-short)
    +    (d-type unsigned-char)
    +    (d-namlen unsigned-char)		; length of string in d-name
    +    (d-name (array char 256))))		; name must be no longer than this
    +
    +#+netbsd
    +(def-alien-type nil
    +  (struct direct
    +    (d-fileno ino-t)
    +    (d-reclen unsigned-short)
    +    (d-namlen unsigned-short)
    +    (d-type unsigned-char)
    +    (d-name (array char 512))))
    +
    +#+(or linux svr4)
    +; High-res time.  Actually posix definition under svr4 name.
    +(def-alien-type nil
    +  (struct timestruc-t
    +    (tv-sec time-t)
    +    (tv-nsec long)))
    +
    +
    +;;; Large file support for Solaris.  Define some of the 64-bit types
    +;;; we need.  Unlike unix-glibc's large file support, Solaris's
    +;;; version is a little simpler because all of the 64-bit versions of
    +;;; the functions actually exist as functions.  So instead of calling
    +;;; the 32-bit versions of the functions, we call the 64-bit versions.
    +;;;
    +;;; These functions are: creat64, open64, truncate64, ftruncate64,
    +;;; stat64, lstat64, fstat64, readdir64.
    +;;;
    +;;; There are also some new structures for large file support:
    +;;; dirent64, stat64.
    +;;;
    +;;; FIXME: We should abstract this better, but I (rtoy) don't have any
    +;;; other system to test this out on, so it's a Solaris hack for now.
    +#+solaris
    +(progn
    +  (deftype file-offset64 () '(signed-byte 64))
    +  (def-alien-type off64-t int64-t)
    +  (def-alien-type ino64-t u-int64-t)
    +  (def-alien-type blkcnt64-t u-int64-t))
    +
    +;;; The 64-bit version of struct dirent.
    +#+solaris
    +(def-alien-type nil
    +  (struct dirent64
    +    (d-ino ino64-t); inode number of entry
    +    (d-off off64-t) ; offset of next disk directory entry
    +    (d-reclen unsigned-short)		; length of this record
    +    (d-name (array char 256))))		; name must be no longer than this
    +
    +
    +#+(and bsd (not netbsd))
    +(def-alien-type nil
    +  (struct stat
    +    (st-dev dev-t)
    +    (st-ino ino-t)
    +    (st-mode mode-t)
    +    (st-nlink nlink-t)
    +    (st-uid uid-t)
    +    (st-gid gid-t)
    +    (st-rdev dev-t)
    +    (st-atime (struct timespec-t))
    +    (st-mtime (struct timespec-t))
    +    (st-ctime (struct timespec-t))
    +    (st-size off-t)
    +    (st-blocks off-t)
    +    (st-blksize unsigned-long)
    +    (st-flags   unsigned-long)
    +    (st-gen     unsigned-long)
    +    (st-lspare  long)
    +    (st-qspare (array long 4))))
    +
    +#+(or linux svr4)
    +(def-alien-type nil
    +  (struct stat
    +    (st-dev dev-t)
    +    (st-pad1 #-linux (array long 3) #+linux unsigned-short)
    +    (st-ino ino-t)
    +    (st-mode #-linux unsigned-long #+linux unsigned-short)
    +    (st-nlink #-linux short #+linux unsigned-short)
    +    (st-uid #-linux uid-t #+linux unsigned-short)
    +    (st-gid #-linux gid-t #+linux unsigned-short)
    +    (st-rdev dev-t)
    +    (st-pad2 #-linux (array long 2) #+linux unsigned-short)
    +    (st-size off-t)
    +    #-linux (st-pad3 long)
    +    #+linux (st-blksize unsigned-long)
    +    #+linux (st-blocks unsigned-long)
    +    #-linux (st-atime (struct timestruc-t))
    +    #+linux (st-atime unsigned-long)
    +    #+linux (unused-1 unsigned-long)
    +    #-linux (st-mtime (struct timestruc-t))
    +    #+linux (st-mtime unsigned-long)
    +    #+linux (unused-2 unsigned-long)
    +    #-linux (st-ctime (struct timestruc-t))
    +    #+linux (st-ctime unsigned-long)
    +    #+linux (unused-3 unsigned-long)
    +    #+linux (unused-4 unsigned-long)
    +    #+linux (unused-5 unsigned-long)
    +    #-linux(st-blksize long)
    +    #-linux (st-blocks long)
    +    #-linux (st-fstype (array char 16))
    +    #-linux (st-pad4 (array long 8))))
    +
    +;;; 64-bit stat for Solaris
    +#+solaris
    +(def-alien-type nil
    +  (struct stat64
    +    (st-dev dev-t)
    +    (st-pad1 (array long 3))		; Pad so ino is 64-bit aligned
    +    (st-ino ino64-t)
    +    (st-mode unsigned-long)
    +    (st-nlink short)
    +    (st-uid uid-t)
    +    (st-gid gid-t)
    +    (st-rdev dev-t)
    +    (st-pad2 (array long 3))		; Pad so size is 64-bit aligned
    +    (st-size off64-t)
    +    (st-atime (struct timestruc-t))
    +    (st-mtime (struct timestruc-t))
    +    (st-ctime (struct timestruc-t))
    +    (st-blksize long)
    +    (st-pad3 (array long 1))		; Pad so blocks is 64-bit aligned
    +    (st-blocks blkcnt64-t)
    +    (st-fstype (array char 16))
    +    (st-pad4 (array long 8))))
    +
    +#+netbsd
    +(def-alien-type nil
    +  (struct stat
    +    (st-dev dev-t)
    +    (st-mode mode-t)
    +    (st-ino ino-t)
    +    (st-nlink nlink-t)
    +    (st-uid uid-t)
    +    (st-gid gid-t)
    +    (st-rdev dev-t)
    +    (st-atime (struct timespec-t))
    +    (st-mtime (struct timespec-t))
    +    (st-ctime (struct timespec-t))
    +    (st-birthtime (struct timespec-t))
    +    (st-size off-t)
    +    (st-blocks off-t)
    +    (st-blksize long)
    +    (st-flags   unsigned-long)
    +    (st-gen     unsigned-long)
    +    (st-spare (array unsigned-long 2))))
    +
    +(defmacro extract-stat-results (buf)
    +  `(values T
    +	   (slot ,buf 'st-dev)
    +	   (slot ,buf 'st-ino)
    +	   (slot ,buf 'st-mode)
    +	   (slot ,buf 'st-nlink)
     	   (slot ,buf 'st-uid)
     	   (slot ,buf 'st-gid)
     	   (slot ,buf 'st-rdev)
    @@ -2246,6 +1341,24 @@
     	     fd (addr buf))))
     )
     
    +(def-alien-type nil
    +  (struct rusage
    +    (ru-utime (struct timeval))		; user time used
    +    (ru-stime (struct timeval))		; system time used.
    +    (ru-maxrss long)
    +    (ru-ixrss long)			; integral sharded memory size
    +    (ru-idrss long)			; integral unsharded data "
    +    (ru-isrss long)			; integral unsharded stack "
    +    (ru-minflt long)			; page reclaims
    +    (ru-majflt long)			; page faults
    +    (ru-nswap long)			; swaps
    +    (ru-inblock long)			; block input operations
    +    (ru-oublock long)			; block output operations
    +    (ru-msgsnd long)			; messages sent
    +    (ru-msgrcv long)			; messages received
    +    (ru-nsignals long)			; signals received
    +    (ru-nvcsw long)			; voluntary context switches
    +    (ru-nivcsw long)))			; involuntary "
     
     (defconstant rusage_self 0 _N"The calling process.")
     (defconstant rusage_children -1 _N"Terminated child processes.")
    @@ -2295,706 +1408,695 @@
     		      (slot usage 'ru-nivcsw))
     	      who (addr usage))))
     
    -;;; Getrusage is not provided in the C library on Solaris 2.4, and is
    -;;; rather slow on later versions so the "times" system call is
    -;;; provided.
    -#+(and sparc svr4)
    -(progn
    -(def-alien-type nil
    -  (struct tms
    -    (tms-utime #-alpha long #+alpha int)	; user time used
    -    (tms-stime #-alpha long #+alpha int)	; system time used.
    -    (tms-cutime #-alpha long #+alpha int)	; user time, children
    -    (tms-cstime #-alpha long #+alpha int)))	; system time, children
    +;;;; Support routines for dealing with unix pathnames.
     
    -(declaim (inline unix-times))
    -(defun unix-times ()
    -  _N"Unix-times returns information about the cpu time usage of the process
    -   and its children."
    -  (with-alien ((usage (struct tms)))
    -    (alien-funcall (extern-alien "times" (function int (* (struct tms))))
    -		   (addr usage))
    -    (values t
    -	    (slot usage 'tms-utime)
    -	    (slot usage 'tms-stime)
    -	    (slot usage 'tms-cutime)
    -	    (slot usage 'tms-cstime))))
    -) ; end progn
    +(defconstant s-ifmt   #o0170000)
    +(defconstant s-ifdir  #o0040000)
    +(defconstant s-ifchr  #o0020000)
    +#+linux (defconstant s-ififo #x0010000)
    +(defconstant s-ifblk  #o0060000)
    +(defconstant s-ifreg  #o0100000)
    +(defconstant s-iflnk  #o0120000)
    +(defconstant s-ifsock #o0140000)
    +(defconstant s-isuid #o0004000)
    +(defconstant s-isgid #o0002000)
    +(defconstant s-isvtx #o0001000)
    +(defconstant s-iread #o0000400)
    +(defconstant s-iwrite #o0000200)
    +(defconstant s-iexec #o0000100)
     
    -;; Requires call to tzset() in main.
    -;; Don't use this now: we 
    -#+(or linux svr4)
    +(defun unix-file-kind (name &optional check-for-links)
    +  _N"Returns either :file, :directory, :link, :special, or NIL."
    +  (declare (simple-string name))
    +  (multiple-value-bind (res dev ino mode)
    +		       (if check-for-links
    +			   (unix-lstat name)
    +			   (unix-stat name))
    +    (declare (type (or fixnum null) mode)
    +	     (ignore dev ino))
    +    (when res
    +      (let ((kind (logand mode s-ifmt)))
    +	(cond ((eql kind s-ifdir) :directory)
    +	      ((eql kind s-ifreg) :file)
    +	      ((eql kind s-iflnk) :link)
    +	      (t :special))))))
    +
    +(defun unix-maybe-prepend-current-directory (name)
    +  (declare (simple-string name))
    +  (if (and (> (length name) 0) (char= (schar name 0) #\/))
    +      name
    +      (multiple-value-bind (win dir) (unix-current-directory)
    +	(if win
    +	    (concatenate 'simple-string dir "/" name)
    +	    name))))
    +
    +(defun unix-resolve-links (pathname)
    +  _N"Returns the pathname with all symbolic links resolved."
    +  (declare (simple-string pathname))
    +  (let ((len (length pathname))
    +	(pending pathname))
    +    (declare (fixnum len) (simple-string pending))
    +    (if (zerop len)
    +	pathname
    +	(let ((result (make-string 100 :initial-element (code-char 0)))
    +	      (fill-ptr 0)
    +	      (name-start 0))
    +	  (loop
    +	    (let* ((name-end (or (position #\/ pending :start name-start) len))
    +		   (new-fill-ptr (+ fill-ptr (- name-end name-start))))
    +	      ;; grow the result string, if necessary.  the ">=" (instead of
    +	      ;; using ">") allows for the trailing "/" if we find this
    +	      ;; component is a directory.
    +	      (when (>= new-fill-ptr (length result))
    +		(let ((longer (make-string (* 3 (length result))
    +					   :initial-element (code-char 0))))
    +		  (replace longer result :end1 fill-ptr)
    +		  (setq result longer)))
    +	      (replace result pending
    +		       :start1 fill-ptr
    +		       :end1 new-fill-ptr
    +		       :start2 name-start
    +		       :end2 name-end)
    +	      (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t)))
    +		(unless kind (return nil))
    +		(cond ((eq kind :link)
    +		       (multiple-value-bind (link err) (unix-readlink result)
    +			 (unless link
    +			   (error (intl:gettext "Error reading link ~S: ~S")
    +				  (subseq result 0 fill-ptr)
    +				  (get-unix-error-msg err)))
    +			 (cond ((or (zerop (length link))
    +				    (char/= (schar link 0) #\/))
    +				;; It's a relative link
    +				(fill result (code-char 0)
    +				      :start fill-ptr
    +				      :end new-fill-ptr))
    +			       ((string= result "/../" :end1 4)
    +				;; It's across the super-root.
    +				(let ((slash (or (position #\/ result :start 4)
    +						 0)))
    +				  (fill result (code-char 0)
    +					:start slash
    +					:end new-fill-ptr)
    +				  (setf fill-ptr slash)))
    +			       (t
    +				;; It's absolute.
    +				(and (> (length link) 0)
    +				     (char= (schar link 0) #\/))
    +				(fill result (code-char 0) :end new-fill-ptr)
    +				(setf fill-ptr 0)))
    +			 (setf pending
    +			       (if (= name-end len)
    +				   link
    +				   (concatenate 'simple-string
    +						link
    +						(subseq pending name-end))))
    +			 (setf len (length pending))
    +			 (setf name-start 0)))
    +		      ((= name-end len)
    +		       (when (eq kind :directory)
    +			 (setf (schar result new-fill-ptr) #\/)
    +			 (incf new-fill-ptr))
    +		       (return (subseq result 0 new-fill-ptr)))
    +		      ((eq kind :directory)
    +		       (setf (schar result new-fill-ptr) #\/)
    +		       (setf fill-ptr (1+ new-fill-ptr))
    +		       (setf name-start (1+ name-end)))
    +		      (t
    +		       (return nil))))))))))
    +
    +(defun unix-simplify-pathname (src)
    +  (declare (simple-string src))
    +  (let* ((src-len (length src))
    +	 (dst (make-string src-len))
    +	 (dst-len 0)
    +	 (dots 0)
    +	 (last-slash nil))
    +    (macrolet ((deposit (char)
    +			`(progn
    +			   (setf (schar dst dst-len) ,char)
    +			   (incf dst-len))))
    +      (dotimes (src-index src-len)
    +	(let ((char (schar src src-index)))
    +	  (cond ((char= char #\.)
    +		 (when dots
    +		   (incf dots))
    +		 (deposit char))
    +		((char= char #\/)
    +		 (case dots
    +		   (0
    +		    ;; Either ``/...' or ``...//...'
    +		    (unless last-slash
    +		      (setf last-slash dst-len)
    +		      (deposit char)))
    +		   (1
    +		    ;; Either ``./...'' or ``..././...''
    +		    (decf dst-len))
    +		   (2
    +		    ;; We've found ..
    +		    (cond
    +		     ((and last-slash (not (zerop last-slash)))
    +		      ;; There is something before this ..
    +		      (let ((prev-prev-slash
    +			     (position #\/ dst :end last-slash :from-end t)))
    +			(cond ((and (= (+ (or prev-prev-slash 0) 2)
    +				       last-slash)
    +				    (char= (schar dst (- last-slash 2)) #\.)
    +				    (char= (schar dst (1- last-slash)) #\.))
    +			       ;; The something before this .. is another ..
    +			       (deposit char)
    +			       (setf last-slash dst-len))
    +			      (t
    +			       ;; The something is some random dir.
    +			       (setf dst-len
    +				     (if prev-prev-slash
    +					 (1+ prev-prev-slash)
    +					 0))
    +			       (setf last-slash prev-prev-slash)))))
    +		     (t
    +		      ;; There is nothing before this .., so we need to keep it
    +		      (setf last-slash dst-len)
    +		      (deposit char))))
    +		   (t
    +		    ;; Something other than a dot between slashes.
    +		    (setf last-slash dst-len)
    +		    (deposit char)))
    +		 (setf dots 0))
    +		(t
    +		 (setf dots nil)
    +		 (setf (schar dst dst-len) char)
    +		 (incf dst-len))))))
    +    (when (and last-slash (not (zerop last-slash)))
    +      (case dots
    +	(1
    +	 ;; We've got  ``foobar/.''
    +	 (decf dst-len))
    +	(2
    +	 ;; We've got ``foobar/..''
    +	 (unless (and (>= last-slash 2)
    +		      (char= (schar dst (1- last-slash)) #\.)
    +		      (char= (schar dst (- last-slash 2)) #\.)
    +		      (or (= last-slash 2)
    +			  (char= (schar dst (- last-slash 3)) #\/)))
    +	   (let ((prev-prev-slash
    +		  (position #\/ dst :end last-slash :from-end t)))
    +	     (if prev-prev-slash
    +		 (setf dst-len (1+ prev-prev-slash))
    +		 (return-from unix-simplify-pathname "./")))))))
    +    (cond ((zerop dst-len)
    +	   "./")
    +	  ((= dst-len src-len)
    +	   dst)
    +	  (t
    +	   (subseq dst 0 dst-len)))))
    +
    +;;;; Errno stuff.
    +
    +(eval-when (compile eval)
    +
    +(defparameter *compiler-unix-errors* nil)
    +
    +(defmacro def-unix-error (name number description)
    +  `(progn
    +     (eval-when (compile eval)
    +       (push (cons ,number ,description) *compiler-unix-errors*))
    +     (defconstant ,name ,number ,description)
    +     (export ',name)))
    +
    +(defmacro emit-unix-errors ()
    +  (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*)))
    +	 (array (make-array (1+ max) :initial-element nil)))
    +    (dolist (error *compiler-unix-errors*)
    +      (setf (svref array (car error)) (cdr error)))
    +    `(progn
    +       (defvar *unix-errors* ',array)
    +       (declaim (simple-vector *unix-errors*)))))
    +
    +) ;eval-when
    +
    +;;; 
    +;;; From <errno.h>
    +;;; 
    +(def-unix-error ESUCCESS 0 _N"Successful")
    +(def-unix-error EPERM 1 _N"Operation not permitted")
    +(def-unix-error ENOENT 2 _N"No such file or directory")
    +(def-unix-error ESRCH 3 _N"No such process")
    +(def-unix-error EINTR 4 _N"Interrupted system call")
    +(def-unix-error EIO 5 _N"I/O error")
    +(def-unix-error ENXIO 6 _N"Device not configured")
    +(def-unix-error E2BIG 7 _N"Arg list too long")
    +(def-unix-error ENOEXEC 8 _N"Exec format error")
    +(def-unix-error EBADF 9 _N"Bad file descriptor")
    +(def-unix-error ECHILD 10 _N"No child process")
    +#+bsd(def-unix-error EDEADLK 11 _N"Resource deadlock avoided")
    +#-bsd(def-unix-error EAGAIN 11 #-linux _N"No more processes" #+linux _N"Try again")
    +(def-unix-error ENOMEM 12 _N"Out of memory")
    +(def-unix-error EACCES 13 _N"Permission denied")
    +(def-unix-error EFAULT 14 _N"Bad address")
    +(def-unix-error ENOTBLK 15 _N"Block device required")
    +(def-unix-error EBUSY 16 _N"Device or resource busy")
    +(def-unix-error EEXIST 17 _N"File exists")
    +(def-unix-error EXDEV 18 _N"Cross-device link")
    +(def-unix-error ENODEV 19 _N"No such device")
    +(def-unix-error ENOTDIR 20 _N"Not a director")
    +(def-unix-error EISDIR 21 _N"Is a directory")
    +(def-unix-error EINVAL 22 _N"Invalid argument")
    +(def-unix-error ENFILE 23 _N"File table overflow")
    +(def-unix-error EMFILE 24 _N"Too many open files")
    +(def-unix-error ENOTTY 25 _N"Inappropriate ioctl for device")
    +(def-unix-error ETXTBSY 26 _N"Text file busy")
    +(def-unix-error EFBIG 27 _N"File too large")
    +(def-unix-error ENOSPC 28 _N"No space left on device")
    +(def-unix-error ESPIPE 29 _N"Illegal seek")
    +(def-unix-error EROFS 30 _N"Read-only file system")
    +(def-unix-error EMLINK 31 _N"Too many links")
    +(def-unix-error EPIPE 32 _N"Broken pipe")
    +;;; 
    +;;; Math
    +(def-unix-error EDOM 33 _N"Numerical argument out of domain")
    +(def-unix-error ERANGE 34 #-linux _N"Result too large" #+linux _N"Math result not representable")
    +;;; 
    +#-(or linux svr4)
     (progn
    -    (def-alien-variable ("daylight" unix-daylight) int)
    -    (def-alien-variable ("timezone" unix-timezone) time-t)
    -    (def-alien-variable ("altzone" unix-altzone) time-t)
    -    #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2))
    -    #+irix (defvar unix-tzname-addr nil)
    -    #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil))
    -                    ext:*after-save-initializations*)
    -    #+irix (declaim (notinline fakeout-compiler))
    -    #+irix (defun fakeout-compiler (name dst)
    -             (unless unix-tzname-addr
    -               (setf unix-tzname-addr (system:foreign-symbol-address
    -				       name
    -				       :flavor :data)))
    -              (deref (sap-alien unix-tzname-addr (array c-string 2)) dst))
    -    (def-alien-routine get-timezone c-call:void
    -		       (when c-call:long :in)
    -		       (minutes-west c-call:int :out)
    -		       (daylight-savings-p alien:boolean :out))
    -    (defun unix-get-minutes-west (secs)
    -	   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    -				(declare (ignore ignore) (ignore dst))
    -				(values minutes))
    -	    )
    -    (defun unix-get-timezone (secs)
    -	   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    -				(declare (ignore ignore) (ignore minutes))
    -                                (values #-irix (deref unix-tzname (if dst 1 0))
    -                                        #+irix (fakeout-compiler "tzname" (if dst 1 0)))
    -	    ) )
    +;;; non-blocking and interrupt i/o
    +(def-unix-error EWOULDBLOCK 35 _N"Operation would block")
    +#-bsd(def-unix-error EDEADLK 35 _N"Operation would block") ; Ditto
    +#+bsd(def-unix-error EAGAIN 35 _N"Resource temporarily unavailable")
    +(def-unix-error EINPROGRESS 36 _N"Operation now in progress")
    +(def-unix-error EALREADY 37 _N"Operation already in progress")
    +;;;
    +;;; ipc/network software
    +(def-unix-error ENOTSOCK 38 _N"Socket operation on non-socket")
    +(def-unix-error EDESTADDRREQ 39 _N"Destination address required")
    +(def-unix-error EMSGSIZE 40 _N"Message too long")
    +(def-unix-error EPROTOTYPE 41 _N"Protocol wrong type for socket")
    +(def-unix-error ENOPROTOOPT 42 _N"Protocol not available")
    +(def-unix-error EPROTONOSUPPORT 43 _N"Protocol not supported")
    +(def-unix-error ESOCKTNOSUPPORT 44 _N"Socket type not supported")
    +(def-unix-error EOPNOTSUPP 45 _N"Operation not supported on socket")
    +(def-unix-error EPFNOSUPPORT 46 _N"Protocol family not supported")
    +(def-unix-error EAFNOSUPPORT 47 _N"Address family not supported by protocol family")
    +(def-unix-error EADDRINUSE 48 _N"Address already in use")
    +(def-unix-error EADDRNOTAVAIL 49 _N"Can't assign requested address")
    +;;;
    +;;; operational errors
    +(def-unix-error ENETDOWN 50 _N"Network is down")
    +(def-unix-error ENETUNREACH 51 _N"Network is unreachable")
    +(def-unix-error ENETRESET 52 _N"Network dropped connection on reset")
    +(def-unix-error ECONNABORTED 53 _N"Software caused connection abort")
    +(def-unix-error ECONNRESET 54 _N"Connection reset by peer")
    +(def-unix-error ENOBUFS 55 _N"No buffer space available")
    +(def-unix-error EISCONN 56 _N"Socket is already connected")
    +(def-unix-error ENOTCONN 57 _N"Socket is not connected")
    +(def-unix-error ESHUTDOWN 58 _N"Can't send after socket shutdown")
    +(def-unix-error ETOOMANYREFS 59 _N"Too many references: can't splice")
    +(def-unix-error ETIMEDOUT 60 _N"Connection timed out")
    +(def-unix-error ECONNREFUSED 61 _N"Connection refused")
    +;;; 
    +(def-unix-error ELOOP 62 _N"Too many levels of symbolic links")
    +(def-unix-error ENAMETOOLONG 63 _N"File name too long")
    +;;; 
    +(def-unix-error EHOSTDOWN 64 _N"Host is down")
    +(def-unix-error EHOSTUNREACH 65 _N"No route to host")
    +(def-unix-error ENOTEMPTY 66 _N"Directory not empty")
    +;;; 
    +;;; quotas & resource 
    +(def-unix-error EPROCLIM 67 _N"Too many processes")
    +(def-unix-error EUSERS 68 _N"Too many users")
    +(def-unix-error EDQUOT 69 _N"Disc quota exceeded")
    +;;;
    +;;; CMU RFS
    +(def-unix-error ELOCAL 126 _N"namei should continue locally")
    +(def-unix-error EREMOTE 127 _N"namei was handled remotely")
    +;;;
    +;;; VICE
    +(def-unix-error EVICEERR 70 _N"Remote file system error _N")
    +(def-unix-error EVICEOP 71 _N"syscall was handled by Vice")
    +)
    +#+svr4
    +(progn
    +(def-unix-error ENOMSG 35 _N"No message of desired type")
    +(def-unix-error EIDRM 36 _N"Identifier removed")
    +(def-unix-error ECHRNG 37 _N"Channel number out of range")
    +(def-unix-error EL2NSYNC 38 _N"Level 2 not synchronized")
    +(def-unix-error EL3HLT 39 _N"Level 3 halted")
    +(def-unix-error EL3RST 40 _N"Level 3 reset")
    +(def-unix-error ELNRNG 41 _N"Link number out of range")
    +(def-unix-error EUNATCH 42 _N"Protocol driver not attached")
    +(def-unix-error ENOCSI 43 _N"No CSI structure available")
    +(def-unix-error EL2HLT 44 _N"Level 2 halted")
    +(def-unix-error EDEADLK 45 _N"Deadlock situation detected/avoided")
    +(def-unix-error ENOLCK 46 _N"No record locks available")
    +(def-unix-error ECANCELED 47 _N"Error 47")
    +(def-unix-error ENOTSUP 48 _N"Error 48")
    +(def-unix-error EBADE 50 _N"Bad exchange descriptor")
    +(def-unix-error EBADR 51 _N"Bad request descriptor")
    +(def-unix-error EXFULL 52 _N"Message tables full")
    +(def-unix-error ENOANO 53 _N"Anode table overflow")
    +(def-unix-error EBADRQC 54 _N"Bad request code")
    +(def-unix-error EBADSLT 55 _N"Invalid slot")
    +(def-unix-error EDEADLOCK 56 _N"File locking deadlock")
    +(def-unix-error EBFONT 57 _N"Bad font file format")
    +(def-unix-error ENOSTR 60 _N"Not a stream device")
    +(def-unix-error ENODATA 61 _N"No data available")
    +(def-unix-error ETIME 62 _N"Timer expired")
    +(def-unix-error ENOSR 63 _N"Out of stream resources")
    +(def-unix-error ENONET 64 _N"Machine is not on the network")
    +(def-unix-error ENOPKG 65 _N"Package not installed")
    +(def-unix-error EREMOTE 66 _N"Object is remote")
    +(def-unix-error ENOLINK 67 _N"Link has been severed")
    +(def-unix-error EADV 68 _N"Advertise error")
    +(def-unix-error ESRMNT 69 _N"Srmount error")
    +(def-unix-error ECOMM 70 _N"Communication error on send")
    +(def-unix-error EPROTO 71 _N"Protocol error")
    +(def-unix-error EMULTIHOP 74 _N"Multihop attempted")
    +(def-unix-error EBADMSG 77 _N"Not a data message")
    +(def-unix-error ENAMETOOLONG 78 _N"File name too long")
    +(def-unix-error EOVERFLOW 79 _N"Value too large for defined data type")
    +(def-unix-error ENOTUNIQ 80 _N"Name not unique on network")
    +(def-unix-error EBADFD 81 _N"File descriptor in bad state")
    +(def-unix-error EREMCHG 82 _N"Remote address changed")
    +(def-unix-error ELIBACC 83 _N"Can not access a needed shared library")
    +(def-unix-error ELIBBAD 84 _N"Accessing a corrupted shared library")
    +(def-unix-error ELIBSCN 85 _N".lib section in a.out corrupted")
    +(def-unix-error ELIBMAX 86 _N"Attempting to link in more shared libraries than system limit")
    +(def-unix-error ELIBEXEC 87 _N"Can not exec a shared library directly")
    +(def-unix-error EILSEQ 88 _N"Error 88")
    +(def-unix-error ENOSYS 89 _N"Operation not applicable")
    +(def-unix-error ELOOP 90 _N"Number of symbolic links encountered during path name traversal exceeds MAXSYMLINKS")
    +(def-unix-error ERESTART 91 _N"Error 91")
    +(def-unix-error ESTRPIPE 92 _N"Error 92")
    +(def-unix-error ENOTEMPTY 93 _N"Directory not empty")
    +(def-unix-error EUSERS 94 _N"Too many users")
    +(def-unix-error ENOTSOCK 95 _N"Socket operation on non-socket")
    +(def-unix-error EDESTADDRREQ 96 _N"Destination address required")
    +(def-unix-error EMSGSIZE 97 _N"Message too long")
    +(def-unix-error EPROTOTYPE 98 _N"Protocol wrong type for socket")
    +(def-unix-error ENOPROTOOPT 99 _N"Option not supported by protocol")
    +(def-unix-error EPROTONOSUPPORT 120 _N"Protocol not supported")
    +(def-unix-error ESOCKTNOSUPPORT 121 _N"Socket type not supported")
    +(def-unix-error EOPNOTSUPP 122 _N"Operation not supported on transport endpoint")
    +(def-unix-error EPFNOSUPPORT 123 _N"Protocol family not supported")
    +(def-unix-error EAFNOSUPPORT 124 _N"Address family not supported by protocol family")
    +(def-unix-error EADDRINUSE 125 _N"Address already in use")
    +(def-unix-error EADDRNOTAVAIL 126 _N"Cannot assign requested address")
    +(def-unix-error ENETDOWN 127 _N"Network is down")
    +(def-unix-error ENETUNREACH 128 _N"Network is unreachable")
    +(def-unix-error ENETRESET 129 _N"Network dropped connection because of reset")
    +(def-unix-error ECONNABORTED 130 _N"Software caused connection abort")
    +(def-unix-error ECONNRESET 131 _N"Connection reset by peer")
    +(def-unix-error ENOBUFS 132 _N"No buffer space available")
    +(def-unix-error EISCONN 133 _N"Transport endpoint is already connected")
    +(def-unix-error ENOTCONN 134 _N"Transport endpoint is not connected")
    +(def-unix-error ESHUTDOWN 143 _N"Cannot send after socket shutdown")
    +(def-unix-error ETOOMANYREFS 144 _N"Too many references: cannot splice")
    +(def-unix-error ETIMEDOUT 145 _N"Connection timed out")
    +(def-unix-error ECONNREFUSED 146 _N"Connection refused")
    +(def-unix-error EHOSTDOWN 147 _N"Host is down")
    +(def-unix-error EHOSTUNREACH 148 _N"No route to host")
    +(def-unix-error EWOULDBLOCK 11 _N"Resource temporarily unavailable")
    +(def-unix-error EALREADY 149 _N"Operation already in progress")
    +(def-unix-error EINPROGRESS 150 _N"Operation now in progress")
    +(def-unix-error ESTALE 151 _N"Stale NFS file handle")
    +)
    +#+linux
    +(progn
    +(def-unix-error  EDEADLK         35     _N"Resource deadlock would occur")
    +(def-unix-error  ENAMETOOLONG    36     _N"File name too long")
    +(def-unix-error  ENOLCK          37     _N"No record locks available")
    +(def-unix-error  ENOSYS          38     _N"Function not implemented")
    +(def-unix-error  ENOTEMPTY       39     _N"Directory not empty")
    +(def-unix-error  ELOOP           40     _N"Too many symbolic links encountered")
    +(def-unix-error  EWOULDBLOCK     11     _N"Operation would block")
    +(def-unix-error  ENOMSG          42     _N"No message of desired type")
    +(def-unix-error  EIDRM           43     _N"Identifier removed")
    +(def-unix-error  ECHRNG          44     _N"Channel number out of range")
    +(def-unix-error  EL2NSYNC        45     _N"Level 2 not synchronized")
    +(def-unix-error  EL3HLT          46     _N"Level 3 halted")
    +(def-unix-error  EL3RST          47     _N"Level 3 reset")
    +(def-unix-error  ELNRNG          48     _N"Link number out of range")
    +(def-unix-error  EUNATCH         49     _N"Protocol driver not attached")
    +(def-unix-error  ENOCSI          50     _N"No CSI structure available")
    +(def-unix-error  EL2HLT          51     _N"Level 2 halted")
    +(def-unix-error  EBADE           52     _N"Invalid exchange")
    +(def-unix-error  EBADR           53     _N"Invalid request descriptor")
    +(def-unix-error  EXFULL          54     _N"Exchange full")
    +(def-unix-error  ENOANO          55     _N"No anode")
    +(def-unix-error  EBADRQC         56     _N"Invalid request code")
    +(def-unix-error  EBADSLT         57     _N"Invalid slot")
    +(def-unix-error  EDEADLOCK       EDEADLK     _N"File locking deadlock error")
    +(def-unix-error  EBFONT          59     _N"Bad font file format")
    +(def-unix-error  ENOSTR          60     _N"Device not a stream")
    +(def-unix-error  ENODATA         61     _N"No data available")
    +(def-unix-error  ETIME           62     _N"Timer expired")
    +(def-unix-error  ENOSR           63     _N"Out of streams resources")
    +(def-unix-error  ENONET          64     _N"Machine is not on the network")
    +(def-unix-error  ENOPKG          65     _N"Package not installed")
    +(def-unix-error  EREMOTE         66     _N"Object is remote")
    +(def-unix-error  ENOLINK         67     _N"Link has been severed")
    +(def-unix-error  EADV            68     _N"Advertise error")
    +(def-unix-error  ESRMNT          69     _N"Srmount error")
    +(def-unix-error  ECOMM           70     _N"Communication error on send")
    +(def-unix-error  EPROTO          71     _N"Protocol error")
    +(def-unix-error  EMULTIHOP       72     _N"Multihop attempted")
    +(def-unix-error  EDOTDOT         73     _N"RFS specific error")
    +(def-unix-error  EBADMSG         74     _N"Not a data message")
    +(def-unix-error  EOVERFLOW       75     _N"Value too large for defined data type")
    +(def-unix-error  ENOTUNIQ        76     _N"Name not unique on network")
    +(def-unix-error  EBADFD          77     _N"File descriptor in bad state")
    +(def-unix-error  EREMCHG         78     _N"Remote address changed")
    +(def-unix-error  ELIBACC         79     _N"Can not access a needed shared library")
    +(def-unix-error  ELIBBAD         80     _N"Accessing a corrupted shared library")
    +(def-unix-error  ELIBSCN         81     _N".lib section in a.out corrupted")
    +(def-unix-error  ELIBMAX         82     _N"Attempting to link in too many shared libraries")
    +(def-unix-error  ELIBEXEC        83     _N"Cannot exec a shared library directly")
    +(def-unix-error  EILSEQ          84     _N"Illegal byte sequence")
    +(def-unix-error  ERESTART        85     _N"Interrupted system call should be restarted _N")
    +(def-unix-error  ESTRPIPE        86     _N"Streams pipe error")
    +(def-unix-error  EUSERS          87     _N"Too many users")
    +(def-unix-error  ENOTSOCK        88     _N"Socket operation on non-socket")
    +(def-unix-error  EDESTADDRREQ    89     _N"Destination address required")
    +(def-unix-error  EMSGSIZE        90     _N"Message too long")
    +(def-unix-error  EPROTOTYPE      91     _N"Protocol wrong type for socket")
    +(def-unix-error  ENOPROTOOPT     92     _N"Protocol not available")
    +(def-unix-error  EPROTONOSUPPORT 93     _N"Protocol not supported")
    +(def-unix-error  ESOCKTNOSUPPORT 94     _N"Socket type not supported")
    +(def-unix-error  EOPNOTSUPP      95     _N"Operation not supported on transport endpoint")
    +(def-unix-error  EPFNOSUPPORT    96     _N"Protocol family not supported")
    +(def-unix-error  EAFNOSUPPORT    97     _N"Address family not supported by protocol")
    +(def-unix-error  EADDRINUSE      98     _N"Address already in use")
    +(def-unix-error  EADDRNOTAVAIL   99     _N"Cannot assign requested address")
    +(def-unix-error  ENETDOWN        100    _N"Network is down")
    +(def-unix-error  ENETUNREACH     101    _N"Network is unreachable")
    +(def-unix-error  ENETRESET       102    _N"Network dropped connection because of reset")
    +(def-unix-error  ECONNABORTED    103    _N"Software caused connection abort")
    +(def-unix-error  ECONNRESET      104    _N"Connection reset by peer")
    +(def-unix-error  ENOBUFS         105    _N"No buffer space available")
    +(def-unix-error  EISCONN         106    _N"Transport endpoint is already connected")
    +(def-unix-error  ENOTCONN        107    _N"Transport endpoint is not connected")
    +(def-unix-error  ESHUTDOWN       108    _N"Cannot send after transport endpoint shutdown")
    +(def-unix-error  ETOOMANYREFS    109    _N"Too many references: cannot splice")
    +(def-unix-error  ETIMEDOUT       110    _N"Connection timed out")
    +(def-unix-error  ECONNREFUSED    111    _N"Connection refused")
    +(def-unix-error  EHOSTDOWN       112    _N"Host is down")
    +(def-unix-error  EHOSTUNREACH    113    _N"No route to host")
    +(def-unix-error  EALREADY        114    _N"Operation already in progress")
    +(def-unix-error  EINPROGRESS     115    _N"Operation now in progress")
    +(def-unix-error  ESTALE          116    _N"Stale NFS file handle")
    +(def-unix-error  EUCLEAN         117    _N"Structure needs cleaning")
    +(def-unix-error  ENOTNAM         118    _N"Not a XENIX named type file")
    +(def-unix-error  ENAVAIL         119    _N"No XENIX semaphores available")
    +(def-unix-error  EISNAM          120    _N"Is a named type file")
    +(def-unix-error  EREMOTEIO       121    _N"Remote I/O error")
    +(def-unix-error  EDQUOT          122    _N"Quota exceeded")
     )
    -(declaim (inline unix-gettimeofday))
    -(defun unix-gettimeofday ()
    -  _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and
    -   microseconds of the current time of day, the timezone (in minutes west
    -   of Greenwich), and a daylight-savings flag.  If it doesn't work, it
    -   returns NIL and the errno."
    -  (with-alien ((tv (struct timeval))
    -	       #-(or svr4 netbsd) (tz (struct timezone)))
    -    (syscall* (#-netbsd "gettimeofday"
    -	       #+netbsd  "__gettimeofday50"
    -	       (* (struct timeval)) #-svr4 (* (struct timezone)))
    -	      (values T
    -		      (slot tv 'tv-sec)
    -		      (slot tv 'tv-usec)
    -		      #-(or svr4 netbsd) (slot tz 'tz-minuteswest)
    -		      #+svr4 (unix-get-minutes-west (slot tv 'tv-sec))
    -		      #-(or svr4 netbsd) (slot tz 'tz-dsttime)
    -		      #+svr4 (unix-get-timezone (slot tv 'tv-sec))
    -		      )
    -	      (addr tv)
    -	      #-(or svr4 netbsd) (addr tz) #+netbsd nil)))
    -
    -;;; Unix-utimes changes the accessed and updated times on UNIX
    -;;; files.  The first argument is the filename (a string) and
    -;;; the second argument is a list of the 4 times- accessed and
    -;;; updated seconds and microseconds.
    -
    -#-hpux
    -(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
    -  _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
    -   times on a specified file.  NIL and an error number is
    -   returned if the call is unsuccessful."
    -  (declare (type unix-pathname file)
    -	   (type (alien unsigned-long)
    -		 atime-sec atime-usec
    -		 mtime-sec mtime-usec))
    -  (with-alien ((tvp (array (struct timeval) 2)))
    -    (setf (slot (deref tvp 0) 'tv-sec) atime-sec)
    -    (setf (slot (deref tvp 0) 'tv-usec) atime-usec)
    -    (setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
    -    (setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
    -    (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval)))
    -		  file
    -		  (cast tvp (* (struct timeval))))))
    -
    -;;; Unix-setreuid sets the real and effective user-id's of the current
    -;;; process to the arguments "ruid" and "euid", respectively.  Usage is
    -;;; restricted for anyone but the super-user.  Setting either "ruid" or
    -;;; "euid" to -1 makes the system use the current id instead.
    -
    -#-(or svr4 hpux)
    -(defun unix-setreuid (ruid euid)
    -  _N"Unix-setreuid sets the real and effective user-id's of the current
    -   process to the specified ones.  NIL and an error number is returned
    -   if the call fails."
    -  (void-syscall ("setreuid" int int) ruid euid))
    -
    -;;; Unix-setregid sets the real and effective group-id's of the current
    -;;; process to the arguments "rgid" and "egid", respectively.  Usage is
    -;;; restricted for anyone but the super-user.  Setting either "rgid" or
    -;;; "egid" to -1 makes the system use the current id instead.
    -
    -#-(or svr4 hpux)
    -(defun unix-setregid (rgid egid)
    -  _N"Unix-setregid sets the real and effective group-id's of the current
    -   process process to the specified ones.  NIL and an error number is
    -   returned if the call fails."
    -  (void-syscall ("setregid" int int) rgid egid))
    -
    -(def-alien-routine ("getpid" unix-getpid) int
    -  _N"Unix-getpid returns the process-id of the current process.")
    -
    -(def-alien-routine ("getppid" unix-getppid) int
    -  _N"Unix-getppid returns the process-id of the parent of the current process.")
    -
    -(def-alien-routine ("getgid" unix-getgid) int
    -  _N"Unix-getgid returns the real group-id of the current process.")
    -
    -(def-alien-routine ("getegid" unix-getegid) int
    -  _N"Unix-getegid returns the effective group-id of the current process.")
    -
    -;;; Unix-getpgrp returns the group-id associated with the
    -;;; current process.
    -
    -(defun unix-getpgrp ()
    -  _N"Unix-getpgrp returns the group-id of the calling process."
    -  (int-syscall ("getpgrp")))
    -
    -;;; Unix-setpgid sets the group-id of the process specified by 
    -;;; "pid" to the value of "pgrp".  The process must either have
    -;;; the same effective user-id or be a super-user process.
    -
    -;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
    -;;; for backward compatibility. setpgrp(void)[solaris] is being phased
    -;;; out in favor of setsid().
    -
    -(defun unix-setpgrp (pid pgrp)
    -  _N"Unix-setpgrp sets the process group on the process pid to
    -   pgrp.  NIL and an error number are returned upon failure."
    -  (void-syscall (#-svr4 "setpgrp" #+svr4 "setpgid" int int) pid pgrp))
    -
    -(defun unix-setpgid (pid pgrp)
    -  _N"Unix-setpgid sets the process group of the process pid to
    -   pgrp. If pgid is equal to pid, the process becomes a process
    -   group leader. NIL and an error number are returned upon failure."
    -  (void-syscall ("setpgid" int int) pid pgrp))
    -
    -(def-alien-routine ("getuid" unix-getuid) int
    -  _N"Unix-getuid returns the real user-id associated with the
    -   current process.")
    -
    -;;; Unix-getpagesize returns the number of bytes in the system page.
    -
    -(defun unix-getpagesize ()
    -  _N"Unix-getpagesize returns the number of bytes in a system page."
    -  (int-syscall ("getpagesize")))
    -
    -(defun unix-gethostname ()
    -  _N"Unix-gethostname returns the name of the host machine as a string."
    -  (with-alien ((buf (array char 256)))
    -    (syscall* ("gethostname" (* char) int)
    -	      (cast buf c-string)
    -	      (cast buf (* char)) 256)))
    -
    -(def-alien-routine ("gethostid" unix-gethostid) unsigned-long
    -  _N"Unix-gethostid returns a 32-bit integer which provides unique
    -   identification for the host machine.")
    -
    -(defun unix-fork ()
    -  _N"Executes the unix fork system call.  Returns 0 in the child and the pid
    -   of the child in the parent if it works, or NIL and an error number if it
    -   doesn't work."
    -  (int-syscall ("fork")))
    -
    -;; Environment manipulation; man getenv(3)
    -(def-alien-routine ("getenv" unix-getenv) c-call:c-string
    -  (name c-call:c-string) 
    -  _N"Get the value of the environment variable named Name.  If no such
    -  variable exists, Nil is returned.")
    -
    -;; This doesn't exist in Solaris 8 but does exist in Solaris 10.
    -(def-alien-routine ("setenv" unix-setenv) c-call:int
    -  (name c-call:c-string)
    -  (value c-call:c-string)
    -  (overwrite c-call:int)
    -  _N"Adds the environment variable named Name to the environment with
    -  the given Value if Name does not already exist. If Name does exist,
    -  the value is changed to Value if Overwrite is non-zero.  Otherwise,
    -  the value is not changed.")
    -
    -
    -(def-alien-routine ("putenv" unix-putenv) c-call:int
    -  (name-value c-call:c-string)
    -  _N"Adds or changes the environment.  Name-value must be a string of
    -  the form \"name=value\".  If the name does not exist, it is added.
    -  If name does exist, the value is updated to the given value.")
    -
    -;; This doesn't exist in Solaris 8 but does exist in Solaris 10.
    -(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int
    -  (name c-call:c-string)
    -  _N"Removes the variable Name from the environment")
    -
    -
    -;;; Operations on Unix Directories.
    -
    -(export '(open-dir read-dir close-dir))
    -
    -(defstruct (%directory
    -	     (:conc-name directory-)
    -	     (:constructor make-directory)
    -	     (:print-function %print-directory))
    -  name
    -  (dir-struct (required-argument) :type system-area-pointer))
    -
    -(defun %print-directory (dir stream depth)
    -  (declare (ignore depth))
    -  (format stream "#<Directory ~S>" (directory-name dir)))
    -
    -(defun open-dir (pathname)
    -  (declare (type unix-pathname pathname))
    -  (when (string= pathname "")
    -    (setf pathname "."))
    -  (let ((kind (unix-file-kind pathname)))
    -    (case kind
    -      (:directory
    -       (let ((dir-struct
    -	      (alien-funcall (extern-alien "opendir"
    -					   (function system-area-pointer
    -						     c-string))
    -			     (%name->file pathname))))
    -	 (if (zerop (sap-int dir-struct))
    -	     (values nil (unix-errno))
    -	     (make-directory :name pathname :dir-struct dir-struct))))
    -      ((nil)
    -       (values nil enoent))
    -      (t
    -       (values nil enotdir)))))
    -
    -#-(and bsd (not solaris))
    -(defun read-dir (dir)
    -  (declare (type %directory dir))
    -  (let ((daddr (alien-funcall (extern-alien "readdir"
    -					    (function system-area-pointer
    -						      system-area-pointer))
    -			      (directory-dir-struct dir))))
    -    (declare (type system-area-pointer daddr))
    -    (if (zerop (sap-int daddr))
    -	nil
    -	(with-alien ((direct (* (struct direct)) daddr))
    -	  #-(or linux svr4)
    -	  (let ((nlen (slot direct 'd-namlen))
    -		(ino (slot direct 'd-ino)))
    -	    (declare (type (unsigned-byte 16) nlen))
    -	    (let ((string (make-string nlen)))
    -	      #-unicode
    -	      (kernel:copy-from-system-area
    -	       (alien-sap (addr (slot direct 'd-name))) 0
    -	       string (* vm:vector-data-offset vm:word-bits)
    -	       (* nlen vm:byte-bits))
    -	      #+unicode
    -	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    -		(dotimes (k nlen)
    -		  (setf (aref string k)
    -			(code-char (sap-ref-8 sap k)))))
    -	      (values (%file->name string) ino)))
    -	  #+(or linux svr4)
    -	  (values (%file->name (cast (slot direct 'd-name) c-string))
    -		  (slot direct 'd-ino))))))
    -
    -;;; 64-bit readdir for Solaris
    -#+solaris
    -(defun read-dir (dir)
    -  (declare (type %directory dir))
    -  (let ((daddr (alien-funcall (extern-alien "readdir64"
    -					    (function system-area-pointer
    -						      system-area-pointer))
    -			      (directory-dir-struct dir))))
    -    (declare (type system-area-pointer daddr))
    -    (if (zerop (sap-int daddr))
    -	nil
    -	(with-alien ((direct (* (struct dirent64)) daddr))
    -	  #-(or linux svr4)
    -	  (let ((nlen (slot direct 'd-namlen))
    -		(ino (slot direct 'd-ino)))
    -	    (declare (type (unsigned-byte 16) nlen))
    -	    (let ((string (make-string nlen)))
    -	      #-unicode
    -	      (kernel:copy-from-system-area
    -	       (alien-sap (addr (slot direct 'd-name))) 0
    -	       string (* vm:vector-data-offset vm:word-bits)
    -	       (* nlen vm:byte-bits))
    -	      #+unicode
    -	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    -		(dotimes (k nlen)
    -		  (setf (aref string k)
    -			(code-char (sap-ref-8 sap k)))))
    -	      (values (%file->name string) ino)))
    -	  #+(or linux svr4)
    -	  (values (%file->name (cast (slot direct 'd-name) c-string))
    -		  (slot direct 'd-ino))))))
     
    -#+(and bsd (not solaris))
    -(defun read-dir (dir)
    -  (declare (type %directory dir))
    -  (let ((daddr (alien-funcall (extern-alien "readdir"
    -					    (function system-area-pointer
    -						      system-area-pointer))
    -			      (directory-dir-struct dir))))
    -    (declare (type system-area-pointer daddr))
    -    (if (zerop (sap-int daddr))
    -	nil
    -	(with-alien ((direct (* (struct direct)) daddr))
    -	  (let ((nlen (slot direct 'd-namlen))
    -		(fino (slot direct 'd-fileno)))
    -	    (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen)
    -		     (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino))
    -	    (let ((string (make-string nlen)))
    -	      #-unicode
    -	      (kernel:copy-from-system-area
    -	       (alien-sap (addr (slot direct 'd-name))) 0
    -	       string (* vm:vector-data-offset vm:word-bits)
    -	       (* nlen vm:byte-bits))
    -	      #+unicode
    -	      (let ((sap (alien-sap (addr (slot direct 'd-name)))))
    -		(dotimes (k nlen)
    -		  (setf (aref string k)
    -			(code-char (sap-ref-8 sap k)))))
    -	      (values (%file->name string) fino)))))))
    +;;;
    +;;; And now for something completely different ...
    +(emit-unix-errors)
     
    +(def-alien-routine ("os_get_errno" unix-get-errno) int)
    +(def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int))
    +(defun unix-errno () (unix-get-errno))
     
    -(defun close-dir (dir)
    -  (declare (type %directory dir))
    -  (alien-funcall (extern-alien "closedir"
    -			       (function void system-area-pointer))
    -		 (directory-dir-struct dir))
    -  nil)
    +;;; GET-UNIX-ERROR-MSG -- public.
    +;;; 
    +(defun get-unix-error-msg (&optional (error-number (unix-errno)))
    +  _N"Returns a string describing the error number which was returned by a
    +  UNIX system call."
    +  (declare (type integer error-number))
    +  (if (array-in-bounds-p *unix-errors* error-number)
    +      (svref *unix-errors* error-number)
    +      (format nil _"Unknown error [~d]" error-number)))
     
    +
    +;;;; Lisp types used by syscalls.
     
    -;; Use getcwd instead of getwd.  But what should we do if the path
    -;; won't fit?  Try again with a larger size?  We don't do that right
    -;; now.
    -(defun unix-current-directory ()
    -  ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
    -  (with-alien ((buf (array c-call:char 5120)))
    -    (let ((result
    -	   (alien-funcall 
    -	    (extern-alien "getcwd"
    -				(function (* c-call:char)
    -					  (* c-call:char) c-call:int))
    -	    (cast buf (* c-call:char))
    -	    5120)))
    -	
    -      (values (not (zerop
    -		    (sap-int (alien-sap result))))
    -	      (%file->name (cast buf c-call:c-string))))))
    +(deftype unix-pathname () 'simple-string)
    +(deftype unix-fd () `(integer 0 ,most-positive-fixnum))
     
    +(deftype unix-file-mode () '(unsigned-byte 32))
    +(deftype unix-uid () '(unsigned-byte 32))
    +(deftype unix-gid () '(unsigned-byte 32))
     
    -
    -;;;; Support routines for dealing with unix pathnames.
     
    -(export '(unix-file-kind unix-maybe-prepend-current-directory
    -	  unix-resolve-links unix-simplify-pathname))
    +;;; UNIX-FAST-SELECT -- public.
    +;;;
    +(defmacro unix-fast-select (num-descriptors
    +			    read-fds write-fds exception-fds
    +			    timeout-secs &optional (timeout-usecs 0))
    +  _N"Perform the UNIX select(2) system call.
    +  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)
    +	   (type (or (alien (* (struct fd-set))) null)
    +		 read-fds write-fds exception-fds)
    +	   (type (or null (unsigned-byte 31)) timeout-secs)
    +	   (type (unsigned-byte 31) timeout-usecs)
    +	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))"
    +  `(let ((timeout-secs ,timeout-secs))
    +     (with-alien ((tv (struct timeval)))
    +       (when timeout-secs
    +	 (setf (slot tv 'tv-sec) timeout-secs)
    +	 (setf (slot tv 'tv-usec) ,timeout-usecs))
    +       (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
    +		     (* (struct fd-set)) (* (struct timeval)))
    +		    ,num-descriptors ,read-fds ,write-fds ,exception-fds
    +		    (if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
     
    -(defun unix-file-kind (name &optional check-for-links)
    -  _N"Returns either :file, :directory, :link, :special, or NIL."
    -  (declare (simple-string name))
    -  (multiple-value-bind (res dev ino mode)
    -		       (if check-for-links
    -			   (unix-lstat name)
    -			   (unix-stat name))
    -    (declare (type (or fixnum null) mode)
    -	     (ignore dev ino))
    -    (when res
    -      (let ((kind (logand mode s-ifmt)))
    -	(cond ((eql kind s-ifdir) :directory)
    -	      ((eql kind s-ifreg) :file)
    -	      ((eql kind s-iflnk) :link)
    -	      (t :special))))))
    +;;; Unix-select accepts sets of file descriptors and waits for an event
    +;;; to happen on one of them or to time out.
     
    -(defun unix-maybe-prepend-current-directory (name)
    -  (declare (simple-string name))
    -  (if (and (> (length name) 0) (char= (schar name 0) #\/))
    -      name
    -      (multiple-value-bind (win dir) (unix-current-directory)
    -	(if win
    -	    (concatenate 'simple-string dir "/" name)
    -	    name))))
    +(defmacro num-to-fd-set (fdset num)
    +  `(if (fixnump ,num)
    +       (progn
    +	 (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
    +	 ,@(loop for index upfrom 1 below (/ fd-setsize 32)
    +	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
    +       (progn
    +	 ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    +	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
    +			    (ldb (byte 32 ,(* index 32)) ,num))))))
     
    -(defun unix-resolve-links (pathname)
    -  _N"Returns the pathname with all symbolic links resolved."
    -  (declare (simple-string pathname))
    -  (let ((len (length pathname))
    -	(pending pathname))
    -    (declare (fixnum len) (simple-string pending))
    -    (if (zerop len)
    -	pathname
    -	(let ((result (make-string 100 :initial-element (code-char 0)))
    -	      (fill-ptr 0)
    -	      (name-start 0))
    -	  (loop
    -	    (let* ((name-end (or (position #\/ pending :start name-start) len))
    -		   (new-fill-ptr (+ fill-ptr (- name-end name-start))))
    -	      ;; grow the result string, if necessary.  the ">=" (instead of
    -	      ;; using ">") allows for the trailing "/" if we find this
    -	      ;; component is a directory.
    -	      (when (>= new-fill-ptr (length result))
    -		(let ((longer (make-string (* 3 (length result))
    -					   :initial-element (code-char 0))))
    -		  (replace longer result :end1 fill-ptr)
    -		  (setq result longer)))
    -	      (replace result pending
    -		       :start1 fill-ptr
    -		       :end1 new-fill-ptr
    -		       :start2 name-start
    -		       :end2 name-end)
    -	      (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t)))
    -		(unless kind (return nil))
    -		(cond ((eq kind :link)
    -		       (multiple-value-bind (link err) (unix-readlink result)
    -			 (unless link
    -			   (error (intl:gettext "Error reading link ~S: ~S")
    -				  (subseq result 0 fill-ptr)
    -				  (get-unix-error-msg err)))
    -			 (cond ((or (zerop (length link))
    -				    (char/= (schar link 0) #\/))
    -				;; It's a relative link
    -				(fill result (code-char 0)
    -				      :start fill-ptr
    -				      :end new-fill-ptr))
    -			       ((string= result "/../" :end1 4)
    -				;; It's across the super-root.
    -				(let ((slash (or (position #\/ result :start 4)
    -						 0)))
    -				  (fill result (code-char 0)
    -					:start slash
    -					:end new-fill-ptr)
    -				  (setf fill-ptr slash)))
    -			       (t
    -				;; It's absolute.
    -				(and (> (length link) 0)
    -				     (char= (schar link 0) #\/))
    -				(fill result (code-char 0) :end new-fill-ptr)
    -				(setf fill-ptr 0)))
    -			 (setf pending
    -			       (if (= name-end len)
    -				   link
    -				   (concatenate 'simple-string
    -						link
    -						(subseq pending name-end))))
    -			 (setf len (length pending))
    -			 (setf name-start 0)))
    -		      ((= name-end len)
    -		       (when (eq kind :directory)
    -			 (setf (schar result new-fill-ptr) #\/)
    -			 (incf new-fill-ptr))
    -		       (return (subseq result 0 new-fill-ptr)))
    -		      ((eq kind :directory)
    -		       (setf (schar result new-fill-ptr) #\/)
    -		       (setf fill-ptr (1+ new-fill-ptr))
    -		       (setf name-start (1+ name-end)))
    -		      (t
    -		       (return nil))))))))))
    +(defmacro fd-set-to-num (nfds fdset)
    +  `(if (<= ,nfds 32)
    +       (deref (slot ,fdset 'fds-bits) 0)
    +       (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    +	      collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
    +			    ,(* index 32))))))
     
    -(defun unix-simplify-pathname (src)
    -  (declare (simple-string src))
    -  (let* ((src-len (length src))
    -	 (dst (make-string src-len))
    -	 (dst-len 0)
    -	 (dots 0)
    -	 (last-slash nil))
    -    (macrolet ((deposit (char)
    -			`(progn
    -			   (setf (schar dst dst-len) ,char)
    -			   (incf dst-len))))
    -      (dotimes (src-index src-len)
    -	(let ((char (schar src src-index)))
    -	  (cond ((char= char #\.)
    -		 (when dots
    -		   (incf dots))
    -		 (deposit char))
    -		((char= char #\/)
    -		 (case dots
    -		   (0
    -		    ;; Either ``/...' or ``...//...'
    -		    (unless last-slash
    -		      (setf last-slash dst-len)
    -		      (deposit char)))
    -		   (1
    -		    ;; Either ``./...'' or ``..././...''
    -		    (decf dst-len))
    -		   (2
    -		    ;; We've found ..
    -		    (cond
    -		     ((and last-slash (not (zerop last-slash)))
    -		      ;; There is something before this ..
    -		      (let ((prev-prev-slash
    -			     (position #\/ dst :end last-slash :from-end t)))
    -			(cond ((and (= (+ (or prev-prev-slash 0) 2)
    -				       last-slash)
    -				    (char= (schar dst (- last-slash 2)) #\.)
    -				    (char= (schar dst (1- last-slash)) #\.))
    -			       ;; The something before this .. is another ..
    -			       (deposit char)
    -			       (setf last-slash dst-len))
    -			      (t
    -			       ;; The something is some random dir.
    -			       (setf dst-len
    -				     (if prev-prev-slash
    -					 (1+ prev-prev-slash)
    -					 0))
    -			       (setf last-slash prev-prev-slash)))))
    -		     (t
    -		      ;; There is nothing before this .., so we need to keep it
    -		      (setf last-slash dst-len)
    -		      (deposit char))))
    -		   (t
    -		    ;; Something other than a dot between slashes.
    -		    (setf last-slash dst-len)
    -		    (deposit char)))
    -		 (setf dots 0))
    -		(t
    -		 (setf dots nil)
    -		 (setf (schar dst dst-len) char)
    -		 (incf dst-len))))))
    -    (when (and last-slash (not (zerop last-slash)))
    -      (case dots
    -	(1
    -	 ;; We've got  ``foobar/.''
    -	 (decf dst-len))
    -	(2
    -	 ;; We've got ``foobar/..''
    -	 (unless (and (>= last-slash 2)
    -		      (char= (schar dst (1- last-slash)) #\.)
    -		      (char= (schar dst (- last-slash 2)) #\.)
    -		      (or (= last-slash 2)
    -			  (char= (schar dst (- last-slash 3)) #\/)))
    -	   (let ((prev-prev-slash
    -		  (position #\/ dst :end last-slash :from-end t)))
    -	     (if prev-prev-slash
    -		 (setf dst-len (1+ prev-prev-slash))
    -		 (return-from unix-simplify-pathname "./")))))))
    -    (cond ((zerop dst-len)
    -	   "./")
    -	  ((= dst-len src-len)
    -	   dst)
    -	  (t
    -	   (subseq dst 0 dst-len)))))
    +;; not checked for linux...
    +(defmacro fd-set (offset fd-set)
    +  (let ((word (gensym))
    +	(bit (gensym)))
    +    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
    +       (setf (deref (slot ,fd-set 'fds-bits) ,word)
    +	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
    +		     (deref (slot ,fd-set 'fds-bits) ,word))))))
     
    -
    -;;;; Other random routines.
    +;; not checked for linux...
    +(defmacro fd-zero (fd-set)
    +  `(progn
    +     ,@(loop for index upfrom 0 below (/ fd-setsize 32)
    +	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
     
    -(def-alien-routine ("isatty" unix-isatty) boolean
    -  _N"Accepts a Unix file descriptor and returns T if the device
    -  associated with it is a terminal."
    -  (fd int))
    +(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
    +  _N"Unix-select examines the sets of descriptors passed as arguments
    +   to see if they are ready for reading and writing.  See the UNIX
    +   Programmers Manual for more information."
    +  (declare (type (integer 0 #.FD-SETSIZE) nfds)
    +	   (type unsigned-byte rdfds wrfds xpfds)
    +	   (type (or (unsigned-byte 31) null) to-secs)
    +	   (type (unsigned-byte 31) to-usecs)
    +	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
    +  (with-alien ((tv (struct timeval))
    +	       (rdf (struct fd-set))
    +	       (wrf (struct fd-set))
    +	       (xpf (struct fd-set)))
    +    (when to-secs
    +      (setf (slot tv 'tv-sec) to-secs)
    +      (setf (slot tv 'tv-usec) to-usecs))
    +    (num-to-fd-set rdf rdfds)
    +    (num-to-fd-set wrf wrfds)
    +    (num-to-fd-set xpf xpfds)
    +    (macrolet ((frob (lispvar alienvar)
    +		 `(if (zerop ,lispvar)
    +		      (int-sap 0)
    +		      (alien-sap (addr ,alienvar)))))
    +      (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
    +		(* (struct fd-set)) (* (struct timeval)))
    +	       (values result
    +		       (fd-set-to-num nfds rdf)
    +		       (fd-set-to-num nfds wrf)
    +		       (fd-set-to-num nfds xpf))
    +	       nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
    +	       (if to-secs (alien-sap (addr tv)) (int-sap 0))))))
     
    -(def-alien-routine ("ttyname" unix-ttyname) c-string
    -  (fd int))
    +(defun unix-symlink (name1 name2)
    +  _N"Unix-symlink creates a symbolic link named name2 to the file
    +   named name1.  NIL and an error number is returned if the call
    +   is unsuccessful."
    +  (declare (type unix-pathname name1 name2))
    +  (void-syscall ("symlink" c-string c-string)
    +		(%name->file name1) (%name->file name2)))
     
    -(def-alien-routine ("openpty" unix-openpty) int
    -  (amaster int :out)
    -  (aslave int :out)
    -  (name c-string)
    -  (termp (* (struct termios)))
    -  (winp (* (struct winsize))))
    +(def-alien-type nil
    +  (struct timeval
    +    (tv-sec #-linux time-t #+linux int)		; seconds
    +    (tv-usec int)))				; and microseconds
    +
    +(def-alien-type nil
    +  (struct timezone
    +    (tz-minuteswest int)		; minutes west of Greenwich
    +    (tz-dsttime				; type of dst correction
    +     #-linux (enum nil :none :usa :aust :wet :met :eet :can)
    +     #+linux int)))
     
    +(declaim (inline unix-gettimeofday))
    +(defun unix-gettimeofday ()
    +  _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and
    +   microseconds of the current time of day, the timezone (in minutes west
    +   of Greenwich), and a daylight-savings flag.  If it doesn't work, it
    +   returns NIL and the errno."
    +  (with-alien ((tv (struct timeval))
    +	       #-(or svr4 netbsd) (tz (struct timezone)))
    +    (syscall* (#-netbsd "gettimeofday"
    +	       #+netbsd  "__gettimeofday50"
    +	       (* (struct timeval)) #-svr4 (* (struct timezone)))
    +	      (values T
    +		      (slot tv 'tv-sec)
    +		      (slot tv 'tv-usec)
    +		      #-(or svr4 netbsd) (slot tz 'tz-minuteswest)
    +		      #+svr4 (unix-get-minutes-west (slot tv 'tv-sec))
    +		      #-(or svr4 netbsd) (slot tz 'tz-dsttime)
    +		      #+svr4 (unix-get-timezone (slot tv 'tv-sec))
    +		      )
    +	      (addr tv)
    +	      #-(or svr4 netbsd) (addr tz) #+netbsd nil)))
     
    -
    -;;;; UNIX-EXECVE
    -
    -(defun unix-execve (program &optional arg-list
    -			    (environment *environment-list*))
    -  _N"Executes the Unix execve system call.  If the system call suceeds, lisp
    -   will no longer be running in this process.  If the system call fails this
    -   function returns two values: NIL and an error code.  Arg-list should be a
    -   list of simple-strings which are passed as arguments to the exec'ed program.
    -   Environment should be an a-list mapping symbols to simple-strings which this
    -   function bashes together to form the environment for the exec'ed program."
    -  (check-type program simple-string)
    -  (let ((env-list (let ((envlist nil))
    -		    (dolist (cons environment)
    -		      (push (if (cdr cons)
    -				(concatenate 'simple-string
    -					     (string (car cons)) "="
    -					     (cdr cons))
    -				(car cons))
    -			    envlist))
    -		    envlist)))
    -    (sub-unix-execve (%name->file program) arg-list env-list)))
    -
    -
    -(defmacro round-bytes-to-words (n)
    -  `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
    +;;; Unix-utimes changes the accessed and updated times on UNIX
    +;;; files.  The first argument is the filename (a string) and
    +;;; the second argument is a list of the 4 times- accessed and
    +;;; updated seconds and microseconds.
     
    -;;;
    -;;; STRING-LIST-TO-C-STRVEC	-- Internal
    -;;; 
    -;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of
    -;;; simple-strings and constructs a C-style string vector (strvec) --
    -;;; a null-terminated array of pointers to null-terminated strings.
    -;;; This function returns two values: a sap and a byte count.  When the
    -;;; memory is no longer needed it should be deallocated with
    -;;; vm_deallocate.
    -;;; 
    -(defun string-list-to-c-strvec (string-list)
    -  ;;
    -  ;; Make a pass over string-list to calculate the amount of memory
    -  ;; needed to hold the strvec.
    -  (let ((string-bytes 0)
    -	(vec-bytes (* 4 (1+ (length string-list)))))
    -    (declare (fixnum string-bytes vec-bytes))
    -    (dolist (s string-list)
    -      (check-type s simple-string)
    -      (incf string-bytes (round-bytes-to-words (1+ (length s)))))
    -    ;;
    -    ;; Now allocate the memory and fill it in.
    -    (let* ((total-bytes (+ string-bytes vec-bytes))
    -	   (vec-sap (system:allocate-system-memory total-bytes))
    -	   (string-sap (sap+ vec-sap vec-bytes))
    -	   (i 0))
    -      (declare (type (and unsigned-byte fixnum) total-bytes i)
    -	       (type system:system-area-pointer vec-sap string-sap))
    -      (dolist (s string-list)
    -	(declare (simple-string s))
    -	(let ((n (length s)))
    -	  ;; 
    -	  ;; Blast the string into place
    -	  #-unicode
    -	  (kernel:copy-to-system-area (the simple-string s)
    -				      (* vm:vector-data-offset vm:word-bits)
    -				      string-sap 0
    -				      (* (1+ n) vm:byte-bits))
    -	  #+unicode
    -	  (progn
    -	    ;; FIXME: Do we need to apply some kind of transformation
    -	    ;; to convert Lisp unicode strings to C strings?  Utf-8?
    -	    (dotimes (k n)
    -	      (setf (sap-ref-8 string-sap k)
    -		    (logand #xff (char-code (aref s k)))))
    -	    (setf (sap-ref-8 string-sap n) 0))
    -	  
    -	  ;; 
    -	  ;; Blast the pointer to the string into place
    -	  (setf (sap-ref-sap vec-sap i) string-sap)
    -	  (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
    -	  (incf i 4)))
    -      ;; Blast in last null pointer
    -      (setf (sap-ref-sap vec-sap i) (int-sap 0))
    -      (values vec-sap total-bytes))))
    -
    -(defun sub-unix-execve (program arg-list env-list)
    -  (let ((argv nil)
    -	(argv-bytes 0)
    -	(envp nil)
    -	(envp-bytes 0)
    -	result error-code)
    -    (unwind-protect
    -	(progn
    -	  ;; Blast the stuff into the proper format
    -	  (multiple-value-setq
    -	      (argv argv-bytes)
    -	    (string-list-to-c-strvec arg-list))
    -	  (multiple-value-setq
    -	      (envp envp-bytes)
    -	    (string-list-to-c-strvec env-list))
    -	  ;;
    -	  ;; Now do the system call
    -	  (multiple-value-setq
    -	      (result error-code)
    -	    (int-syscall ("execve"
    -			  c-string system-area-pointer system-area-pointer)
    -			 program argv envp)))
    -      ;; 
    -      ;; Deallocate memory
    -      (when argv
    -	(system:deallocate-system-memory argv argv-bytes))
    -      (when envp
    -	(system:deallocate-system-memory envp envp-bytes)))
    -    (values result error-code)))
    +#-hpux
    +(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
    +  _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
    +   times on a specified file.  NIL and an error number is
    +   returned if the call is unsuccessful."
    +  (declare (type unix-pathname file)
    +	   (type (alien unsigned-long)
    +		 atime-sec atime-usec
    +		 mtime-sec mtime-usec))
    +  (with-alien ((tvp (array (struct timeval) 2)))
    +    (setf (slot (deref tvp 0) 'tv-sec) atime-sec)
    +    (setf (slot (deref tvp 0) 'tv-usec) atime-usec)
    +    (setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
    +    (setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
    +    (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval)))
    +		  file
    +		  (cast tvp (* (struct timeval))))))
     
    +(def-alien-routine ("getpid" unix-getpid) int
    +  _N"Unix-getpid returns the process-id of the current process.")
     
     
     ;;;; Socket support.
    @@ -3061,88 +2163,190 @@
     
     ;; Datagram support
     
    -(defun unix-recvfrom (fd buffer length flags sockaddr len)
    -  (with-alien ((l c-call:int len))
    -    (values
    -     (alien-funcall (extern-alien "recvfrom"
    -				  (function c-call:int
    -					    c-call:int
    -					    system-area-pointer
    -					    c-call:int
    -					    c-call:int
    -					    (* t)
    -					    (* c-call:int)))
    -		    fd
    -		    (system:vector-sap buffer)
    -		    length
    -		    flags
    -		    sockaddr
    -		    (addr l))
    -     l)))
    +(defun unix-recvfrom (fd buffer length flags sockaddr len)
    +  (with-alien ((l c-call:int len))
    +    (values
    +     (alien-funcall (extern-alien "recvfrom"
    +				  (function c-call:int
    +					    c-call:int
    +					    system-area-pointer
    +					    c-call:int
    +					    c-call:int
    +					    (* t)
    +					    (* c-call:int)))
    +		    fd
    +		    (system:vector-sap buffer)
    +		    length
    +		    flags
    +		    sockaddr
    +		    (addr l))
    +     l)))
    +
    +#-unicode
    +(def-alien-routine ("sendto" unix-sendto) int
    +  (fd int)
    +  (buffer c-string)
    +  (length int)
    +  (flags int)
    +  (sockaddr (* t))
    +  (len int))
    +
    +(defun unix-sendto (fd buffer length flags sockaddr len)
    +  (alien-funcall (extern-alien "sendto"
    +			       (function c-call:int
    +					 c-call:int
    +					 system-area-pointer
    +					 c-call:int
    +					 c-call:int
    +					 (* t)
    +					 c-call:int))
    +		 fd
    +		 (system:vector-sap buffer)
    +		 length
    +		 flags
    +		 sockaddr
    +		 len))
    +
    +(def-alien-routine ("shutdown" unix-shutdown) int
    +  (socket int)
    +  (level int))
    +
    +
    +;;;; Memory-mapped files
    +
    +(defconstant +null+ (sys:int-sap 0))
    +
    +(defconstant prot_read 1)		; Readable
    +(defconstant prot_write 2)		; Writable
    +(defconstant prot_exec 4)		; Executable
    +(defconstant prot_none 0)		; No access
    +
    +(defconstant map_shared 1)		; Changes are shared
    +(defconstant map_private 2)		; Changes are private
    +(defconstant map_fixed 16)		; Fixed, user-defined address
    +(defconstant map_noreserve #x40)	; Don't reserve swap space
    +(defconstant map_anonymous
    +  #+solaris #x100			; Solaris
    +  #+linux 32				; Linux
    +  #+bsd #x1000)
    +
    +(defconstant ms_async 1)
    +(defconstant ms_sync 4)
    +(defconstant ms_invalidate 2)
    +
    +;; The return value from mmap that means mmap failed.
    +(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
    +
    +(defun unix-mmap (addr length prot flags fd offset)
    +  (declare (type (or null system-area-pointer) addr)
    +	   (type (unsigned-byte 32) length)
    +           (type (integer 1 7) prot)
    +	   (type (unsigned-byte 32) flags)
    +	   (type (or null unix-fd) fd)
    +	   (type file-offset offset))
    +  ;; Can't use syscall, because the address that is returned could be
    +  ;; "negative".  Hence we explicitly check for mmap returning
    +  ;; MAP_FAILED.
    +  (let ((result
    +	 (alien-funcall (extern-alien "mmap" (function system-area-pointer
    +						       system-area-pointer
    +						       size-t int int int off-t))
    +			(or addr +null+) length prot flags (or fd -1) offset)))
    +    (if (sap= result map_failed)
    +	(values nil (unix-errno))
    +	(values result 0))))
    +
    +(defun unix-munmap (addr length)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length))
    +  (syscall ("munmap" system-area-pointer size-t) t addr length))
    +
    +(defun unix-mprotect (addr length prot)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length)
    +           (type (integer 1 7) prot))
    +  (syscall ("mprotect" system-area-pointer size-t int)
    +	   t addr length prot))
    +  
    +(defun unix-msync (addr length flags)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length)
    +	   (type (signed-byte 32) flags))
    +  (syscall ("msync" system-area-pointer size-t int) t addr length flags))
    +
    +
    +;;;; User and group database structures
    +
    +(defstruct user-info
    +  (name "" :type string)
    +  (password "" :type string)
    +  (uid 0 :type unix-uid)
    +  (gid 0 :type unix-gid)
    +  #+solaris (age "" :type string)
    +  #+solaris (comment "" :type string)
    +  #+freebsd (change -1 :type fixnum)
    +  (gecos "" :type string)
    +  (dir "" :type string)
    +  (shell "" :type string))
    +
    +;; see <pwd.h>
    +#+solaris
    +(def-alien-type nil
    +    (struct passwd
    +	    (pw-name (* char))          ; user's login name
    +	    (pw-passwd (* char))        ; no longer used
    +	    (pw-uid uid-t)              ; user id
    +	    (pw-gid gid-t)              ; group id
    +	    (pw-age (* char))           ; password age (not used)
    +	    (pw-comment (* char))       ; not used
    +	    (pw-gecos (* char))         ; typically user's full name
    +	    (pw-dir (* char))           ; user's home directory
    +	    (pw-shell (* char))))       ; user's login shell
    +
    +#+bsd
    +(def-alien-type nil
    +    (struct passwd
    +	    (pw-name (* char))          ; user's login name
    +	    (pw-passwd (* char))        ; no longer used
    +	    (pw-uid uid-t)              ; user id
    +	    (pw-gid gid-t)              ; group id
    +            (pw-change int)             ; password change time
    +            (pw-class (* char))         ; user access class
    +	    (pw-gecos (* char))         ; typically user's full name
    +	    (pw-dir (* char))           ; user's home directory
    +	    (pw-shell (* char))         ; user's login shell
    +            (pw-expire int)             ; account expiration
    +            #+(or freebsd darwin)
    +	    (pw-fields int)))           ; internal
    +
    +;;;; Other random routines.
    +(def-alien-routine ("isatty" unix-isatty) boolean
    +  _N"Accepts a Unix file descriptor and returns T if the device
    +  associated with it is a terminal."
    +  (fd int))
     
    -#-unicode
    -(def-alien-routine ("sendto" unix-sendto) int
    -  (fd int)
    -  (buffer c-string)
    -  (length int)
    -  (flags int)
    -  (sockaddr (* t))
    -  (len int))
    +(def-alien-routine ("ttyname" unix-ttyname) c-string
    +  (fd int))
     
    -(defun unix-sendto (fd buffer length flags sockaddr len)
    -  (alien-funcall (extern-alien "sendto"
    -			       (function c-call:int
    -					 c-call:int
    -					 system-area-pointer
    -					 c-call:int
    -					 c-call:int
    -					 (* t)
    -					 c-call:int))
    -		 fd
    -		 (system:vector-sap buffer)
    -		 length
    -		 flags
    -		 sockaddr
    -		 len))
    +(def-alien-routine ("openpty" unix-openpty) int
    +  (amaster int :out)
    +  (aslave int :out)
    +  (name c-string)
    +  (termp (* (struct termios)))
    +  (winp (* (struct winsize))))
     
    -(def-alien-routine ("shutdown" unix-shutdown) int
    -  (socket int)
    -  (level int))
    +(def-alien-type nil
    +  (struct itimerval
    +    (it-interval (struct timeval))	; timer interval
    +    (it-value (struct timeval))))	; current value
     
    -
     ;;;
     ;;; Support for the Interval Timer (experimental)
     ;;;
    -
    -
     (defconstant ITIMER-REAL 0)
     (defconstant ITIMER-VIRTUAL 1)
     (defconstant ITIMER-PROF 2)
     
    -(defun unix-getitimer (which)
    -  _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of
    -   three system timers (:real :virtual or :profile). On success,
    -   unix-getitimer returns 5 values,
    -   T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
    -  (declare (type (member :real :virtual :profile) which)
    -	   (values t
    -		   #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
    -		   (mod 1000000)
    -		   #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
    -		   (mod 1000000)))
    -  (let ((which (ecase which
    -		 (:real ITIMER-REAL)
    -		 (:virtual ITIMER-VIRTUAL)
    -		 (:profile ITIMER-PROF))))
    -    (with-alien ((itv (struct itimerval)))
    -      (syscall* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval)))
    -		(values T
    -			(slot (slot itv 'it-interval) 'tv-sec)
    -			(slot (slot itv 'it-interval) 'tv-usec)
    -			(slot (slot itv 'it-value) 'tv-sec)
    -			(slot (slot itv 'it-value) 'tv-usec))
    -		which (alien-sap (addr itv))))))
    -
     (defun unix-setitimer (which int-secs int-usec val-secs val-usec)
       _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of
        three system timers (:real :virtual or :profile). A SIGALRM signal
    @@ -3182,57 +2386,6 @@
     ;;;; User and group database access, POSIX Standard 9.2.2
     
     #+solaris
    -(defun unix-getpwnam (login)
    -  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    -  (declare (type simple-string login))
    -  (with-alien ((buf (array c-call:char 1024))
    -	       (user-info (struct passwd)))
    -    (let ((result
    -	   (alien-funcall
    -	    (extern-alien "getpwnam_r"
    -			  (function (* (struct passwd))
    -				    c-call:c-string
    -				    (* (struct passwd))
    -				    (* c-call:char)
    -				    c-call:unsigned-int))
    -	    login
    -	    (addr user-info)
    -	    (cast buf (* c-call:char))
    -	    1024)))
    -      (when (not (zerop (sap-int (alien-sap result))))
    -	(make-user-info
    -	 :name (string (cast (slot result 'pw-name) c-call:c-string))
    -	 :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    -	 :uid (slot result 'pw-uid)
    -	 :gid (slot result 'pw-gid)
    -	 :age (string (cast (slot result 'pw-age) c-call:c-string))
    -	 :comment (string (cast (slot result 'pw-comment) c-call:c-string))
    -	 :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    -	 :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    -	 :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    -
    -#+bsd
    -(defun unix-getpwnam (login)
    -  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    -  (declare (type simple-string login))
    -  (let ((result
    -         (alien-funcall
    -          (extern-alien "getpwnam"
    -                        (function (* (struct passwd))
    -                                  c-call:c-string))
    -          login)))
    -    (when (not (zerop (sap-int (alien-sap result))))
    -      (make-user-info
    -       :name (string (cast (slot result 'pw-name) c-call:c-string))
    -       :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    -       :uid (slot result 'pw-uid)
    -       :gid (slot result 'pw-gid)
    -       #-darwin :change #-darwin (slot result 'pw-change)
    -       :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    -       :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    -       :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
    -
    -#+solaris
     (defun unix-getpwuid (uid)
       _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
       (declare (type unix-uid uid))
    @@ -3282,145 +2435,66 @@
            :dir (string (cast (slot result 'pw-dir) c-call:c-string))
            :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
     
    -#+solaris
    -(eval-when (:compile-toplevel :load-toplevel :execute)
    -  ;; sysconf(_SC_GETGR_R_SIZE_MAX)
    -  (defconstant +sc-getgr-r-size-max+ 7296
    -    _N"The maximum size of the group entry buffer"))
    -
    -#+solaris
    -(defun unix-getgrnam (name)
    -  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    -  (declare (type simple-string name))
    -  (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
    -	       (group-info (struct group)))
    -    (let ((result
    -	   (alien-funcall
    -	    (extern-alien "getgrnam_r"
    -			  (function (* (struct group))
    -                                    c-call:c-string
    -                                    (* (struct group))
    -                                    (* c-call:char)
    -                                    c-call:unsigned-int))
    -	    name
    -	    (addr group-info)
    -	    (cast buf (* c-call:char))
    -	    #.+sc-getgr-r-size-max+)))
    -      (unless (zerop (sap-int (alien-sap result)))
    -	(make-group-info
    -	 :name (string (cast (slot result 'gr-name) c-call:c-string))
    -	 :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -	 :gid (slot result 'gr-gid)
    -         :members (loop :with members = (slot result 'gr-mem)
    -                        :for i :from 0
    -                        :for member = (deref members i)
    -                        :until (zerop (sap-int (alien-sap member)))
    -                        :collect (string (cast member c-call:c-string))))))))
    -
    -#+bsd
    -(defun unix-getgrnam (name)
    -  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    -  (declare (type simple-string name))
    -  (let ((result
    -         (alien-funcall
    -          (extern-alien "getgrnam"
    -                        (function (* (struct group))
    -                                  c-call:c-string))
    -          name)))
    -    (unless (zerop (sap-int (alien-sap result)))
    -      (make-group-info
    -       :name (string (cast (slot result 'gr-name) c-call:c-string))
    -       :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -       :gid (slot result 'gr-gid)
    -       :members (loop :with members = (slot result 'gr-mem)
    -                      :for i :from 0
    -                      :for member = (deref members i)
    -                      :until (zerop (sap-int (alien-sap member)))
    -                      :collect (string (cast member c-call:c-string)))))))
    -
    -#+solaris
    -(defun unix-getgrgid (gid)
    -  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    -  (declare (type unix-gid gid))
    -  (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
    -	       (group-info (struct group)))
    -    (let ((result
    -	   (alien-funcall
    -	    (extern-alien "getgrgid_r"
    -			  (function (* (struct group))
    -				     c-call:unsigned-int
    -				     (* (struct group))
    -				     (* c-call:char)
    -				     c-call:unsigned-int))
    -	    gid
    -	    (addr group-info)
    -	    (cast buf (* c-call:char))
    -	    #.+sc-getgr-r-size-max+)))
    -      (unless (zerop (sap-int (alien-sap result)))
    -	(make-group-info
    -	 :name (string (cast (slot result 'gr-name) c-call:c-string))
    -	 :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -	 :gid (slot result 'gr-gid)
    -	 :members (loop :with members = (slot result 'gr-mem)
    -		        :for i :from 0
    -		        :for member = (deref members i)
    -		        :until (zerop (sap-int (alien-sap member)))
    -		        :collect (string (cast member c-call:c-string))))))))
    -
    -#+bsd
    -(defun unix-getgrgid (gid)
    -  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    -  (declare (type unix-gid gid))
    -  (let ((result
    -         (alien-funcall
    -          (extern-alien "getgrgid"
    -                        (function (* (struct group))
    -                                  c-call:unsigned-int))
    -          gid)))
    -    (unless (zerop (sap-int (alien-sap result)))
    -      (make-group-info
    -       :name (string (cast (slot result 'gr-name) c-call:c-string))
    -       :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    -       :gid (slot result 'gr-gid)
    -       :members (loop :with members = (slot result 'gr-mem)
    -                      :for i :from 0
    -                      :for member = (deref members i)
    -                      :until (zerop (sap-int (alien-sap member)))
    -                      :collect (string (cast member c-call:c-string)))))))
    -
    -#+solaris
    -(defun unix-setpwent ()
    -  (void-syscall ("setpwent")))
    +;;; Getrusage is not provided in the C library on Solaris 2.4, and is
    +;;; rather slow on later versions so the "times" system call is
    +;;; provided.
    +#+(and sparc svr4)
    +(progn
    +(def-alien-type nil
    +  (struct tms
    +    (tms-utime #-alpha long #+alpha int)	; user time used
    +    (tms-stime #-alpha long #+alpha int)	; system time used.
    +    (tms-cutime #-alpha long #+alpha int)	; user time, children
    +    (tms-cstime #-alpha long #+alpha int)))	; system time, children
     
    -#+solaris
    -(defun unix-endpwent ()
    -  (void-syscall ("endpwent")))
    +(declaim (inline unix-times))
    +(defun unix-times ()
    +  _N"Unix-times returns information about the cpu time usage of the process
    +   and its children."
    +  (with-alien ((usage (struct tms)))
    +    (alien-funcall (extern-alien "times" (function int (* (struct tms))))
    +		   (addr usage))
    +    (values t
    +	    (slot usage 'tms-utime)
    +	    (slot usage 'tms-stime)
    +	    (slot usage 'tms-cutime)
    +	    (slot usage 'tms-cstime))))
    +) ; end progn
     
    -#+solaris
    -(defun unix-getpwent ()
    -  (with-alien ((buf (array c-call:char 1024))
    -	       (user-info (struct passwd)))
    -    (let ((result
    -	   (alien-funcall
    -	    (extern-alien "getpwent_r"
    -			  (function (* (struct passwd))
    -				    (* (struct passwd))
    -				    (* c-call:char)
    -				    c-call:unsigned-int))
    -	    (addr user-info)
    -	    (cast buf (* c-call:char))
    -	    1024)))
    -      (when (not (zerop (sap-int (alien-sap result))))
    -	(make-user-info
    -	 :name (string (cast (slot result 'pw-name) c-call:c-string))
    -	 :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    -	 :uid (slot result 'pw-uid)
    -	 :gid (slot result 'pw-gid)
    -	 :age (string (cast (slot result 'pw-age) c-call:c-string))
    -	 :comment (string (cast (slot result 'pw-comment) c-call:c-string))
    -	 :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    -	 :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    -	 :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    +;; Requires call to tzset() in main.
    +;; Don't use this now: we 
    +#+(or linux svr4)
    +(progn
    +    (def-alien-variable ("daylight" unix-daylight) int)
    +    (def-alien-variable ("timezone" unix-timezone) time-t)
    +    (def-alien-variable ("altzone" unix-altzone) time-t)
    +    #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2))
    +    #+irix (defvar unix-tzname-addr nil)
    +    #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil))
    +                    ext:*after-save-initializations*)
    +    #+irix (declaim (notinline fakeout-compiler))
    +    #+irix (defun fakeout-compiler (name dst)
    +             (unless unix-tzname-addr
    +               (setf unix-tzname-addr (system:foreign-symbol-address
    +				       name
    +				       :flavor :data)))
    +              (deref (sap-alien unix-tzname-addr (array c-string 2)) dst))
    +    (def-alien-routine get-timezone c-call:void
    +		       (when c-call:long :in)
    +		       (minutes-west c-call:int :out)
    +		       (daylight-savings-p alien:boolean :out))
    +    (defun unix-get-minutes-west (secs)
    +	   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    +				(declare (ignore ignore) (ignore dst))
    +				(values minutes))
    +	    )
    +    (defun unix-get-timezone (secs)
    +	   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    +				(declare (ignore ignore) (ignore minutes))
    +                                (values #-irix (deref unix-tzname (if dst 1 0))
    +                                        #+irix (fakeout-compiler "tzname" (if dst 1 0)))
    +	    ) )
    +)
     
     (def-alien-type nil
       (struct utsname
    @@ -3443,105 +2517,3 @@
     		      (cast (slot names 'machine) c-string))
     	      #+freebsd 256
     	      (addr names))))
    -
    -#+(and solaris svr4)
    -(export '(unix-sysinfo
    -	  si-sysname si-hostname si-release si-version si-machine
    -	  si-architecture si-hw-serial si-hw-provider si-srpc-domain
    -	  si-platform si-isalist si-dhcp-cache))
    -
    -#+(and solaris svr4)
    -(progn
    -;; From sys/systeminfo.h.  We don't list the set values here.
    -(def-enum + 1
    -  si-sysname si-hostname si-release si-version si-machine
    -  si-architecture si-hw-serial si-hw-provider si-srpc-domain)
    -
    -(def-enum + 513
    -  si-platform si-isalist si-dhcp-cache)
    -
    -
    -(defun unix-sysinfo (command)
    -  ;; Hope a buffer of length 2048 is long enough.
    -  (with-alien ((buf (array c-call:unsigned-char 2048)))
    -    (let ((result
    -	   (alien-funcall
    -	    (extern-alien "sysinfo"
    -			  (function c-call:int
    -				    c-call:int
    -				    c-call:c-string
    -				    c-call:int))
    -	    command
    -	    (cast buf (* c-call:char))
    -	    2048)))
    -      (when (>= result 0)
    -	(cast buf c-call:c-string)))))
    -)
    -
    -#+solaris
    -(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core rlimit_nofile
    -	  rlimit_vmem rlimit_as))
    -
    -#+solaris
    -(progn
    -(defconstant rlimit_cpu 0
    -  _N"CPU time per process (in milliseconds)")
    -(defconstant rlimit_fsize 1
    -  _N"Maximum file size")
    -(defconstant rlimit_data 2
    -  _N"Data segment size")
    -(defconstant rlimit_stack 3
    -  _N"Stack size")
    -(defconstant rlimit_core 4
    -  _N"Core file size")
    -(defconstant rlimit_nofile 5
    -  _N"Number of open files")
    -(defconstant rlimit_vmem 6
    -  _N"Maximum mapped memory")
    -(defconstant rlimit_as rlimit_vmem)
    -)
    -
    -#+(and darwin x86)
    -(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core
    -	  rlimit_as rlimit_rss rlimit_memlock rlimit_nproc rlimit_nofile))
    -
    -#+(and darwin x86)
    -(progn
    -(defconstant rlimit_cpu 0
    -  _N"CPU time per process")
    -(defconstant rlimit_fsize 1
    -  _N"File size")
    -(defconstant rlimit_data 2
    -  _N"Data segment size")
    -(defconstant rlimit_stack 3
    -  _N"Stack size")
    -(defconstant rlimit_core 4
    -  _N"Core file size")
    -(defconstant rlimit_as 5
    -  _N"Addess space (resident set size)")
    -(defconstant rlimit_rss rlimit_as)
    -(defconstant rlimit_memlock 6
    -  _N"Locked-in-memory address space")
    -(defconstant rlimit_nproc 7
    -  _N"Number of processes")
    -(defconstant rlimit_nofile 8
    -  _N"Number of open files")
    -)
    -
    -
    -#+(or solaris (and darwin x86))
    -(export '(unix-getrlimit))
    -
    -#+(or solaris (and darwin x86))
    -(defun unix-getrlimit (resource)
    -  _N"Get the limits on the consumption of system resouce specified by
    -  Resource.  If successful, return three values: T, the current (soft)
    -  limit, and the maximum (hard) limit."
    -  
    -  (with-alien ((rlimit (struct rlimit)))
    -    (syscall ("getrlimit" c-call:int (* (struct rlimit)))
    -	     (values t
    -		     (slot rlimit 'rlim-cur)
    -		     (slot rlimit 'rlim-max))
    -	     resource (addr rlimit))))
    -;; EOF
    

  • src/contrib/load-unix.lisp
    --- /dev/null
    +++ b/src/contrib/load-unix.lisp
    @@ -0,0 +1,7 @@
    +;; Load extra functionality in the UNIX package.
    +
    +(ext:without-package-locks
    +  (load (compile-file-pathname #-linux "modules:unix/unix"
    +			       #+linux "modules:unix/unix-glibc2")))
    +
    +(provide 'unix)
    

  • src/contrib/unix/unix-glibc2.lisp
    --- /dev/null
    +++ b/src/contrib/unix/unix-glibc2.lisp
    @@ -0,0 +1,2053 @@
    +;;; -*- Package: UNIX -*-
    +;;;
    +;;; **********************************************************************
    +;;; This code was written as part of the CMU Common Lisp project at
    +;;; Carnegie Mellon University, and has been placed in the public domain.
    +;;;
    +(ext:file-comment
    +  "$Header: src/code/unix-glibc2.lisp $")
    +;;;
    +;;; **********************************************************************
    +;;;
    +;;; This file contains the UNIX low-level support for glibc2.  Based
    +;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998).
    +;;; Alpha support by Julian Dolby, 1999.
    +;;;
    +;;; All the functions with #+(or) in front are work in progress,
    +;;; and mostly don't work.
    +;;;
    +;; Todo: #+(or)'ed stuff and ioctl's
    +;;
    +;;
    +;; Large File Support (LFS) added by Pierre Mai and Eric Marsden, Feb
    +;; 2003. This is necessary to be able to read/write/stat files that
    +;; are larger than 2GB on a 32-bit system. From a C program, defining
    +;; a preprocessor macro _LARGEFILE64_SOURCE makes the preproccessor
    +;; replace a call to open() by open64(), and similarly for stat,
    +;; fstat, lstat, lseek, readdir and friends. Furthermore, certain data
    +;; types, that are normally 32 bits wide, are replaced by 64-bit wide
    +;; equivalents: off_t -> off64_t etc. The libc.so fiddles around with
    +;; weak symbols to support this mess.
    +;;
    +;; From CMUCL, we make FFI calls to the xxx64 functions, and use the
    +;; 64-bit wide versions of the data structures. The most ugly aspect
    +;; is that some of the stat functions are not available via dlsym, so
    +;; we reference them explicitly from linux-stubs.S. Another amusing
    +;; fact is that on glibc 2.2, stat64() returns a struct stat with a
    +;; 32-bit ino_t, whereas readdir64() returns a struct dirent that
    +;; contains a 64-bit ino_t.  On glibc 2.1, OTOH, both stat64 and
    +;; readdir64 use structs with 32-bit ino_t.
    +;;
    +;; The current version deals with this by going with the glibc 2.2
    +;; definitions, unless the keyword :glibc2.1 also occurs on *features*,
    +;; in addition to :glibc2, in which case we go with the glibc 2.1
    +;; definitions.  Note that binaries compiled against glibc 2.1 do in
    +;; fact work fine on glibc 2.2, because readdir64 is available in both
    +;; glibc 2.1 and glibc 2.2 versions in glibc 2.2, disambiguated through
    +;; ELF symbol versioning.  We use an entry for readdir64 in linux-stubs.S
    +;; in order to force usage of the correct version of readdir64 at runtime.
    +;;
    +;; So in order to compile for glibc 2.2 and newer, just compile CMUCL
    +;; on a glibc 2.2 system, and make sure that :glibc2.1 doesn't appear
    +;; on the *features* list.  In order to compile for glibc 2.1 and newer,
    +;; compile CMUCL on a glibc 2.1 system, and make sure that :glibc2.1 does
    +;; appear on the *features* list.
    +
    +(in-package "UNIX")
    +(use-package "ALIEN")
    +(use-package "C-CALL")
    +(use-package "SYSTEM")
    +(use-package "EXT")
    +(intl:textdomain "cmucl-unix-glibc2")
    +
    +(export '(
    +	  daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
    +          blkcnt-t fsblkcnt-t fsfilcnt-t
    +	  unix-lockf f_ulock f_lock f_tlock f_test
    +	  timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
    +	  itimerval it-interval it-value tchars t-intrc t-quitc t-startc
    +	  t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
    +	  t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
    +	  sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
    +	  direct d-off d-ino d-reclen  d-name
    +	  stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
    +	  st-atime st-mtime st-ctime st-blksize st-blocks
    +	  s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
    +	  s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
    +	  ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
    +	  ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
    +	  ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
    +	  rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
    +	  unix-errno get-unix-error-msg
    +	  prot_read prot_write prot_exec prot_none
    +	  map_shared map_private map_fixed map_anonymous
    +	  ms_async ms_sync ms_invalidate
    +	  unix-mmap unix-munmap unix-msync unix-mprotect
    +	  unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
    +	  unix-setitimer unix-getitimer
    +	  unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
    +	  setgidexec savetext readown writeown execown readgrp writegrp
    +	  execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
    +	  unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
    +	  unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
    +	  fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
    +	  l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
    +	  o_ndelay
    +	  o_noctty
    +	  o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
    +	  unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
    +	  fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
    +	  unix-ftruncate unix-symlink unix-unlink unix-write unix-ioctl
    +	  unix-uname utsname
    +	  tcsetpgrp tcgetpgrp tty-process-group
    +	  terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
    +	  tty-cbreak
    +	   termios
    +           c-lflag
    +	   c-iflag
    +           c-oflag
    +	   tty-icrnl
    +           tty-ocrnl
    +	   veof
    +	   vintr
    +           vquit
    +           vstart
    +	   vstop
    +           vsusp
    +	   c-cflag
    +	   c-cc
    +           tty-icanon
    +	   vmin
    +           vtime
    +	   tty-ixon
    +           tcsanow
    +           tcsadrain
    +           tciflush
    +           tcoflush
    +           tcioflush
    +	   tcsaflush
    +           unix-tcgetattr
    +           unix-tcsetattr
    +           tty-ignbrk
    +           tty-brkint
    +           tty-ignpar
    +           tty-parmrk
    +           tty-inpck
    +           tty-istrip
    +           tty-inlcr
    +           tty-igncr
    +           tty-iuclc
    +           tty-ixany
    +           tty-ixoff
    +	  tty-imaxbel
    +           tty-opost
    +           tty-olcuc
    +           tty-onlcr
    +           tty-onocr
    +           tty-onlret
    +           tty-ofill
    +           tty-ofdel
    +           tty-isig
    +           tty-xcase
    +           tty-echoe
    +           tty-echok
    +           tty-echonl
    +           tty-noflsh
    +           tty-iexten
    +           tty-tostop
    +           tty-echoctl
    +           tty-echoprt
    +           tty-echoke
    +           tty-pendin
    +           tty-cstopb
    +           tty-cread
    +           tty-parenb
    +           tty-parodd
    +           tty-hupcl
    +           tty-clocal
    +           vintr
    +           verase
    +           vkill
    +           veol
    +           veol2
    +	  TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
    +	  TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
    +	  TIOCSIGSEND
    +
    +	  KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
    +	  KBDSCLICK FIONREAD	  unix-exit unix-stat unix-lstat unix-fstat
    +	  unix-getrusage unix-fast-getrusage rusage_self rusage_children
    +	  unix-gettimeofday
    +	  unix-utimes unix-sched-yield unix-setreuid
    +	  unix-setregid
    +	  unix-getpid unix-getppid
    +	  unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
    +	  unix-getpagesize unix-gethostname unix-gethostid unix-fork
    +	  unix-getenv unix-setenv unix-putenv unix-unsetenv
    +	  unix-current-directory unix-isatty unix-ttyname unix-execve
    +	  unix-socket unix-connect unix-bind unix-listen unix-accept
    +	  unix-recv unix-send unix-getpeername unix-getsockname
    +	  unix-getsockopt unix-setsockopt unix-openpty
    +
    +	  unix-recvfrom unix-sendto unix-shutdown
    +
    +          unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid
    +          user-info user-info-name user-info-password user-info-uid
    +          user-info-gid user-info-gecos user-info-dir user-info-shell
    +          group-info group-info-name group-info-gid group-info-members))
    +
    +;;;; Common machine independent structures.
    +
    +(defmacro def-enum (inc cur &rest names)
    +  (flet ((defform (name)
    +	     (prog1 (when name `(defconstant ,name ,cur))
    +	       (setf cur (funcall inc cur 1)))))
    +    `(progn ,@(mapcar #'defform names))))
    +
    +;;;; User and group database structures: <pwd.h> and <grp.h>
    +
    +(defstruct group-info
    +  (name "" :type string)
    +  (password "" :type string)
    +  (gid 0 :type unix-gid)
    +  (members nil :type list))             ; list of logins as strings
    +
    +(def-alien-type nil
    +  (struct group
    +      (gr-name (* char))                ; name of the group
    +      (gr-passwd (* char))              ; encrypted group password
    +      (gr-gid gid-t)                    ; numerical group ID
    +      (gr-mem (* (* char)))))           ; vector of pointers to member names
    +
    +;;; From stdio.h
    +
    +;;; From sys/types.h
    +;;;         and
    +;;;      gnu/types.h
    +
    +(defconstant +max-s-long+ 2147483647)
    +
    +(def-alien-type quad-t #+alpha long #-alpha (array long 2))
    +(def-alien-type qaddr-t (* quad-t))
    +(def-alien-type daddr-t int)
    +(def-alien-type caddr-t (* char))
    +(def-alien-type swblk-t long)
    +(def-alien-type clock-t long)
    +(def-alien-type uid-t unsigned-int)
    +(def-alien-type ssize-t #-alpha int #+alpha long)
    +(def-alien-type key-t int)
    +(def-alien-type int8-t char)
    +(def-alien-type u-int8-t unsigned-char)
    +(def-alien-type int16-t short)
    +(def-alien-type u-int16-t unsigned-short)
    +(def-alien-type int32-t int)
    +(def-alien-type register-t #-alpha int #+alpha long)
    +
    +(def-alien-type fsblkcnt-t u-int64-t)
    +(def-alien-type fsfilcnt-t u-int64-t)
    +(def-alien-type pid-t int)
    +;(def-alien-type ssize-t #-alpha int #+alpha long)
    +
    +(def-alien-type fsid-t (array int 2))
    +
    +(def-alien-type key-t int)
    +
    +(def-alien-type ipc-pid-t unsigned-short)
    +
    +
    +;;; dlfcn.h -> in foreign.lisp
    +
    +(defun unix-getdtablesize ()
    +  _N"Unix-getdtablesize returns the maximum size of the file descriptor
    +   table. (i.e. the maximum number of descriptors that can exist at
    +   one time.)"
    +  (int-syscall ("getdtablesize")))
    +
    +;;; fcntlbits.h
    +
    +
    +
    +(defconstant f-dupfd    0  _N"Duplicate a file descriptor")
    +(defconstant f-getfd    1  _N"Get file desc. flags")
    +(defconstant f-setfd    2  _N"Set file desc. flags")
    +
    +(defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl")
    +
    +#-alpha
    +(progn
    +  (defconstant F-RDLCK 0 _N"for fcntl and lockf")
    +  (defconstant F-WRLCK 1 _N"for fcntl and lockf")
    +  (defconstant F-UNLCK 2 _N"for fcntl and lockf")
    +  (defconstant F-EXLCK 4 _N"old bsd flock (depricated)")
    +  (defconstant F-SHLCK 8 _N"old bsd flock (depricated)"))
    +#+alpha
    +(progn
    +  (defconstant F-RDLCK 1 _N"for fcntl and lockf")
    +  (defconstant F-WRLCK 2 _N"for fcntl and lockf")
    +  (defconstant F-UNLCK 8 _N"for fcntl and lockf")
    +  (defconstant F-EXLCK 16 _N"old bsd flock (depricated)")
    +  (defconstant F-SHLCK 32 _N"old bsd flock (depricated)"))
    +
    +(defconstant F-LOCK-SH 1 _N"Shared lock for bsd flock")
    +(defconstant F-LOCK-EX 2 _N"Exclusive lock for bsd flock")
    +(defconstant F-LOCK-NB 4 _N"Don't block. Combine with F-LOCK-SH or F-LOCK-EX")
    +(defconstant F-LOCK-UN 8 _N"Remove lock for bsd flock")
    +
    +(def-alien-type nil
    +    (struct flock
    +	    (l-type short)
    +	    (l-whence short)
    +	    (l-start off-t)
    +	    (l-len off-t)
    +	    (l-pid pid-t)))
    +
    +;;; grp.h 
    +
    +;;;  POSIX Standard: 9.2.1 Group Database Access	<grp.h>
    +
    +#+(or)
    +(defun unix-setgrend ()
    +  _N"Rewind the group-file stream."
    +  (void-syscall ("setgrend")))
    +
    +#+(or)
    +(defun unix-endgrent ()
    +  _N"Close the group-file stream."
    +  (void-syscall ("endgrent")))
    +
    +#+(or)
    +(defun unix-getgrent ()
    +  _N"Read an entry from the group-file stream, opening it if necessary."
    +  
    +  (let ((result (alien-funcall (extern-alien "getgrent"
    +					     (function (* (struct group)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +;;; ioctl-types.h
    +
    +(defconstant +NCC+ 8
    +  _N"Size of control character vector.")
    +
    +(def-alien-type nil
    +  (struct termio
    +    (c-iflag unsigned-int) ; input mode flags
    +    (c-oflag unsigned-int) ; output mode flags
    +    (c-cflag unsigned-int) ; control mode flags
    +    (c-lflag unsigned-int) ; local mode flags
    +    (c-line unsigned-char) ; line discipline
    +    (c-cc (array unsigned-char #.+NCC+)))) ; control characters
    +
    +;;; modem lines 
    +(defconstant tiocm-le  1)
    +(defconstant tiocm-dtr 2)
    +(defconstant tiocm-rts 4)
    +(defconstant tiocm-st  8)
    +(defconstant tiocm-sr  #x10)
    +(defconstant tiocm-cts #x20)
    +(defconstant tiocm-car #x40)
    +(defconstant tiocm-rng #x80)
    +(defconstant tiocm-dsr #x100)
    +(defconstant tiocm-cd  tiocm-car)
    +(defconstant tiocm-ri  #x80)
    +
    +;;; ioctl (fd, TIOCSERGETLSR, &result) where result may be as below 
    +
    +;;; line disciplines 
    +(defconstant N-TTY    0)
    +(defconstant N-SLIP   1)
    +(defconstant N-MOUSE  2)
    +(defconstant N-PPP    3)
    +(defconstant N-STRIP  4)
    +(defconstant N-AX25   5)
    +
    +
    +;;; ioctls.h
    +
    +;;; Routing table calls. 
    +(defconstant siocaddrt	#x890B) ;; add routing table entry	
    +(defconstant siocdelrt	#x890C) ;; delete routing table entry	
    +(defconstant siocrtmsg	#x890D) ;; call to routing system	
    +
    +;;; Socket configuration controls.
    +(defconstant siocgifname #x8910) ;; get iface name		
    +(defconstant siocsiflink #x8911) ;; set iface channel		
    +(defconstant siocgifconf #x8912) ;; get iface list		
    +(defconstant siocgifflags #x8913) ;; get flags			
    +(defconstant siocsifflags #x8914) ;; set flags			
    +(defconstant siocgifaddr #x8915) ;; get PA address		
    +(defconstant siocsifaddr #x8916) ;; set PA address		
    +(defconstant siocgifdstaddr #x8917  ) ;; get remote PA address 
    +(defconstant siocsifdstaddr #x8918  ) ;; set remote PA address 
    +(defconstant siocgifbrdaddr #x8919  ) ;; get broadcast PA address 
    +(defconstant siocsifbrdaddr #x891a  ) ;; set broadcast PA address 
    +(defconstant siocgifnetmask #x891b  ) ;; get network PA mask  
    +(defconstant siocsifnetmask #x891c  ) ;; set network PA mask  
    +(defconstant siocgifmetric #x891d  ) ;; get metric   
    +(defconstant siocsifmetric #x891e  ) ;; set metric   
    +(defconstant siocgifmem #x891f  ) ;; get memory address (BSD) 
    +(defconstant siocsifmem #x8920  ) ;; set memory address (BSD) 
    +(defconstant siocgifmtu #x8921  ) ;; get MTU size   
    +(defconstant siocsifmtu #x8922  ) ;; set MTU size   
    +(defconstant siocsifhwaddr #x8924  ) ;; set hardware address  
    +(defconstant siocgifencap #x8925  ) ;; get/set encapsulations       
    +(defconstant siocsifencap #x8926)
    +(defconstant siocgifhwaddr #x8927  ) ;; Get hardware address  
    +(defconstant siocgifslave #x8929  ) ;; Driver slaving support 
    +(defconstant siocsifslave #x8930)
    +(defconstant siocaddmulti #x8931  ) ;; Multicast address lists 
    +(defconstant siocdelmulti #x8932)
    +(defconstant siocgifindex #x8933  ) ;; name -> if_index mapping 
    +(defconstant siogifindex SIOCGIFINDEX ) ;; misprint compatibility :-) 
    +(defconstant siocsifpflags #x8934  ) ;; set/get extended flags set 
    +(defconstant siocgifpflags #x8935)
    +(defconstant siocdifaddr #x8936  ) ;; delete PA address  
    +(defconstant siocsifhwbroadcast #x8937 ) ;; set hardware broadcast addr 
    +(defconstant siocgifcount #x8938  ) ;; get number of devices 
    +
    +(defconstant siocgifbr #x8940  ) ;; Bridging support  
    +(defconstant siocsifbr #x8941  ) ;; Set bridging options  
    +
    +(defconstant siocgiftxqlen #x8942  ) ;; Get the tx queue length 
    +(defconstant siocsiftxqlen #x8943  ) ;; Set the tx queue length  
    +
    +
    +;;; ARP cache control calls. 
    +;;  0x8950 - 0x8952  * obsolete calls, don't re-use 
    +(defconstant siocdarp #x8953  ) ;; delete ARP table entry 
    +(defconstant siocgarp #x8954  ) ;; get ARP table entry  
    +(defconstant siocsarp #x8955  ) ;; set ARP table entry  
    +
    +;;; RARP cache control calls. 
    +(defconstant siocdrarp #x8960  ) ;; delete RARP table entry 
    +(defconstant siocgrarp #x8961  ) ;; get RARP table entry  
    +(defconstant siocsrarp #x8962  ) ;; set RARP table entry  
    +
    +;;; Driver configuration calls 
    +
    +(defconstant siocgifmap #x8970  ) ;; Get device parameters 
    +(defconstant siocsifmap #x8971  ) ;; Set device parameters 
    +
    +;;; DLCI configuration calls 
    +
    +(defconstant siocadddlci #x8980  ) ;; Create new DLCI device 
    +(defconstant siocdeldlci #x8981  ) ;; Delete DLCI device  
    +
    +;;; Device private ioctl calls. 
    +
    +;; These 16 ioctls are available to devices via the do_ioctl() device
    +;; vector.  Each device should include this file and redefine these
    +;; names as their own. Because these are device dependent it is a good
    +;; idea _NOT_ to issue them to random objects and hope. 
    +
    +(defconstant siocdevprivate	#x89F0	) ;; to 89FF 
    +
    +
    +;;; netdb.h
    +
    +;; All data returned by the network data base library are supplied in
    +;; host order and returned in network order (suitable for use in
    +;; system calls).
    +
    +;;; Absolute file name for network data base files.
    +(defconstant path-hequiv "/etc/hosts.equiv")
    +(defconstant path-hosts "/etc/hosts")
    +(defconstant path-networks "/etc/networks")
    +(defconstant path-nsswitch_conf "/etc/nsswitch.conf")
    +(defconstant path-protocols "/etc/protocols")
    +(defconstant path-services "/etc/services")
    +
    +
    +;;; Possible values left in `h_errno'.
    +(defconstant netdb-internal -1 _N"See errno.")
    +(defconstant netdb-success 0 _N"No problem.")
    +(defconstant host-not-found 1 _N"Authoritative Answer Host not found.")
    +(defconstant try-again 2 _N"Non-Authoritative Host not found,or SERVERFAIL.")
    +(defconstant no-recovery 3 _N"Non recoverable errors, FORMERR, REFUSED, NOTIMP.")
    +(defconstant no-data 4	"Valid name, no data record of requested type.")
    +(defconstant no-address	no-data	"No address, look for MX record.")
    +
    +;;; Description of data base entry for a single host.
    +
    +(def-alien-type nil
    +    (struct hostent
    +	    (h-name c-string)        ; Official name of host.
    +	    (h-aliases (* c-string)) ; Alias list.
    +	    (h-addrtype int)         ; Host address type.
    +	    (h_length int)           ; Length of address.
    +	    (h-addr-list (* c-string)))) ; List of addresses from name server.
    +
    +#+(or)
    +(defun unix-sethostent (stay-open)
    +  _N"Open host data base files and mark them as staying open even after
    +a later search if STAY_OPEN is non-zero."
    +  (void-syscall ("sethostent" int) stay-open))
    +
    +#+(or)
    +(defun unix-endhostent ()
    +  _N"Close host data base files and clear `stay open' flag."
    +  (void-syscall ("endhostent")))
    +
    +#+(or)
    +(defun unix-gethostent ()
    +  _N"Get next entry from host data base file.  Open data base if
    +necessary."
    +    (let ((result (alien-funcall (extern-alien "gethostent"
    +					     (function (* (struct hostent)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-gethostbyaddr(addr length type)
    +  _N"Return entry from host data base which address match ADDR with
    +length LEN and type TYPE."
    +    (let ((result (alien-funcall (extern-alien "gethostbyaddr"
    +					     (function (* (struct hostent))
    +						       c-string int int))
    +				 addr len type)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-gethostbyname (name)
    +  _N"Return entry from host data base for host with NAME."
    +    (let ((result (alien-funcall (extern-alien "gethostbyname"
    +					     (function (* (struct hostent))
    +						       c-string))
    +				 name)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-gethostbyname2 (name af)
    +  _N"Return entry from host data base for host with NAME.  AF must be
    +   set to the address type which as `AF_INET' for IPv4 or `AF_INET6'
    +   for IPv6."
    +    (let ((result (alien-funcall (extern-alien "gethostbyname2"
    +					     (function (* (struct hostent))
    +						       c-string int))
    +				 name af)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +;; Description of data base entry for a single network.  NOTE: here a
    +;; poor assumption is made.  The network number is expected to fit
    +;; into an unsigned long int variable.
    +
    +(def-alien-type nil
    +    (struct netent
    +	    (n-name c-string) ; Official name of network.
    +	    (n-aliases (* c-string)) ; Alias list.
    +	    (n-addrtype int) ;  Net address type.
    +	    (n-net unsigned-long))) ; Network number.
    +
    +#+(or)
    +(defun unix-setnetent (stay-open)
    +  _N"Open network data base files and mark them as staying open even
    +   after a later search if STAY_OPEN is non-zero."
    +  (void-syscall ("setnetent" int) stay-open))
    +
    +
    +#+(or)
    +(defun unix-endnetent ()
    +  _N"Close network data base files and clear `stay open' flag."
    +  (void-syscall ("endnetent")))
    +
    +
    +#+(or)
    +(defun unix-getnetent ()
    +  _N"Get next entry from network data base file.  Open data base if
    +   necessary."
    +    (let ((result (alien-funcall (extern-alien "getnetent"
    +					     (function (* (struct netent)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +
    +#+(or)
    +(defun unix-getnetbyaddr (net type)
    +  _N"Return entry from network data base which address match NET and
    +   type TYPE."
    +    (let ((result (alien-funcall (extern-alien "getnetbyaddr"
    +					     (function (* (struct netent))
    +						       unsigned-long int))
    +				 net type)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getnetbyname (name)
    +  _N"Return entry from network data base for network with NAME."
    +    (let ((result (alien-funcall (extern-alien "getnetbyname"
    +					     (function (* (struct netent))
    +						       c-string))
    +				 name)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +;; Description of data base entry for a single service.
    +(def-alien-type nil
    +    (struct servent
    +	    (s-name c-string) ; Official service name.
    +	    (s-aliases (* c-string)) ; Alias list.
    +	    (s-port int) ; Port number.
    +	    (s-proto c-string))) ; Protocol to use.
    +
    +#+(or)
    +(defun unix-setservent (stay-open)
    +  _N"Open service data base files and mark them as staying open even
    +   after a later search if STAY_OPEN is non-zero."
    +  (void-syscall ("setservent" int) stay-open))
    +
    +#+(or)
    +(defun unix-endservent (stay-open)
    +  _N"Close service data base files and clear `stay open' flag."
    +  (void-syscall ("endservent")))
    +
    +
    +#+(or)
    +(defun unix-getservent ()
    +  _N"Get next entry from service data base file.  Open data base if
    +   necessary."
    +    (let ((result (alien-funcall (extern-alien "getservent"
    +					     (function (* (struct servent)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getservbyname (name proto)
    +  _N"Return entry from network data base for network with NAME and
    +   protocol PROTO."
    +    (let ((result (alien-funcall (extern-alien "getservbyname"
    +					     (function (* (struct netent))
    +						       c-string (* char)))
    +				 name proto)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getservbyport (port proto)
    +  _N"Return entry from service data base which matches port PORT and
    +   protocol PROTO."
    +    (let ((result (alien-funcall (extern-alien "getservbyport"
    +					     (function (* (struct netent))
    +						       int (* char)))
    +				 port proto)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +;;  Description of data base entry for a single service.
    +
    +(def-alien-type nil
    +    (struct protoent
    +	    (p-name c-string) ; Official protocol name.
    +	    (p-aliases (* c-string)) ; Alias list.
    +	    (p-proto int))) ; Protocol number.
    +
    +#+(or)
    +(defun unix-setprotoent (stay-open)
    +  _N"Open protocol data base files and mark them as staying open even
    +   after a later search if STAY_OPEN is non-zero."
    +  (void-syscall ("setprotoent" int) stay-open))
    +
    +#+(or)
    +(defun unix-endprotoent ()
    +  _N"Close protocol data base files and clear `stay open' flag."
    +  (void-syscall ("endprotoent")))
    +
    +#+(or)
    +(defun unix-getprotoent ()
    +  _N"Get next entry from protocol data base file.  Open data base if
    +   necessary."
    +    (let ((result (alien-funcall (extern-alien "getprotoent"
    +					     (function (* (struct protoent)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getprotobyname (name)
    +  _N"Return entry from protocol data base for network with NAME."
    +    (let ((result (alien-funcall (extern-alien "getprotobyname"
    +					     (function (* (struct protoent))
    +						       c-string))
    +				 name)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getprotobynumber (proto)
    +  _N"Return entry from protocol data base which number is PROTO."
    +    (let ((result (alien-funcall (extern-alien "getprotobynumber"
    +					     (function (* (struct protoent))
    +						       int))
    +				 proto)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-setnetgrent (netgroup)
    +  _N"Establish network group NETGROUP for enumeration."
    +  (int-syscall ("setservent" c-string) netgroup))
    +
    +#+(or)
    +(defun unix-endnetgrent ()
    +  _N"Free all space allocated by previous `setnetgrent' call."
    +  (void-syscall ("endnetgrent")))
    +
    +#+(or)
    +(defun unix-getnetgrent (hostp userp domainp)
    +  _N"Get next member of netgroup established by last `setnetgrent' call
    +   and return pointers to elements in HOSTP, USERP, and DOMAINP."
    +  (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string))
    +	       hostp userp domainp))
    +
    +#+(or)
    +(defun unix-innetgr (netgroup host user domain)
    +  _N"Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)."
    +  (int-syscall ("innetgr" c-string c-string c-string c-string)
    +	       netgroup host user domain))
    +
    +(def-alien-type nil
    +    (struct addrinfo
    +	    (ai-flags int)    ; Input flags.
    +	    (ai-family int)   ; Protocol family for socket.
    +	    (ai-socktype int) ; Socket type.
    +	    (ai-protocol int) ; Protocol for socket.
    +	    (ai-addrlen int)  ; Length of socket address.
    +	    (ai-addr (* (struct sockaddr)))
    +	                      ; Socket address for socket.
    +	    (ai-cononname c-string)
    +	                      ; Canonical name for service location.
    +	    (ai-net (* (struct addrinfo))))) ; Pointer to next in list.
    +
    +;; Possible values for `ai_flags' field in `addrinfo' structure.
    +
    +(defconstant ai_passive 1 _N"Socket address is intended for `bind'.")
    +(defconstant ai_canonname 2 _N"Request for canonical name.")
    +
    +;; Error values for `getaddrinfo' function.
    +(defconstant eai_badflags -1 _N"Invalid value for `ai_flags' field.")
    +(defconstant eai_noname -2 _N"NAME or SERVICE is unknown.")
    +(defconstant eai_again -3 _N"Temporary failure in name resolution.")
    +(defconstant eai_fail -4 _N"Non-recoverable failure in name res.")
    +(defconstant eai_nodata -5 _N"No address associated with NAME.")
    +(defconstant eai_family -6 _N"ai_family not supported.")
    +(defconstant eai_socktype -7 _N"ai_socktype not supported.")
    +(defconstant eai_service -8 _N"SERVICE not supported for ai_socktype.")
    +(defconstant eai_addrfamily -9 _N"Address family for NAME not supported.")
    +(defconstant eai_memory -10 _N"Memory allocation failure.")
    +(defconstant eai_system -11 _N"System error returned in errno.")
    +
    +
    +#+(or)
    +(defun unix-getaddrinfo (name service req pai)
    +  _N"Translate name of a service location and/or a service name to set of
    +   socket addresses."
    +  (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo))
    +			      (* (* struct addrinfo)))
    +	       name service req pai))
    +
    +
    +#+(or)
    +(defun unix-freeaddrinfo (ai)
    +  _N"Free `addrinfo' structure AI including associated storage."
    +  (void-syscall ("freeaddrinfo" (* struct addrinfo))
    +		ai))
    +
    +
    +#+(or)
    +(defun unix-forkpty (amaster name termp winp)
    +  _N"Create child process and establish the slave pseudo terminal as the
    +   child's controlling terminal."
    +  (int-syscall ("forkpty" (* int) c-string (* (struct termios))
    +			  (* (struct winsize)))
    +	       amaster name termp winp))
    +
    +
    +;; POSIX Standard: 9.2.2 User Database Access <pwd.h>
    +
    +#+(or)
    +(defun unix-setpwent ()
    +  _N"Rewind the password-file stream."
    +  (void-syscall ("setpwent")))
    +
    +#+(or)
    +(defun unix-endpwent ()
    +  _N"Close the password-file stream."
    +  (void-syscall ("endpwent")))
    +
    +#+(or)
    +(defun unix-getpwent ()
    +  _N"Read an entry from the password-file stream, opening it if necessary."
    +    (let ((result (alien-funcall (extern-alien "getpwent"
    +					     (function (* (struct passwd)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +	result)))
    +
    +;;; resourcebits.h
    +
    +(def-alien-type nil
    +  (struct rlimit
    +    (rlim-cur long)	 ; current (soft) limit
    +    (rlim-max long))); maximum value for rlim-cur
    +
    +;; Priority limits.
    +
    +(defconstant prio-min -20 _N"Minimum priority a process can have")
    +(defconstant prio-max 20 _N"Maximum priority a process can have")
    +
    +
    +;;; The type of the WHICH argument to `getpriority' and `setpriority',
    +;;; indicating what flavor of entity the WHO argument specifies.
    +
    +(defconstant priority-process 0 _N"WHO is a process ID")
    +(defconstant priority-pgrp 1 _N"WHO is a process group ID")
    +(defconstant priority-user 2 _N"WHO is a user ID")
    +
    +;;; sched.h
    +
    +#+(or)
    +(defun unix-sched_setparam (pid param)
    +  _N"Rewind the password-file stream."
    +  (int-syscall ("sched_setparam" pid-t (struct psched-param))
    +		pid param))
    +
    +#+(or)
    +(defun unix-sched_getparam (pid param)
    +  _N"Rewind the password-file stream."
    +  (int-syscall ("sched_getparam" pid-t (struct psched-param))
    +		pid param))
    +
    +
    +#+(or)
    +(defun unix-sched_setscheduler (pid policy param)
    +  _N"Set scheduling algorithm and/or parameters for a process."
    +  (int-syscall ("sched_setscheduler" pid-t int (struct psched-param))
    +		pid policy param))
    +
    +#+(or)
    +(defun unix-sched_getscheduler (pid)
    +  _N"Retrieve scheduling algorithm for a particular purpose."
    +  (int-syscall ("sched_getscheduler" pid-t)
    +		pid))
    +
    +(defun unix-sched-yield ()
    +  _N"Retrieve scheduling algorithm for a particular purpose."
    +  (int-syscall ("sched_yield")))
    +
    +#+(or)
    +(defun unix-sched_get_priority_max (algorithm)
    +  _N"Get maximum priority value for a scheduler."
    +  (int-syscall ("sched_get_priority_max" int)
    +		algorithm))
    +
    +#+(or)
    +(defun unix-sched_get_priority_min (algorithm)
    +  _N"Get minimum priority value for a scheduler."
    +  (int-syscall ("sched_get_priority_min" int)
    +		algorithm))
    +
    +
    +
    +#+(or)
    +(defun unix-sched_rr_get_interval (pid t)
    +  _N"Get the SCHED_RR interval for the named process."
    +  (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec)))
    +		pid t))
    +
    +;;; schedbits.h
    +
    +(defconstant scheduler-other 0)
    +(defconstant scheduler-fifo 1)
    +(defconstant scheduler-rr 2)
    +
    +
    +;; Data structure to describe a process' schedulability.
    +
    +(def-alien-type nil
    +    (struct sched_param
    +	    (sched-priority int)))
    +
    +;; Cloning flags.
    +(defconstant csignal       #x000000ff _N"Signal mask to be sent at exit.")
    +(defconstant clone_vm      #x00000100 _N"Set if VM shared between processes.")
    +(defconstant clone_fs      #x00000200 _N"Set if fs info shared between processes")
    +(defconstant clone_files   #x00000400 _N"Set if open files shared between processe")
    +(defconstant clone_sighand #x00000800 _N"Set if signal handlers shared.")
    +(defconstant clone_pid     #x00001000 _N"Set if pid shared.")
    +
    +
    +;;; shadow.h
    +
    +;; Structure of the password file.
    +
    +(def-alien-type nil
    +    (struct spwd
    +	    (sp-namp c-string) ; Login name.
    +	    (sp-pwdp c-string) ; Encrypted password.
    +	    (sp-lstchg long)   ; Date of last change.
    +	    (sp-min long)      ; Minimum number of days between changes.
    +	    (sp-max long)      ; Maximum number of days between changes.
    +	    (sp-warn long)     ; Number of days to warn user to change the password.
    +	    (sp-inact long)    ; Number of days the account may be inactive.
    +	    (sp-expire long)   ; Number of days since 1970-01-01 until account expires.
    +	    (sp-flags long)))  ; Reserved.
    +
    +#+(or)
    +(defun unix-setspent ()
    +  _N"Open database for reading."
    +  (void-syscall ("setspent")))
    +
    +#+(or)
    +(defun unix-endspent ()
    +  _N"Close database."
    +  (void-syscall ("endspent")))
    +
    +#+(or)
    +(defun unix-getspent ()
    +  _N"Get next entry from database, perhaps after opening the file."
    +    (let ((result (alien-funcall (extern-alien "getspent"
    +					     (function (* (struct spwd)))))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-getspnam (name)
    +  _N"Get shadow entry matching NAME."
    +    (let ((result (alien-funcall (extern-alien "getspnam"
    +					     (function (* (struct spwd))
    +						       c-string))
    +				 name)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +#+(or)
    +(defun unix-sgetspent (string)
    +  _N"Read shadow entry from STRING."
    +    (let ((result (alien-funcall (extern-alien "sgetspent"
    +					     (function (* (struct spwd))
    +						       c-string))
    +				 string)))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +;; 
    +
    +#+(or)
    +(defun unix-lckpwdf ()
    +  _N"Protect password file against multi writers."
    +  (void-syscall ("lckpwdf")))
    +
    +
    +#+(or)
    +(defun unix-ulckpwdf ()
    +  _N"Unlock password file."
    +  (void-syscall ("ulckpwdf")))
    +
    +;; Protection bits.
    +
    +(defconstant s-isuid #o0004000 _N"Set user ID on execution.")
    +(defconstant s-isgid #o0002000 _N"Set group ID on execution.")
    +(defconstant s-isvtx #o0001000 _N"Save swapped text after use (sticky).")
    +(defconstant s-iread #o0000400 _N"Read by owner")
    +(defconstant s-iwrite #o0000200 _N"Write by owner.")
    +(defconstant s-iexec #o0000100 _N"Execute by owner.")
    +
    +;;; statfsbuf.h
    +
    +(def-alien-type nil
    +    (struct statfs
    +	    (f-type int)
    +	    (f-bsize int)
    +	    (f-blocks fsblkcnt-t)
    +	    (f-bfree fsblkcnt-t)
    +	    (f-bavail fsblkcnt-t)
    +	    (f-files fsfilcnt-t)
    +	    (f-ffree fsfilcnt-t)
    +	    (f-fsid fsid-t)
    +	    (f-namelen int)
    +	    (f-spare (array int 6))))
    +
    +
    +;;; termbits.h
    +
    +
    +
    +(def-enum + 0 tciflush tcoflush tcioflush)
    +
    +(defconstant tty-nl0 0)
    +(defconstant tty-nl1 #o400)
    +
    +(defconstant tty-crdly	#o0003000)
    +(defconstant   tty-cr0	#o0000000)
    +(defconstant   tty-cr1	#o0001000)
    +(defconstant   tty-cr2	#o0002000)
    +(defconstant   tty-cr3	#o0003000)
    +(defconstant tty-tabdly	#o0014000)
    +(defconstant   tty-tab0	#o0000000)
    +(defconstant   tty-tab1	#o0004000)
    +(defconstant   tty-tab2	#o0010000)
    +(defconstant   tty-tab3	#o0014000)
    +(defconstant   tty-xtabs	#o0014000)
    +(defconstant tty-bsdly	#o0020000)
    +(defconstant   tty-bs0	#o0000000)
    +(defconstant   tty-bs1	#o0020000)
    +(defconstant tty-vtdly	#o0040000)
    +(defconstant   tty-vt0	#o0000000)
    +(defconstant   tty-vt1	#o0040000)
    +(defconstant tty-ffdly	#o0100000)
    +(defconstant   tty-ff0	#o0000000)
    +(defconstant   tty-ff1	#o0100000)
    +
    +;; c-cflag bit meaning
    +(defconstant tty-cbaud	#o0010017)
    +(defconstant tty-b0	#o0000000) ;; hang up
    +(defconstant tty-b50	#o0000001)
    +(defconstant tty-b75	#o0000002)
    +(defconstant tty-b110	#o0000003)
    +(defconstant tty-b134	#o0000004)
    +(defconstant tty-b150	#o0000005)
    +(defconstant tty-b200	#o0000006)
    +(defconstant tty-b300	#o0000007)
    +(defconstant tty-b600	#o0000010)
    +(defconstant tty-b1200	#o0000011)
    +(defconstant tty-b1800	#o0000012)
    +(defconstant tty-b2400	#o0000013)
    +(defconstant tty-b4800	#o0000014)
    +(defconstant tty-b9600	#o0000015)
    +(defconstant tty-b19200	#o0000016)
    +(defconstant tty-b38400	#o0000017)
    +(defconstant tty-exta tty-b19200)
    +(defconstant tty-extb tty-b38400)
    +(defconstant tty-csize	#o0000060)
    +(defconstant tty-cs5	#o0000000)
    +(defconstant tty-cs6	#o0000020)
    +(defconstant tty-cs7	#o0000040)
    +(defconstant tty-cs8	#o0000060)
    +(defconstant tty-cstopb	#o0000100)
    +(defconstant tty-cread	#o0000200)
    +(defconstant tty-parenb	#o0000400)
    +(defconstant tty-parodd	#o0001000)
    +(defconstant tty-hupcl	#o0002000)
    +(defconstant tty-clocal	#o0004000)
    +(defconstant tty-cbaudex #o0010000)
    +(defconstant tty-b57600  #o0010001)
    +(defconstant tty-b115200 #o0010002)
    +(defconstant tty-b230400 #o0010003)
    +(defconstant tty-b460800 #o0010004)
    +(defconstant tty-cibaud	  #o002003600000) ; input baud rate (not used)
    +(defconstant tty-crtscts	  #o020000000000) ;flow control 
    +
    +;;; tcflow() and TCXONC use these 
    +(def-enum + 0 tty-tcooff tty-tcoon tty-tcioff tty-tcion)
    +
    +;; tcflush() and TCFLSH use these */
    +(def-enum + 0 tty-tciflush tty-tcoflush tty-tcioflush)
    +
    +;; tcsetattr uses these
    +(def-enum + 0 tty-tcsanow tty-tcsadrain tty-tcsaflush)
    +
    +;;; termios.h
    +
    +(defun unix-cfsetospeed (termios speed)
    +  _N"Set terminal output speed."
    +  (let ((baud (or (position speed terminal-speeds)
    +		  (error _"Bogus baud rate ~S" speed))))
    +    (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
    +
    +(defun unix-cfgetispeed (termios)
    +  _N"Get terminal input speed."
    +  (multiple-value-bind (speed errno)
    +      (int-syscall ("cfgetispeed" (* (struct termios))) termios)
    +    (if speed
    +	(values (svref terminal-speeds speed) 0)
    +      (values speed errno))))
    +
    +(defun unix-cfsetispeed (termios speed)
    +  _N"Set terminal input speed."
    +  (let ((baud (or (position speed terminal-speeds)
    +		  (error _"Bogus baud rate ~S" speed))))
    +    (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
    +
    +(defun unix-tcsendbreak (fd duration)
    +  _N"Send break"
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcsendbreak" int int) fd duration))
    +
    +(defun unix-tcdrain (fd)
    +  _N"Wait for output for finish"
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcdrain" int) fd))
    +
    +(defun unix-tcflush (fd selector)
    +  _N"See tcflush(3)"
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcflush" int int) fd selector))
    +
    +(defun unix-tcflow (fd action)
    +  _N"Flow control"
    +  (declare (type unix-fd fd))
    +  (void-syscall ("tcflow" int int) fd action))
    +
    +;;; timebits.h
    +
    +;;; unistd.h
    +
    +(defun sub-unix-execve (program arg-list env-list)
    +  (let ((argv nil)
    +	(argv-bytes 0)
    +	(envp nil)
    +	(envp-bytes 0)
    +	result error-code)
    +    (unwind-protect
    +	(progn
    +	  ;; Blast the stuff into the proper format
    +	  (multiple-value-setq
    +	      (argv argv-bytes)
    +	    (string-list-to-c-strvec arg-list))
    +	  (multiple-value-setq
    +	      (envp envp-bytes)
    +	    (string-list-to-c-strvec env-list))
    +	  ;;
    +	  ;; Now do the system call
    +	  (multiple-value-setq
    +	      (result error-code)
    +	    (int-syscall ("execve"
    +			  c-string system-area-pointer system-area-pointer)
    +			 program argv envp)))
    +      ;; 
    +      ;; Deallocate memory
    +      (when argv
    +	(system:deallocate-system-memory argv argv-bytes))
    +      (when envp
    +	(system:deallocate-system-memory envp envp-bytes)))
    +    (values result error-code)))
    +
    +;;;; UNIX-EXECVE
    +
    +(defun unix-execve (program &optional arg-list
    +			    (environment *environment-list*))
    +  _N"Executes the Unix execve system call.  If the system call suceeds, lisp
    +   will no longer be running in this process.  If the system call fails this
    +   function returns two values: NIL and an error code.  Arg-list should be a
    +   list of simple-strings which are passed as arguments to the exec'ed program.
    +   Environment should be an a-list mapping symbols to simple-strings which this
    +   function bashes together to form the environment for the exec'ed program."
    +  (check-type program simple-string)
    +  (let ((env-list (let ((envlist nil))
    +		    (dolist (cons environment)
    +		      (push (if (cdr cons)
    +				(concatenate 'simple-string
    +					     (string (car cons)) "="
    +					     (cdr cons))
    +				(car cons))
    +			    envlist))
    +		    envlist)))
    +    (sub-unix-execve (%name->file program) arg-list env-list)))
    +
    +
    +(defmacro round-bytes-to-words (n)
    +  `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
    +
    +(defun unix-chown (path uid gid)
    +  _N"Given a file path, an integer user-id, and an integer group-id,
    +   unix-chown changes the owner of the file and the group of the
    +   file to those specified.  Either the owner or the group may be
    +   left unchanged by specifying them as -1.  Note: Permission will
    +   fail if the caller is not the superuser."
    +  (declare (type unix-pathname path)
    +	   (type (or unix-uid (integer -1 -1)) uid)
    +	   (type (or unix-gid (integer -1 -1)) gid))
    +  (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
    +
    +;;; Unix-fchown is exactly the same as unix-chown except that the file
    +;;; is specified by a file-descriptor ("fd") instead of a pathname.
    +
    +(defun unix-fchown (fd uid gid)
    +  _N"Unix-fchown is like unix-chown, except that it accepts an integer
    +   file descriptor instead of a file path name."
    +  (declare (type unix-fd fd)
    +	   (type (or unix-uid (integer -1 -1)) uid)
    +	   (type (or unix-gid (integer -1 -1)) gid))
    +  (void-syscall ("fchown" int int int) fd uid gid))
    +
    +#+(or)
    +(defun unix-pathconf (path name)
    +  _N"Get file-specific configuration information about PATH."
    +  (int-syscall ("pathconf" c-string int) (%name->file path) name))
    +
    +#+(or)
    +(defun unix-sysconf (name)
    +  _N"Get the value of the system variable NAME."
    +  (int-syscall ("sysconf" int) name))
    +
    +#+(or)
    +(defun unix-confstr (name)
    +  _N"Get the value of the string-valued system variable NAME."
    +  (with-alien ((buf (array char 1024)))
    +    (values (not (zerop (alien-funcall (extern-alien "confstr"
    +						     (function int
    +							       c-string
    +							       size-t))
    +				       name buf 1024)))
    +	    (cast buf c-string))))
    +
    +
    +(def-alien-routine ("getppid" unix-getppid) int
    +  _N"Unix-getppid returns the process-id of the parent of the current process.")
    +
    +;;; Unix-getpgrp returns the group-id associated with the
    +;;; current process.
    +
    +(defun unix-getpgrp ()
    +  _N"Unix-getpgrp returns the group-id of the calling process."
    +  (int-syscall ("getpgrp")))
    +
    +;;; Unix-setpgid sets the group-id of the process specified by 
    +;;; "pid" to the value of "pgrp".  The process must either have
    +;;; the same effective user-id or be a super-user process.
    +
    +;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
    +;;; for backward compatibility. setpgrp(void)[solaris] is being phased
    +;;; out in favor of setsid().
    +
    +(defun unix-setpgrp (pid pgrp)
    +  _N"Unix-setpgrp sets the process group on the process pid to
    +   pgrp.  NIL and an error number are returned upon failure."
    +  (void-syscall ("setpgid" int int) pid pgrp))
    +
    +(defun unix-setpgid (pid pgrp)
    +  _N"Unix-setpgid sets the process group of the process pid to
    +   pgrp. If pgid is equal to pid, the process becomes a process
    +   group leader. NIL and an error number are returned upon failure."
    +  (void-syscall ("setpgid" int int) pid pgrp))
    +
    +#+(or)
    +(defun unix-setsid ()
    +  _N"Create a new session with the calling process as its leader.
    +   The process group IDs of the session and the calling process
    +   are set to the process ID of the calling process, which is returned."
    +  (void-syscall ( "setsid")))
    +
    +#+(or)
    +(defun unix-getsid ()
    +  _N"Return the session ID of the given process."
    +  (int-syscall ( "getsid")))
    +
    +#+(or)
    +(def-alien-routine ("geteuid" unix-getuid) int
    +  _N"Get the effective user ID of the calling process.")
    +
    +(def-alien-routine ("getgid" unix-getgid) int
    +  _N"Unix-getgid returns the real group-id of the current process.")
    +
    +(def-alien-routine ("getegid" unix-getegid) int
    +  _N"Unix-getegid returns the effective group-id of the current process.")
    +
    +;/* If SIZE is zero, return the number of supplementary groups
    +;   the calling process is in.  Otherwise, fill in the group IDs
    +;   of its supplementary groups in LIST and return the number written.  */
    +;extern int getgroups __P ((int __size, __gid_t __list[]));
    +
    +#+(or)
    +(defun unix-group-member (gid)
    +  _N"Return nonzero iff the calling process is in group GID."
    +  (int-syscall ( "group-member" gid-t) gid))
    +
    +
    +(defun unix-setuid (uid)
    +  _N"Set the user ID of the calling process to UID.
    +   If the calling process is the super-user, set the real
    +   and effective user IDs, and the saved set-user-ID to UID;
    +   if not, the effective user ID is set to UID."
    +  (int-syscall ("setuid" uid-t) uid))
    +
    +;;; Unix-setreuid sets the real and effective user-id's of the current
    +;;; process to the arguments "ruid" and "euid", respectively.  Usage is
    +;;; restricted for anyone but the super-user.  Setting either "ruid" or
    +;;; "euid" to -1 makes the system use the current id instead.
    +
    +(defun unix-setreuid (ruid euid)
    +  _N"Unix-setreuid sets the real and effective user-id's of the current
    +   process to the specified ones.  NIL and an error number is returned
    +   if the call fails."
    +  (void-syscall ("setreuid" int int) ruid euid))
    +
    +(defun unix-setgid (gid)
    +  _N"Set the group ID of the calling process to GID.
    +   If the calling process is the super-user, set the real
    +   and effective group IDs, and the saved set-group-ID to GID;
    +   if not, the effective group ID is set to GID."
    +  (int-syscall ("setgid" gid-t) gid))
    +
    +
    +;;; Unix-setregid sets the real and effective group-id's of the current
    +;;; process to the arguments "rgid" and "egid", respectively.  Usage is
    +;;; restricted for anyone but the super-user.  Setting either "rgid" or
    +;;; "egid" to -1 makes the system use the current id instead.
    +
    +(defun unix-setregid (rgid egid)
    +  _N"Unix-setregid sets the real and effective group-id's of the current
    +   process process to the specified ones.  NIL and an error number is
    +   returned if the call fails."
    +  (void-syscall ("setregid" int int) rgid egid))
    +
    +(defun unix-fork ()
    +  _N"Executes the unix fork system call.  Returns 0 in the child and the pid
    +   of the child in the parent if it works, or NIL and an error number if it
    +   doesn't work."
    +  (int-syscall ("fork")))
    +
    +;; Environment maninpulation; man getenv(3)
    +(def-alien-routine ("getenv" unix-getenv) c-call:c-string
    +  (name c-call:c-string) 
    +  _N"Get the value of the environment variable named Name.  If no such
    +  variable exists, Nil is returned.")
    +
    +(def-alien-routine ("setenv" unix-setenv) c-call:int
    +  (name c-call:c-string)
    +  (value c-call:c-string)
    +  (overwrite c-call:int)
    +  _N"Adds the environment variable named Name to the environment with
    +  the given Value if Name does not already exist. If Name does exist,
    +  the value is changed to Value if Overwrite is non-zero.  Otherwise,
    +  the value is not changed.")
    +
    +(def-alien-routine ("putenv" unix-putenv) c-call:int
    +  (name c-call:c-string)
    +  _N"Adds or changes the environment.  Name-value must be a string of
    +  the form \"name=value\".  If the name does not exist, it is added.
    +  If name does exist, the value is updated to the given value.")
    +
    +(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int
    +  (name c-call:c-string)
    +  _N"Removes the variable Name from the environment")
    +
    +;;; Unix-link creates a hard link from name2 to name1.
    +
    +(defun unix-link (name1 name2)
    +  _N"Unix-link creates a hard link from the file with name1 to the
    +   file with name2."
    +  (declare (type unix-pathname name1 name2))
    +  (void-syscall ("link" c-string c-string)
    +		(%name->file name1) (%name->file name2)))
    +
    +(defun tcgetpgrp (fd)
    +  _N"Get the tty-process-group for the unix file-descriptor FD."
    +  (alien:with-alien ((alien-pgrp c-call:int))
    +    (multiple-value-bind (ok err)
    +	(unix-ioctl fd
    +		     tiocgpgrp
    +		     (alien:alien-sap (alien:addr alien-pgrp)))
    +      (if ok
    +	  (values alien-pgrp nil)
    +	  (values nil err)))))
    +
    +(defun tty-process-group (&optional fd)
    +  _N"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,
    +  FD defaults to /dev/tty."
    +  (if fd
    +      (tcgetpgrp fd)
    +      (multiple-value-bind (tty-fd errno)
    +	  (unix-open "/dev/tty" o_rdwr 0)
    +	(cond (tty-fd
    +	       (multiple-value-prog1
    +		   (tcgetpgrp tty-fd)
    +		 (unix-close tty-fd)))
    +	      (t
    +	       (values nil errno))))))
    +
    +(defun tcsetpgrp (fd pgrp)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP."
    +  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    +    (unix-ioctl fd
    +		tiocspgrp
    +		(alien:alien-sap (alien:addr alien-pgrp)))))
    +
    +(defun %set-tty-process-group (pgrp &optional fd)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    +  supplied, FD defaults to /dev/tty."
    +  (let ((old-sigs
    +	 (unix-sigblock
    +	  (sigmask :sigttou :sigttin :sigtstp :sigchld))))
    +    (declare (type (unsigned-byte 32) old-sigs))
    +    (unwind-protect
    +	(if fd
    +	    (tcsetpgrp fd pgrp)
    +	    (multiple-value-bind (tty-fd errno)
    +		(unix-open "/dev/tty" o_rdwr 0)
    +	      (cond (tty-fd
    +		     (multiple-value-prog1
    +			 (tcsetpgrp tty-fd pgrp)
    +		       (unix-close tty-fd)))
    +		    (t
    +		     (values nil errno)))))
    +      (unix-sigsetmask old-sigs))))
    +  
    +(defsetf tty-process-group (&optional fd) (pgrp)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    +  supplied, FD defaults to /dev/tty."
    +  `(%set-tty-process-group ,pgrp ,fd))
    +
    +#+(or)
    +(defun unix-getlogin ()
    +  _N"Return the login name of the user."
    +    (let ((result (alien-funcall (extern-alien "getlogin"
    +					     (function c-string)))))
    +    (declare (type system-area-pointer result))
    +    (if (zerop (sap-int result))
    +	nil
    +      result)))
    +
    +
    +#+(or)
    +(defun unix-sethostname (name len)
    +  (int-syscall ("sethostname" c-string size-t) name len))
    +
    +#+(or)
    +(defun unix-sethostid (id)
    +  (int-syscall ("sethostid" long) id))
    +
    +#+(or)
    +(defun unix-getdomainname (name len)
    +  (int-syscall ("getdomainname" c-string size-t) name len))
    +
    +#+(or)
    +(defun unix-setdomainname (name len)
    +  (int-syscall ("setdomainname" c-string size-t) name len))
    +
    +;;; Unix-fsync writes the core-image of the file described by "fd" to
    +;;; permanent storage (i.e. disk).
    +
    +(defun unix-fsync (fd)
    +  _N"Unix-fsync writes the core image of the file described by
    +   fd to disk."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("fsync" int) fd))
    +
    +
    +#+(or)
    +(defun unix-vhangup ()
    + _N"Revoke access permissions to all processes currently communicating
    +  with the control terminal, and then send a SIGHUP signal to the process
    +  group of the control terminal." 
    + (int-syscall ("vhangup")))
    +
    +#+(or)
    +(defun unix-revoke (file)
    + _N"Revoke the access of all descriptors currently open on FILE."
    + (int-syscall ("revoke" c-string) (%name->file file)))
    +
    +
    +#+(or)
    +(defun unix-chroot (path)
    + _N"Make PATH be the root directory (the starting point for absolute paths).
    +   This call is restricted to the super-user."
    + (int-syscall ("chroot" c-string) (%name->file path)))
    +
    +;;; Unix-sync writes all information in core memory which has been modified
    +;;; to permanent storage (i.e. disk).
    +
    +(defun unix-sync ()
    +  _N"Unix-sync writes all information in core memory which has been
    +   modified to disk.  It returns NIL and an error code if an error
    +   occured."
    +  (void-syscall ("sync")))
    +
    +;;; Unix-truncate accepts a file name and a new length.  The file is
    +;;; truncated to the new length.
    +
    +(defun unix-truncate (name length)
    +  _N"Unix-truncate truncates the named file to the length (in
    +   bytes) specified by LENGTH.  NIL and an error number is returned
    +   if the call is unsuccessful."
    +  (declare (type unix-pathname name)
    +	   (type (unsigned-byte 64) length))
    +  (void-syscall ("truncate64" c-string off-t) (%name->file name) length))
    +
    +(defun unix-ftruncate (fd length)
    +  _N"Unix-ftruncate is similar to unix-truncate except that the first
    +   argument is a file descriptor rather than a file name."
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 64) length))
    +  (void-syscall ("ftruncate64" int off-t) fd length))
    +
    +#+(or)
    +(defun unix-getdtablesize ()
    +  _N"Return the maximum number of file descriptors
    +   the current process could possibly have."
    +  (int-syscall ("getdtablesize")))
    +
    +(defconstant f_ulock 0 _N"Unlock a locked region")
    +(defconstant f_lock 1 _N"Lock a region for exclusive use")
    +(defconstant f_tlock 2 _N"Test and lock a region for exclusive use")
    +(defconstant f_test 3 _N"Test a region for othwer processes locks")
    +
    +(defun unix-lockf (fd cmd length)
    +  _N"Unix-locks can lock, unlock and test files according to the cmd
    +   which can be one of the following:
    +
    +   f_ulock  Unlock a locked region
    +   f_lock   Lock a region for exclusive use
    +   f_tlock  Test and lock a region for exclusive use
    +   f_test   Test a region for othwer processes locks
    +
    +   The lock is for a region from the current location for a length
    +   of length.
    +
    +   This is a simpler version of the interface provided by unix-fcntl.
    +   "
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte 64) length)
    +	   (type (integer 0 3) cmd))
    +  (int-syscall ("lockf64" int int off-t) fd cmd length))
    +
    +;;; utime.h
    +
    +;; Structure describing file times.
    +
    +(def-alien-type nil
    +    (struct utimbuf
    +	    (actime time-t) ; Access time. 
    +	    (modtime time-t))) ; Modification time.
    +
    +;;; waitflags.h
    +
    +;; Bits in the third argument to `waitpid'.
    +
    +(defconstant waitpid-wnohang 1 _N"Don't block waiting.")
    +(defconstant waitpid-wuntranced 2 _N"Report status of stopped children.")
    +
    +(defconstant waitpid-wclone #x80000000 _N"Wait for cloned process.")
    +
    +
    +;;; sys/fsuid.h
    +
    +#+(or)
    +(defun unix-setfsuid (uid)
    +  _N"Change uid used for file access control to UID, without affecting
    +   other priveledges (such as who can send signals at the process)."
    +  (int-syscall ("setfsuid" uid-t) uid))
    +
    +#+(or)
    +(defun unix-setfsgid (gid)
    +  _N"Change gid used for file access control to GID, without affecting
    +   other priveledges (such as who can send signals at the process)."
    +  (int-syscall ("setfsgid" gid-t) gid))
    +
    +;;; sys/poll.h
    +
    +;; Data structure describing a polling request.
    +
    +(def-alien-type nil
    +    (struct pollfd
    +	    (fd int)       ; File descriptor to poll.
    +	    (events short) ; Types of events poller cares about.
    +	    (revents short))) ; Types of events that actually occurred.
    +
    +;; Event types that can be polled for.  These bits may be set in `events'
    +;; to indicate the interesting event types; they will appear in `revents'
    +;; to indicate the status of the file descriptor.  
    +
    +(defconstant POLLIN  #o1 _N"There is data to read.")
    +(defconstant POLLPRI #o2 _N"There is urgent data to read.")
    +(defconstant POLLOUT #o4 _N"Writing now will not block.")
    +
    +;; Event types always implicitly polled for.  These bits need not be set in
    +;;`events', but they will appear in `revents' to indicate the status of
    +;; the file descriptor.  */
    +
    +
    +(defconstant POLLERR  #o10 _N"Error condition.")
    +(defconstant POLLHUP  #o20 _N"Hung up.")
    +(defconstant POLLNVAL #o40 _N"Invalid polling request.")
    +
    +
    +(defconstant +npollfile+ 30 _N"Canonical number of polling requests to read
    +in at a time in poll.")
    +
    +#+(or)
    +(defun unix-poll (fds nfds timeout)
    + _N" Poll the file descriptors described by the NFDS structures starting at
    +   FDS.  If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for
    +   an event to occur; if TIMEOUT is -1, block until an event occurs.
    +   Returns the number of file descriptors with events, zero if timed out,
    +   or -1 for errors."
    + (int-syscall ("poll" (* (struct pollfd)) long int)
    +	      fds nfds timeout))
    +
    +;;; sys/resource.h
    +
    +(defun unix-getrlimit (resource)
    +  _N"Get the soft and hard limits for RESOURCE."
    +  (with-alien ((rlimits (struct rlimit)))
    +    (syscall ("getrlimit" int (* (struct rlimit)))
    +	     (values t
    +		     (slot rlimits 'rlim-cur)
    +		     (slot rlimits 'rlim-max))
    +	     resource (addr rlimits))))
    +
    +(defun unix-setrlimit (resource current maximum)
    +  _N"Set the current soft and hard maximum limits for RESOURCE.
    +   Only the super-user can increase hard limits."
    +  (with-alien ((rlimits (struct rlimit)))
    +    (setf (slot rlimits 'rlim-cur) current)
    +    (setf (slot rlimits 'rlim-max) maximum)
    +    (void-syscall ("setrlimit" int (* (struct rlimit)))
    +		  resource (addr rlimits))))
    +
    +
    +#+(or)
    +(defun unix-ulimit (cmd newlimit)
    + _N"Function depends on CMD:
    +  1 = Return the limit on the size of a file, in units of 512 bytes.
    +  2 = Set the limit on the size of a file to NEWLIMIT.  Only the
    +      super-user can increase the limit.
    +  3 = Return the maximum possible address of the data segment.
    +  4 = Return the maximum number of files that the calling process can open.
    +  Returns -1 on errors."
    + (int-syscall ("ulimit" int long) cmd newlimit))
    +
    +#+(or)
    +(defun unix-getpriority (which who)
    +  _N"Return the highest priority of any process specified by WHICH and WHO
    +   (see above); if WHO is zero, the current process, process group, or user
    +   (as specified by WHO) is used.  A lower priority number means higher
    +   priority.  Priorities range from PRIO_MIN to PRIO_MAX (above)."
    +  (int-syscall ("getpriority" int int)
    +	       which who))
    +
    +#+(or)
    +(defun unix-setpriority (which who)
    +  _N"Set the priority of all processes specified by WHICH and WHO (see above)
    +   to PRIO.  Returns 0 on success, -1 on errors."
    +  (int-syscall ("setpriority" int int)
    +	       which who))
    +
    +
    +(defun unix-umask (mask)
    +  _N"Set the file creation mask of the current process to MASK,
    +   and return the old creation mask."
    +  (int-syscall ("umask" mode-t) mask))
    +
    +#+(or)
    +(defun unix-makedev (path mode dev)
    + _N"Create a device file named PATH, with permission and special bits MODE
    +  and device number DEV (which can be constructed from major and minor
    +  device numbers with the `makedev' macro above)."
    +  (declare (type unix-pathname path)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev))
    +
    +
    +#+(or)
    +(defun unix-fifo (name mode)
    +  _N"Create a new FIFO named PATH, with permission bits MODE."
    +  (declare (type unix-pathname name)
    +	   (type unix-file-mode mode))
    +  (void-syscall ("mkfifo" c-string int) (%name->file name) mode))
    +
    +;;; sys/statfs.h
    +
    +#+(or)
    +(defun unix-statfs (file buf)
    +  _N"Return information about the filesystem on which FILE resides."
    +  (int-syscall ("statfs64" c-string (* (struct statfs)))
    +	       (%name->file file) buf))
    +
    +;;; sys/swap.h
    +
    +#+(or)
    +(defun unix-swapon (path flags)
    + _N"Make the block special device PATH available to the system for swapping.
    +  This call is restricted to the super-user."
    + (int-syscall ("swapon" c-string int) (%name->file path) flags))
    +
    +#+(or)
    +(defun unix-swapoff (path)
    + _N"Make the block special device PATH unavailable to the system for swapping.
    +  This call is restricted to the super-user."
    + (int-syscall ("swapoff" c-string) (%name->file path)))
    +
    +;;; sys/sysctl.h
    +
    +#+(or)
    +(defun unix-sysctl (name nlen oldval oldlenp newval newlen)
    +  _N"Read or write system parameters."
    +  (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t)
    +	       name nlen oldval oldlenp newval newlen))
    +
    +;;; time.h
    +
    +;; POSIX.4 structure for a time value.  This is like a `struct timeval' but
    +;; has nanoseconds instead of microseconds.
    +
    +(def-alien-type nil
    +    (struct timespec
    +	    (tv-sec long)   ;Seconds
    +	    (tv-nsec long))) ;Nanoseconds
    +
    +;; Used by other time functions. 
    +
    +(def-alien-type nil
    +    (struct tm
    +	    (tm-sec int)   ; Seconds.	[0-60] (1 leap second)
    +	    (tm-min int)   ; Minutes.	[0-59]
    +	    (tm-hour int)  ; Hours.	[0-23]
    +	    (tm-mday int)  ; Day.		[1-31]
    +	    (tm-mon int)   ;  Month.	[0-11]
    +	    (tm-year int)  ; Year	- 1900.
    +	    (tm-wday int)  ; Day of week.	[0-6]
    +	    (tm-yday int)  ; Days in year.[0-365]
    +	    (tm-isdst int) ;  DST.		[-1/0/1]
    +	    (tm-gmtoff long) ;  Seconds east of UTC.
    +	    (tm-zone c-string))) ; Timezone abbreviation.  
    +
    +#+(or)
    +(defun unix-clock ()
    +  _N"Time used by the program so far (user time + system time).
    +   The result / CLOCKS_PER_SECOND is program time in seconds."
    +  (int-syscall ("clock")))
    +
    +#+(or)
    +(defun unix-time (timer)
    +  _N"Return the current time and put it in *TIMER if TIMER is not NULL."
    +  (int-syscall ("time" time-t) timer))
    +
    +;; Requires call to tzset() in main.
    +
    +(def-alien-variable ("daylight" unix-daylight) int)
    +(def-alien-variable ("timezone" unix-timezone) time-t)
    +;(def-alien-variable ("altzone" unix-altzone) time-t) doesn't exist
    +(def-alien-variable ("tzname" unix-tzname) (array c-string 2))
    +
    +(def-alien-routine get-timezone c-call:void
    +  (when c-call:long :in)
    +  (minutes-west c-call:int :out)
    +  (daylight-savings-p alien:boolean :out))
    +
    +(defun unix-get-minutes-west (secs)
    +  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    +    (declare (ignore ignore) (ignore dst))
    +    (values minutes)))
    +  
    +(defun unix-get-timezone (secs)
    +  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
    +    (declare (ignore ignore) (ignore minutes))
    +    (values (deref unix-tzname (if dst 1 0)))))
    +
    +;/* Set the current time of day and timezone information.
    +;   This call is restricted to the super-user.  */
    +;extern int __settimeofday __P ((__const struct timeval *__tv,
    +;    __const struct timezone *__tz));
    +;extern int settimeofday __P ((__const struct timeval *__tv,
    +;         __const struct timezone *__tz));
    +
    +;/* Adjust the current time of day by the amount in DELTA.
    +;   If OLDDELTA is not NULL, it is filled in with the amount
    +;   of time adjustment remaining to be done from the last `adjtime' call.
    +;   This call is restricted to the super-user.  */
    +;extern int __adjtime __P ((__const struct timeval *__delta,
    +;      struct timeval *__olddelta));
    +;extern int adjtime __P ((__const struct timeval *__delta,
    +;    struct timeval *__olddelta));
    +
    +
    +;;; sys/timeb.h
    +
    +;; Structure returned by the `ftime' function.
    +
    +(def-alien-type nil
    +    (struct timeb
    +	    (time time-t)      ; Seconds since epoch, as from `time'.
    +	    (millitm short)    ; Additional milliseconds.
    +	    (timezone int)     ; Minutes west of GMT.
    +	    (dstflag short)))  ; Nonzero if Daylight Savings Time used. 
    +
    +#+(or)
    +(defun unix-fstime (timebuf)
    +  _N"Fill in TIMEBUF with information about the current time."
    +  (int-syscall ("ftime" (* (struct timeb))) timebuf))
    +
    +
    +;;; sys/times.h
    +
    +;; Structure describing CPU time used by a process and its children.
    +
    +(def-alien-type nil
    +    (struct tms
    +	    (tms-utime clock-t) ; User CPU time.
    +	    (tms-stime clock-t) ; System CPU time.
    +	    (tms-cutime clock-t) ; User CPU time of dead children.
    +	    (tms-cstime clock-t))) ; System CPU time of dead children.
    +
    +#+(or)
    +(defun unix-times (buffer)
    +  _N"Store the CPU time used by this process and all its
    +   dead children (and their dead children) in BUFFER.
    +   Return the elapsed real time, or (clock_t) -1 for errors.
    +   All times are in CLK_TCKths of a second."
    +  (int-syscall ("times" (* (struct tms))) buffer))
    +
    +;;; sys/wait.h
    +
    +#+(or)
    +(defun unix-wait (status)
    +  _N"Wait for a child to die.  When one does, put its status in *STAT_LOC
    +   and return its process ID.  For errors, return (pid_t) -1."
    +  (int-syscall ("wait" (* int)) status))
    +
    +#+(or)
    +(defun unix-waitpid (pid status options)
    +  _N"Wait for a child matching PID to die.
    +   If PID is greater than 0, match any process whose process ID is PID.
    +   If PID is (pid_t) -1, match any process.
    +   If PID is (pid_t) 0, match any process with the
    +   same process group as the current process.
    +   If PID is less than -1, match any process whose
    +   process group is the absolute value of PID.
    +   If the WNOHANG bit is set in OPTIONS, and that child
    +   is not already dead, return (pid_t) 0.  If successful,
    +   return PID and store the dead child's status in STAT_LOC.
    +   Return (pid_t) -1 for errors.  If the WUNTRACED bit is
    +   set in OPTIONS, return status for stopped children; otherwise don't."
    +  (int-syscall ("waitpit" pid-t (* int) int)
    +	       pid status options))
    +
    +;;; the ioctl's.
    +;;;
    +;;; I've deleted all the stuff that wasn't in the header files.
    +;;; This is what survived.
    +
    +
    +;;; asm/sockios.h
    +
    +;;; Socket options.
    +
    +(define-ioctl-command SIOCSPGRP #x89 #x02)
    +
    +(defun siocspgrp (fd pgrp)
    +  _N"Set the socket process-group for the unix file-descriptor FD to PGRP."
    +  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    +    (unix-ioctl fd
    +		siocspgrp
    +		(alien:alien-sap (alien:addr alien-pgrp)))))
    +
    +;;; A few random constants and functions
    +
    +(defconstant setuidexec #o4000 _N"Set user ID on execution")
    +(defconstant setgidexec #o2000 _N"Set group ID on execution")
    +(defconstant savetext #o1000 _N"Save text image after execution")
    +(defconstant readown #o400 _N"Read by owner")
    +(defconstant execown #o100 _N"Execute (search directory) by owner")
    +(defconstant readgrp #o40 _N"Read by group")
    +(defconstant writegrp #o20 _N"Write by group")
    +(defconstant execgrp #o10 _N"Execute (search directory) by group")
    +(defconstant readoth #o4 _N"Read by others")
    +(defconstant writeoth #o2 _N"Write by others")
    +(defconstant execoth #o1 _N"Execute (search directory) by others")
    +
    +;;;; Support routines for dealing with unix pathnames.
    +
    +(export '(unix-file-kind unix-maybe-prepend-current-directory
    +	  unix-resolve-links unix-simplify-pathname))
    +
    +;;;
    +;;; STRING-LIST-TO-C-STRVEC	-- Internal
    +;;; 
    +;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of
    +;;; simple-strings and constructs a C-style string vector (strvec) --
    +;;; a null-terminated array of pointers to null-terminated strings.
    +;;; This function returns two values: a sap and a byte count.  When the
    +;;; memory is no longer needed it should be deallocated with
    +;;; vm_deallocate.
    +;;; 
    +(defun string-list-to-c-strvec (string-list)
    +  ;;
    +  ;; Make a pass over string-list to calculate the amount of memory
    +  ;; needed to hold the strvec.
    +  (let ((string-bytes 0)
    +	(vec-bytes (* 4 (1+ (length string-list)))))
    +    (declare (fixnum string-bytes vec-bytes))
    +    (dolist (s string-list)
    +      (check-type s simple-string)
    +      (incf string-bytes (round-bytes-to-words (1+ (length s)))))
    +    ;;
    +    ;; Now allocate the memory and fill it in.
    +    (let* ((total-bytes (+ string-bytes vec-bytes))
    +	   (vec-sap (system:allocate-system-memory total-bytes))
    +	   (string-sap (sap+ vec-sap vec-bytes))
    +	   (i 0))
    +      (declare (type (and unsigned-byte fixnum) total-bytes i)
    +	       (type system:system-area-pointer vec-sap string-sap))
    +      (dolist (s string-list)
    +	(declare (simple-string s))
    +	(let ((n (length s)))
    +	  ;; 
    +	  ;; Blast the string into place
    +	  #-unicode
    +	  (kernel:copy-to-system-area (the simple-string s)
    +				      (* vm:vector-data-offset vm:word-bits)
    +				      string-sap 0
    +				      (* (1+ n) vm:byte-bits))
    +	  #+unicode
    +	  (progn
    +	    ;; FIXME: Do we need to apply some kind of transformation
    +	    ;; to convert Lisp unicode strings to C strings?  Utf-8?
    +	    (dotimes (k n)
    +	      (setf (sap-ref-8 string-sap k)
    +		    (logand #xff (char-code (aref s k)))))
    +	    (setf (sap-ref-8 string-sap n) 0))
    +	  ;; 
    +	  ;; Blast the pointer to the string into place
    +	  (setf (sap-ref-sap vec-sap i) string-sap)
    +	  (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
    +	  (incf i 4)))
    +      ;; Blast in last null pointer
    +      (setf (sap-ref-sap vec-sap i) (int-sap 0))
    +      (values vec-sap total-bytes))))
    +
    +;;; Stuff not yet found in the header files...
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    +;;; Abandon all hope who enters here...
    +
    +
    +;;;; User and group database access, POSIX Standard 9.2.2
    +
    +(defun unix-getpwnam (login)
    +  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    +  (declare (type simple-string login))
    +  (with-alien ((buf (array c-call:char 1024))
    +	       (user-info (struct passwd))
    +               (result (* (struct passwd))))
    +    (let ((returned
    +	   (alien-funcall
    +	    (extern-alien "getpwnam_r"
    +			  (function c-call:int
    +                                    c-call:c-string
    +                                    (* (struct passwd))
    +				    (* c-call:char)
    +                                    c-call:unsigned-int
    +                                    (* (* (struct passwd)))))
    +	    login
    +	    (addr user-info)
    +	    (cast buf (* c-call:char))
    +	    1024
    +            (addr result))))
    +      (when (zerop returned)
    +        (make-user-info
    +         :name (string (cast (slot result 'pw-name) c-call:c-string))
    +         :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    +         :uid (slot result 'pw-uid)
    +         :gid (slot result 'pw-gid)
    +         :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    +         :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    +         :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    +
    +(defun unix-getgrnam (name)
    +  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    +  (declare (type simple-string name))
    +  (with-alien ((buf (array c-call:char 2048))
    +	       (group-info (struct group))
    +               (result (* (struct group))))
    +    (let ((returned
    +	   (alien-funcall
    +	    (extern-alien "getgrnam_r"
    +			  (function c-call:int
    +                                    c-call:c-string
    +                                    (* (struct group))
    +                                    (* c-call:char)
    +                                    c-call:unsigned-int
    +                                    (* (* (struct group)))))
    +	    name
    +	    (addr group-info)
    +	    (cast buf (* c-call:char))
    +	    2048
    +            (addr result))))
    +      (when (zerop returned)
    +        (make-group-info
    +         :name (string (cast (slot result 'gr-name) c-call:c-string))
    +         :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +         :gid (slot result 'gr-gid)
    +         :members (loop :with members = (slot result 'gr-mem)
    +                        :for i :from 0
    +                        :for member = (deref members i)
    +                        :until (zerop (sap-int (alien-sap member)))
    +                        :collect (string (cast member c-call:c-string))))))))
    +
    +(defun unix-getgrgid (gid)
    +  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    +  (declare (type unix-gid gid))
    +  (with-alien ((buf (array c-call:char 2048))
    +	       (group-info (struct group))
    +               (result (* (struct group))))
    +    (let ((returned
    +	   (alien-funcall
    +	    (extern-alien "getgrgid_r"
    +			  (function c-call:int
    +                                    c-call:unsigned-int
    +                                    (* (struct group))
    +                                    (* c-call:char)
    +                                    c-call:unsigned-int
    +                                    (* (* (struct group)))))
    +	    gid
    +	    (addr group-info)
    +	    (cast buf (* c-call:char))
    +	    2048
    +            (addr result))))
    +      (when (zerop returned)
    +        (make-group-info
    +         :name (string (cast (slot result 'gr-name) c-call:c-string))
    +         :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +         :gid (slot result 'gr-gid)
    +         :members (loop :with members = (slot result 'gr-mem)
    +                        :for i :from 0
    +                        :for member = (deref members i)
    +                        :until (zerop (sap-int (alien-sap member)))
    +                        :collect (string (cast member c-call:c-string))))))))
    +
    +
    +;; EOF
    

  • src/contrib/unix/unix.lisp
    --- /dev/null
    +++ b/src/contrib/unix/unix.lisp
    @@ -0,0 +1,1116 @@
    +;;; -*- Package: UNIX -*-
    +;;;
    +;;; **********************************************************************
    +;;; This code was written as part of the CMU Common Lisp project at
    +;;; Carnegie Mellon University, and has been placed in the public domain.
    +;;;
    +;;; This contains extra functionality for the UNIX package that is not
    +;;; needed by CMUCL core.
    +(ext:file-comment
    +  "$Header: src/contrib/unix/unix.lisp $")
    +;;;
    +;;; **********************************************************************
    +;;;
    +;;; This file contains the UNIX low-level support.
    +;;;
    +(in-package "UNIX")
    +(use-package "ALIEN")
    +(use-package "C-CALL")
    +(use-package "SYSTEM")
    +(use-package "EXT")
    +(intl:textdomain "cmucl-unix")
    +
    +(export '(daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
    +	  timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
    +	  itimerval it-interval it-value tchars t-intrc t-quitc t-startc
    +	  t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
    +	  t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
    +	  sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
    +	  direct d-off d-ino d-reclen #-(or linux svr4) d-namlen d-name
    +	  stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
    +	  st-atime st-mtime st-ctime st-blksize st-blocks
    +	  s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
    +	  s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
    +	  ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
    +	  ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
    +	  ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
    +	  rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
    +
    +	  unix-errno get-unix-error-msg
    +
    +	  prot_read prot_write prot_exec prot_none
    +	  map_shared map_private map_fixed map_anonymous
    +	  ms_async ms_sync ms_invalidate
    +	  unix-mmap unix-munmap unix-msync
    +	  unix-mprotect
    +
    +	  unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
    +	  unix-setitimer unix-getitimer
    +	  unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
    +	  setgidexec savetext readown writeown execown readgrp writegrp
    +	  execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
    +	  unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
    +	  unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
    +	  fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
    +	  l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
    +	  #+(or hpux svr4 bsd linux) o_ndelay
    +	  #+(or hpux svr4 bsd linux) o_noctty #+(or hpux svr4 bsd) o_nonblock
    +	  o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
    +	  unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
    +	  fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
    +	  unix-ftruncate unix-symlink
    +	  #+(and sparc svr4) unix-times
    +	  unix-unlink unix-write unix-ioctl
    +	  tcsetpgrp tcgetpgrp tty-process-group
    +	  terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
    +	  #-hpux tty-cbreak #-(or hpux linux) tty-tandem
    +	  #+(or hpux svr4 linux bsd) termios
    +          #+(or hpux svr4 linux bsd) c-lflag
    +	  #+(or hpux svr4 linux bsd) c-iflag
    +          #+(or hpux svr4 linux bsd) c-oflag
    +	  #+(or hpux svr4 linux bsd) tty-icrnl
    +          #+(or hpux svr4 linux) tty-ocrnl
    +	  #+(or hpux svr4 bsd) vdsusp #+(or hpux svr4 linux bsd) veof
    +	  #+(or hpux svr4 linux bsd) vintr
    +          #+(or hpux svr4 linux bsd) vquit
    +          #+(or hpux svr4 linux bsd) vstart
    +	  #+(or hpux svr4 linux bsd) vstop
    +          #+(or hpux svr4 linux bsd) vsusp
    +	  #+(or hpux svr4 linux bsd) c-cflag
    +	  #+(or hpux svr4 linux bsd) c-cc
    +	  #+(or bsd osf1) c-ispeed
    +	  #+(or bsd osf1) c-ospeed
    +          #+(or hpux svr4 linux bsd) tty-icanon
    +	  #+(or hpux svr4 linux bsd) vmin
    +          #+(or hpux svr4 linux bsd) vtime
    +	  #+(or hpux svr4 linux bsd) tty-ixon
    +          #+(or hpux svr4 linux bsd) tcsanow
    +          #+(or hpux svr4 linux bsd) tcsadrain
    +          #+(or hpux svr4 linux bsd) tciflush
    +          #+(or hpux svr4 linux bsd) tcoflush
    +          #+(or hpux svr4 linux bsd) tcioflush
    +	  #+(or hpux svr4 linux bsd) tcsaflush
    +          #+(or hpux svr4 linux bsd) unix-tcgetattr
    +          #+(or hpux svr4 linux bsd) unix-tcsetattr
    +          #+(or hpux svr4 bsd) unix-cfgetospeed
    +          #+(or hpux svr4 bsd) unix-cfsetospeed
    +          #+(or hpux svr4 bsd) unix-cfgetispeed
    +          #+(or hpux svr4 bsd) unix-cfsetispeed
    +          #+(or hpux svr4 linux bsd) tty-ignbrk
    +          #+(or hpux svr4 linux bsd) tty-brkint
    +          #+(or hpux svr4 linux bsd) tty-ignpar
    +          #+(or hpux svr4 linux bsd) tty-parmrk
    +          #+(or hpux svr4 linux bsd) tty-inpck
    +          #+(or hpux svr4 linux bsd) tty-istrip
    +          #+(or hpux svr4 linux bsd) tty-inlcr
    +          #+(or hpux svr4 linux bsd) tty-igncr
    +          #+(or hpux svr4 linux) tty-iuclc
    +          #+(or hpux svr4 linux bsd) tty-ixany
    +          #+(or hpux svr4 linux bsd) tty-ixoff
    +          #+hpux tty-ienqak
    +          #+(or hpux irix solaris linux bsd) tty-imaxbel
    +          #+(or hpux svr4 linux bsd) tty-opost
    +          #+(or hpux svr4 linux) tty-olcuc
    +          #+(or hpux svr4 linux bsd) tty-onlcr
    +          #+(or hpux svr4 linux) tty-onocr
    +          #+(or hpux svr4 linux) tty-onlret
    +          #+(or hpux svr4 linux) tty-ofill
    +          #+(or hpux svr4 linux) tty-ofdel
    +          #+(or hpux svr4 linux bsd) tty-isig
    +          #+(or hpux svr4 linux) tty-xcase
    +          #+(or hpux svr4 linux bsd) tty-echoe
    +          #+(or hpux svr4 linux bsd) tty-echok
    +          #+(or hpux svr4 linux bsd) tty-echonl
    +          #+(or hpux svr4 linux bsd) tty-noflsh
    +          #+(or hpux svr4 linux bsd) tty-iexten
    +          #+(or hpux svr4 linux bsd) tty-tostop
    +          #+(or hpux irix solaris linux bsd) tty-echoctl
    +          #+(or hpux irix solaris linux bsd) tty-echoprt
    +          #+(or hpux irix solaris linux bsd) tty-echoke
    +          #+(or hpux irix solaris) tty-defecho
    +          #+(or hpux irix solaris bsd) tty-flusho
    +          #+(or hpux irix solaris linux bsd) tty-pendin
    +          #+(or hpux svr4 linux bsd) tty-cstopb
    +          #+(or hpux svr4 linux bsd) tty-cread
    +          #+(or hpux svr4 linux bsd) tty-parenb
    +          #+(or hpux svr4 linux bsd) tty-parodd
    +          #+(or hpux svr4 linux bsd) tty-hupcl
    +          #+(or hpux svr4 linux bsd) tty-clocal
    +          #+(or irix solaris) rcv1en
    +          #+(or irix solaris) xmt1en
    +          #+(or hpux irix solaris) tty-loblk
    +          #+(or hpux svr4 linux bsd) vintr
    +          #+(or hpux svr4 linux bsd) verase
    +          #+(or hpux svr4 linux bsd) vkill
    +          #+(or hpux svr4 linux bsd) veol
    +          #+(or hpux irix solaris linux bsd) veol2
    +          #+(or hpux irix solaris) tty-cbaud
    +          #+(or hpux svr4 bsd) tty-csize #+(or hpux svr4 bsd) tty-cs5
    +          #+(or hpux svr4 bsd) tty-cs6 #+(or hpux svr4 bsd) tty-cs7
    +          #+(or hpux svr4 bsd) tty-cs8
    +          #+(or hpux svr4 bsd) unix-tcsendbreak
    +          #+(or hpux svr4 bsd) unix-tcdrain
    +          #+(or hpux svr4 bsd) unix-tcflush
    +          #+(or hpux svr4 bsd) unix-tcflow
    +          
    +	  TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
    +	  TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
    +	  TIOCSIGSEND
    +
    +	  KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
    +	  KBDSCLICK FIONREAD #+(or hpux bsd) siocspgrp
    +	  unix-exit unix-stat unix-lstat unix-fstat
    +	  unix-getrusage unix-fast-getrusage rusage_self rusage_children
    +	  unix-gettimeofday
    +	  #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid
    +	  #-(or svr4 hpux) unix-setregid
    +	  unix-getpid unix-getppid
    +	  #+(or svr4 bsd)unix-setpgid
    +	  unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
    +	  unix-getpagesize unix-gethostname unix-gethostid unix-fork
    +	  unix-getenv unix-setenv unix-putenv unix-unsetenv
    +	  unix-current-directory unix-isatty unix-ttyname unix-execve
    +	  unix-socket unix-connect unix-bind unix-listen unix-accept
    +	  unix-recv unix-send unix-getpeername unix-getsockname
    +	  unix-getsockopt unix-setsockopt unix-openpty
    +
    +	  unix-recvfrom unix-sendto unix-shutdown
    +	  
    +          unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid
    +          user-info user-info-name user-info-password user-info-uid
    +          user-info-gid user-info-gecos user-info-dir user-info-shell
    +          group-info group-info-name group-info-gid group-info-members
    +
    +	  unix-uname))
    +
    +
    +;;;; Common machine independent structures.
    +
    +;;; From sys/types.h
    +
    +(def-alien-type u-int64-t (unsigned 64))
    +
    +(def-alien-type daddr-t
    +    #-(or linux alpha) long
    +    #+(or linux alpha) int)
    +
    +(def-alien-type caddr-t (* char))
    +
    +(def-alien-type swblk-t long)
    +
    +
    +
    +;;; Large file support for Solaris.  Define some of the 64-bit types
    +;;; we need.  Unlike unix-glibc's large file support, Solaris's
    +;;; version is a little simpler because all of the 64-bit versions of
    +;;; the functions actually exist as functions.  So instead of calling
    +;;; the 32-bit versions of the functions, we call the 64-bit versions.
    +;;;
    +;;; These functions are: creat64, open64, truncate64, ftruncate64,
    +;;; stat64, lstat64, fstat64, readdir64.
    +;;;
    +;;; There are also some new structures for large file support:
    +;;; dirent64, stat64.
    +;;;
    +;;; FIXME: We should abstract this better, but I (rtoy) don't have any
    +;;; other system to test this out on, so it's a Solaris hack for now.
    +#+solaris
    +(progn
    +  (deftype file-offset64 () '(signed-byte 64))
    +  (def-alien-type off64-t int64-t)
    +  (def-alien-type ino64-t u-int64-t)
    +  (def-alien-type blkcnt64-t u-int64-t))
    +
    +;;; From sys/time.h
    +
    +;;; From ioctl.h
    +
    +
    +;;; From sys/dir.h
    +;;;
    +
    +
    +;;; From sys/stat.h
    +;; oh boy, in linux-> 2 stat(s)!!
    +
    +#-(or svr4 bsd linux)		; eg hpux and alpha
    +(def-alien-type nil
    +  (struct stat
    +    (st-dev dev-t)
    +    (st-ino ino-t)
    +    (st-mode mode-t)
    +    (st-nlink nlink-t)
    +    (st-uid uid-t)
    +    (st-gid gid-t)
    +    (st-rdev dev-t)
    +    (st-size off-t)
    +    (st-atime time-t)
    +    (st-spare1 int)
    +    (st-mtime time-t)
    +    (st-spare2 int)
    +    (st-ctime time-t)
    +    (st-spare3 int)
    +    (st-blksize #-alpha long #+alpha unsigned-int)
    +    (st-blocks #-alpha long #+alpha int)
    +    (st-spare4 (array long 2))))
    +
    +#+netbsd
    +(def-alien-type nil
    +  (struct stat
    +    (st-dev dev-t)
    +    (st-mode mode-t)
    +    (st-ino ino-t)
    +    (st-nlink nlink-t)
    +    (st-uid uid-t)
    +    (st-gid gid-t)
    +    (st-rdev dev-t)
    +    (st-atime (struct timespec-t))
    +    (st-mtime (struct timespec-t))
    +    (st-ctime (struct timespec-t))
    +    (st-birthtime (struct timespec-t))
    +    (st-size off-t)
    +    (st-blocks off-t)
    +    (st-blksize long)
    +    (st-flags   unsigned-long)
    +    (st-gen     unsigned-long)
    +    (st-spare (array unsigned-long 2))))
    +
    +;;; From sys/resource.h
    +
    +(def-alien-type nil
    +  (struct rlimit
    +    (rlim-cur #-(or linux alpha) int #+linux long #+alpha unsigned-int)	 ; current (soft) limit
    +    (rlim-max #-(or linux alpha) int #+linux long #+alpha unsigned-int))); maximum value for rlim-cur
    +
    +
    +
    +
    +(defun (setf unix-errno) (newvalue) (unix-set-errno newvalue))
    +
    +
    +
    +;;;; User and group database structures
    +
    +
    +
    +(defstruct group-info
    +  (name "" :type string)
    +  (password "" :type string)
    +  (gid 0 :type unix-gid)
    +  (members nil :type list))             ; list of logins as strings
    +
    +;; see <grp.h>
    +(def-alien-type nil
    +  (struct group
    +      (gr-name (* char))                ; name of the group
    +      (gr-passwd (* char))              ; encrypted group password
    +      (gr-gid gid-t)                    ; numerical group ID
    +      (gr-mem (* (* char)))))           ; vector of pointers to member names
    +
    +
    +
    +
    +(defun unix-setuid (uid)
    +  _N"Set the user ID of the calling process to UID.
    +   If the calling process is the super-user, set the real
    +   and effective user IDs, and the saved set-user-ID to UID;
    +   if not, the effective user ID is set to UID."
    +  (int-syscall ("setuid" uid-t) uid))
    +
    +(defun unix-setgid (gid)
    +  _N"Set the group ID of the calling process to GID.
    +   If the calling process is the super-user, set the real
    +   and effective group IDs, and the saved set-group-ID to GID;
    +   if not, the effective group ID is set to GID."
    +  (int-syscall ("setgid" gid-t) gid))
    +
    +
    +
    +(defun unix-msync (addr length flags)
    +  (declare (type system-area-pointer addr)
    +	   (type (unsigned-byte 32) length)
    +	   (type (signed-byte 32) flags))
    +  (syscall ("msync" system-area-pointer size-t int) t addr length flags))
    +
    +
    +
    +(defun unix-chown (path uid gid)
    +  _N"Given a file path, an integer user-id, and an integer group-id,
    +   unix-chown changes the owner of the file and the group of the
    +   file to those specified.  Either the owner or the group may be
    +   left unchanged by specifying them as -1.  Note: Permission will
    +   fail if the caller is not the superuser."
    +  (declare (type unix-pathname path)
    +	   (type (or unix-uid (integer -1 -1)) uid)
    +	   (type (or unix-gid (integer -1 -1)) gid))
    +  (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
    +
    +;;; Unix-fchown is exactly the same as unix-chown except that the file
    +;;; is specified by a file-descriptor ("fd") instead of a pathname.
    +
    +(defun unix-fchown (fd uid gid)
    +  _N"Unix-fchown is like unix-chown, except that it accepts an integer
    +   file descriptor instead of a file path name."
    +  (declare (type unix-fd fd)
    +	   (type (or unix-uid (integer -1 -1)) uid)
    +	   (type (or unix-gid (integer -1 -1)) gid))
    +  (void-syscall ("fchown" int int int) fd uid gid))
    +
    +;;; Returns the maximum size (i.e. the number of array elements
    +;;; of the file descriptor table.
    +
    +(defun unix-getdtablesize ()
    +  _N"Unix-getdtablesize returns the maximum size of the file descriptor
    +   table. (i.e. the maximum number of descriptors that can exist at
    +   one time.)"
    +  (int-syscall ("getdtablesize")))
    +
    +;;; Unix-dup2 makes the second file-descriptor describe the same file
    +;;; as the first. If the second file-descriptor points to an open
    +;;; file, it is first closed. In any case, the second should have a 
    +;;; value which is a valid file-descriptor.
    +
    +(defun unix-dup2 (fd1 fd2)
    +  _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup
    +   does only the new value of the duplicate descriptor may be requested
    +   through the second argument.  If a file already exists with the
    +   requested descriptor number, it will be closed and the number
    +   assigned to the duplicate."
    +  (declare (type unix-fd fd1 fd2))
    +  (void-syscall ("dup2" int int) fd1 fd2))
    +
    +
    +;;; Unix-link creates a hard link from name2 to name1.
    +
    +(defun unix-link (name1 name2)
    +  _N"Unix-link creates a hard link from the file with name1 to the
    +   file with name2."
    +  (declare (type unix-pathname name1 name2))
    +  (void-syscall ("link" c-string c-string)
    +		(%name->file name1) (%name->file name2)))
    +
    +
    +;;; Unix-sync writes all information in core memory which has been modified
    +;;; to permanent storage (i.e. disk).
    +
    +(defun unix-sync ()
    +  _N"Unix-sync writes all information in core memory which has been
    +   modified to disk.  It returns NIL and an error code if an error
    +   occured."
    +  (void-syscall ("sync")))
    +
    +;;; Unix-fsync writes the core-image of the file described by "fd" to
    +;;; permanent storage (i.e. disk).
    +
    +(defun unix-fsync (fd)
    +  _N"Unix-fsync writes the core image of the file described by
    +   fd to disk."
    +  (declare (type unix-fd fd))
    +  (void-syscall ("fsync" int) fd))
    +
    +;;; Unix-truncate accepts a file name and a new length.  The file is
    +;;; truncated to the new length.
    +
    +(defun unix-truncate (name len)
    +  _N"Unix-truncate truncates the named file to the length (in
    +   bytes) specified by len.  NIL and an error number is returned
    +   if the call is unsuccessful."
    +  (declare (type unix-pathname name)
    +	   (type (unsigned-byte #+solaris 64 #-solaris 32) len))
    +  #-(and bsd x86)
    +  (void-syscall (#+solaris "truncate64" #-solaris "truncate" c-string int) name len)
    +  #+(and bsd x86)
    +  (void-syscall ("truncate" c-string unsigned-long unsigned-long) name len 0))
    +
    +(defun unix-ftruncate (fd len)
    +  _N"Unix-ftruncate is similar to unix-truncate except that the first
    +   argument is a file descriptor rather than a file name."
    +  (declare (type unix-fd fd)
    +	   (type (unsigned-byte #+solaris 64 #-solaris 32) len))
    +  #-(and bsd x86)
    +  (void-syscall (#+solaris "ftruncate64" #-solaris "ftruncate" int int) fd len)
    +  #+(and bsd x86)
    +  (void-syscall ("ftruncate" int unsigned-long unsigned-long) fd len 0))
    +
    +;;; TTY ioctl commands.
    +
    +
    +
    +#+(or svr4 hpux bsd linux)
    +(progn
    +  #+bsd
    +  (defun unix-cfgetospeed (termios)
    +    _N"Get terminal output speed."
    +    (int-syscall ("cfgetospeed" (* (struct termios))) termios))
    +
    +  #-bsd
    +  (defun unix-cfsetospeed (termios speed)
    +    _N"Set terminal output speed."
    +    (let ((baud (or (position speed terminal-speeds)
    +                    (error _"Bogus baud rate ~S" speed))))
    +      (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
    +  
    +  #+bsd
    +  (defun unix-cfsetospeed (termios speed)
    +    _N"Set terminal output speed."
    +    (void-syscall ("cfsetospeed" (* (struct termios)) int) termios speed))
    +  
    +  #-bsd
    +  (defun unix-cfgetispeed (termios)
    +    _N"Get terminal input speed."
    +    (multiple-value-bind (speed errno)
    +        (int-syscall ("cfgetispeed" (* (struct termios))) termios)
    +      (if speed
    +          (values (svref terminal-speeds speed) 0)
    +          (values speed errno))))
    +
    +  #+bsd
    +  (defun unix-cfgetispeed (termios)
    +    _N"Get terminal input speed."
    +    (int-syscall ("cfgetispeed" (* (struct termios))) termios))
    +  
    +  #-bsd
    +  (defun unix-cfsetispeed (termios speed)
    +    _N"Set terminal input speed."
    +    (let ((baud (or (position speed terminal-speeds)
    +                    (error _"Bogus baud rate ~S" speed))))
    +      (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
    +
    +  #+bsd
    +  (defun unix-cfsetispeed (termios speed)
    +    _N"Set terminal input speed."
    +    (void-syscall ("cfsetispeed" (* (struct termios)) int) termios speed))
    +
    +  (defun unix-tcsendbreak (fd duration)
    +    _N"Send break"
    +    (declare (type unix-fd fd))
    +    (void-syscall ("tcsendbreak" int int) fd duration))
    +
    +  (defun unix-tcdrain (fd)
    +    _N"Wait for output for finish"
    +    (declare (type unix-fd fd))
    +    (void-syscall ("tcdrain" int) fd))
    +
    +  (defun unix-tcflush (fd selector)
    +    _N"See tcflush(3)"
    +    (declare (type unix-fd fd))
    +    (void-syscall ("tcflush" int int) fd selector))
    +
    +  (defun unix-tcflow (fd action)
    +    _N"Flow control"
    +    (declare (type unix-fd fd))
    +    (void-syscall ("tcflow" int int) fd action)))
    +
    +(defun tcsetpgrp (fd pgrp)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP."
    +  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    +    (unix-ioctl fd
    +		tiocspgrp
    +		(alien:alien-sap (alien:addr alien-pgrp)))))
    +
    +(defun tcgetpgrp (fd)
    +  _N"Get the tty-process-group for the unix file-descriptor FD."
    +  (alien:with-alien ((alien-pgrp c-call:int))
    +    (multiple-value-bind (ok err)
    +	(unix-ioctl fd
    +		     tiocgpgrp
    +		     (alien:alien-sap (alien:addr alien-pgrp)))
    +      (if ok
    +	  (values alien-pgrp nil)
    +	  (values nil err)))))
    +
    +(defun tty-process-group (&optional fd)
    +  _N"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,
    +  FD defaults to /dev/tty."
    +  (if fd
    +      (tcgetpgrp fd)
    +      (multiple-value-bind (tty-fd errno)
    +	  (unix-open "/dev/tty" o_rdwr 0)
    +	(cond (tty-fd
    +	       (multiple-value-prog1
    +		   (tcgetpgrp tty-fd)
    +		 (unix-close tty-fd)))
    +	      (t
    +	       (values nil errno))))))
    +
    +(defun %set-tty-process-group (pgrp &optional fd)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    +  supplied, FD defaults to /dev/tty."
    +  (let ((old-sigs
    +	 (unix-sigblock
    +	  (sigmask :sigttou :sigttin :sigtstp :sigchld))))
    +    (declare (type (unsigned-byte 32) old-sigs))
    +    (unwind-protect
    +	(if fd
    +	    (tcsetpgrp fd pgrp)
    +	    (multiple-value-bind (tty-fd errno)
    +		(unix-open "/dev/tty" o_rdwr 0)
    +	      (cond (tty-fd
    +		     (multiple-value-prog1
    +			 (tcsetpgrp tty-fd pgrp)
    +		       (unix-close tty-fd)))
    +		    (t
    +		     (values nil errno)))))
    +      (unix-sigsetmask old-sigs))))
    +  
    +(defsetf tty-process-group (&optional fd) (pgrp)
    +  _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
    +  supplied, FD defaults to /dev/tty."
    +  `(%set-tty-process-group ,pgrp ,fd))
    +
    +
    +;;; Socket options.
    +
    +#+(or hpux bsd)
    +(define-ioctl-command SIOCSPGRP #\s 8 int :in)
    +
    +#+linux
    +(define-ioctl-command SIOCSPGRP #\s #x8904 int :in)
    +
    +#+(or hpux bsd linux)
    +(defun siocspgrp (fd pgrp)
    +  _N"Set the socket process-group for the unix file-descriptor FD to PGRP."
    +  (alien:with-alien ((alien-pgrp c-call:int pgrp))
    +    (unix-ioctl fd
    +		siocspgrp
    +		(alien:alien-sap (alien:addr alien-pgrp)))))
    +
    +;;; Unix-setreuid sets the real and effective user-id's of the current
    +;;; process to the arguments "ruid" and "euid", respectively.  Usage is
    +;;; restricted for anyone but the super-user.  Setting either "ruid" or
    +;;; "euid" to -1 makes the system use the current id instead.
    +
    +#-(or svr4 hpux)
    +(defun unix-setreuid (ruid euid)
    +  _N"Unix-setreuid sets the real and effective user-id's of the current
    +   process to the specified ones.  NIL and an error number is returned
    +   if the call fails."
    +  (void-syscall ("setreuid" int int) ruid euid))
    +
    +;;; Unix-setregid sets the real and effective group-id's of the current
    +;;; process to the arguments "rgid" and "egid", respectively.  Usage is
    +;;; restricted for anyone but the super-user.  Setting either "rgid" or
    +;;; "egid" to -1 makes the system use the current id instead.
    +
    +#-(or svr4 hpux)
    +(defun unix-setregid (rgid egid)
    +  _N"Unix-setregid sets the real and effective group-id's of the current
    +   process process to the specified ones.  NIL and an error number is
    +   returned if the call fails."
    +  (void-syscall ("setregid" int int) rgid egid))
    +
    +(def-alien-routine ("getppid" unix-getppid) int
    +  _N"Unix-getppid returns the process-id of the parent of the current process.")
    +
    +(def-alien-routine ("getgid" unix-getgid) int
    +  _N"Unix-getgid returns the real group-id of the current process.")
    +
    +(def-alien-routine ("getegid" unix-getegid) int
    +  _N"Unix-getegid returns the effective group-id of the current process.")
    +
    +;;; Unix-getpgrp returns the group-id associated with the
    +;;; current process.
    +
    +(defun unix-getpgrp ()
    +  _N"Unix-getpgrp returns the group-id of the calling process."
    +  (int-syscall ("getpgrp")))
    +
    +;;; Unix-setpgid sets the group-id of the process specified by 
    +;;; "pid" to the value of "pgrp".  The process must either have
    +;;; the same effective user-id or be a super-user process.
    +
    +;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
    +;;; for backward compatibility. setpgrp(void)[solaris] is being phased
    +;;; out in favor of setsid().
    +
    +(defun unix-setpgrp (pid pgrp)
    +  _N"Unix-setpgrp sets the process group on the process pid to
    +   pgrp.  NIL and an error number are returned upon failure."
    +  (void-syscall (#-svr4 "setpgrp" #+svr4 "setpgid" int int) pid pgrp))
    +
    +(defun unix-setpgid (pid pgrp)
    +  _N"Unix-setpgid sets the process group of the process pid to
    +   pgrp. If pgid is equal to pid, the process becomes a process
    +   group leader. NIL and an error number are returned upon failure."
    +  (void-syscall ("setpgid" int int) pid pgrp))
    +
    +(defun unix-fork ()
    +  _N"Executes the unix fork system call.  Returns 0 in the child and the pid
    +   of the child in the parent if it works, or NIL and an error number if it
    +   doesn't work."
    +  (int-syscall ("fork")))
    +
    +;; Environment manipulation; man getenv(3)
    +(def-alien-routine ("getenv" unix-getenv) c-call:c-string
    +  (name c-call:c-string) 
    +  _N"Get the value of the environment variable named Name.  If no such
    +  variable exists, Nil is returned.")
    +
    +;; This doesn't exist in Solaris 8 but does exist in Solaris 10.
    +(def-alien-routine ("setenv" unix-setenv) c-call:int
    +  (name c-call:c-string)
    +  (value c-call:c-string)
    +  (overwrite c-call:int)
    +  _N"Adds the environment variable named Name to the environment with
    +  the given Value if Name does not already exist. If Name does exist,
    +  the value is changed to Value if Overwrite is non-zero.  Otherwise,
    +  the value is not changed.")
    +
    +
    +(def-alien-routine ("putenv" unix-putenv) c-call:int
    +  (name-value c-call:c-string)
    +  _N"Adds or changes the environment.  Name-value must be a string of
    +  the form \"name=value\".  If the name does not exist, it is added.
    +  If name does exist, the value is updated to the given value.")
    +
    +;; This doesn't exist in Solaris 8 but does exist in Solaris 10.
    +(def-alien-routine ("unsetenv" unix-unsetenv) c-call:int
    +  (name c-call:c-string)
    +  _N"Removes the variable Name from the environment")
    +
    +
    +;;;; Support routines for dealing with unix pathnames.
    +
    +(export '(unix-file-kind unix-maybe-prepend-current-directory
    +	  unix-resolve-links unix-simplify-pathname))
    +
    +
    +;;;; UNIX-EXECVE
    +
    +(defun unix-execve (program &optional arg-list
    +			    (environment *environment-list*))
    +  _N"Executes the Unix execve system call.  If the system call suceeds, lisp
    +   will no longer be running in this process.  If the system call fails this
    +   function returns two values: NIL and an error code.  Arg-list should be a
    +   list of simple-strings which are passed as arguments to the exec'ed program.
    +   Environment should be an a-list mapping symbols to simple-strings which this
    +   function bashes together to form the environment for the exec'ed program."
    +  (check-type program simple-string)
    +  (let ((env-list (let ((envlist nil))
    +		    (dolist (cons environment)
    +		      (push (if (cdr cons)
    +				(concatenate 'simple-string
    +					     (string (car cons)) "="
    +					     (cdr cons))
    +				(car cons))
    +			    envlist))
    +		    envlist)))
    +    (sub-unix-execve (%name->file program) arg-list env-list)))
    +
    +
    +(defmacro round-bytes-to-words (n)
    +  `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
    +
    +;;;
    +;;; STRING-LIST-TO-C-STRVEC	-- Internal
    +;;; 
    +;;; STRING-LIST-TO-C-STRVEC is a function which takes a list of
    +;;; simple-strings and constructs a C-style string vector (strvec) --
    +;;; a null-terminated array of pointers to null-terminated strings.
    +;;; This function returns two values: a sap and a byte count.  When the
    +;;; memory is no longer needed it should be deallocated with
    +;;; vm_deallocate.
    +;;; 
    +(defun string-list-to-c-strvec (string-list)
    +  ;;
    +  ;; Make a pass over string-list to calculate the amount of memory
    +  ;; needed to hold the strvec.
    +  (let ((string-bytes 0)
    +	(vec-bytes (* 4 (1+ (length string-list)))))
    +    (declare (fixnum string-bytes vec-bytes))
    +    (dolist (s string-list)
    +      (check-type s simple-string)
    +      (incf string-bytes (round-bytes-to-words (1+ (length s)))))
    +    ;;
    +    ;; Now allocate the memory and fill it in.
    +    (let* ((total-bytes (+ string-bytes vec-bytes))
    +	   (vec-sap (system:allocate-system-memory total-bytes))
    +	   (string-sap (sap+ vec-sap vec-bytes))
    +	   (i 0))
    +      (declare (type (and unsigned-byte fixnum) total-bytes i)
    +	       (type system:system-area-pointer vec-sap string-sap))
    +      (dolist (s string-list)
    +	(declare (simple-string s))
    +	(let ((n (length s)))
    +	  ;; 
    +	  ;; Blast the string into place
    +	  #-unicode
    +	  (kernel:copy-to-system-area (the simple-string s)
    +				      (* vm:vector-data-offset vm:word-bits)
    +				      string-sap 0
    +				      (* (1+ n) vm:byte-bits))
    +	  #+unicode
    +	  (progn
    +	    ;; FIXME: Do we need to apply some kind of transformation
    +	    ;; to convert Lisp unicode strings to C strings?  Utf-8?
    +	    (dotimes (k n)
    +	      (setf (sap-ref-8 string-sap k)
    +		    (logand #xff (char-code (aref s k)))))
    +	    (setf (sap-ref-8 string-sap n) 0))
    +	  
    +	  ;; 
    +	  ;; Blast the pointer to the string into place
    +	  (setf (sap-ref-sap vec-sap i) string-sap)
    +	  (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
    +	  (incf i 4)))
    +      ;; Blast in last null pointer
    +      (setf (sap-ref-sap vec-sap i) (int-sap 0))
    +      (values vec-sap total-bytes))))
    +
    +(defun sub-unix-execve (program arg-list env-list)
    +  (let ((argv nil)
    +	(argv-bytes 0)
    +	(envp nil)
    +	(envp-bytes 0)
    +	result error-code)
    +    (unwind-protect
    +	(progn
    +	  ;; Blast the stuff into the proper format
    +	  (multiple-value-setq
    +	      (argv argv-bytes)
    +	    (string-list-to-c-strvec arg-list))
    +	  (multiple-value-setq
    +	      (envp envp-bytes)
    +	    (string-list-to-c-strvec env-list))
    +	  ;;
    +	  ;; Now do the system call
    +	  (multiple-value-setq
    +	      (result error-code)
    +	    (int-syscall ("execve"
    +			  c-string system-area-pointer system-area-pointer)
    +			 program argv envp)))
    +      ;; 
    +      ;; Deallocate memory
    +      (when argv
    +	(system:deallocate-system-memory argv argv-bytes))
    +      (when envp
    +	(system:deallocate-system-memory envp envp-bytes)))
    +    (values result error-code)))
    +
    +
    +
    +;;;
    +;;; Support for the Interval Timer (experimental)
    +;;;
    +
    +
    +(defun unix-getitimer (which)
    +  _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of
    +   three system timers (:real :virtual or :profile). On success,
    +   unix-getitimer returns 5 values,
    +   T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
    +  (declare (type (member :real :virtual :profile) which)
    +	   (values t
    +		   #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
    +		   (mod 1000000)
    +		   #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
    +		   (mod 1000000)))
    +  (let ((which (ecase which
    +		 (:real ITIMER-REAL)
    +		 (:virtual ITIMER-VIRTUAL)
    +		 (:profile ITIMER-PROF))))
    +    (with-alien ((itv (struct itimerval)))
    +      (syscall* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval)))
    +		(values T
    +			(slot (slot itv 'it-interval) 'tv-sec)
    +			(slot (slot itv 'it-interval) 'tv-usec)
    +			(slot (slot itv 'it-value) 'tv-sec)
    +			(slot (slot itv 'it-value) 'tv-usec))
    +		which (alien-sap (addr itv))))))
    +
    +
    +;;;; User and group database access, POSIX Standard 9.2.2
    +
    +#+solaris
    +(defun unix-getpwnam (login)
    +  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    +  (declare (type simple-string login))
    +  (with-alien ((buf (array c-call:char 1024))
    +	       (user-info (struct passwd)))
    +    (let ((result
    +	   (alien-funcall
    +	    (extern-alien "getpwnam_r"
    +			  (function (* (struct passwd))
    +				    c-call:c-string
    +				    (* (struct passwd))
    +				    (* c-call:char)
    +				    c-call:unsigned-int))
    +	    login
    +	    (addr user-info)
    +	    (cast buf (* c-call:char))
    +	    1024)))
    +      (when (not (zerop (sap-int (alien-sap result))))
    +	(make-user-info
    +	 :name (string (cast (slot result 'pw-name) c-call:c-string))
    +	 :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    +	 :uid (slot result 'pw-uid)
    +	 :gid (slot result 'pw-gid)
    +	 :age (string (cast (slot result 'pw-age) c-call:c-string))
    +	 :comment (string (cast (slot result 'pw-comment) c-call:c-string))
    +	 :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    +	 :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    +	 :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    +
    +#+bsd
    +(defun unix-getpwnam (login)
    +  _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
    +  (declare (type simple-string login))
    +  (let ((result
    +         (alien-funcall
    +          (extern-alien "getpwnam"
    +                        (function (* (struct passwd))
    +                                  c-call:c-string))
    +          login)))
    +    (when (not (zerop (sap-int (alien-sap result))))
    +      (make-user-info
    +       :name (string (cast (slot result 'pw-name) c-call:c-string))
    +       :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    +       :uid (slot result 'pw-uid)
    +       :gid (slot result 'pw-gid)
    +       #-darwin :change #-darwin (slot result 'pw-change)
    +       :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    +       :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    +       :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
    +
    +
    +#+solaris
    +(eval-when (:compile-toplevel :load-toplevel :execute)
    +  ;; sysconf(_SC_GETGR_R_SIZE_MAX)
    +  (defconstant +sc-getgr-r-size-max+ 7296
    +    _N"The maximum size of the group entry buffer"))
    +
    +#+solaris
    +(defun unix-getgrnam (name)
    +  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    +  (declare (type simple-string name))
    +  (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
    +	       (group-info (struct group)))
    +    (let ((result
    +	   (alien-funcall
    +	    (extern-alien "getgrnam_r"
    +			  (function (* (struct group))
    +                                    c-call:c-string
    +                                    (* (struct group))
    +                                    (* c-call:char)
    +                                    c-call:unsigned-int))
    +	    name
    +	    (addr group-info)
    +	    (cast buf (* c-call:char))
    +	    #.+sc-getgr-r-size-max+)))
    +      (unless (zerop (sap-int (alien-sap result)))
    +	(make-group-info
    +	 :name (string (cast (slot result 'gr-name) c-call:c-string))
    +	 :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +	 :gid (slot result 'gr-gid)
    +         :members (loop :with members = (slot result 'gr-mem)
    +                        :for i :from 0
    +                        :for member = (deref members i)
    +                        :until (zerop (sap-int (alien-sap member)))
    +                        :collect (string (cast member c-call:c-string))))))))
    +
    +#+bsd
    +(defun unix-getgrnam (name)
    +  _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
    +  (declare (type simple-string name))
    +  (let ((result
    +         (alien-funcall
    +          (extern-alien "getgrnam"
    +                        (function (* (struct group))
    +                                  c-call:c-string))
    +          name)))
    +    (unless (zerop (sap-int (alien-sap result)))
    +      (make-group-info
    +       :name (string (cast (slot result 'gr-name) c-call:c-string))
    +       :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +       :gid (slot result 'gr-gid)
    +       :members (loop :with members = (slot result 'gr-mem)
    +                      :for i :from 0
    +                      :for member = (deref members i)
    +                      :until (zerop (sap-int (alien-sap member)))
    +                      :collect (string (cast member c-call:c-string)))))))
    +
    +#+solaris
    +(defun unix-getgrgid (gid)
    +  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    +  (declare (type unix-gid gid))
    +  (with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
    +	       (group-info (struct group)))
    +    (let ((result
    +	   (alien-funcall
    +	    (extern-alien "getgrgid_r"
    +			  (function (* (struct group))
    +				     c-call:unsigned-int
    +				     (* (struct group))
    +				     (* c-call:char)
    +				     c-call:unsigned-int))
    +	    gid
    +	    (addr group-info)
    +	    (cast buf (* c-call:char))
    +	    #.+sc-getgr-r-size-max+)))
    +      (unless (zerop (sap-int (alien-sap result)))
    +	(make-group-info
    +	 :name (string (cast (slot result 'gr-name) c-call:c-string))
    +	 :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +	 :gid (slot result 'gr-gid)
    +	 :members (loop :with members = (slot result 'gr-mem)
    +		        :for i :from 0
    +		        :for member = (deref members i)
    +		        :until (zerop (sap-int (alien-sap member)))
    +		        :collect (string (cast member c-call:c-string))))))))
    +
    +#+bsd
    +(defun unix-getgrgid (gid)
    +  _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
    +  (declare (type unix-gid gid))
    +  (let ((result
    +         (alien-funcall
    +          (extern-alien "getgrgid"
    +                        (function (* (struct group))
    +                                  c-call:unsigned-int))
    +          gid)))
    +    (unless (zerop (sap-int (alien-sap result)))
    +      (make-group-info
    +       :name (string (cast (slot result 'gr-name) c-call:c-string))
    +       :password (string (cast (slot result 'gr-passwd) c-call:c-string))
    +       :gid (slot result 'gr-gid)
    +       :members (loop :with members = (slot result 'gr-mem)
    +                      :for i :from 0
    +                      :for member = (deref members i)
    +                      :until (zerop (sap-int (alien-sap member)))
    +                      :collect (string (cast member c-call:c-string)))))))
    +
    +#+solaris
    +(defun unix-setpwent ()
    +  (void-syscall ("setpwent")))
    +
    +#+solaris
    +(defun unix-endpwent ()
    +  (void-syscall ("endpwent")))
    +
    +#+solaris
    +(defun unix-getpwent ()
    +  (with-alien ((buf (array c-call:char 1024))
    +	       (user-info (struct passwd)))
    +    (let ((result
    +	   (alien-funcall
    +	    (extern-alien "getpwent_r"
    +			  (function (* (struct passwd))
    +				    (* (struct passwd))
    +				    (* c-call:char)
    +				    c-call:unsigned-int))
    +	    (addr user-info)
    +	    (cast buf (* c-call:char))
    +	    1024)))
    +      (when (not (zerop (sap-int (alien-sap result))))
    +	(make-user-info
    +	 :name (string (cast (slot result 'pw-name) c-call:c-string))
    +	 :password (string (cast (slot result 'pw-passwd) c-call:c-string))
    +	 :uid (slot result 'pw-uid)
    +	 :gid (slot result 'pw-gid)
    +	 :age (string (cast (slot result 'pw-age) c-call:c-string))
    +	 :comment (string (cast (slot result 'pw-comment) c-call:c-string))
    +	 :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
    +	 :dir (string (cast (slot result 'pw-dir) c-call:c-string))
    +	 :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
    +
    +#+(and solaris svr4)
    +(export '(unix-sysinfo
    +	  si-sysname si-hostname si-release si-version si-machine
    +	  si-architecture si-hw-serial si-hw-provider si-srpc-domain
    +	  si-platform si-isalist si-dhcp-cache))
    +
    +#+(and solaris svr4)
    +(progn
    +;; From sys/systeminfo.h.  We don't list the set values here.
    +(def-enum + 1
    +  si-sysname si-hostname si-release si-version si-machine
    +  si-architecture si-hw-serial si-hw-provider si-srpc-domain)
    +
    +(def-enum + 513
    +  si-platform si-isalist si-dhcp-cache)
    +
    +
    +(defun unix-sysinfo (command)
    +  ;; Hope a buffer of length 2048 is long enough.
    +  (with-alien ((buf (array c-call:unsigned-char 2048)))
    +    (let ((result
    +	   (alien-funcall
    +	    (extern-alien "sysinfo"
    +			  (function c-call:int
    +				    c-call:int
    +				    c-call:c-string
    +				    c-call:int))
    +	    command
    +	    (cast buf (* c-call:char))
    +	    2048)))
    +      (when (>= result 0)
    +	(cast buf c-call:c-string)))))
    +)
    +
    +#+solaris
    +(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core rlimit_nofile
    +	  rlimit_vmem rlimit_as))
    +
    +#+solaris
    +(progn
    +(defconstant rlimit_cpu 0
    +  _N"CPU time per process (in milliseconds)")
    +(defconstant rlimit_fsize 1
    +  _N"Maximum file size")
    +(defconstant rlimit_data 2
    +  _N"Data segment size")
    +(defconstant rlimit_stack 3
    +  _N"Stack size")
    +(defconstant rlimit_core 4
    +  _N"Core file size")
    +(defconstant rlimit_nofile 5
    +  _N"Number of open files")
    +(defconstant rlimit_vmem 6
    +  _N"Maximum mapped memory")
    +(defconstant rlimit_as rlimit_vmem)
    +)
    +
    +#+(and darwin x86)
    +(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core
    +	  rlimit_as rlimit_rss rlimit_memlock rlimit_nproc rlimit_nofile))
    +
    +#+(and darwin x86)
    +(progn
    +(defconstant rlimit_cpu 0
    +  _N"CPU time per process")
    +(defconstant rlimit_fsize 1
    +  _N"File size")
    +(defconstant rlimit_data 2
    +  _N"Data segment size")
    +(defconstant rlimit_stack 3
    +  _N"Stack size")
    +(defconstant rlimit_core 4
    +  _N"Core file size")
    +(defconstant rlimit_as 5
    +  _N"Addess space (resident set size)")
    +(defconstant rlimit_rss rlimit_as)
    +(defconstant rlimit_memlock 6
    +  _N"Locked-in-memory address space")
    +(defconstant rlimit_nproc 7
    +  _N"Number of processes")
    +(defconstant rlimit_nofile 8
    +  _N"Number of open files")
    +)
    +
    +
    +#+(or solaris (and darwin x86))
    +(export '(unix-getrlimit))
    +
    +#+(or solaris (and darwin x86))
    +(defun unix-getrlimit (resource)
    +  _N"Get the limits on the consumption of system resouce specified by
    +  Resource.  If successful, return three values: T, the current (soft)
    +  limit, and the maximum (hard) limit."
    +  
    +  (with-alien ((rlimit (struct rlimit)))
    +    (syscall ("getrlimit" c-call:int (* (struct rlimit)))
    +	     (values t
    +		     (slot rlimit 'rlim-cur)
    +		     (slot rlimit 'rlim-max))
    +	     resource (addr rlimit))))
    +;; EOF
    

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

  • src/i18n/locale/cmucl-unix.pot
    --- a/src/i18n/locale/cmucl-unix.pot
    +++ b/src/i18n/locale/cmucl-unix.pot
    @@ -16,1535 +16,1223 @@ msgstr ""
     "Content-Transfer-Encoding: 8bit\n"
     
     #: src/code/unix.lisp
    -msgid "Size of control character vector."
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Successful"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Operation not permitted"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No such file or directory"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No such process"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Interrupted system call"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "I/O error"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Device not configured"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Arg list too long"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Exec format error"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Bad file descriptor"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No child process"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Resource deadlock avoided"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No more processes"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Try again"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Out of memory"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Permission denied"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Bad address"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Block device required"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Device or resource busy"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "File exists"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Cross-device link"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No such device"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Not a director"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Is a directory"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Invalid argument"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "File table overflow"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Too many open files"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Inappropriate ioctl for device"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Text file busy"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "File too large"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "No space left on device"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Illegal seek"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Read-only file system"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Too many links"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Broken pipe"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Numerical argument out of domain"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Result too large"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Math result not representable"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Operation would block"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Resource temporarily unavailable"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Operation now in progress"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Operation already in progress"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Socket operation on non-socket"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Destination address required"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Message too long"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Protocol wrong type for socket"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Protocol not available"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Protocol not supported"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Socket type not supported"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Operation not supported on socket"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Protocol family not supported"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Address family not supported by protocol family"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Address already in use"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Can't assign requested address"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Network is down"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Network is unreachable"
    -msgstr ""
    -
    -#: src/code/unix.lisp
    -msgid "Network dropped connection on reset"
    +msgid "Syscall ~A failed: ~A"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Software caused connection abort"
    +msgid "Test for read permission"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Connection reset by peer"
    +msgid "Class not yet defined: ~S"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No buffer space available"
    +msgid "Test for write permission"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Socket is already connected"
    +msgid "Test for execute permission"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Socket is not connected"
    +msgid "Test for presence of file"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Can't send after socket shutdown"
    +msgid ""
    +"Given a file path (a string) and one of four constant modes,\n"
    +"   unix-access returns T if the file is accessible with that\n"
    +"   mode and NIL if not.  It also returns an errno value with\n"
    +"   NIL which determines why the file was not accessible.\n"
    +"\n"
    +"   The access modes are:\n"
    +"	r_ok     Read permission.\n"
    +"	w_ok     Write permission.\n"
    +"	x_ok     Execute permission.\n"
    +"	f_ok     Presence of file."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many references: can't splice"
    +msgid ""
    +"Given a file path string, unix-chdir changes the current working \n"
    +"   directory to the one specified."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Connection timed out"
    +msgid "Set user ID on execution"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Connection refused"
    +msgid "Set group ID on execution"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many levels of symbolic links"
    +msgid "Save text image after execution"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "File name too long"
    +msgid "Read by owner"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Host is down"
    +msgid "Write by owner"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No route to host"
    +msgid "Execute (search directory) by owner"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Directory not empty"
    +msgid "Read by group"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many processes"
    +msgid "Write by group"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many users"
    +msgid "Execute (search directory) by group"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Disc quota exceeded"
    +msgid "Read by others"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "namei should continue locally"
    +msgid "Write by others"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "namei was handled remotely"
    +msgid "Execute (search directory) by others"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Remote file system error _N"
    +msgid ""
    +"Given a file path string and a constant mode, unix-chmod changes the\n"
    +"   permission mode for that file to the one specified. The new mode\n"
    +"   can be created by logically OR'ing the following:\n"
    +"\n"
    +"      setuidexec        Set user ID on execution.\n"
    +"      setgidexec        Set group ID on execution.\n"
    +"      savetext          Save text image after execution.\n"
    +"      readown           Read by owner.\n"
    +"      writeown          Write by owner.\n"
    +"      execown           Execute (search directory) by owner.\n"
    +"      readgrp           Read by group.\n"
    +"      writegrp          Write by group.\n"
    +"      execgrp           Execute (search directory) by group.\n"
    +"      readoth           Read by others.\n"
    +"      writeoth          Write by others.\n"
    +"      execoth           Execute (search directory) by others.\n"
    +"  \n"
    +"  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n"
    +"  are equivalent for 'mode.  The octal-base is familar to Unix users.\n"
    +"\n"
    +"  It returns T on successfully completion; NIL and an error number\n"
    +"  otherwise."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "syscall was handled by Vice"
    +msgid ""
    +"Given an integer file descriptor and a mode (the same as those\n"
    +"   used for unix-chmod), unix-fchmod changes the permission mode\n"
    +"   for that file to the one specified. T is returned if the call\n"
    +"   was successful."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No message of desired type"
    +msgid "set the file pointer"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Identifier removed"
    +msgid "increment the file pointer"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Channel number out of range"
    +msgid "extend the file size"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Level 2 not synchronized"
    +msgid ""
    +"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n"
    +"   a certain offset for that file.  Whence can be any of the following:\n"
    +"\n"
    +"   l_set        Set the file pointer.\n"
    +"   l_incr       Increment the file pointer.\n"
    +"   l_xtnd       Extend the file size.\n"
    +"  _N"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Level 3 halted"
    +msgid ""
    +"Unix-mkdir creates a new directory with the specified name and mode.\n"
    +"   (Same as those for unix-chmod.)  It returns T upon success, otherwise\n"
    +"   NIL and an error number."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Level 3 reset"
    +msgid ""
    +"Unix-unlink removes the directory entry for the named file.\n"
    +"   NIL and an error code is returned if the call fails."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Link number out of range"
    +msgid "Read-only flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Protocol driver not attached"
    +msgid "Write-only flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No CSI structure available"
    +msgid "Read-write flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Level 2 halted"
    +msgid "Non-blocking I/O"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Deadlock situation detected/avoided"
    +msgid "Append flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No record locks available"
    +msgid "Create if nonexistant flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error 47"
    +msgid "Truncate flag."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error 48"
    +msgid "Error if already exists."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Bad exchange descriptor"
    +msgid "Don't assign controlling tty"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Bad request descriptor"
    +msgid "Non-blocking mode"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Message tables full"
    +msgid "Synchronous writes (on ext2)"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Anode table overflow"
    +msgid ""
    +"Unix-open opens the file whose pathname is specified by path\n"
    +"   for reading and/or writing as specified by the flags argument.\n"
    +"   The flags argument can be:\n"
    +"\n"
    +"     o_rdonly        Read-only flag.\n"
    +"     o_wronly        Write-only flag.\n"
    +"     o_rdwr          Read-and-write flag.\n"
    +"     o_append        Append flag.\n"
    +"     o_creat         Create-if-nonexistant flag.\n"
    +"     o_trunc         Truncate-to-size-0 flag.\n"
    +"\n"
    +"   If the o_creat flag is specified, then the file is created with\n"
    +"   a permission of argument mode if the file doesn't exist.  An\n"
    +"   integer file descriptor is returned by unix-open."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Bad request code"
    +msgid ""
    +"Unix-close takes an integer file descriptor as an argument and\n"
    +"   closes the file associated with it.  T is returned upon successful\n"
    +"   completion, otherwise NIL and an error number."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Invalid slot"
    +msgid ""
    +"Unix-creat accepts a file name and a mode (same as those for\n"
    +"   unix-chmod) and creates a file by that name with the specified\n"
    +"   permission mode.  It returns a file descriptor on success,\n"
    +"   or NIL and an error  number otherwise.\n"
    +"\n"
    +"   This interface is made obsolete by UNIX-OPEN."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "File locking deadlock"
    +msgid ""
    +"Unix-dup duplicates an existing file descriptor (given as the\n"
    +"   argument) and return it.  If FD is not a valid file descriptor, NIL\n"
    +"   and an error number are returned."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Bad font file format"
    +msgid "Duplicate a file descriptor"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Not a stream device"
    +msgid "Get file desc. flags"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No data available"
    +msgid "Set file desc. flags"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Timer expired"
    +msgid "Get file flags"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Out of stream resources"
    +msgid "Set file flags"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Machine is not on the network"
    +msgid "Get owner"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Package not installed"
    +msgid "Get lock"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Object is remote"
    +msgid "Set owner"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Link has been severed"
    +msgid "Set lock"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Advertise error"
    +msgid "Set lock, wait for release"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Srmount error"
    +msgid "Non-blocking reads"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Communication error on send"
    +msgid "Append on each write"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Protocol error"
    +msgid "Signal pgrp when data ready"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Multihop attempted"
    +msgid "Create if nonexistant"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Not a data message"
    +msgid "Truncate to zero length"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Value too large for defined data type"
    +msgid "Error if already created"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Name not unique on network"
    +msgid ""
    +"Unix-fcntl manipulates file descriptors according to the\n"
    +"   argument CMD which can be one of the following:\n"
    +"\n"
    +"   F-DUPFD         Duplicate a file descriptor.\n"
    +"   F-GETFD         Get file descriptor flags.\n"
    +"   F-SETFD         Set file descriptor flags.\n"
    +"   F-GETFL         Get file flags.\n"
    +"   F-SETFL         Set file flags.\n"
    +"   F-GETOWN        Get owner.\n"
    +"   F-SETOWN        Set owner.\n"
    +"\n"
    +"   The flags that can be specified for F-SETFL are:\n"
    +"\n"
    +"   FNDELAY         Non-blocking reads.\n"
    +"   FAPPEND         Append on each write.\n"
    +"   FASYNC          Signal pgrp when data ready.\n"
    +"   FCREAT          Create if nonexistant.\n"
    +"   FTRUNC          Truncate to zero length.\n"
    +"   FEXCL           Error if already created.\n"
    +"   "
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "File descriptor in bad state"
    +msgid ""
    +"Unix-pipe sets up a unix-piping mechanism consisting of\n"
    +"  an input pipe and an output pipe.  Unix-Pipe returns two\n"
    +"  values: if no error occurred the first value is the pipe\n"
    +"  to be read from and the second is can be written to.  If\n"
    +"  an error occurred the first value is NIL and the second\n"
    +"  the unix error code."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Remote address changed"
    +msgid ""
    +"Unix-read attempts to read from the file described by fd into\n"
    +"   the buffer buf until it is full.  Len is the length of the buffer.\n"
    +"   The number of bytes actually read is returned or NIL and an error\n"
    +"   number if an error occured."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Can not access a needed shared library"
    +msgid ""
    +"Unix-readlink invokes the readlink system call on the file name\n"
    +"  specified by the simple string path.  It returns up to two values:\n"
    +"  the contents of the symbolic link if the call is successful, or\n"
    +"  NIL and the Unix error number."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Accessing a corrupted shared library"
    +msgid ""
    +"Unix-rename renames the file with string name1 to the string\n"
    +"   name2.  NIL and an error code is returned if an error occured."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ".lib section in a.out corrupted"
    +msgid ""
    +"Unix-rmdir attempts to remove the directory name.  NIL and\n"
    +"   an error number is returned if an error occured."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Attempting to link in more shared libraries than system limit"
    +msgid ""
    +"Unix-write attempts to write a character buffer (buf) of length\n"
    +"   len to the file described by the file descriptor fd.  NIL and an\n"
    +"   error is returned if the call is unsuccessful."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Can not exec a shared library directly"
    +msgid ""
    +"Unix-ioctl performs a variety of operations on open i/o\n"
    +"   descriptors.  See the UNIX Programmer's Manual for more\n"
    +"   information."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error 88"
    +msgid "Get terminal attributes."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Operation not applicable"
    +msgid "Set terminal attributes."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Number of symbolic links encountered during path name traversal exceeds "
    -"MAXSYMLINKS"
    +msgid "Get terminal output speed."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error 91"
    +msgid ""
    +"Unix-getuid returns the real user-id associated with the\n"
    +"   current process."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error 92"
    +msgid "Unix-getpagesize returns the number of bytes in a system page."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Option not supported by protocol"
    +msgid "Unix-gethostname returns the name of the host machine as a string."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Operation not supported on transport endpoint"
    +msgid ""
    +"Unix-gethostid returns a 32-bit integer which provides unique\n"
    +"   identification for the host machine."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Cannot assign requested address"
    +msgid ""
    +"Unix-exit terminates the current process with an optional\n"
    +"   error code.  If successful, the call doesn't return.  If\n"
    +"   unsuccessful, the call returns NIL and an error number."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Network dropped connection because of reset"
    +msgid "Size of control character vector."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Transport endpoint is already connected"
    +msgid ""
    +"Unix-stat retrieves information about the specified\n"
    +"   file returning them in the form of multiple values.\n"
    +"   See the UNIX Programmer's Manual for a description\n"
    +"   of the values returned.  If the call fails, then NIL\n"
    +"   and an error number is returned instead."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Transport endpoint is not connected"
    +msgid ""
    +"Unix-lstat is similar to unix-stat except the specified\n"
    +"   file must be a symbolic link."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Cannot send after socket shutdown"
    +msgid ""
    +"Unix-fstat is similar to unix-stat except the file is specified\n"
    +"   by the file descriptor fd."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many references: cannot splice"
    +msgid "The calling process."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Stale NFS file handle"
    +msgid "Terminated child processes."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Resource deadlock would occur"
    +msgid ""
    +"Like call getrusage, but return only the system and user time, and returns\n"
    +"   the seconds and microseconds as separate values."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Function not implemented"
    +msgid ""
    +"Unix-getrusage returns information about the resource usage\n"
    +"   of the process specified by who.  Who can be either the\n"
    +"   current process (rusage_self) or all of the terminated\n"
    +"   child processes (rusage_children).  NIL and an error number\n"
    +"   is returned if the call fails."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Too many symbolic links encountered"
    +msgid "Returns either :file, :directory, :link, :special, or NIL."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Invalid exchange"
    +msgid "Returns the pathname with all symbolic links resolved."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Invalid request descriptor"
    +msgid "Error reading link ~S: ~S"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Exchange full"
    +msgid "Successful"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No anode"
    +msgid "Operation not permitted"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Invalid request code"
    +msgid "No such file or directory"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "File locking deadlock error"
    +msgid "No such process"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Device not a stream"
    +msgid "Interrupted system call"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Out of streams resources"
    +msgid "I/O error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "RFS specific error"
    +msgid "Device not configured"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Attempting to link in too many shared libraries"
    +msgid "Arg list too long"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Cannot exec a shared library directly"
    +msgid "Exec format error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Illegal byte sequence"
    +msgid "Bad file descriptor"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Interrupted system call should be restarted _N"
    +msgid "No child process"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Streams pipe error"
    +msgid "Resource deadlock avoided"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Address family not supported by protocol"
    +msgid "No more processes"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Cannot send after transport endpoint shutdown"
    +msgid "Try again"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Structure needs cleaning"
    +msgid "Out of memory"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Not a XENIX named type file"
    +msgid "Permission denied"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "No XENIX semaphores available"
    +msgid "Bad address"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Is a named type file"
    +msgid "Block device required"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Remote I/O error"
    +msgid "Device or resource busy"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Quota exceeded"
    +msgid "File exists"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Returns a string describing the error number which was returned by a\n"
    -"  UNIX system call."
    +msgid "Cross-device link"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unknown error [~d]"
    +msgid "No such device"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Class not yet defined: ~S"
    +msgid "Not a director"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Syscall ~A failed: ~A"
    +msgid "Is a directory"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Set the user ID of the calling process to UID.\n"
    -"   If the calling process is the super-user, set the real\n"
    -"   and effective user IDs, and the saved set-user-ID to UID;\n"
    -"   if not, the effective user ID is set to UID."
    +msgid "Invalid argument"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Set the group ID of the calling process to GID.\n"
    -"   If the calling process is the super-user, set the real\n"
    -"   and effective group IDs, and the saved set-group-ID to GID;\n"
    -"   if not, the effective group ID is set to GID."
    +msgid "File table overflow"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Test for read permission"
    +msgid "Too many open files"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Test for write permission"
    +msgid "Inappropriate ioctl for device"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Test for execute permission"
    +msgid "Text file busy"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Test for presence of file"
    +msgid "File too large"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Given a file path (a string) and one of four constant modes,\n"
    -"   unix-access returns T if the file is accessible with that\n"
    -"   mode and NIL if not.  It also returns an errno value with\n"
    -"   NIL which determines why the file was not accessible.\n"
    -"\n"
    -"   The access modes are:\n"
    -"	r_ok     Read permission.\n"
    -"	w_ok     Write permission.\n"
    -"	x_ok     Execute permission.\n"
    -"	f_ok     Presence of file."
    +msgid "No space left on device"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Given a file path string, unix-chdir changes the current working \n"
    -"   directory to the one specified."
    +msgid "Illegal seek"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set user ID on execution"
    +msgid "Read-only file system"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set group ID on execution"
    +msgid "Too many links"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Save text image after execution"
    +msgid "Broken pipe"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Read by owner"
    +msgid "Numerical argument out of domain"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Write by owner"
    +msgid "Result too large"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Execute (search directory) by owner"
    +msgid "Math result not representable"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Read by group"
    +msgid "Operation would block"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Write by group"
    +msgid "Resource temporarily unavailable"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Execute (search directory) by group"
    +msgid "Operation now in progress"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Read by others"
    +msgid "Operation already in progress"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Write by others"
    +msgid "Socket operation on non-socket"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Execute (search directory) by others"
    +msgid "Destination address required"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Given a file path string and a constant mode, unix-chmod changes the\n"
    -"   permission mode for that file to the one specified. The new mode\n"
    -"   can be created by logically OR'ing the following:\n"
    -"\n"
    -"      setuidexec        Set user ID on execution.\n"
    -"      setgidexec        Set group ID on execution.\n"
    -"      savetext          Save text image after execution.\n"
    -"      readown           Read by owner.\n"
    -"      writeown          Write by owner.\n"
    -"      execown           Execute (search directory) by owner.\n"
    -"      readgrp           Read by group.\n"
    -"      writegrp          Write by group.\n"
    -"      execgrp           Execute (search directory) by group.\n"
    -"      readoth           Read by others.\n"
    -"      writeoth          Write by others.\n"
    -"      execoth           Execute (search directory) by others.\n"
    -"  \n"
    -"  Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n"
    -"  are equivalent for 'mode.  The octal-base is familar to Unix users.\n"
    -"\n"
    -"  It returns T on successfully completion; NIL and an error number\n"
    -"  otherwise."
    +msgid "Message too long"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Given an integer file descriptor and a mode (the same as those\n"
    -"   used for unix-chmod), unix-fchmod changes the permission mode\n"
    -"   for that file to the one specified. T is returned if the call\n"
    -"   was successful."
    +msgid "Protocol wrong type for socket"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Given a file path, an integer user-id, and an integer group-id,\n"
    -"   unix-chown changes the owner of the file and the group of the\n"
    -"   file to those specified.  Either the owner or the group may be\n"
    -"   left unchanged by specifying them as -1.  Note: Permission will\n"
    -"   fail if the caller is not the superuser."
    +msgid "Protocol not available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-fchown is like unix-chown, except that it accepts an integer\n"
    -"   file descriptor instead of a file path name."
    +msgid "Protocol not supported"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-getdtablesize returns the maximum size of the file descriptor\n"
    -"   table. (i.e. the maximum number of descriptors that can exist at\n"
    -"   one time.)"
    +msgid "Socket type not supported"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-close takes an integer file descriptor as an argument and\n"
    -"   closes the file associated with it.  T is returned upon successful\n"
    -"   completion, otherwise NIL and an error number."
    +msgid "Operation not supported on socket"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-creat accepts a file name and a mode (same as those for\n"
    -"   unix-chmod) and creates a file by that name with the specified\n"
    -"   permission mode.  It returns a file descriptor on success,\n"
    -"   or NIL and an error  number otherwise.\n"
    -"\n"
    -"   This interface is made obsolete by UNIX-OPEN."
    +msgid "Protocol family not supported"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-dup duplicates an existing file descriptor (given as the\n"
    -"   argument) and return it.  If FD is not a valid file descriptor, NIL\n"
    -"   and an error number are returned."
    +msgid "Address family not supported by protocol family"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-dup2 duplicates an existing file descriptor just as unix-dup\n"
    -"   does only the new value of the duplicate descriptor may be requested\n"
    -"   through the second argument.  If a file already exists with the\n"
    -"   requested descriptor number, it will be closed and the number\n"
    -"   assigned to the duplicate."
    +msgid "Address already in use"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Duplicate a file descriptor"
    +msgid "Can't assign requested address"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get file desc. flags"
    +msgid "Network is down"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set file desc. flags"
    +msgid "Network is unreachable"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get file flags"
    +msgid "Network dropped connection on reset"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set file flags"
    +msgid "Software caused connection abort"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get owner"
    +msgid "Connection reset by peer"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get lock"
    +msgid "No buffer space available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set owner"
    +msgid "Socket is already connected"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set lock"
    +msgid "Socket is not connected"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set lock, wait for release"
    +msgid "Can't send after socket shutdown"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Non-blocking reads"
    +msgid "Too many references: can't splice"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Append on each write"
    +msgid "Connection timed out"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Signal pgrp when data ready"
    +msgid "Connection refused"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Create if nonexistant"
    +msgid "Too many levels of symbolic links"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Truncate to zero length"
    +msgid "File name too long"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error if already created"
    +msgid "Host is down"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-fcntl manipulates file descriptors according to the\n"
    -"   argument CMD which can be one of the following:\n"
    -"\n"
    -"   F-DUPFD         Duplicate a file descriptor.\n"
    -"   F-GETFD         Get file descriptor flags.\n"
    -"   F-SETFD         Set file descriptor flags.\n"
    -"   F-GETFL         Get file flags.\n"
    -"   F-SETFL         Set file flags.\n"
    -"   F-GETOWN        Get owner.\n"
    -"   F-SETOWN        Set owner.\n"
    -"\n"
    -"   The flags that can be specified for F-SETFL are:\n"
    -"\n"
    -"   FNDELAY         Non-blocking reads.\n"
    -"   FAPPEND         Append on each write.\n"
    -"   FASYNC          Signal pgrp when data ready.\n"
    -"   FCREAT          Create if nonexistant.\n"
    -"   FTRUNC          Truncate to zero length.\n"
    -"   FEXCL           Error if already created.\n"
    -"   "
    +msgid "No route to host"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-link creates a hard link from the file with name1 to the\n"
    -"   file with name2."
    +msgid "Directory not empty"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "set the file pointer"
    +msgid "Too many processes"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "increment the file pointer"
    +msgid "Too many users"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "extend the file size"
    +msgid "Disc quota exceeded"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n"
    -"   a certain offset for that file.  Whence can be any of the following:\n"
    -"\n"
    -"   l_set        Set the file pointer.\n"
    -"   l_incr       Increment the file pointer.\n"
    -"   l_xtnd       Extend the file size.\n"
    -"  _N"
    +msgid "namei should continue locally"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-mkdir creates a new directory with the specified name and mode.\n"
    -"   (Same as those for unix-chmod.)  It returns T upon success, otherwise\n"
    -"   NIL and an error number."
    +msgid "namei was handled remotely"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Read-only flag."
    +msgid "Remote file system error _N"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Write-only flag."
    +msgid "syscall was handled by Vice"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Read-write flag."
    +msgid "No message of desired type"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Non-blocking I/O"
    +msgid "Identifier removed"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Append flag."
    +msgid "Channel number out of range"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Create if nonexistant flag."
    +msgid "Level 2 not synchronized"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Truncate flag."
    +msgid "Level 3 halted"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error if already exists."
    +msgid "Level 3 reset"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Don't assign controlling tty"
    +msgid "Link number out of range"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Non-blocking mode"
    +msgid "Protocol driver not attached"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Synchronous writes (on ext2)"
    +msgid "No CSI structure available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-open opens the file whose pathname is specified by path\n"
    -"   for reading and/or writing as specified by the flags argument.\n"
    -"   The flags argument can be:\n"
    -"\n"
    -"     o_rdonly        Read-only flag.\n"
    -"     o_wronly        Write-only flag.\n"
    -"     o_rdwr          Read-and-write flag.\n"
    -"     o_append        Append flag.\n"
    -"     o_creat         Create-if-nonexistant flag.\n"
    -"     o_trunc         Truncate-to-size-0 flag.\n"
    -"\n"
    -"   If the o_creat flag is specified, then the file is created with\n"
    -"   a permission of argument mode if the file doesn't exist.  An\n"
    -"   integer file descriptor is returned by unix-open."
    +msgid "Level 2 halted"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-pipe sets up a unix-piping mechanism consisting of\n"
    -"  an input pipe and an output pipe.  Unix-Pipe returns two\n"
    -"  values: if no error occurred the first value is the pipe\n"
    -"  to be read from and the second is can be written to.  If\n"
    -"  an error occurred the first value is NIL and the second\n"
    -"  the unix error code."
    +msgid "Deadlock situation detected/avoided"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-read attempts to read from the file described by fd into\n"
    -"   the buffer buf until it is full.  Len is the length of the buffer.\n"
    -"   The number of bytes actually read is returned or NIL and an error\n"
    -"   number if an error occured."
    +msgid "No record locks available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-readlink invokes the readlink system call on the file name\n"
    -"  specified by the simple string path.  It returns up to two values:\n"
    -"  the contents of the symbolic link if the call is successful, or\n"
    -"  NIL and the Unix error number."
    +msgid "Error 47"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-rename renames the file with string name1 to the string\n"
    -"   name2.  NIL and an error code is returned if an error occured."
    +msgid "Error 48"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-rmdir attempts to remove the directory name.  NIL and\n"
    -"   an error number is returned if an error occured."
    +msgid "Bad exchange descriptor"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Perform the UNIX select(2) system call.\n"
    -"  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n"
    -"	   (type (or (alien (* (struct fd-set))) null)\n"
    -"		 read-fds write-fds exception-fds)\n"
    -"	   (type (or null (unsigned-byte 31)) timeout-secs)\n"
    -"	   (type (unsigned-byte 31) timeout-usecs)\n"
    -"	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))"
    +msgid "Bad request descriptor"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-select examines the sets of descriptors passed as arguments\n"
    -"   to see if they are ready for reading and writing.  See the UNIX\n"
    -"   Programmers Manual for more information."
    +msgid "Message tables full"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-sync writes all information in core memory which has been\n"
    -"   modified to disk.  It returns NIL and an error code if an error\n"
    -"   occured."
    +msgid "Anode table overflow"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-fsync writes the core image of the file described by\n"
    -"   fd to disk."
    +msgid "Bad request code"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-truncate truncates the named file to the length (in\n"
    -"   bytes) specified by len.  NIL and an error number is returned\n"
    -"   if the call is unsuccessful."
    +msgid "Invalid slot"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-ftruncate is similar to unix-truncate except that the first\n"
    -"   argument is a file descriptor rather than a file name."
    +msgid "File locking deadlock"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-symlink creates a symbolic link named name2 to the file\n"
    -"   named name1.  NIL and an error number is returned if the call\n"
    -"   is unsuccessful."
    +msgid "Bad font file format"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-unlink removes the directory entry for the named file.\n"
    -"   NIL and an error code is returned if the call fails."
    +msgid "Not a stream device"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-write attempts to write a character buffer (buf) of length\n"
    -"   len to the file described by the file descriptor fd.  NIL and an\n"
    -"   error is returned if the call is unsuccessful."
    +msgid "No data available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-ioctl performs a variety of operations on open i/o\n"
    -"   descriptors.  See the UNIX Programmer's Manual for more\n"
    -"   information."
    +msgid "Timer expired"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get terminal attributes."
    +msgid "Out of stream resources"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set terminal attributes."
    +msgid "Machine is not on the network"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get terminal output speed."
    +msgid "Package not installed"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set terminal output speed."
    +msgid "Object is remote"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Bogus baud rate ~S"
    +msgid "Link has been severed"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get terminal input speed."
    +msgid "Advertise error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set terminal input speed."
    +msgid "Srmount error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Send break"
    +msgid "Communication error on send"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Wait for output for finish"
    +msgid "Protocol error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "See tcflush(3)"
    +msgid "Multihop attempted"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Flow control"
    +msgid "Not a data message"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set the tty-process-group for the unix file-descriptor FD to PGRP."
    +msgid "Value too large for defined data type"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Get the tty-process-group for the unix file-descriptor FD."
    +msgid "Name not unique on network"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,"
    -"\n"
    -"  FD defaults to /dev/tty."
    +msgid "File descriptor in bad state"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not\n"
    -"  supplied, FD defaults to /dev/tty."
    +msgid "Remote address changed"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Set the socket process-group for the unix file-descriptor FD to PGRP."
    +msgid "Can not access a needed shared library"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-exit terminates the current process with an optional\n"
    -"   error code.  If successful, the call doesn't return.  If\n"
    -"   unsuccessful, the call returns NIL and an error number."
    +msgid "Accessing a corrupted shared library"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-stat retrieves information about the specified\n"
    -"   file returning them in the form of multiple values.\n"
    -"   See the UNIX Programmer's Manual for a description\n"
    -"   of the values returned.  If the call fails, then NIL\n"
    -"   and an error number is returned instead."
    +msgid ".lib section in a.out corrupted"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-lstat is similar to unix-stat except the specified\n"
    -"   file must be a symbolic link."
    +msgid "Attempting to link in more shared libraries than system limit"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-fstat is similar to unix-stat except the file is specified\n"
    -"   by the file descriptor fd."
    +msgid "Can not exec a shared library directly"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "The calling process."
    +msgid "Error 88"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Terminated child processes."
    +msgid "Operation not applicable"
     msgstr ""
     
     #: src/code/unix.lisp
     msgid ""
    -"Like call getrusage, but return only the system and user time, and returns\n"
    -"   the seconds and microseconds as separate values."
    +"Number of symbolic links encountered during path name traversal exceeds "
    +"MAXSYMLINKS"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-getrusage returns information about the resource usage\n"
    -"   of the process specified by who.  Who can be either the\n"
    -"   current process (rusage_self) or all of the terminated\n"
    -"   child processes (rusage_children).  NIL and an error number\n"
    -"   is returned if the call fails."
    +msgid "Error 91"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-times returns information about the cpu time usage of the process\n"
    -"   and its children."
    +msgid "Error 92"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n"
    -"   microseconds of the current time of day, the timezone (in minutes west\n"
    -"   of Greenwich), and a daylight-savings flag.  If it doesn't work, it\n"
    -"   returns NIL and the errno."
    +msgid "Option not supported by protocol"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-utimes sets the 'last-accessed' and 'last-updated'\n"
    -"   times on a specified file.  NIL and an error number is\n"
    -"   returned if the call is unsuccessful."
    +msgid "Operation not supported on transport endpoint"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-setreuid sets the real and effective user-id's of the current\n"
    -"   process to the specified ones.  NIL and an error number is returned\n"
    -"   if the call fails."
    +msgid "Cannot assign requested address"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-setregid sets the real and effective group-id's of the current\n"
    -"   process process to the specified ones.  NIL and an error number is\n"
    -"   returned if the call fails."
    +msgid "Network dropped connection because of reset"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-getpid returns the process-id of the current process."
    +msgid "Transport endpoint is already connected"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-getppid returns the process-id of the parent of the current process."
    +msgid "Transport endpoint is not connected"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-getgid returns the real group-id of the current process."
    +msgid "Cannot send after socket shutdown"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-getegid returns the effective group-id of the current process."
    +msgid "Too many references: cannot splice"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-getpgrp returns the group-id of the calling process."
    +msgid "Stale NFS file handle"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-setpgrp sets the process group on the process pid to\n"
    -"   pgrp.  NIL and an error number are returned upon failure."
    +msgid "Resource deadlock would occur"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-setpgid sets the process group of the process pid to\n"
    -"   pgrp. If pgid is equal to pid, the process becomes a process\n"
    -"   group leader. NIL and an error number are returned upon failure."
    +msgid "Function not implemented"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-getuid returns the real user-id associated with the\n"
    -"   current process."
    +msgid "Too many symbolic links encountered"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-getpagesize returns the number of bytes in a system page."
    +msgid "Invalid exchange"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Unix-gethostname returns the name of the host machine as a string."
    +msgid "Invalid request descriptor"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-gethostid returns a 32-bit integer which provides unique\n"
    -"   identification for the host machine."
    +msgid "Exchange full"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Executes the unix fork system call.  Returns 0 in the child and the pid\n"
    -"   of the child in the parent if it works, or NIL and an error number if it\n"
    -"   doesn't work."
    +msgid "No anode"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Get the value of the environment variable named Name.  If no such\n"
    -"  variable exists, Nil is returned."
    +msgid "Invalid request code"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Adds the environment variable named Name to the environment with\n"
    -"  the given Value if Name does not already exist. If Name does exist,\n"
    -"  the value is changed to Value if Overwrite is non-zero.  Otherwise,\n"
    -"  the value is not changed."
    +msgid "File locking deadlock error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Adds or changes the environment.  Name-value must be a string of\n"
    -"  the form \"name=value\".  If the name does not exist, it is added.\n"
    -"  If name does exist, the value is updated to the given value."
    +msgid "Device not a stream"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Removes the variable Name from the environment"
    +msgid "Out of streams resources"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Returns either :file, :directory, :link, :special, or NIL."
    +msgid "RFS specific error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Returns the pathname with all symbolic links resolved."
    +msgid "Attempting to link in too many shared libraries"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Error reading link ~S: ~S"
    +msgid "Cannot exec a shared library directly"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Accepts a Unix file descriptor and returns T if the device\n"
    -"  associated with it is a terminal."
    +msgid "Illegal byte sequence"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Executes the Unix execve system call.  If the system call suceeds, lisp\n"
    -"   will no longer be running in this process.  If the system call fails "
    -"this\n"
    -"   function returns two values: NIL and an error code.  Arg-list should be "
    -"a\n"
    -"   list of simple-strings which are passed as arguments to the exec'ed "
    -"program.\n"
    -"   Environment should be an a-list mapping symbols to simple-strings which "
    -"this\n"
    -"   function bashes together to form the environment for the exec'ed "
    -"program."
    +msgid "Interrupted system call should be restarted _N"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n"
    -"   three system timers (:real :virtual or :profile). On success,\n"
    -"   unix-getitimer returns 5 values,\n"
    -"   T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
    +msgid "Streams pipe error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n"
    -"   three system timers (:real :virtual or :profile). A SIGALRM signal\n"
    -"   will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n"
    -"   when non-zero, is <seconds+microseconds> to be loaded each time\n"
    -"   the timer expires. Setting INTERVAL and VALUE to zero disables\n"
    -"   the timer. See the Unix man page for more details. On success,\n"
    -"   unix-setitimer returns the old contents of the INTERVAL and VALUE\n"
    -"   slots as in unix-getitimer."
    +msgid "Address family not supported by protocol"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Return a USER-INFO structure for the user identified by LOGIN, or NIL if "
    -"not found."
    +msgid "Cannot send after transport endpoint shutdown"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Return a USER-INFO structure for the user identified by UID, or NIL if not "
    -"found."
    +msgid "Structure needs cleaning"
    +msgstr ""
    +
    +#: src/code/unix.lisp
    +msgid "Not a XENIX named type file"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "The maximum size of the group entry buffer"
    +msgid "No XENIX semaphores available"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Return a GROUP-INFO structure for the group identified by NAME, or NIL if "
    -"not found."
    +msgid "Is a named type file"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid ""
    -"Return a GROUP-INFO structure for the group identified by GID, or NIL if "
    -"not found."
    +msgid "Remote I/O error"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "CPU time per process (in milliseconds)"
    +msgid "Quota exceeded"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Maximum file size"
    +msgid ""
    +"Returns a string describing the error number which was returned by a\n"
    +"  UNIX system call."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Data segment size"
    +msgid "Unknown error [~d]"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Stack size"
    +msgid ""
    +"Perform the UNIX select(2) system call.\n"
    +"  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n"
    +"	   (type (or (alien (* (struct fd-set))) null)\n"
    +"		 read-fds write-fds exception-fds)\n"
    +"	   (type (or null (unsigned-byte 31)) timeout-secs)\n"
    +"	   (type (unsigned-byte 31) timeout-usecs)\n"
    +"	   (optimize (speed 3) (safety 0) (inhibit-warnings 3)))"
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Core file size"
    +msgid ""
    +"Unix-select examines the sets of descriptors passed as arguments\n"
    +"   to see if they are ready for reading and writing.  See the UNIX\n"
    +"   Programmers Manual for more information."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Number of open files"
    +msgid ""
    +"Unix-symlink creates a symbolic link named name2 to the file\n"
    +"   named name1.  NIL and an error number is returned if the call\n"
    +"   is unsuccessful."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Maximum mapped memory"
    +msgid ""
    +"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n"
    +"   microseconds of the current time of day, the timezone (in minutes west\n"
    +"   of Greenwich), and a daylight-savings flag.  If it doesn't work, it\n"
    +"   returns NIL and the errno."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "CPU time per process"
    +msgid ""
    +"Unix-utimes sets the 'last-accessed' and 'last-updated'\n"
    +"   times on a specified file.  NIL and an error number is\n"
    +"   returned if the call is unsuccessful."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "File size"
    +msgid "Unix-getpid returns the process-id of the current process."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Addess space (resident set size)"
    +msgid ""
    +"Accepts a Unix file descriptor and returns T if the device\n"
    +"  associated with it is a terminal."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Locked-in-memory address space"
    +msgid ""
    +" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n"
    +"   three system timers (:real :virtual or :profile). A SIGALRM signal\n"
    +"   will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n"
    +"   when non-zero, is <seconds+microseconds> to be loaded each time\n"
    +"   the timer expires. Setting INTERVAL and VALUE to zero disables\n"
    +"   the timer. See the Unix man page for more details. On success,\n"
    +"   unix-setitimer returns the old contents of the INTERVAL and VALUE\n"
    +"   slots as in unix-getitimer."
     msgstr ""
     
     #: src/code/unix.lisp
    -msgid "Number of processes"
    +msgid ""
    +"Return a USER-INFO structure for the user identified by UID, or NIL if not "
    +"found."
     msgstr ""
     
     #: src/code/unix.lisp
     msgid ""
    -"Get the limits on the consumption of system resouce specified by\n"
    -"  Resource.  If successful, return three values: T, the current (soft)\n"
    -"  limit, and the maximum (hard) limit."
    +"Unix-times returns information about the cpu time usage of the process\n"
    +"   and its children."
     msgstr ""