ViewVC logotype

Diff of /src/code/run-program.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision by rtoy, Sat May 31 01:23:14 2008 UTC revision by rtoy, Sun Nov 2 13:30:01 2008 UTC
# Line 268  Line 268 
268  #-irix  #-irix
269  (defun find-a-pty ()  (defun find-a-pty ()
270    "Returns the master fd, the slave fd, and the name of the tty"    "Returns the master fd, the slave fd, and the name of the tty"
271    (dolist (char '(#\p #\q))    (multiple-value-bind (error master-fd slave-fd)
272      (dotimes (digit 16)        (unix:unix-openpty nil nil nil)
273        (let* ((master-name (format nil "/dev/pty~C~X" char digit))      (when (zerop error)
274               (master-fd (unix:unix-open master-name        #-glibc2
275                                          unix:o_rdwr        (alien:with-alien ((stuff (alien:struct unix:sgttyb)))
276                                          #o666)))          (let ((sap (alien:alien-sap stuff)))
277          (when master-fd            (unix:unix-ioctl slave-fd unix:TIOCGETP sap)
278            (let* ((slave-name (format nil "/dev/tty~C~X" char digit))            (setf (alien:slot stuff 'unix:sg-flags) #o300) ; EVENP|ODDP
279                   (slave-fd (unix:unix-open slave-name            (unix:unix-ioctl slave-fd unix:TIOCSETP sap)
280                                             unix:o_rdwr            (unix:unix-ioctl master-fd unix:TIOCGETP sap)
281                                             #o666)))            (setf (alien:slot stuff 'unix:sg-flags)
282              (when slave-fd                  (logand (alien:slot stuff 'unix:sg-flags)
283                ; Maybe put a vhangup here?                          (lognot 8)))    ; ~ECHO
284                #-glibc2            (unix:unix-ioctl master-fd unix:TIOCSETP sap)))
285                (alien:with-alien ((stuff (alien:struct unix:sgttyb)))        (return-from find-a-pty
286                  (let ((sap (alien:alien-sap stuff)))                     (values master-fd
287                    (unix:unix-ioctl slave-fd unix:TIOCGETP sap)                             slave-fd
288                    (setf (alien:slot stuff 'unix:sg-flags) #o300) ; EVENP|ODDP                             (unix:unix-ttyname slave-fd))))
289                    (unix:unix-ioctl slave-fd unix:TIOCSETP sap)      (error "Could not find a pty.")))
                   (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  
           (unix:unix-close master-fd))))))  
   (error "Could not find a pty."))  
291  #+irix  #+irix
292  (alien:def-alien-routine ("_getpty" c-getpty) c-call:c-string  (alien:def-alien-routine ("_getpty" c-getpty) c-call:c-string

Removed from v.  
changed lines
  Added in v.

  ViewVC Help
Powered by ViewVC 1.1.5