diff --git a/code/run-program.lisp b/code/run-program.lisp index 715a93da9cbb0aef149f75bacde4fe4766ca4026..2a53ad01d00f875fb74954e2c60c992ce331225e 100644 --- a/code/run-program.lisp +++ b/code/run-program.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/run-program.lisp,v 1.26 2003/02/25 17:22:06 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/run-program.lisp,v 1.27 2008/09/24 09:42:25 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -268,36 +268,25 @@ #-irix (defun find-a-pty () "Returns the master fd, the slave fd, and the name of the tty" - (dolist (char '(#\p #\q)) - (dotimes (digit 16) - (let* ((master-name (format nil "/dev/pty~C~X" char digit)) - (master-fd (unix:unix-open master-name - unix:o_rdwr - #o666))) - (when master-fd - (let* ((slave-name (format nil "/dev/tty~C~X" char digit)) - (slave-fd (unix:unix-open slave-name - unix:o_rdwr - #o666))) - (when slave-fd - ; Maybe put a vhangup here? - #-glibc2 - (alien:with-alien ((stuff (alien:struct unix:sgttyb))) - (let ((sap (alien:alien-sap stuff))) - (unix:unix-ioctl slave-fd unix:TIOCGETP sap) - (setf (alien:slot stuff 'unix:sg-flags) #o300) ; EVENP|ODDP - (unix:unix-ioctl slave-fd unix:TIOCSETP sap) - (unix:unix-ioctl master-fd unix:TIOCGETP sap) - (setf (alien:slot stuff 'unix:sg-flags) - (logand (alien:slot stuff 'unix:sg-flags) - (lognot 8))) ; ~ECHO - (unix:unix-ioctl master-fd unix:TIOCSETP sap))) - (return-from find-a-pty - (values master-fd - slave-fd - slave-name))) - (unix:unix-close master-fd)))))) - (error "Could not find a pty.")) + (multiple-value-bind (error master-fd slave-fd) + (unix:unix-openpty nil nil nil) + (when (zerop error) + #-glibc2 + (alien:with-alien ((stuff (alien:struct unix:sgttyb))) + (let ((sap (alien:alien-sap stuff))) + (unix:unix-ioctl slave-fd unix:TIOCGETP sap) + (setf (alien:slot stuff 'unix:sg-flags) #o300) ; EVENP|ODDP + (unix:unix-ioctl slave-fd unix:TIOCSETP sap) + (unix:unix-ioctl master-fd unix:TIOCGETP sap) + (setf (alien:slot stuff 'unix:sg-flags) + (logand (alien:slot stuff 'unix:sg-flags) + (lognot 8))) ; ~ECHO + (unix:unix-ioctl master-fd unix:TIOCSETP sap))) + (return-from find-a-pty + (values master-fd + slave-fd + (unix:unix-ttyname slave-fd)))) + (error "Could not find a pty."))) #+irix (alien:def-alien-routine ("_getpty" c-getpty) c-call:c-string diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 6fbea5e2bac1096e05a83bb6f279b1067057bc01..5c6f21829f441a5d7ccb5c70753931144531ea00 100644 --- a/code/unix-glibc2.lisp +++ b/code/unix-glibc2.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-glibc2.lisp,v 1.43 2007/11/14 17:20:46 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.44 2008/09/24 09:42:31 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -185,7 +185,7 @@ unix-current-directory unix-isatty unix-ttyname unix-execve unix-socket unix-connect unix-bind unix-listen unix-accept unix-recv unix-send unix-getpeername unix-getsockname - unix-getsockopt unix-setsockopt + unix-getsockopt unix-setsockopt unix-openpty unix-recvfrom unix-sendto unix-shutdown @@ -1272,7 +1272,6 @@ length LEN and type TYPE." ;;; pty.h -#+(or) (defun unix-openpty (amaster aslave name termp winp) "Create pseudo tty master slave pair with NAME and set terminal attributes according to TERMP and WINP and return handles for both diff --git a/code/unix.lisp b/code/unix.lisp index 1629d1ac74d3271abc19931137ff8a514e4b7c43..697b92e4470c950d19d40ac88b46868a8aaa5bfd 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.119 2008/04/02 13:28:28 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.120 2008/09/24 09:42:31 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -168,7 +168,7 @@ unix-current-directory unix-isatty unix-ttyname unix-execve unix-socket unix-connect unix-bind unix-listen unix-accept unix-recv unix-send unix-getpeername unix-getsockname - unix-getsockopt unix-setsockopt + unix-getsockopt unix-setsockopt unix-openpty unix-recvfrom unix-sendto unix-shutdown @@ -2758,6 +2758,12 @@ (def-alien-routine ("ttyname" unix-ttyname) c-string (fd int)) +(def-alien-routine ("openpty" unix-openpty) int + (amaster int :out) + (aslave int :out) + (name c-string) + (termp (* (struct termios))) + (winp (* (struct winsize)))) diff --git a/lisp/Config.FreeBSD_gencgc b/lisp/Config.FreeBSD_gencgc index cb7263b0597517ef4ba83d073c36b8812c339041..823bde5176163e68c4ae9664801cdf950cb09a3a 100644 --- a/lisp/Config.FreeBSD_gencgc +++ b/lisp/Config.FreeBSD_gencgc @@ -16,9 +16,9 @@ NM = nm -gp UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC = x86-assem.S ARCH_SRC = x86-arch.c -OS_SRC = FreeBSD-os.c os-common.c elf.c e_rem_pio2.c k_rem_pio2.c +OS_SRC = FreeBSD-os.c os-common.c elf.c e_rem_pio2.c k_rem_pio2.c undefineds.c OS_LINK_FLAGS = -dynamic -export-dynamic -OS_LIBS = +OS_LIBS = -lutil GC_SRC = gencgc.c # This has aliasing problems, so turn off aliasing. diff --git a/lisp/Config.linux_gencgc b/lisp/Config.linux_gencgc index 0b6f2a171fbbbc3c5bb2fca48e771bc60e1271e9..924d84ec00cc820fa6d33b6a979ed2892f4a0d2f 100644 --- a/lisp/Config.linux_gencgc +++ b/lisp/Config.linux_gencgc @@ -32,9 +32,9 @@ NM = $(PATH1)/linux-nm UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC = x86-assem.S linux-stubs.S ARCH_SRC = x86-arch.c -OS_SRC = Linux-os.c os-common.c elf.c e_rem_pio2.c k_rem_pio2.c +OS_SRC = Linux-os.c os-common.c elf.c e_rem_pio2.c k_rem_pio2.c undefineds.c OS_LINK_FLAGS = -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo -OS_LIBS = -ldl +OS_LIBS = -ldl -lutil #GC_SRC = gencgc.c # e_rem_pio2.c has strict aliasing issues. Compile this with diff --git a/lisp/solaris-os.c b/lisp/solaris-os.c index 1c49f1754b2b251797cdfb326fcbb4a0ca08dea6..97301d1815eeaae46526e023222899d9f8a4bd5a 100644 --- a/lisp/solaris-os.c +++ b/lisp/solaris-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.22 2008/09/16 08:52:32 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.23 2008/09/24 09:42:33 cshapiro Rel $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -20,6 +20,8 @@ #include <fcntl.h> #include <sys/file.h> +#include <stropts.h> +#include <termios.h> #include <unistd.h> #include <errno.h> #include <sys/param.h> @@ -342,6 +344,45 @@ sigsetmask(int mask) } +int +openpty(int *amaster, int *aslave, char *name, struct termios *termp, + struct winsize *winp) +{ + char *slavename; + int masterfd, slavefd; + + if ((masterfd = open("/dev/ptmx", O_RDWR)) == -1) + return -1; + if (grantpt(masterfd) == -1) { + close(masterfd); + return -1; + } + if (unlockpt(masterfd) == -1) { + close(masterfd); + return -1; + } + if ((slavename = ptsname(masterfd)) == NULL) { + close(masterfd); + return -1; + } + if ((slavefd = open(slavename, O_RDWR | O_NOCTTY)) == -1) { + close(masterfd); + return -1; + } + *amaster = masterfd; + *aslave = slavefd; + ioctl(*aslave, I_PUSH, "ptem"); + ioctl(*aslave, I_PUSH, "ldterm"); + ioctl(*aslave, I_PUSH, "ttcompat"); + if (name) + strcpy(name, slavename); + if (termp) + tcsetattr(slavefd, TCSAFLUSH, termp); + if (winp) + ioctl(slavefd, TIOCSWINSZ, (char *) winp); + return 0; +} + os_vm_address_t round_up_sparse_size(os_vm_address_t addr) { return (addr + SPARSE_BLOCK_SIZE - 1) & ~SPARSE_SIZE_MASK; diff --git a/lisp/undefineds.h b/lisp/undefineds.h index 26dca850ff5fc51b491726bfa7e2d6348db8adef..7e138b051bac71650aed6195fa25a1d277f4d4b2 100644 --- a/lisp/undefineds.h +++ b/lisp/undefineds.h @@ -1,5 +1,5 @@ /* Routines that must be linked into the core for lisp to work. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.39 2008/09/07 07:07:50 cshapiro Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.40 2008/09/24 09:42:33 cshapiro Exp $ */ /* * Do not wrap this inside an #ifndef/#endif! @@ -85,6 +85,7 @@ F(accept) F(msync) F(munmap) F(open) + F(openpty) F(pipe) F(profil) F(ptrace)