diff --git a/code/foreign.lisp b/code/foreign.lisp index 7d8d4b83aee8ac3f14a72616d6687d77a05de544..9466112be2d4aad73e5000df6f7585146a2ce857 100644 --- a/code/foreign.lisp +++ b/code/foreign.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.27 1997/11/15 11:03:27 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.28 1998/05/01 01:21:37 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -391,9 +391,17 @@ #+(or linux solaris irix) (progn -(defconstant rtld-lazy 1) -(defconstant rtld-now 2) -(defconstant rtld-global #-irix #o400 #+irix 4) +(defconstant rtld-lazy 1 + "Lazy function call binding") +(defconstant rtld-now 2 + "Immediate function call binding") +#+(and linux glibc2) +(defconstant rtld-binding-mask #x3 + "Mask of binding time value") + +(defconstant rtld-global #-irix #x100 #+irix 4 + "If set the symbols of the loaded object and its dependencies are + made visible as if the object were linked directly into the program") (defvar *global-table* nil) ;;; Dynamically loaded stuff isn't there upon restoring from a @@ -408,10 +416,10 @@ #+(or linux irix) "/usr/bin/ld") (alien:def-alien-routine dlopen system-area-pointer - (str c-call:c-string) (i c-call:int)) + (file c-call:c-string) (mode c-call:int)) (alien:def-alien-routine dlsym system-area-pointer (lib system-area-pointer) - (str c-call:c-string)) + (name c-call:c-string)) (alien:def-alien-routine dlclose void (lib system-area-pointer)) (alien:def-alien-routine dlerror c-call:c-string) diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp new file mode 100644 index 0000000000000000000000000000000000000000..b1bfbf8793f982235702e6a6ae390b13dd1a3a2c --- /dev/null +++ b/code/unix-glibc2.lisp @@ -0,0 +1,2314 @@ +;;; -*- 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: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.1 1998/05/01 01:21:37 dtc Exp $") +;;; +;;; ********************************************************************** +;;; +;;; This file contains the UNIX low-level support for glibc2. Based +;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998) +;;; + + +;;; fnmatch.h + +(in-package "UNIX") +(use-package "ALIEN") +(use-package "C-CALL") +(use-package "SYSTEM") +(use-package "EXT") + +(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 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 + 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 + 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-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-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)) + +(pushnew :unix *features*) + + +;;;; Common machine independent structures. + +(def-alien-type quad-t (array long 2)) +(def-alien-type uquad-t (array unsigned-long 2)) +(def-alien-type qaddr-t (* quad-t)) + +;;; From sys/types.h +;;; Linux: gnu/types.h +(def-alien-type daddr-t int) +(def-alien-type caddr-t (* char)) +(def-alien-type ino-t unsigned-long) +(def-alien-type swblk-t long) +(def-alien-type size-t unsigned-int) +(def-alien-type time-t long) +(def-alien-type clock-t long) + +(def-alien-type dev-t quad-t) + +(def-alien-type off-t long) +(def-alien-type loff-t quad-t) + +(def-alien-type uid-t unsigned-int) + +(def-alien-type gid-t unsigned-int) + +(def-alien-type pid-t int) +(def-alien-type ssize-t int) +(def-alien-type fd-mask unsigned-long) +(def-alien-type key-t int) + +(def-alien-type mode-t unsigned-int) ;XXX HIER + +(def-alien-type nlink-t unsigned-int) + +(defconstant FD-SETSIZE 1024) + +;; not checked for linux... +(def-alien-type nil + (struct fd-set + (fds-bits (array fd-mask #.(/ 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)) + (bit (gensym))) + `(multiple-value-bind (,word ,bit) (floor ,offset 32) + (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 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)))) + +;;; From sys/time.h + +(def-alien-type nil + (struct timeval + (tv-sec time-t) ; seconds + (tv-usec time-t))) ; and microseconds + +(def-alien-type nil + (struct timezone + (tz-minuteswest int) ; minutes west of Greenwich + (tz-dsttime ; type of dst correction + int))) + +(def-alien-type nil + (struct itimerval + (it-interval (struct timeval)) ; timer interval + (it-value (struct timeval)))) ; current value + +; High-res time. Actually posix definition under svr4 name. +(def-alien-type nil + (struct timestruc-t + (tv-sec time-t) + (tv-nsec long))) + +(def-alien-type nil + (struct timespec-t + (ts-sec long) + (ts-nsec long))) + +;;; From ioctl.h +(def-alien-type nil + (struct tchars + (t-intrc char) ; interrupt + (t-quitc char) ; quit + (t-eofc char) ; end-of-file + (t-startc char) ; start output + (t-stopc char) ; stop output + (t-brkc char))) ; input delimiter (like nl) + +;; not found (semi) linux +(def-alien-type nil + (struct ltchars + (t-werasc char) ; word erase + (t-suspc char) ; stop process signal + (t-dsuspc char) ; delayed stop process signal + (t-rprntc char) ; reprint line + (t-flushc char) ; flush output (toggles) + (t-lnextc char))) ; literal next character + + +(def-alien-type nil + (struct sgttyb + (sg-flags int) ; mode flags + (sg-ispeed char) ; input speed. + (sg-ospeed char) ; output speed + (sg-erase char) ; erase character + (sg-kill char) + (t (struct termios)) + (check int))) + +;;; ioctl-types.h +(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 + +(defconstant +NCC+ 8 + "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 #x40) +(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) + +;;; 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+ 19 + "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) + (c-reserved unsigned-char) + (c-cc (array unsigned-char #.+NCCS+)))) + +;;; From sys/dir.h +(def-alien-type nil + (struct direct + (d-ino ino-t); inode number of entry + (d-off long) ; 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 + +;;; From sys/stat.h +;; oh boy, in linux-> 2 stat(s)!! + +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-pad1 unsigned-short) + (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-pad2 unsigned-short) + (st-size off-t) + (st-blksize unsigned-long) + (st-blocks unsigned-long) + (st-atime time-t) + (unused-1 unsigned-long) + (st-mtime time-t) + (unused-2 unsigned-long) + (st-ctime time-t) + (unused-3 unsigned-long) + (unused-4 unsigned-long) + (unused-5 unsigned-long))) + +(defconstant s-ifmt #o0170000) +(defconstant s-ifdir #o0040000) +(defconstant s-ifchr #o0020000) +(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) + +;;; 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 " + +(def-alien-type nil + (struct rlimit + (rlim-cur long) ; current (soft) limit + (rlim-max long))); maximum value for rlim-cur + + + +;;;; 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) + (proclaim '(simple-vector *unix-errors*))))) + +) ;eval-when + +;;; +;;; From <errno.h> +;;; +(def-unix-error ESUCCESS 0 "Successful") +(def-unix-error EPERM 1 "Operation not permitted") +(def-unix-error ENOENT 2 "No such file or directory") +(def-unix-error ESRCH 3 "No such process") +(def-unix-error EINTR 4 "Interrupted system call") +(def-unix-error EIO 5 "I/O error") +(def-unix-error ENXIO 6 "No such device or address") +(def-unix-error E2BIG 7 "Arg list too long") +(def-unix-error ENOEXEC 8 "Exec format error") +(def-unix-error EBADF 9 "Bad file number") +(def-unix-error ECHILD 10 "No children") +(def-unix-error EAGAIN 11 "Try again") +(def-unix-error ENOMEM 12 "Out of memory") +(def-unix-error EACCES 13 "Permission denied") +(def-unix-error EFAULT 14 "Bad address") +(def-unix-error ENOTBLK 15 "Block device required") +(def-unix-error EBUSY 16 "Device or resource busy") +(def-unix-error EEXIST 17 "File exists") +(def-unix-error EXDEV 18 "Cross-device link") +(def-unix-error ENODEV 19 "No such device") +(def-unix-error ENOTDIR 20 "Not a director") +(def-unix-error EISDIR 21 "Is a directory") +(def-unix-error EINVAL 22 "Invalid argument") +(def-unix-error ENFILE 23 "File table overflow") +(def-unix-error EMFILE 24 "Too many open files") +(def-unix-error ENOTTY 25 "Not a typewriter") +(def-unix-error ETXTBSY 26 "Text file busy") +(def-unix-error EFBIG 27 "File too large") +(def-unix-error ENOSPC 28 "No space left on device") +(def-unix-error ESPIPE 29 "Illegal seek") +(def-unix-error EROFS 30 "Read-only file system") +(def-unix-error EMLINK 31 "Too many links") +(def-unix-error EPIPE 32 "Broken pipe") +;;; +;;; Math +(def-unix-error EDOM 33 "Math argument out of domain") +(def-unix-error ERANGE 34 "Math result not representable") +;;; +(def-unix-error EDEADLK 35 "Resource deadlock would occur") +(def-unix-error ENAMETOOLONG 36 "File name too long") +(def-unix-error ENOLCK 37 "No record locks available") +(def-unix-error ENOSYS 38 "Function not implemented") +(def-unix-error ENOTEMPTY 39 "Directory not empty") +(def-unix-error ELOOP 40 "Too many symbolic links encountered") +(def-unix-error EWOULDBLOCK 11 "Operation would block") +(def-unix-error ENOMSG 42 "No message of desired type") +(def-unix-error EIDRM 43 "Identifier removed") +(def-unix-error ECHRNG 44 "Channel number out of range") +(def-unix-error EL2NSYNC 45 "Level 2 not synchronized") +(def-unix-error EL3HLT 46 "Level 3 halted") +(def-unix-error EL3RST 47 "Level 3 reset") +(def-unix-error ELNRNG 48 "Link number out of range") +(def-unix-error EUNATCH 49 "Protocol driver not attached") +(def-unix-error ENOCSI 50 "No CSI structure available") +(def-unix-error EL2HLT 51 "Level 2 halted") +(def-unix-error EBADE 52 "Invalid exchange") +(def-unix-error EBADR 53 "Invalid request descriptor") +(def-unix-error EXFULL 54 "Exchange full") +(def-unix-error ENOANO 55 "No anode") +(def-unix-error EBADRQC 56 "Invalid request code") +(def-unix-error EBADSLT 57 "Invalid slot") +(def-unix-error EDEADLOCK EDEADLK "File locking deadlock error") +(def-unix-error EBFONT 59 "Bad font file format") +(def-unix-error ENOSTR 60 "Device not a stream") +(def-unix-error ENODATA 61 "No data available") +(def-unix-error ETIME 62 "Timer expired") +(def-unix-error ENOSR 63 "Out of streams resources") +(def-unix-error ENONET 64 "Machine is not on the network") +(def-unix-error ENOPKG 65 "Package not installed") +(def-unix-error EREMOTE 66 "Object is remote") +(def-unix-error ENOLINK 67 "Link has been severed") +(def-unix-error EADV 68 "Advertise error") +(def-unix-error ESRMNT 69 "Srmount error") +(def-unix-error ECOMM 70 "Communication error on send") +(def-unix-error EPROTO 71 "Protocol error") +(def-unix-error EMULTIHOP 72 "Multihop attempted") +(def-unix-error EDOTDOT 73 "RFS specific error") +(def-unix-error EBADMSG 74 "Not a data message") +(def-unix-error EOVERFLOW 75 "Value too large for defined data type") +(def-unix-error ENOTUNIQ 76 "Name not unique on network") +(def-unix-error EBADFD 77 "File descriptor in bad state") +(def-unix-error EREMCHG 78 "Remote address changed") +(def-unix-error ELIBACC 79 "Can not access a needed shared library") +(def-unix-error ELIBBAD 80 "Accessing a corrupted shared library") +(def-unix-error ELIBSCN 81 ".lib section in a.out corrupted") +(def-unix-error ELIBMAX 82 "Attempting to link in too many shared libraries") +(def-unix-error ELIBEXEC 83 "Cannot exec a shared library directly") +(def-unix-error EILSEQ 84 "Illegal byte sequence") +(def-unix-error ERESTART 85 "Interrupted system call should be restarted ") +(def-unix-error ESTRPIPE 86 "Streams pipe error") +(def-unix-error EUSERS 87 "Too many users") +(def-unix-error ENOTSOCK 88 "Socket operation on non-socket") +(def-unix-error EDESTADDRREQ 89 "Destination address required") +(def-unix-error EMSGSIZE 90 "Message too long") +(def-unix-error EPROTOTYPE 91 "Protocol wrong type for socket") +(def-unix-error ENOPROTOOPT 92 "Protocol not available") +(def-unix-error EPROTONOSUPPORT 93 "Protocol not supported") +(def-unix-error ESOCKTNOSUPPORT 94 "Socket type not supported") +(def-unix-error EOPNOTSUPP 95 "Operation not supported on transport endpoint") +(def-unix-error EPFNOSUPPORT 96 "Protocol family not supported") +(def-unix-error EAFNOSUPPORT 97 "Address family not supported by protocol") +(def-unix-error EADDRINUSE 98 "Address already in use") +(def-unix-error EADDRNOTAVAIL 99 "Cannot assign requested address") +(def-unix-error ENETDOWN 100 "Network is down") +(def-unix-error ENETUNREACH 101 "Network is unreachable") +(def-unix-error ENETRESET 102 "Network dropped connection because of reset") +(def-unix-error ECONNABORTED 103 "Software caused connection abort") +(def-unix-error ECONNRESET 104 "Connection reset by peer") +(def-unix-error ENOBUFS 105 "No buffer space available") +(def-unix-error EISCONN 106 "Transport endpoint is already connected") +(def-unix-error ENOTCONN 107 "Transport endpoint is not connected") +(def-unix-error ESHUTDOWN 108 "Cannot send after transport endpoint shutdown") +(def-unix-error ETOOMANYREFS 109 "Too many references: cannot splice") +(def-unix-error ETIMEDOUT 110 "Connection timed out") +(def-unix-error ECONNREFUSED 111 "Connection refused") +(def-unix-error EHOSTDOWN 112 "Host is down") +(def-unix-error EHOSTUNREACH 113 "No route to host") +(def-unix-error EALREADY 114 "Operation already in progress") +(def-unix-error EINPROGRESS 115 "Operation now in progress") +(def-unix-error ESTALE 116 "Stale NFS file handle") +(def-unix-error EUCLEAN 117 "Structure needs cleaning") +(def-unix-error ENOTNAM 118 "Not a XENIX named type file") +(def-unix-error ENAVAIL 119 "No XENIX semaphores available") +(def-unix-error EISNAM 120 "Is a named type file") +(def-unix-error EREMOTEIO 121 "Remote I/O error") +(def-unix-error EDQUOT 122 "Quota exceeded") + +;;; +;;; And now for something completely different ... +(emit-unix-errors) + + + +;;;; 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)) + + +;;;; System calls. +(def-alien-variable ("errno" unix-errno) int) + +;;; later... +(defun unix-get-errno ()) + +;;; GET-UNIX-ERROR-MSG -- public. +;;; +(defun get-unix-error-msg (&optional (error-number unix-errno)) + "Returns a string describing the error number which was returned by a + UNIX system call." + (declare (type integer error-number)) + + (unix-get-errno) + (if (array-in-bounds-p *unix-errors* error-number) + (svref *unix-errors* error-number) + (format nil "Unknown error [~d]" error-number))) + +(defmacro syscall ((name &rest arg-types) success-form &rest args) + `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (minusp result) + (progn + (unix-get-errno) + (values nil unix-errno)) + ,success-form))) + +;;; 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 (minusp 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)) + +(defun unix-get-errno () + "Get the unix errno value in errno..." + (void-syscall ("update_errno"))) + +;;; fcntl.h +;;; 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 "Test for read permission") +(defconstant w_ok 2 "Test for write permission") +(defconstant x_ok 1 "Test for execute permission") +(defconstant f_ok 0 "Test for presence of file") + +(defun unix-access (path mode) + "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) path mode)) + +;;; Unix-chdir accepts a directory name and makes that the +;;; current working directory. + +(defun unix-chdir (path) + "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) path)) + +;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. + +(defconstant setuidexec #o4000 "Set user ID on execution") +(defconstant setgidexec #o2000 "Set group ID on execution") +(defconstant savetext #o1000 "Save text image after execution") +(defconstant readown #o400 "Read by owner") +(defconstant writeown #o200 "Write by owner") +(defconstant execown #o100 "Execute (search directory) by owner") +(defconstant readgrp #o40 "Read by group") +(defconstant writegrp #o20 "Write by group") +(defconstant execgrp #o10 "Execute (search directory) by group") +(defconstant readoth #o4 "Read by others") +(defconstant writeoth #o2 "Write by others") +(defconstant execoth #o1 "Execute (search directory) by others") + +(defun unix-chmod (path mode) + "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. + + 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) 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) + "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) + "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) 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) + "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 () + "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) + "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) + "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 ("creat" c-string int) name mode)) + +;;; Unix-dup returns a duplicate copy of the existing file-descriptor +;;; passed as an argument. + +(defun unix-dup (fd) + "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) + "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-fcntl takes a file descriptor, an integer command +;;; number, and optional command arguments. It performs +;;; operations on the associated file and/or returns inform- +;;; ation about the file. + +;;; fcntlbits.h +;;; Operations performed on file descriptors: + +(defconstant F-DUPFD 0 "Duplicate a file descriptor") +(defconstant F-GETFD 1 "Get file desc. flags") +(defconstant F-SETFD 2 "Set file desc. flags") +(defconstant F-GETFL 3 "Get file flags") +(defconstant F-SETFL 4 "Set file flags") +(defconstant F-GETLK 5 "Get lock") +(defconstant F-SETLK 6 "Set lock") +(defconstant F-SETLKW 7 "Set lock, wait for release") +(defconstant F-SETOWN 8 "Set owner (for sockets)") +(defconstant F-GETOWN 9 "Get owner (for sockets)") + +;;; File flags for F-GETFL and F-SETFL: +(defconstant F-CLOEXEC 1 "XXX no idea") + +(defconstant F-RDLCK 0 "XXX no idea") +(defconstant F-WDLCK 1 "XXX no idea") +(defconstant F-UNLCK 2 "XXX no idea") + +#+nil ;; old stuff ? +(defconstant F-EXLCK 4 "XXX no idea") +#+nil ;; old stuff ? +(defconstant F-SHLCK 8 "XXX no idea") + +(defconstant F-LOCK-SH 1 "Shared lock for bsd flock") +(defconstant F-LOCK-EX 2 "Exclusive lock for bsd flock") +(defconstant F-LOCK-NB 4 "Don't block. Combine with F-LOCK-SH or F-LOCK-EX") +(defconstant F-LOCK-UN 8 "Remove lock for bsd flock") + +(def-alien-type nil + (struct flock + (tv-sec time-t) + (l-type short) + (l-whence short) + (l-start off-t) + (l-len off-t) + (l-pid pid-t))) + +#| old stuff shouldn't be used anymore +(defconstant FNDELAY o_ndelay "compatibily stuff") +(defconstant FAPPEND o_append "compatibily stuff") +(defconstant FASYNC o_async "compatibily stuff") +|# + +;;; fcntl.h +(defun unix-fcntl (fd cmd arg) + "Unix-fcntl manipulates file descriptors accoridng to the + argument CMD which can be one of the following: + + 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. + + The flags that can be specified for F-SETFL are: + + 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 16) cmd) + (type (unsigned-byte 16) arg)) + (int-syscall ("fcntl" int int int) fd cmd arg)) + +;;; Unix-link creates a hard link from name2 to name1. + +(defun unix-link (name1 name2) + "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) name1 name2)) + +;;; Unix-lseek accepts a file descriptor, an offset, and whence value. + +(defconstant l_set 0 "set the file pointer") +(defconstant l_incr 1 "increment the file pointer") +(defconstant l_xtnd 2 "extend the file size") + +(defun unix-lseek (fd offset whence) + "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 (unsigned-byte 32) offset) + (type (integer 0 2) whence)) + (int-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) + "Unix-mkdir creates a new directory with the specified name and mode. + (Same as those for unix-fchmod.) 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 mode)) + +;;; fcntlbits.h +;;; Unix-open accepts a pathname (a simple string), flags, and mode and +;;; attempts to open file with name pathname. + +(defconstant o_rdonly 0 "Read-only flag.") +(defconstant o_wronly 1 "Write-only flag.") +(defconstant o_rdwr 2 "Read-write flag.") +(defconstant o_accmode 3 "Access mode mask.") +(defconstant o_creat #o100 "Create if nonexistant flag.") +(defconstant o_excl #o200 "Error if already exists.") +(defconstant o_noctty #o400 "Don't assign controlling tty") +(defconstant o_trunc #o1000 "Truncate flag.") +(defconstant o_append #o2000 "Append flag.") +(defconstant o_ndelay #o4000 "Non-blocking I/O") +(defconstant o_nonblock #o4000 "Non-blocking I/O") +(defconstant o_sync #o10000 "Synchronous writes (on ext2)") +(defconstant o_fsync #o10000 "Synchronous writes (on ext2)") +(defconstant o_async #o20000 "Asynchronous I/O") + +(defun unix-open (path flags mode) + "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. + o_excl Error if the file allready 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. An + integer file descriptor is returned by unix-open." + (declare (type unix-pathname path) + (type fixnum flags) + (type unix-file-mode mode)) + (int-syscall ("open" c-string int int) path flags mode)) + +(defun unix-pipe () + "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-read (fd buf len) + "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)) + + (int-syscall ("read" int (* char) int) fd buf len)) + +(defun unix-readlink (path) + "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))) + (kernel:copy-from-system-area + (alien-sap buf) 0 + string (* vm:vector-data-offset vm:word-bits) + (* result vm:byte-bits)) + string) + path (cast buf (* char)) 1024))) + +;;; Unix-rename accepts two files names and renames the first to the second. + +(defun unix-rename (name1 name2) + "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) name1 name2)) + +;;; Unix-rmdir accepts a name and removes the associated directory. + +(defun unix-rmdir (name) + "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)) + + +;;; UNIX-FAST-SELECT -- public. +;;; +(defmacro unix-fast-select (num-descriptors + read-fds write-fds exception-fds + timeout-secs &optional (timeout-usecs 0)) + "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 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)) + "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)))))) + + +;;; Unix-sync writes all information in core memory which has been modified +;;; to permanent storage (i.e. disk). + +(defun unix-sync () + "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) + "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) + "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 32) len)) + (void-syscall ("truncate" c-string int) name len)) + +(defun unix-ftruncate (fd len) + "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 32) len)) + (void-syscall ("ftruncate" int int) fd len)) + +(defun unix-symlink (name1 name2) + "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) name1 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) + "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)) + +;;; 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) + "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)) + +;;; Unix-ioctl is used to change parameters of devices in a device +;;; dependent way. + + +(defconstant terminal-speeds + '#(0 50 75 110 134 150 200 300 600 1200 1800 2400 + 4800 9600 19200 38400 57600 115200 230400)) + +;;; from /usr/include/bsd/sgtty.h (linux) + +(defconstant tty-raw 1) +(defconstant tty-crmod 4) +(defconstant tty-lcase 2) +(defconstant tty-cbreak 64) +(defconstant tty-echo 8) +(defconstant tty-oddp 16) +(defconstant tty-evenp 32) + +(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)))) + +;; input modes /usr/include/asm/termbits.h +(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) + +;; output modes +(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr + tty-onlret tty-ofill tty-ofdel) + +;; local modes +(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 + nil tty-pendin tty-iexten) + +;; control modes +(def-enum ash #o100 tty-cstopb + tty-cread tty-parenb tty-parodd tty-hupcl tty-clocal) + +;; special control characters +(def-enum + 0 vintr vquit verase vkill veof) +(defconstant veol 11) +(defconstant veol2 16) + +(defconstant tciflush 0) +(defconstant tcoflush 1) +(defconstant tcioflush 2) + +(defconstant tcsanow 0) +(defconstant tcsadrain 1) +(defconstant tcsaflush 2) + +(defconstant vstart 8) +(defconstant vstop 9) +(defconstant vsusp 10) +(defconstant vmin 6) +(defconstant vtime 5) + +(eval-when (compile load eval) + +(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) + (declare (ignore arg parm-type)) + `(eval-when (eval load compile) + (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd))))) + +;;; TTY ioctl commands. + +(define-ioctl-command TIOCGETP #\t #x81 (struct sgttyb) :out) +(define-ioctl-command TIOCSETP #\t #x82 (struct sgttyb) :in) +(define-ioctl-command TIOCFLUSH #\t #x89 int :in) +(define-ioctl-command TIOCSETC #\t #x84 (struct tchars) :in) +(define-ioctl-command TIOCGETC #\t #x83 (struct tchars) :out) +(define-ioctl-command TIOCGWINSZ #\t 104 (struct winsize) + :out) +(define-ioctl-command TIOCSWINSZ #\t 103 (struct winsize) + :in) + +(define-ioctl-command TIOCNOTTY #\t #x22 nil :void) + +(define-ioctl-command TIOCSLTC #\t #x84 (struct ltchars) :in) +(define-ioctl-command TIOCGLTC #\t #x85 (struct ltchars) :out) +(define-ioctl-command TIOCSPGRP #\t 118 int :in) +(define-ioctl-command TIOCGPGRP #\t 119 int :out) + +;;; File ioctl commands. +(define-ioctl-command FIONREAD #\f #x1B int :out) + + +(defun unix-ioctl (fd cmd arg) + "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)) + (void-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) + +(defun unix-tcgetattr (fd termios) + "Get terminal attributes." + (declare (type unix-fd fd)) + (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) + +(defun unix-tcsetattr (fd opt termios) + "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. +(defun unix-cfgetospeed (termios) + "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)))) + +(defun unix-cfsetospeed (termios speed) + "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) + "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) + "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) + "Send break" + (declare (type unix-fd fd)) + (void-syscall ("tcsendbreak" int int) fd duration)) + +(defun unix-tcdrain (fd) + "Wait for output for finish" + (declare (type unix-fd fd)) + (void-syscall ("tcdrain" int) fd)) + +(defun unix-tcflush (fd selector) + "See tcflush(3)" + (declare (type unix-fd fd)) + (void-syscall ("tcflush" int int) fd selector)) + +(defun unix-tcflow (fd action) + "Flow control" + (declare (type unix-fd fd)) + (void-syscall ("tcflow" int int) fd action)) + +(defun tcsetpgrp (fd pgrp) + "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) + "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) + "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) + "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) + "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. + +(define-ioctl-command SIOCSPGRP #\s #x8904 int :in) + +(defun siocspgrp (fd pgrp) + "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-exit terminates a program. + +(defun unix-exit (&optional (code 0)) + "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)) + +;;; STAT and friends. + +(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) + (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) + "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 ("stat" c-string (* (struct stat))) + (extract-stat-results buf) + name (addr buf)))) + + +(defun unix-lstat (name) + "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 ("lstat" c-string (* (struct stat))) + (extract-stat-results buf) + name (addr buf)))) + +(defun unix-fstat (fd) + "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 ("fstat" int (* (struct stat))) + (extract-stat-results buf) + fd (addr buf)))) + + +(defconstant rusage_self 0 "The calling process.") +(defconstant rusage_children -1 "Terminated child processes.") + +(declaim (inline unix-fast-getrusage)) +(defun unix-fast-getrusage (who) + "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)))) + +(defun unix-getrusage (who) + "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)))) + +;; Requires call to tzset() in main. +;; Don't use this now: we + +(def-alien-variable ("daylight" unix-daylight) int) +(def-alien-variable ("timezone" unix-timezone) time-t) +(def-alien-variable ("altzone" unix-altzone) time-t) +(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))))) + +(declaim (inline unix-gettimeofday)) +(defun unix-gettimeofday () + "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-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-utimes (file atime-sec atime-usec mtime-sec mtime-usec) + "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)))))) + +;;; 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) + "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. + +(defun unix-setregid (rgid egid) + "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 + "Unix-getpid returns the process-id of the current process.") + +(def-alien-routine ("getppid" unix-getppid) int + "Unix-getppid returns the process-id of the parent of the current process.") + +(def-alien-routine ("getgid" unix-getgid) int + "Unix-getgid returns the real group-id of the current process.") + +(def-alien-routine ("getegid" unix-getegid) int + "Unix-getegid returns the effective group-id of the current process.") + +;;; Unix-getpgrp returns the group-id associated with the +;;; process whose process-id is specified as an argument. +;;; As usual, if the process-id is 0, it refers to the current +;;; process. + +(defun unix-getpgrp (pid) + "Unix-getpgrp returns the group-id of the process associated + with pid." + (int-syscall ("getpgrp" int) pid)) + +;;; Unix-setpgrp 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. + +(defun unix-setpgrp (pid pgrp) + "Unix-setpgrp sets the process group on the process pid to + pgrp. NIL and an error number is returned upon failure." + (void-syscall ( "setpgrp" int int) pid pgrp)) + +(def-alien-routine ("getuid" unix-getuid) int + "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 () + "Unix-getpagesize returns the number of bytes in a system page." + (int-syscall ("getpagesize"))) + +(defun unix-gethostname () + "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 + "Unix-gethostid returns a 32-bit integer which provides unique + identification for the host machine.") + +(defun unix-fork () + "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"))) + + + +;;; Operations on Unix Directories. + +(export '(open-dir read-dir close-dir)) + +(defstruct (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)) + pathname))) + (if (zerop (sap-int dir-struct)) + (progn (unix-get-errno) + (values nil unix-errno)) + (make-directory :name pathname :dir-struct dir-struct)))) + ((nil) + (values nil enoent)) + (t + (values nil enotdir))))) + +(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)) + + (values (cast (slot direct 'd-name) c-string) + (slot direct 'd-ino)))))) + +(defun close-dir (dir) + (declare (type directory dir)) + (alien-funcall (extern-alien "closedir" + (function void system-area-pointer)) + (directory-dir-struct dir)) + nil) + + +(defun unix-current-directory () + (with-alien ((buf (array char 1024))) + (values (not (zerop (alien-funcall (extern-alien "getwd" + (function int (* char))) + (cast buf (* char))))) + (cast buf c-string)))) + + + +;;;; 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) + "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) + "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 1024 :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)))) + (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 "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) + (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))))) + + +;;;; Other random routines. + +(def-alien-routine ("isatty" unix-isatty) boolean + "Accepts a Unix file descriptor and returns T if the device + associated with it is a terminal." + (fd int)) + +(def-alien-routine ("ttyname" unix-ttyname) c-string + (fd int)) + + + + +;;;; UNIX-EXECVE + +(defun unix-execve (program &optional arg-list + (environment *environment-list*)) + "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 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 + (kernel:copy-to-system-area (the simple-string s) + (* vm:vector-data-offset vm:word-bits) + string-sap 0 + (* (1+ n) vm:byte-bits)) + ;; + ;; 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" + (* char) system-area-pointer system-area-pointer) + (vector-sap 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))) + + + +;;;; Socket support. + + + ;;; +(def-alien-routine ("socket" unix-socket) int + (domain int) + (type int) + (protocol int)) + +(def-alien-routine ("connect" unix-connect) int + (socket int) + (sockaddr (* t)) + (len int)) + +(def-alien-routine ("bind" unix-bind) int + (socket int) + (sockaddr (* t)) + (len int)) + +(def-alien-routine ("listen" unix-listen) int + (socket int) + (backlog int)) + +(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))) + + +;;; +;;; Support for the Interval Timer (experimental) +;;; + + +(defconstant ITIMER-REAL 0) +(defconstant ITIMER-VIRTUAL 1) +(defconstant ITIMER-PROF 2) + +(defun unix-getitimer(which) + "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) + " 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)))))) + +#| +;;; fcntl.h +(defconstant f_ulock 0 "Unlock a locked region") +(defconstant f_lock 1 "Lock a region for exclusive use") +(defconstant f_tlock 2 "Test and lock a region for exclusive use") +(defconstant f_test 3 "Test a region for othwer processes locks") + +#+nil +(defun unix-lockf (fd cmd length) + "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 32) length) + (type (integer 0 3) cmd)) + (int-syscall ("lockf" int int off-t) fd cmd length)) + +;;; grp.h + +(def-alien-type nil + (struct group + (gr-name c-string) ;; group name + (gr-passwd c-string) ;; password + (gr-gid gid-t) ;; group ID + (gr-mem (* c-string)))) + + +#+nil +(defun unix-setgrend () + "Rewind the group-file stream." + (void-syscall ("setgrend"))) + +(defun unix-getgrent () + "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))) + +#+nil +(defun unix-getgrgid (id) + "Search for an entry with a matching group ID." + (declare (type gid-t id)) + + (let ((result (alien-funcall (extern-alien "getgrgid" + (function (* (struct group)) + gid-t)) + id))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +#+nil +(defun unix-getgrnam (name) + "Search for an entry with a matching group ID." + (declare (type simple-string name)) + + (let ((result (alien-funcall (extern-alien "getgrnam" + (function (* (struct group)) + c-string)) + name))) + (declare (type system-area-pointer result)) + (if (zerop (sap-int result)) + nil + result))) + +;;; langinfo.h + +#+nil +(defmacro def-math-rtn (name num-args) + (let ((function (intern (concatenate 'simple-string + "%" + (string-upcase name))))) + `(progn + (proclaim '(inline ,function)) + (export ',function) + (alien:def-alien-routine (,name ,function) double-float + ,@(let ((results nil)) + (dotimes (i num-args (nreverse results)) + (push (list (intern (format nil "ARG-~D" i)) + 'double-float) + results))))))) + +#+nil +(defmacro def-math-rtn-int-double (name num-args) + (let ((function (intern (concatenate 'simple-string + "%" + (string-upcase name))))) + `(progn + (proclaim '(inline ,function)) + (export ',function) + (alien:def-alien-routine (,name ,function) double-float + (ARG-1 'integer) + (ARG-2 'double))))) + +;;; not done: frexp, ldexp (d i) +#+nil +(def-math-rtn "cbrt" 1) ; returns cuberoot + +#+nil +(def-math-rtn "erf" 1) + +#+nil +(def-math-rtn "erfc" 1) + +#+nil +(def-math-rtn "gamma" 1) + +#+nil +(def-math-rtn "j0" 1) + +#+nil +(def-math-rtn "j1" 1) + +#+nil +(def-math-rtn-int-double "jn") + +#+nil +(def-math-rtn "lgamma" 1) + +#+nil +(def-math-rtn "y0" 1) + +#+nil +(def-math-rtn "y1" 1) + +#+nil +(def-math-rtn-int-double "yn") + +;;; pwd + +(def-alien-type nil + (struct passwd + (gr-name c-string) ;; group name + + ;;; pwd... + +|# + + + + + diff --git a/code/unix.lisp b/code/unix.lisp index 4cdeeadb5f637a8b0c536e824d3a915020896838..f0ed898a1d60b1c442ee8051f913ecc6047d26d3 100644 --- a/code/unix.lisp +++ b/code/unix.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.59 1998/03/01 21:46:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.60 1998/05/01 01:21:38 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1575,31 +1575,37 @@ `(eval-when (eval load compile) (defconstant ,name ,code)))) -#+(or linux (and svr4 (not irix))) +#+(and svr4 (not irix)) (defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) (declare (ignore dev arg parm-type)) `(eval-when (eval load compile) (defconstant ,name ,(logior (ash (char-code #\t) 8) cmd)))) +#+linux +(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) + (declare (ignore arg parm-type)) + `(eval-when (eval load compile) + (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd)))) + ) ;;; TTY ioctl commands. -(define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x5481 (struct sgttyb) :out) -(define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x5482 (struct sgttyb) :in) -(define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x5489 int :in) -(define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x5484 (struct tchars) :in) -(define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x5483 (struct tchars) :out) +(define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) +(define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) +(define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) +(define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) +(define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) (define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) :out) (define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) :in) -(define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x5422 nil :void) +(define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void) #-hpux (progn - (define-ioctl-command TIOCSLTC #\t #-linux 117 #+linux #x5484 (struct ltchars) :in) - (define-ioctl-command TIOCGLTC #\t #-linux 116 #+linux #x5485 (struct ltchars) :out) + (define-ioctl-command TIOCSLTC #\t #-linux 117 #+linux #x84 (struct ltchars) :in) + (define-ioctl-command TIOCGLTC #\t #-linux 116 #+linux #x85 (struct ltchars) :out) (define-ioctl-command TIOCSPGRP #\t #-svr4 118 #+svr4 21 int :in) (define-ioctl-command TIOCGPGRP #\t #-svr4 119 #+svr4 20 int :out)) #+hpux @@ -1611,7 +1617,7 @@ (define-ioctl-command TIOCSIGSEND #\t 93 nil)) ;;; File ioctl commands. -(define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x541B int :out) +(define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x1B int :out) (defun unix-ioctl (fd cmd arg) diff --git a/lisp/Config.linux_gencgc b/lisp/Config.linux_gencgc index 69a040306b8bc940aa5fbbd8815f307579526134..32d363b3384fcf419779c285cea7aee09797a9df 100644 --- a/lisp/Config.linux_gencgc +++ b/lisp/Config.linux_gencgc @@ -1,7 +1,7 @@ -vpath %.h /usr/dtc2/cmucl/p86/lisp:/usr/dtc2/cmucl/src/lisp -vpath %.c /usr/dtc2/cmucl/p86/lisp:/usr/dtc2/cmucl/src/lisp -vpath %.S /usr/dtc2/cmucl/p86/lisp:/usr/dtc2/cmucl/src/lisp -CPPFLAGS = -I. -I/usr/dtc2/cmucl/p86/lisp -I/usr/dtc2/cmucl/src/lisp -I- -I/usr/X11R6/include +vpath %.h /usr/src/cmucl/cmucl/p86/lisp:/usr/src/cmucl/cmucl/src/lisp +vpath %.c /usr/src/cmucl/cmucl/p86/lisp:/usr/src/cmucl/cmucl/src/lisp +vpath %.S /usr/src/cmucl/cmucl/p86/lisp:/usr/src/cmucl/cmucl/src/lisp +CPPFLAGS = -I. -I/usr/src/cmucl/cmucl/src/lisp -I- -I/usr/X11R6/include CC = gcc -Wstrict-prototypes -O2 -fno-strength-reduce # -Wall LD = ld CPP = cpp diff --git a/lisp/Linux-os.c b/lisp/Linux-os.c index cc720d016e8d682d32cf5697ea1f2d6b8b838dd8..67314602ffbe5e5f54a220540bf3901d462cf6ba 100644 --- a/lisp/Linux-os.c +++ b/lisp/Linux-os.c @@ -14,7 +14,7 @@ * Morfed from the FreeBSD file by Peter Van Eynde (July 1996) * GENCGC support by Douglas Crosher, 1996, 1997. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.3 1997/11/25 17:59:17 dtc Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.4 1998/05/01 01:21:40 dtc Exp $ * */ @@ -57,6 +57,17 @@ static double estack_buf[SIG_STACK_SIZE]; #include "gencgc.h" #endif +#if ((LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6)) +int PVE_stub_errno; +#endif + +#if ((LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6)) +void update_errno (void) +{ + PVE_stub_errno = errno; +} +#endif + void os_init(void) @@ -90,7 +101,7 @@ __setfpucw(0x1372|4|8|16|32); /*no interrupts */ } int -#if LINUX_VERSION_CODE >= linuxversion(2,1,0) +#if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) sc_reg(struct sigcontext *c, int offset) #else sc_reg(struct sigcontext_struct *c, int offset) diff --git a/lisp/Linux-os.h b/lisp/Linux-os.h index 3c1883124eef873cb6e01ef484c2c737ecdba544..c2d538191d594f67f106f5d4f403f96cffb041b4 100644 --- a/lisp/Linux-os.h +++ b/lisp/Linux-os.h @@ -1,4 +1,4 @@ -/* +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.5 1998/05/01 01:21:41 dtc Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -35,7 +35,7 @@ typedef int os_vm_prot_t; /* like hpux */ #define OS_VM_DEFAULT_PAGESIZE 4096 /* like hpux */ -#if LINUX_VERSION_CODE >= linuxversion(2,1,0) +#if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) int sc_reg(struct sigcontext *,int); #else int sc_reg(struct sigcontext_struct *,int); @@ -44,7 +44,7 @@ void os_save_context(void); #define SAVE_CONTEXT os_save_context -#if LINUX_VERSION_CODE >= linuxversion(2,1,0) +#if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) typedef struct sigcontext sigcontext; #else typedef struct sigcontext_struct sigcontext; @@ -52,7 +52,7 @@ typedef struct sigcontext_struct sigcontext; #define POSIX_SIGS -#if LINUX_VERSION_CODE >= linuxversion(2,1,0) +#if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) #define HANDLER_ARGS int signal, struct sigcontext contextstruct #define GET_CONTEXT int code=0; struct sigcontext *context=&contextstruct; #else @@ -64,12 +64,14 @@ typedef struct sigcontext_struct sigcontext; #define sv_mask sa_mask #define sv_flags sa_flags #define sv_handler sa_handler +#if (__GNU_LIBRARY__ < 6) #define sv_onstack sa_mask /* ouch, this one really hurts */ +#endif #define uc_sigmask oldmask #define sc_pc eip #define sc_mask oldmask #define sc_sp esp -#if LINUX_VERSION_CODE >= linuxversion(2,1,0) +#if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) #define sigcontext sigcontext #else #define sigcontext sigcontext_struct diff --git a/lisp/interrupt.c b/lisp/interrupt.c index a53dfeb3e76f2f2fbb8918450b0ad01ad40cd3e7..b5d123687ef3f1161755356ebb4ae8a37705e48c 100644 --- a/lisp/interrupt.c +++ b/lisp/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.14 1998/01/05 05:42:30 dtc Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.15 1998/05/01 01:21:42 dtc Exp $ */ /* Interrupt handing magic. */ @@ -161,23 +161,30 @@ undo_fake_foreign_function_call(struct sigcontext *context) } void -interrupt_internal_error(HANDLER_ARGS, - boolean continuable) +interrupt_internal_error(HANDLER_ARGS, boolean continuable) { - lispobj context_sap; + lispobj context_sap; #ifdef __linux__ - GET_CONTEXT + GET_CONTEXT #endif fake_foreign_function_call(context); - /* Allocate the SAP object while the interrupts are still - disabled. */ + /* Allocate the SAP object while the interrupts are still disabled. */ if (internal_errors_enabled) - context_sap = alloc_sap(context), + context_sap = alloc_sap(context); #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) sigprocmask(SIG_SETMASK,&context->uc_sigmask, 0); +#else + { + sigset_t temp; + sigemptyset(&temp); + temp.__val[0] = context->uc_sigmask; + sigprocmask(SIG_SETMASK,&temp, 0); + } +#endif #else sigsetmask(context->sc_mask); #endif @@ -213,7 +220,11 @@ interrupt_handle_pending(struct sigcontext *context) } #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) context->uc_sigmask = pending_mask; +#else + context->uc_sigmask = pending_mask.__val[0]; +#endif sigemptyset(&pending_mask); #else context->sc_mask = pending_mask; @@ -284,7 +295,16 @@ interrupt_handle_now(HANDLER_ARGS) /* Allow signals again. */ #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); +#else + { + sigset_t temp; + sigemptyset(&temp); + temp.__val[0] = &context->uc_sigmask; + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); + } +#endif #else sigsetmask(context->sc_mask); #endif @@ -299,7 +319,16 @@ interrupt_handle_now(HANDLER_ARGS) } else { /* Allow signals again. */ #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); +#else + { + sigset_t temp; + sigemptyset(&temp); + temp.__val[0] = &context->uc_sigmask; + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); + } +#endif #else sigsetmask(context->sc_mask); #endif @@ -334,8 +363,21 @@ maybe_now_maybe_later(HANDLER_ARGS) pending_signal = signal; pending_code = DEREFCODE(code); #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) pending_mask = context->uc_sigmask; FILLBLOCKSET(&context->uc_sigmask); +#else + { + sigset_t temp; + sigemptyset(&temp); + pending_mask.__val[0] = context->uc_sigmask; + temp.__val[0] = context->uc_sigmask; + FILLBLOCKSET(&temp); + + context->uc_sigmask = temp.__val[0]; + } +#endif + #else pending_mask = context->sc_mask; context->sc_mask |= BLOCKABLE; @@ -349,8 +391,19 @@ maybe_now_maybe_later(HANDLER_ARGS) pending_signal = signal; pending_code = DEREFCODE(code); #ifdef POSIX_SIGS +#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) pending_mask = context->uc_sigmask; FILLBLOCKSET(&context->uc_sigmask); +#else + { + sigset_t temp; + sigemptyset(&temp); + pending_mask.__val[0] = context->uc_sigmask; + temp.__val[0] = context->uc_sigmask; + FILLBLOCKSET(&temp); + context->uc_sigmask = temp.__val[0]; + } +#endif #else pending_mask = context->sc_mask; context->sc_mask |= BLOCKABLE; diff --git a/lisp/linux-stubs.S b/lisp/linux-stubs.S index 4257c218ced46357e38e52fe0e65e755e736162d..cff2a77bc6916882520f5a9e3f05ba2c468a56cf 100644 --- a/lisp/linux-stubs.S +++ b/lisp/linux-stubs.S @@ -1,6 +1,6 @@ /* linux-stubs.S - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/linux-stubs.S,v 1.5 1997/10/02 17:42:21 dtc Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/linux-stubs.S,v 1.6 1998/05/01 01:21:41 dtc Exp $ These are needed because the locations of the libraries are filled in by ld.so at runtime. @@ -9,7 +9,8 @@ .file "linux-stubs.S" .version "01.01" gcc2_compiled.: -.text + .text + #define doe(fct) \ .align 16 ;\ .globl PVE_stub_ ## fct ;\ @@ -19,793 +20,898 @@ PVE_stub_ ## fct: ;\ .L ## fct ## e1: ;\ .size PVE_stub_ ## fct,.L ## fct ## e1-PVE_stub_ ## fct ; - doe(abort) - doe(abs) doe(accept) doe(access) - doe(acct) doe(acos) doe(acosh) - doe(acoshl) - doe(acosl) - doe(addmntent) - doe(adjtime) - doe(adjtimex) - doe(alarm) - doe(alphasort) - doe(altzone) - doe(asctime) doe(asin) doe(asinh) - doe(asinhl) - doe(asinl) - doe(atan) - doe(atan2) - doe(atan2l) doe(atanh) - doe(atanhl) - doe(atanl) - doe(atexit) - doe(atof) - doe(atoi) - doe(atol) - doe(authdes_create) - doe(authnone_create) - doe(authunix_create) - doe(authunix_create_default) - doe(basename) - doe(bcmp) - doe(bcopy) doe(bind) - doe(bindresvport) - doe(brk) - doe(bsearch) - doe(bzero) - doe(calloc) - doe(callrpc) - doe(catclose) - doe(catgets) - doe(catopen) - doe(cbc_crypt) - doe(cbrt) - doe(cbrtl) - doe(ceil) - doe(ceill) doe(cfgetispeed) doe(cfgetospeed) - doe(cfmakeraw) - doe(cfree) doe(cfsetispeed) doe(cfsetospeed) doe(chdir) doe(chmod) doe(chown) - doe(chroot) - doe(clearerr) - doe(clnt_broadcast) - doe(clnt_create) - doe(clnt_pcreateerror) - doe(clnt_perrno) - doe(clnt_perror) - doe(clnt_spcreateerror) - doe(clnt_sperrno) - doe(clnt_sperror) - doe(clntraw_create) - doe(clnttcp_create) - doe(clntudp_bufcreate) - doe(clntudp_create) - doe(clock) doe(close) doe(closedir) - doe(closelog) - doe(confstr) doe(connect) - doe(copysign) - doe(copysignl) - doe(cos) doe(cosh) - doe(coshl) - doe(cosl) doe(creat) - doe(crypt) - doe(ctermid) - doe(ctime) - doe(ctime_r) - doe(cuserid) - doe(daylight) - doe(des_setparity) - doe(difftime) - doe(dirfd) - doe(div) doe(dlclose) doe(dlerror) doe(dlopen) doe(dlsym) - doe(dn_comp) - doe(dn_expand) - doe(dn_skipname) - doe(drand48) - doe(drem) doe(dup) doe(dup2) - doe(ecb_crypt) - doe(ecvt) - doe(encrypt) - doe(endgrent) - doe(endhostent) - doe(endmntent) - doe(endnetent) - doe(endprotoent) - doe(endpwent) - doe(endrpcent) - doe(endservent) - doe(endsgent) - doe(endspent) - doe(endusershell) - doe(endutent) - doe(environ) - doe(erand48) - doe(erf) - doe(erfc) - doe(erfcl) - doe(erfl) - doe(execl) - doe(execle) - doe(execlp) - doe(execv) doe(execve) - doe(execvp) doe(exit) - doe(exp) - doe(expl) - doe(expm1) - doe(expm1l) - doe(fabs) - doe(fabsl) - doe(fchdir) doe(fchmod) doe(fchown) - doe(fclose) doe(fcntl) - doe(fcvt) - doe(fdopen) - doe(feof) - doe(ferror) - doe(fflush) - doe(ffs) - doe(fgetc) - doe(fgetgrent) - doe(fgetpos) - doe(fgetpwent) - doe(fgets) - doe(fgetsgent) - doe(fgetspent) - doe(fileno) - doe(finite) - doe(flock) - doe(flockfile) - doe(floor) - doe(floorl) - doe(fmod) - doe(fmodl) - doe(fnmatch) - doe(fopen) doe(fork) - doe(fp_nquery) - doe(fp_query) - doe(fp_resstat) - doe(fpathconf) - doe(fpclassifyd) - doe(fpclassifyf) - doe(fpclassifyl) - doe(fprintf) - doe(fputc) - doe(fputs) - doe(fread) doe(free) - doe(freopen) - doe(frexp) - doe(frexpl) - doe(fscanf) - doe(fseek) - doe(fsetpos) doe(fstat) - doe(fstatfs) doe(fsync) - doe(ftell) - doe(ftime) - doe(ftok) doe(ftruncate) - doe(ftrylockfile) - doe(ftw) - doe(funlockfile) - doe(fwrite) - doe(gcvt) - doe(get_current_dir_name) - doe(get_myaddress) - doe(getc) - doe(getchar) - doe(getcwd) - doe(getdelim) - doe(getdents) - doe(getdirentries) - doe(getdomainname) doe(getdtablesize) doe(getegid) - doe(getenv) - doe(geteuid) doe(getgid) - doe(getgrent) - doe(getgrgid) - doe(getgrnam) - doe(getgroups) + doe(gethostid) doe(gethostbyaddr) doe(gethostbyname) - doe(gethostent) - doe(gethostid) doe(gethostname) doe(getitimer) - doe(getlogin) - doe(getmntent) - doe(getnetbyaddr) - doe(getnetbyname) - doe(getnetent) - doe(getopt) - doe(getopt_long) - doe(getopt_long_only) doe(getpagesize) - doe(getpass) doe(getpeername) - doe(getpgid) doe(getpgrp) doe(getpid) doe(getppid) - doe(getpriority) - doe(getprotobyname) - doe(getprotobynumber) - doe(getprotoent) - doe(getpw) - doe(getpwent) - doe(getpwnam) - doe(getpwuid) - doe(getrlimit) - doe(getrpcbyname) - doe(getrpcbynumber) - doe(getrpcent) - doe(getrpcport) doe(getrusage) - doe(gets) - doe(getservbyname) - doe(getservbyport) - doe(getservent) - doe(getsgent) - doe(getsgnam) - doe(getsid) doe(getsockname) - doe(getsockopt) - doe(getspent) - doe(getspnam) doe(gettimeofday) doe(getuid) - doe(getusershell) - doe(getutent) - doe(getutid) - doe(getutline) - doe(getw) doe(getwd) - doe(glob) - doe(globfree) - doe(gmtime) - doe(gmtime_r) - doe(gsignal) - doe(hasmntopt) - doe(hcreate) - doe(hdestroy) - doe(herror) - doe(hostalias) - doe(hsearch) - doe(htonl) - doe(htons) doe(hypot) - doe(hypotl) - doe(idle) - doe(index) - doe(inet_addr) - doe(inet_aton) - doe(inet_lnaof) - doe(inet_makeaddr) - doe(inet_netof) - doe(inet_network) - doe(inet_nsap_addr) - doe(inet_nsap_ntoa) - doe(inet_ntoa) - doe(infnan) - doe(init_des) - doe(initgroups) - doe(initstate) - doe(insque) doe(ioctl) - doe(ioperm) - doe(iopl) - doe(ipc) - doe(isalnum) - doe(isalpha) - doe(isascii) doe(isatty) - doe(isblank) - doe(iscntrl) - doe(isdigit) - doe(isgraph) - doe(isinf) - doe(isinfl) - doe(islower) - doe(isnan) - doe(isnanl) - doe(isprint) - doe(ispunct) - doe(isspace) - doe(isupper) - doe(isxdigit) - doe(j0) - doe(j0l) - doe(j1) - doe(j1l) - doe(jn) - doe(jnl) - doe(jrand48) doe(kill) doe(killpg) - doe(labs) - doe(lckpwdf) - doe(lcong48) - doe(ldexp) - doe(ldexpl) - doe(ldiv) - doe(lfind) - doe(lgamma) - doe(lgammal) - doe(libc_nls_init) doe(link) doe(listen) - doe(llseek) - doe(localeconv) - doe(localtime) - doe(localtime_r) - doe(lockf) - doe(log) - doe(log10) - doe(log10l) doe(log1p) - doe(log1pl) - doe(log2l) - doe(logl) - doe(longjmp) - doe(lrand48) - doe(lsearch) doe(lseek) doe(lstat) - doe(mallinfo) doe(malloc) - doe(malloc_stats) - doe(malloc_trim) - doe(malloc_usable_size) - doe(mallopt) - doe(mblen) - doe(mbstowcs) - doe(mbtowc) - doe(memalign) - doe(memccpy) - doe(memchr) - doe(memcmp) - doe(memcpy) - doe(memfrob) - doe(memmem) - doe(memmove) - doe(memset) doe(mkdir) - doe(mkfifo) - doe(mknod) - doe(mkstemp) - doe(mktemp) - doe(mktime) - doe(mlock) - doe(mlockall) - doe(mmap) - doe(modf) - doe(modfl) - doe(mount) - doe(mprotect) - doe(mrand48) - doe(mremap) - doe(msgctl) - doe(msgget) - doe(msgrcv) - doe(msgsnd) - doe(msync) - doe(munlock) - doe(munlockall) - doe(munmap) - doe(nice) - doe(nl_langinfo) - doe(nrand48) - doe(ntohl) - doe(ntohs) - doe(obstack_free) - doe(on_exit) doe(open) doe(opendir) - doe(openlog) - doe(optarg) - doe(opterr) - doe(optind) - doe(optopt) - doe(p_cdname) - doe(p_cdnname) - doe(p_class) - doe(p_fqname) - doe(p_option) - doe(p_query) - doe(p_rr) - doe(p_time) - doe(p_type) - doe(parse_printf_format) - doe(pathconf) - doe(pause) - doe(pclose) - doe(perror) doe(pipe) - doe(pmap_getmaps) - doe(pmap_getport) - doe(pmap_rmtcall) - doe(pmap_set) - doe(pmap_unset) - doe(popen) doe(pow) - doe(pow10) - doe(pow10l) - doe(pow2) - doe(pow2l) - doe(powl) - doe(prev_fstat) - doe(prev_lstat) - doe(prev_mknod) - doe(prev_stat) - doe(prev_ustat) - doe(printf) - doe(psignal) - doe(pthread_cond_signal) - doe(pthread_cond_wait) - doe(pthread_mutex_lock) - doe(pthread_mutex_unlock) - doe(pthread_once) - doe(pthread_yield) - doe(ptrace) - doe(putc) - doe(putchar) - doe(putenv) - doe(putlong) - doe(putpwent) - doe(puts) - doe(putsgent) - doe(putshort) - doe(putspent) - doe(pututline) - doe(putw) - doe(qsort) - doe(raise) - doe(rand) - doe(random) - doe(rcmd) - doe(re_comp) - doe(re_compile_fastmap) - doe(re_compile_pattern) - doe(re_error_msg) - doe(re_exec) - doe(re_match) - doe(re_match_2) - doe(re_search) - doe(re_search_2) - doe(re_set_registers) - doe(re_set_syntax) - doe(re_syntax_options) doe(read) doe(readdir) - doe(readdir_r) doe(readlink) - doe(readv) - doe(realloc) - doe(realpath) - doe(reboot) doe(recv) - doe(recvfrom) - doe(recvmsg) - doe(regcomp) - doe(regerror) - doe(regexec) - doe(regfree) - doe(register_printf_function) - doe(remove) - doe(remque) doe(rename) - doe(res_init) - doe(res_isourserver) - doe(res_mkquery) - doe(res_nameinquery) - doe(res_queriesmatch) - doe(res_query) - doe(res_querydomain) - doe(res_randomid) - doe(res_search) - doe(res_send) - doe(rewind) - doe(rewinddir) - doe(rexec) - doe(rindex) - doe(rint) doe(rmdir) - doe(rpc_createerr) - doe(rresvport) - doe(rtime) - doe(ruserok) - doe(rx_cache_bound) - doe(rx_id_instruction_table) - doe(rx_id_translation) - doe(rx_slowmap) - doe(rx_version_string) - doe(sbrk) - doe(scandir) - doe(scanf) - doe(seed48) - doe(seekdir) doe(select) - doe(semctl) - doe(semget) - doe(semop) doe(send) - doe(sendmsg) - doe(sendto) - doe(set_new_handler) - doe(setbuf) - doe(setbuffer) - doe(setdomainname) - doe(setegid) - doe(setenv) - doe(seteuid) - doe(setfsgid) - doe(setfsuid) - doe(setgid) - doe(setgrent) - doe(setgroups) - doe(sethostent) - doe(sethostid) - doe(sethostname) doe(setitimer) - doe(setkey) - doe(setlinebuf) - doe(setlocale) - doe(setlogmask) - doe(setmntent) - doe(setnetent) - doe(setpgid) doe(setpgrp) - doe(setpriority) - doe(setprotoent) - doe(setpwent) doe(setregid) doe(setreuid) - doe(setrlimit) - doe(setrpcent) - doe(setservent) - doe(setsgent) - doe(setsid) - doe(setsockopt) - doe(setspent) - doe(setstate) - doe(settimeofday) - doe(setuid) - doe(setusershell) - doe(setutent) - doe(setvbuf) - doe(sgetsgent) - doe(sgetspent) - doe(shmat) - doe(shmctl) - doe(shmdt) - doe(shmget) - doe(shutdown) - doe(sigaction) - doe(sigaddset) doe(sigblock) - doe(sigdelset) - doe(sigemptyset) - doe(sigfillset) - doe(siggetmask) - doe(siginterrupt) - doe(sigismember) - doe(siglongjmp) - doe(signal) - doe(signgam) - doe(signgaml) doe(sigpause) - doe(sigpending) - doe(sigprocmask) - doe(sigreturn) doe(sigsetmask) - doe(sigsuspend) - doe(sin) doe(sinh) - doe(sinhl) - doe(sinl) - doe(sleep) - doe(snprintf) doe(socket) - doe(socketcall) - doe(socketpair) - doe(sprintf) - doe(sqrt) - doe(sqrtl) - doe(srand) - doe(srand48) - doe(srandom) - doe(sscanf) - doe(ssignal) doe(stat) - doe(statfs) - doe(stderr) - doe(stdin) - doe(stdout) - doe(stime) - doe(stpcpy) - doe(stpncpy) - doe(strcasecmp) - doe(strcat) - doe(strchr) - doe(strcmp) - doe(strcoll) - doe(strcpy) - doe(strcspn) - doe(strdup) - doe(strerror) - doe(strfry) - doe(strftime) - doe(strlen) - doe(strncasecmp) - doe(strncat) - doe(strncmp) - doe(strncpy) - doe(strpbrk) - doe(strptime) - doe(strrchr) - doe(strsep) - doe(strsignal) - doe(strspn) - doe(strstr) - doe(strtod) - doe(strtof) - doe(strtok) - doe(strtol) - doe(strtold) - doe(strtoq) - doe(strtoul) - doe(strtouq) - doe(strxfrm) - doe(svc_exit) - doe(svc_fdset) - doe(svc_getreq) - doe(svc_getreqset) - doe(svc_register) - doe(svc_run) - doe(svc_sendreply) - doe(svc_unregister) - doe(svcerr_auth) - doe(svcerr_decode) - doe(svcerr_noproc) - doe(svcerr_noprog) - doe(svcerr_progvers) - doe(svcerr_systemerr) - doe(svcerr_weakauth) - doe(svcraw_create) - doe(svctcp_create) - doe(svcudp_bufcreate) - doe(svcudp_create) - doe(swab) - doe(swapoff) - doe(swapon) doe(symlink) doe(sync) - doe(sys_errlist) - doe(sys_nerr) - doe(sys_siglist) - doe(syscall) - doe(syscall_flock) - doe(syscall_readv) - doe(syscall_writev) - doe(sysconf) - doe(sysinfo) - doe(syslog) - doe(system) - doe(tan) doe(tanh) - doe(tanhl) - doe(tanl) doe(tcdrain) doe(tcflow) doe(tcflush) doe(tcgetattr) - doe(tcgetpgrp) doe(tcsendbreak) doe(tcsetattr) - doe(tcsetpgrp) - doe(tdelete) - doe(tell) - doe(telldir) - doe(tempnam) - doe(tfind) - doe(time) - doe(timegm) - doe(times) - doe(timezone) - doe(tmpfile) - doe(tmpnam) - doe(toascii) - doe(tolower) - doe(toupper) doe(truncate) - doe(tsearch) doe(ttyname) - doe(ttyname_r) - doe(twalk) doe(tzname) - doe(tzset) - doe(ulckpwdf) - doe(ulimit) - doe(umask) - doe(umount) - doe(uname) - doe(ungetc) doe(unlink) - doe(unsetenv) - doe(uselib) - doe(usleep) - doe(ustat) - doe(utime) doe(utimes) - doe(utmpname) - doe(valloc) - doe(vasprintf) - doe(vfork) - doe(vfprintf) - doe(vfscanf) - doe(vhangup) - doe(vm86) - doe(vprintf) - doe(vscanf) - doe(vsnprintf) - doe(vsprintf) - doe(vsscanf) - doe(vsyslog) - doe(wait) - doe(wait3) - doe(wait4) - doe(waitpid) - doe(wctomb) + doe(wait3) doe(write) - doe(writev) - doe(y0) - doe(y0l) - doe(y1) - doe(y1l) - doe(yn) - doe(ynl) - doe(yp_all) - doe(yp_bind) - doe(yp_first) - doe(yp_get_default_domain) - doe(yp_maplist) - doe(yp_master) - doe(yp_match) - doe(yp_next) - doe(yp_order) - doe(yp_unbind) - doe(yperr_string) - doe(ypprot_err) + +/* doe(abort) */ +/* doe(abs) */ +/* doe(accept) */ +/* doe(access) */ +/* doe(acct) */ +/* doe(acos) */ +/* doe(acosh) */ +/* doe(acoshl) */ +/* doe(acosl) */ +/* doe(addmntent) */ +/* doe(adjtime) */ +/* doe(adjtimex) */ +/* doe(alarm) */ +/* doe(alphasort) */ +/* doe(altzone) */ +/* doe(asctime) */ +/* doe(asin) */ +/* doe(asinh) */ +/* doe(asinhl) */ +/* doe(asinl) */ +/* doe(atan) */ +/* doe(atan2) */ +/* doe(atan2l) */ +/* doe(atanh) */ +/* doe(atanhl) */ +/* doe(atanl) */ +/* doe(atexit) */ +/* doe(atof) */ +/* doe(atoi) */ +/* doe(atol) */ +/* doe(authdes_create) */ +/* doe(authnone_create) */ +/* doe(authunix_create) */ +/* doe(authunix_create_default) */ +/* doe(basename) */ +/* doe(bcmp) */ +/* doe(bcopy) */ +/* doe(bind) */ +/* doe(bindresvport) */ +/* doe(brk) */ +/* doe(bsearch) */ +/* doe(bzero) */ +/* doe(calloc) */ +/* doe(callrpc) */ +/* doe(catclose) */ +/* doe(catgets) */ +/* doe(catopen) */ +/* doe(cbc_crypt) */ +/* doe(cbrt) */ +/* doe(cbrtl) */ +/* doe(ceil) */ +/* doe(ceill) */ +/* doe(cfgetispeed) */ +/* doe(cfgetospeed) */ +/* doe(cfmakeraw) */ +/* doe(cfree) */ +/* doe(cfsetispeed) */ +/* doe(cfsetospeed) */ +/* doe(chdir) */ +/* doe(chmod) */ +/* doe(chown) */ +/* doe(chroot) */ +/* doe(clearerr) */ +/* doe(clnt_broadcast) */ +/* doe(clnt_create) */ +/* doe(clnt_pcreateerror) */ +/* doe(clnt_perrno) */ +/* doe(clnt_perror) */ +/* doe(clnt_spcreateerror) */ +/* doe(clnt_sperrno) */ +/* doe(clnt_sperror) */ +/* doe(clntraw_create) */ +/* doe(clnttcp_create) */ +/* doe(clntudp_bufcreate) */ +/* doe(clntudp_create) */ +/* doe(clock) */ +/* doe(close) */ +/* doe(closedir) */ +/* doe(closelog) */ +/* doe(confstr) */ +/* doe(connect) */ +/* doe(copysign) */ +/* doe(copysignl) */ +/* doe(cos) */ +/* doe(cosh) */ +/* doe(coshl) */ +/* doe(cosl) */ +/* doe(creat) */ +/* doe(crypt) */ +/* doe(ctermid) */ +/* doe(ctime) */ +/* doe(ctime_r) */ +/* doe(cuserid) */ +/* doe(daylight) */ +/* doe(des_setparity) */ +/* doe(difftime) */ +/* doe(dirfd) */ +/* doe(div) */ +/* doe(dlclose) */ +/* doe(dlerror) */ +/* doe(dlopen) */ +/* doe(dlsym) */ +/* doe(dn_comp) */ +/* doe(dn_expand) */ +/* doe(dn_skipname) */ +/* doe(drand48) */ +/* doe(drem) */ +/* doe(dup) */ +/* doe(dup2) */ +/* doe(ecb_crypt) */ +/* doe(ecvt) */ +/* doe(encrypt) */ +/* doe(endgrent) */ +/* doe(endhostent) */ +/* doe(endmntent) */ +/* doe(endnetent) */ +/* doe(endprotoent) */ +/* doe(endpwent) */ +/* doe(endrpcent) */ +/* doe(endservent) */ +/* doe(endsgent) */ +/* doe(endspent) */ +/* doe(endusershell) */ +/* doe(endutent) */ +/* doe(environ) */ +/* doe(erand48) */ +/* doe(erf) */ +/* doe(erfc) */ +/* doe(erfcl) */ +/* doe(erfl) */ +/* doe(execl) */ +/* doe(execle) */ +/* doe(execlp) */ +/* doe(execv) */ +/* doe(execve) */ +/* doe(execvp) */ +/* doe(exit) */ +/* doe(exp) */ +/* doe(expl) */ +/* doe(expm1) */ +/* doe(expm1l) */ +/* doe(fabs) */ +/* doe(fabsl) */ +/* doe(fchdir) */ +/* doe(fchmod) */ +/* doe(fchown) */ +/* doe(fclose) */ +/* doe(fcntl) */ +/* doe(fcvt) */ +/* doe(fdopen) */ +/* doe(feof) */ +/* doe(ferror) */ +/* doe(fflush) */ +/* doe(ffs) */ +/* doe(fgetc) */ +/* doe(fgetgrent) */ +/* doe(fgetpos) */ +/* doe(fgetpwent) */ +/* doe(fgets) */ +/* doe(fgetsgent) */ +/* doe(fgetspent) */ +/* doe(fileno) */ +/* doe(finite) */ +/* doe(flock) */ +/* doe(flockfile) */ +/* doe(floor) */ +/* doe(floorl) */ +/* doe(fmod) */ +/* doe(fmodl) */ +/* doe(fnmatch) */ +/* doe(fopen) */ +/* doe(fork) */ +/* doe(fp_nquery) */ +/* doe(fp_query) */ +/* doe(fp_resstat) */ +/* doe(fpathconf) */ +/* doe(fpclassifyd) */ +/* doe(fpclassifyf) */ +/* doe(fpclassifyl) */ +/* doe(fprintf) */ +/* doe(fputc) */ +/* doe(fputs) */ +/* doe(fread) */ +/* doe(free) */ +/* doe(freopen) */ +/* doe(frexp) */ +/* doe(frexpl) */ +/* doe(fscanf) */ +/* doe(fseek) */ +/* doe(fsetpos) */ +/* doe(fstat) */ +/* doe(fstatfs) */ +/* doe(fsync) */ +/* doe(ftell) */ +/* doe(ftime) */ +/* doe(ftok) */ +/* doe(ftruncate) */ +/* doe(ftrylockfile) */ +/* doe(ftw) */ +/* doe(funlockfile) */ +/* doe(fwrite) */ +/* doe(gcvt) */ +/* doe(get_current_dir_name) */ +/* doe(get_myaddress) */ +/* doe(getc) */ +/* doe(getchar) */ +/* doe(getcwd) */ +/* doe(getdelim) */ +/* doe(getdents) */ +/* doe(getdirentries) */ +/* doe(getdomainname) */ +/* doe(getdtablesize) */ +/* doe(getegid) */ +/* doe(getenv) */ +/* doe(geteuid) */ +/* doe(getgid) */ +/* doe(getgrent) */ +/* doe(getgrgid) */ +/* doe(getgrnam) */ +/* doe(getgroups) */ +/* doe(gethostbyaddr) */ +/* doe(gethostbyname) */ +/* doe(gethostent) */ +/* doe(gethostid) */ +/* doe(gethostname) */ +/* doe(getitimer) */ +/* doe(getlogin) */ +/* doe(getmntent) */ +/* doe(getnetbyaddr) */ +/* doe(getnetbyname) */ +/* doe(getnetent) */ +/* doe(getopt) */ +/* doe(getopt_long) */ +/* doe(getopt_long_only) */ +/* doe(getpagesize) */ +/* doe(getpass) */ +/* doe(getpeername) */ +/* doe(getpgid) */ +/* doe(getpgrp) */ +/* doe(getpid) */ +/* doe(getppid) */ +/* doe(getpriority) */ +/* doe(getprotobyname) */ +/* doe(getprotobynumber) */ +/* doe(getprotoent) */ +/* doe(getpw) */ +/* doe(getpwent) */ +/* doe(getpwnam) */ +/* doe(getpwuid) */ +/* doe(getrlimit) */ +/* doe(getrpcbyname) */ +/* doe(getrpcbynumber) */ +/* doe(getrpcent) */ +/* doe(getrpcport) */ +/* doe(getrusage) */ +/* doe(gets) */ +/* doe(getservbyname) */ +/* doe(getservbyport) */ +/* doe(getservent) */ +/* doe(getsgent) */ +/* doe(getsgnam) */ +/* doe(getsid) */ +/* doe(getsockname) */ +/* doe(getsockopt) */ +/* doe(getspent) */ +/* doe(getspnam) */ +/* doe(gettimeofday) */ +/* doe(getuid) */ +/* doe(getusershell) */ +/* doe(getutent) */ +/* doe(getutid) */ +/* doe(getutline) */ +/* doe(getw) */ +/* doe(getwd) */ +/* doe(glob) */ +/* doe(globfree) */ +/* doe(gmtime) */ +/* doe(gmtime_r) */ +/* doe(gsignal) */ +/* doe(hasmntopt) */ +/* doe(hcreate) */ +/* doe(hdestroy) */ +/* doe(herror) */ +/* doe(hostalias) */ +/* doe(hsearch) */ +/* doe(htonl) */ +/* doe(htons) */ +/* doe(hypot) */ +/* doe(hypotl) */ +/* doe(idle) */ +/* doe(index) */ +/* doe(inet_addr) */ +/* doe(inet_aton) */ +/* doe(inet_lnaof) */ +/* doe(inet_makeaddr) */ +/* doe(inet_netof) */ +/* doe(inet_network) */ +/* doe(inet_nsap_addr) */ +/* doe(inet_nsap_ntoa) */ +/* doe(inet_ntoa) */ +/* doe(infnan) */ +/* doe(init_des) */ +/* doe(initgroups) */ +/* doe(initstate) */ +/* doe(insque) */ +/* doe(ioctl) */ +/* doe(ioperm) */ +/* doe(iopl) */ +/* doe(ipc) */ +/* doe(isalnum) */ +/* doe(isalpha) */ +/* doe(isascii) */ +/* doe(isatty) */ +/* doe(isblank) */ +/* doe(iscntrl) */ +/* doe(isdigit) */ +/* doe(isgraph) */ +/* doe(isinf) */ +/* doe(isinfl) */ +/* doe(islower) */ +/* doe(isnan) */ +/* doe(isnanl) */ +/* doe(isprint) */ +/* doe(ispunct) */ +/* doe(isspace) */ +/* doe(isupper) */ +/* doe(isxdigit) */ +/* doe(j0) */ +/* doe(j0l) */ +/* doe(j1) */ +/* doe(j1l) */ +/* doe(jn) */ +/* doe(jnl) */ +/* doe(jrand48) */ +/* doe(kill) */ +/* doe(killpg) */ +/* doe(labs) */ +/* doe(lckpwdf) */ +/* doe(lcong48) */ +/* doe(ldexp) */ +/* doe(ldexpl) */ +/* doe(ldiv) */ +/* doe(lfind) */ +/* doe(lgamma) */ +/* doe(lgammal) */ +/* doe(libc_nls_init) */ +/* doe(link) */ +/* doe(listen) */ +/* doe(llseek) */ +/* doe(localeconv) */ +/* doe(localtime) */ +/* doe(localtime_r) */ +/* doe(lockf) */ +/* doe(log) */ +/* doe(log10) */ +/* doe(log10l) */ +/* doe(log1p) */ +/* doe(log1pl) */ +/* doe(log2l) */ +/* doe(logl) */ +/* doe(longjmp) */ +/* doe(lrand48) */ +/* doe(lsearch) */ +/* doe(lseek) */ +/* doe(lstat) */ +/* doe(mallinfo) */ +/* doe(malloc) */ +/* doe(malloc_stats) */ +/* doe(malloc_trim) */ +/* doe(malloc_usable_size) */ +/* doe(mallopt) */ +/* doe(mblen) */ +/* doe(mbstowcs) */ +/* doe(mbtowc) */ +/* doe(memalign) */ +/* doe(memccpy) */ +/* doe(memchr) */ +/* doe(memcmp) */ +/* doe(memcpy) */ +/* doe(memfrob) */ +/* doe(memmem) */ +/* doe(memmove) */ +/* doe(memset) */ +/* doe(mkdir) */ +/* doe(mkfifo) */ +/* doe(mknod) */ +/* doe(mkstemp) */ +/* doe(mktemp) */ +/* doe(mktime) */ +/* doe(mlock) */ +/* doe(mlockall) */ +/* doe(mmap) */ +/* doe(modf) */ +/* doe(modfl) */ +/* doe(mount) */ +/* doe(mprotect) */ +/* doe(mrand48) */ +/* doe(mremap) */ +/* doe(msgctl) */ +/* doe(msgget) */ +/* doe(msgrcv) */ +/* doe(msgsnd) */ +/* doe(msync) */ +/* doe(munlock) */ +/* doe(munlockall) */ +/* doe(munmap) */ +/* doe(nice) */ +/* doe(nl_langinfo) */ +/* doe(nrand48) */ +/* doe(ntohl) */ +/* doe(ntohs) */ +/* doe(obstack_free) */ +/* doe(on_exit) */ +/* doe(open) */ +/* doe(opendir) */ +/* doe(openlog) */ +/* doe(optarg) */ +/* doe(opterr) */ +/* doe(optind) */ +/* doe(optopt) */ +/* doe(p_cdname) */ +/* doe(p_cdnname) */ +/* doe(p_class) */ +/* doe(p_fqname) */ +/* doe(p_option) */ +/* doe(p_query) */ +/* doe(p_rr) */ +/* doe(p_time) */ +/* doe(p_type) */ +/* doe(parse_printf_format) */ +/* doe(pathconf) */ +/* doe(pause) */ +/* doe(pclose) */ +/* doe(perror) */ +/* doe(pipe) */ +/* doe(pmap_getmaps) */ +/* doe(pmap_getport) */ +/* doe(pmap_rmtcall) */ +/* doe(pmap_set) */ +/* doe(pmap_unset) */ +/* doe(popen) */ +/* doe(pow) */ +/* doe(pow10) */ +/* doe(pow10l) */ +/* doe(pow2) */ +/* doe(pow2l) */ +/* doe(powl) */ +/* doe(prev_fstat) */ +/* doe(prev_lstat) */ +/* doe(prev_mknod) */ +/* doe(prev_stat) */ +/* doe(prev_ustat) */ +/* doe(printf) */ +/* doe(psignal) */ +/* doe(pthread_cond_signal) */ +/* doe(pthread_cond_wait) */ +/* doe(pthread_mutex_lock) */ +/* doe(pthread_mutex_unlock) */ +/* doe(pthread_once) */ +/* doe(pthread_yield) */ +/* doe(ptrace) */ +/* doe(putc) */ +/* doe(putchar) */ +/* doe(putenv) */ +/* doe(putlong) */ +/* doe(putpwent) */ +/* doe(puts) */ +/* doe(putsgent) */ +/* doe(putshort) */ +/* doe(putspent) */ +/* doe(pututline) */ +/* doe(putw) */ +/* doe(qsort) */ +/* doe(raise) */ +/* doe(rand) */ +/* doe(random) */ +/* doe(rcmd) */ +/* doe(re_comp) */ +/* doe(re_compile_fastmap) */ +/* doe(re_compile_pattern) */ +/* doe(re_error_msg) */ +/* doe(re_exec) */ +/* doe(re_match) */ +/* doe(re_match_2) */ +/* doe(re_search) */ +/* doe(re_search_2) */ +/* doe(re_set_registers) */ +/* doe(re_set_syntax) */ +/* doe(re_syntax_options) */ +/* doe(read) */ +/* doe(readdir) */ +/* doe(readdir_r) */ +/* doe(readlink) */ +/* doe(readv) */ +/* doe(realloc) */ +/* doe(realpath) */ +/* doe(reboot) */ +/* doe(recv) */ +/* doe(recvfrom) */ +/* doe(recvmsg) */ +/* doe(regcomp) */ +/* doe(regerror) */ +/* doe(regexec) */ +/* doe(regfree) */ +/* doe(register_printf_function) */ +/* doe(remove) */ +/* doe(remque) */ +/* doe(rename) */ +/* doe(res_init) */ +/* doe(res_isourserver) */ +/* doe(res_mkquery) */ +/* doe(res_nameinquery) */ +/* doe(res_queriesmatch) */ +/* doe(res_query) */ +/* doe(res_querydomain) */ +/* doe(res_randomid) */ +/* doe(res_search) */ +/* doe(res_send) */ +/* doe(rewind) */ +/* doe(rewinddir) */ +/* doe(rexec) */ +/* doe(rindex) */ +/* doe(rint) */ +/* doe(rmdir) */ +/* doe(rpc_createerr) */ +/* doe(rresvport) */ +/* doe(rtime) */ +/* doe(ruserok) */ +/* doe(rx_cache_bound) */ +/* doe(rx_id_instruction_table) */ +/* doe(rx_id_translation) */ +/* doe(rx_slowmap) */ +/* doe(rx_version_string) */ +/* doe(sbrk) */ +/* doe(scandir) */ +/* doe(scanf) */ +/* doe(seed48) */ +/* doe(seekdir) */ +/* doe(select) */ +/* doe(semctl) */ +/* doe(semget) */ +/* doe(semop) */ +/* doe(send) */ +/* doe(sendmsg) */ +/* doe(sendto) */ +/* doe(set_new_handler) */ +/* doe(setbuf) */ +/* doe(setbuffer) */ +/* doe(setdomainname) */ +/* doe(setegid) */ +/* doe(setenv) */ +/* doe(seteuid) */ +/* doe(setfsgid) */ +/* doe(setfsuid) */ +/* doe(setgid) */ +/* doe(setgrent) */ +/* doe(setgroups) */ +/* doe(sethostent) */ +/* doe(sethostid) */ +/* doe(sethostname) */ +/* doe(setitimer) */ +/* doe(setkey) */ +/* doe(setlinebuf) */ +/* doe(setlocale) */ +/* doe(setlogmask) */ +/* doe(setmntent) */ +/* doe(setnetent) */ +/* doe(setpgid) */ +/* doe(setpgrp) */ +/* doe(setpriority) */ +/* doe(setprotoent) */ +/* doe(setpwent) */ +/* doe(setregid) */ +/* doe(setreuid) */ +/* doe(setrlimit) */ +/* doe(setrpcent) */ +/* doe(setservent) */ +/* doe(setsgent) */ +/* doe(setsid) */ +/* doe(setsockopt) */ +/* doe(setspent) */ +/* doe(setstate) */ +/* doe(settimeofday) */ +/* doe(setuid) */ +/* doe(setusershell) */ +/* doe(setutent) */ +/* doe(setvbuf) */ +/* doe(sgetsgent) */ +/* doe(sgetspent) */ +/* doe(shmat) */ +/* doe(shmctl) */ +/* doe(shmdt) */ +/* doe(shmget) */ +/* doe(shutdown) */ +/* doe(sigaction) */ +/* doe(sigaddset) */ +/* doe(sigblock) */ +/* doe(sigdelset) */ +/* doe(sigemptyset) */ +/* doe(sigfillset) */ +/* doe(siggetmask) */ +/* doe(siginterrupt) */ +/* doe(sigismember) */ +/* doe(siglongjmp) */ +/* doe(signal) */ +/* doe(signgam) */ +/* doe(signgaml) */ +/* doe(sigpause) */ +/* doe(sigpending) */ +/* doe(sigprocmask) */ +/* doe(sigreturn) */ +/* doe(sigsetmask) */ +/* doe(sigsuspend) */ +/* doe(sin) */ +/* doe(sinh) */ +/* doe(sinhl) */ +/* doe(sinl) */ +/* doe(sleep) */ +/* doe(snprintf) */ +/* doe(socket) */ +/* doe(socketcall) */ +/* doe(socketpair) */ +/* doe(sprintf) */ +/* doe(sqrt) */ +/* doe(sqrtl) */ +/* doe(srand) */ +/* doe(srand48) */ +/* doe(srandom) */ +/* doe(sscanf) */ +/* doe(ssignal) */ +/* doe(stat) */ +/* doe(statfs) */ +/* doe(stderr) */ +/* doe(stdin) */ +/* doe(stdout) */ +/* doe(stime) */ +/* doe(stpcpy) */ +/* doe(stpncpy) */ +/* doe(strcasecmp) */ +/* doe(strcat) */ +/* doe(strchr) */ +/* doe(strcmp) */ +/* doe(strcoll) */ +/* doe(strcpy) */ +/* doe(strcspn) */ +/* doe(strdup) */ +/* doe(strerror) */ +/* doe(strfry) */ +/* doe(strftime) */ +/* doe(strlen) */ +/* doe(strncasecmp) */ +/* doe(strncat) */ +/* doe(strncmp) */ +/* doe(strncpy) */ +/* doe(strpbrk) */ +/* doe(strptime) */ +/* doe(strrchr) */ +/* doe(strsep) */ +/* doe(strsignal) */ +/* doe(strspn) */ +/* doe(strstr) */ +/* doe(strtod) */ +/* doe(strtof) */ +/* doe(strtok) */ +/* doe(strtol) */ +/* doe(strtold) */ +/* doe(strtoq) */ +/* doe(strtoul) */ +/* doe(strtouq) */ +/* doe(strxfrm) */ +/* doe(svc_exit) */ +/* doe(svc_fdset) */ +/* doe(svc_getreq) */ +/* doe(svc_getreqset) */ +/* doe(svc_register) */ +/* doe(svc_run) */ +/* doe(svc_sendreply) */ +/* doe(svc_unregister) */ +/* doe(svcerr_auth) */ +/* doe(svcerr_decode) */ +/* doe(svcerr_noproc) */ +/* doe(svcerr_noprog) */ +/* doe(svcerr_progvers) */ +/* doe(svcerr_systemerr) */ +/* doe(svcerr_weakauth) */ +/* doe(svcraw_create) */ +/* doe(svctcp_create) */ +/* doe(svcudp_bufcreate) */ +/* doe(svcudp_create) */ +/* doe(swab) */ +/* doe(swapoff) */ +/* doe(swapon) */ +/* doe(symlink) */ +/* doe(sync) */ +/* doe(sys_errlist) */ +/* doe(sys_nerr) */ +/* doe(sys_siglist) */ +/* doe(syscall) */ +/* doe(syscall_flock) */ +/* doe(syscall_readv) */ +/* doe(syscall_writev) */ +/* doe(sysconf) */ +/* doe(sysinfo) */ +/* doe(syslog) */ +/* doe(system) */ +/* doe(tan) */ +/* doe(tanh) */ +/* doe(tanhl) */ +/* doe(tanl) */ +/* doe(tcdrain) */ +/* doe(tcflow) */ +/* doe(tcflush) */ +/* doe(tcgetattr) */ +/* doe(tcgetpgrp) */ +/* doe(tcsendbreak) */ +/* doe(tcsetattr) */ +/* doe(tcsetpgrp) */ +/* doe(tdelete) */ +/* doe(tell) */ +/* doe(telldir) */ +/* doe(tempnam) */ +/* doe(tfind) */ +/* doe(time) */ +/* doe(timegm) */ +/* doe(times) */ +/* doe(timezone) */ +/* doe(tmpfile) */ +/* doe(tmpnam) */ +/* doe(toascii) */ +/* doe(tolower) */ +/* doe(toupper) */ +/* doe(truncate) */ +/* doe(tsearch) */ +/* doe(ttyname) */ +/* doe(ttyname_r) */ +/* doe(twalk) */ +/* doe(tzname) */ +/* doe(tzset) */ +/* doe(ulckpwdf) */ +/* doe(ulimit) */ +/* doe(umask) */ +/* doe(umount) */ +/* doe(uname) */ +/* doe(ungetc) */ +/* doe(unlink) */ +/* doe(unsetenv) */ +/* doe(uselib) */ +/* doe(usleep) */ +/* doe(ustat) */ +/* doe(utime) */ +/* doe(utimes) */ +/* doe(utmpname) */ +/* doe(valloc) */ +/* doe(vasprintf) */ +/* doe(vfork) */ +/* doe(vfprintf) */ +/* doe(vfscanf) */ +/* doe(vhangup) */ +/* doe(vm86) */ +/* doe(vprintf) */ +/* doe(vscanf) */ +/* doe(vsnprintf) */ +/* doe(vsprintf) */ +/* doe(vsscanf) */ +/* doe(vsyslog) */ +/* doe(wait) */ +/* doe(wait3) */ +/* doe(wait4) */ +/* doe(waitpid) */ +/* doe(wctomb) */ +/* doe(write) */ +/* doe(writev) */ +/* doe(y0) */ +/* doe(y0l) */ +/* doe(y1) */ +/* doe(y1l) */ +/* doe(yn) */ +/* doe(ynl) */ +/* doe(yp_all) */ +/* doe(yp_bind) */ +/* doe(yp_first) */ +/* doe(yp_get_default_domain) */ +/* doe(yp_maplist) */ +/* doe(yp_master) */ +/* doe(yp_match) */ +/* doe(yp_next) */ +/* doe(yp_order) */ +/* doe(yp_unbind) */ +/* doe(yperr_string) */ +/* doe(ypprot_err) */ diff --git a/lisp/x86-lispregs.h b/lisp/x86-lispregs.h index e81b38520ccc316e52f553512596a7c5fd949aef..ef6180b54164cbaa7e6cf72d5f465885b4945ab1 100644 --- a/lisp/x86-lispregs.h +++ b/lisp/x86-lispregs.h @@ -1,5 +1,5 @@ -/* 86-lispregs.h -*- Mode: C; -*- - * +/* x86-lispregs.h -*- Mode: C; -*- + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-lispregs.h,v 1.2 1998/05/01 01:21:41 dtc Exp $ */ /* These register names and offsets correspond to definitions diff --git a/lisp/x86-validate.h b/lisp/x86-validate.h index 44daee37e2bc66d05d5110c53c5c022dd5ce69d6..d61414fbe23e42d600b9f52a10b32a024dca7768 100644 --- a/lisp/x86-validate.h +++ b/lisp/x86-validate.h @@ -3,6 +3,7 @@ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.5 1998/05/01 01:21:42 dtc Exp $ */ diff --git a/tools/worldbuild.lisp b/tools/worldbuild.lisp index d0d761081f8ba6a6963ce60b722a9ba16588b5c3..2d262910c6ca9382f583b9a082f18830bd7ca117 100644 --- a/tools/worldbuild.lisp +++ b/tools/worldbuild.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.40 1998/01/13 19:18:02 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.41 1998/05/01 01:21:42 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -112,7 +112,9 @@ "target:code/alieneval" "target:code/c-call" "target:code/sap" - "target:code/unix" + ,@(if (c:backend-featurep :glibc2) + '("target:code/unix-glibc2") + '("target:code/unix")) ,@(when (c:backend-featurep :mach) '("target:code/mach" "target:code/mach-os")) diff --git a/tools/worldcom.lisp b/tools/worldcom.lisp index f46e1b8d36aac5d479c5682c64a6e159bfd8cb97..7712a0b43aaaaf9cea17be61e82a70f97613a5f0 100644 --- a/tools/worldcom.lisp +++ b/tools/worldcom.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.76 1997/12/12 15:28:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.77 1998/05/01 01:21:42 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -137,7 +137,10 @@ (comf "target:code/string") (comf "target:code/mipsstrops") -(comf "target:code/unix" :proceed t) +(if (c:backend-featurep :glibc2) + (comf "target:code/unix-glibc2" :proceed t) + (comf "target:code/unix" :proceed t)) + (when (c:backend-featurep :mach) (comf "target:code/mach") (comf "target:code/mach-os"))