0.6.10:

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 0d1f594..7db3ff5 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -11,9 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB-EXT")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; Import wait3(2) from Unix.
 
@@ -22,10 +19,9 @@
   (options sb-c-call:int)
   (rusage sb-c-call:int))
 
-(eval-when (load eval compile)
-  (defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
-  (defconstant wait-wuntraced #-svr4 2 #+svr4 4)
-  (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced))
+(defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
+(defconstant wait-wuntraced #-svr4 2 #+svr4 4)
+(defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced)
 
 (defun wait3 (&optional do-not-hang check-for-stopped)
   "Return any available status information on child process. "
@@ -123,10 +119,10 @@
   (process-pid proc))
 
 (defun process-kill (proc signal &optional (whom :pid))
-  "Hand SIGNAL to PROC.  If whom is :pid, use the kill Unix system call.  If
-   whom is :process-group, use the killpg Unix system call.  If whom is
-   :pty-process-group deliver the signal to whichever process group is currently
-   in the foreground."
+  "Hand SIGNAL to PROC. If WHOM is :PID, use the kill Unix system call. If
+   WHOM is :PROCESS-GROUP, use the killpg Unix system call. If WHOM is
+   :PTY-PROCESS-GROUP deliver the signal to whichever process group is
+   currently in the foreground."
   (let ((pid (ecase whom
               ((:pid :process-group)
                (process-pid proc))
@@ -213,13 +209,18 @@
 
 #+FreeBSD
 (def-alien-type nil
-    (struct sgttyb
-           (sg-ispeed sb-c-call:char)  ; input speed
-           (sg-ospeed sb-c-call:char)  ; output speed
-           (sg-erase sb-c-call:char)   ; erase character
-           (sg-kill sb-c-call:char)    ; kill character
-           (sg-flags sb-c-call:short)  ; mode flags
-           ))
+  (struct sgttyb
+         (sg-ispeed sb-c-call:char)    ; input speed
+         (sg-ospeed sb-c-call:char)    ; output speed
+         (sg-erase sb-c-call:char)     ; erase character
+         (sg-kill sb-c-call:char)      ; kill character
+         (sg-flags sb-c-call:short)))  ; mode flags
+#+OpenBSD
+(def-alien-type nil
+  (struct sgttyb
+         (sg-four sb-c-call:int)
+         (sg-chars (array sb-c-call:char 4))
+         (sg-flags sb-c-call:int)))
 
 ;;; Find a pty that is not in use. Return three values: the file
 ;;; descriptor for the master side of the pty, the file descriptor for
@@ -238,17 +239,32 @@
                                              sb-unix:o_rdwr
                                              #o666)))
            (when slave-fd
-                                       ; Maybe put a vhangup here?
-              #-linux
+             ;; comment from classic CMU CL:
+             ;;   Maybe put a vhangup here?
+             ;;
+             ;; FIXME: It seems as though this logic should be in
+             ;; OPEN-PTY, not FIND-A-PTY (both from the comments
+             ;; documenting DEFUN FIND-A-PTY, and from the
+             ;; connotations of the function names).
+             ;;
+             ;; FIXME: It would be nice to have a note, and/or a pointer
+             ;; to some reference material somewhere, explaining
+             ;; why we need this on *BSD and not on Linux.
+              #+bsd
              (sb-alien:with-alien ((stuff (sb-alien:struct sgttyb)))
                (let ((sap (sb-alien:alien-sap stuff)))
                  (sb-unix:unix-ioctl slave-fd sb-unix:TIOCGETP sap)
                  (setf (sb-alien:slot stuff 'sg-flags)
-                       #o300)          ; EVENP|ODDP
+                       ;; This is EVENP|ODDP, the same numeric code
+                       ;; both on FreeBSD and on OpenBSD. -- WHN 20000929
+                       #o300) ; EVENP|ODDP
                  (sb-unix:unix-ioctl slave-fd sb-unix:TIOCSETP sap)
                  (sb-unix:unix-ioctl master-fd sb-unix:TIOCGETP sap)
                  (setf (sb-alien:slot stuff 'sg-flags)
                        (logand (sb-alien:slot stuff 'sg-flags)
+                               ;; This is ~ECHO, the same numeric
+                               ;; code both on FreeBSD and on OpenBSD.
+                               ;; -- WHN 20000929
                                (lognot 8))) ; ~ECHO
                  (sb-unix:unix-ioctl master-fd sb-unix:TIOCSETP sap)))
              (return-from find-a-pty
@@ -499,11 +515,9 @@
       (process-wait proc))
     proc))
 
-;;; COPY-DESCRIPTOR-TO-STREAM -- internal
-;;;
-;;;   Installs a handler for any input that shows up on the file descriptor.
-;;; The handler reads the data and writes it to the stream.
-;;; 
+;;; Install a handler for any input that shows up on the file
+;;; descriptor. The handler reads the data and writes it to the
+;;; stream.
 (defun copy-descriptor-to-stream (descriptor stream cookie)
   (incf (car cookie))
   (let ((string (make-string 256))