/[cmucl]/src/code/run-program.lisp
ViewVC logotype

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

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

revision 1.22 by pw, Thu Mar 13 22:19:02 1997 UTC revision 1.22.2.2 by pw, Sat Mar 23 18:50:10 2002 UTC
# Line 104  Line 104 
104  (defun process-status (proc)  (defun process-status (proc)
105    "Return the current status of process.  The result is one of :running,    "Return the current status of process.  The result is one of :running,
106     :stopped, :exited, :signaled."     :stopped, :exited, :signaled."
107      (declare (type process proc))
108    (get-processes-status-changes)    (get-processes-status-changes)
109    (process-%status proc))    (process-%status proc))
110    
# Line 112  Line 113 
113  ;;;  ;;;
114  (defun process-wait (proc &optional check-for-stopped)  (defun process-wait (proc &optional check-for-stopped)
115    "Wait for PROC to quit running for some reason.  Returns PROC."    "Wait for PROC to quit running for some reason.  Returns PROC."
116      (declare (type process proc))
117    (loop    (loop
118      (case (process-status proc)      (case (process-status proc)
119        (:running)        (:running)
# Line 153  Line 155 
155     whom is :process-group, use the killpg Unix system call.  If whom is     whom is :process-group, use the killpg Unix system call.  If whom is
156     :pty-process-group deliver the signal to whichever process group is currently     :pty-process-group deliver the signal to whichever process group is currently
157     in the foreground."     in the foreground."
158      (declare (type process proc))
159    (let ((pid (ecase whom    (let ((pid (ecase whom
160                 ((:pid :process-group)                 ((:pid :process-group)
161                  (process-pid proc))                  (process-pid proc))
# Line 191  Line 194 
194  ;;;  ;;;
195  (defun process-alive-p (proc)  (defun process-alive-p (proc)
196    "Returns T if the process is still alive, NIL otherwise."    "Returns T if the process is still alive, NIL otherwise."
197      (declare (type process proc))
198    (let ((status (process-status proc)))    (let ((status (process-status proc)))
199      (if (or (eq status :running)      (if (or (eq status :running)
200              (eq status :stopped))              (eq status :stopped))
# Line 203  Line 207 
207  ;;;  ;;;
208  (defun process-close (proc)  (defun process-close (proc)
209    "Close all streams connected to PROC and stop maintaining the status slot."    "Close all streams connected to PROC and stop maintaining the status slot."
210      (declare (type process proc))
211    (macrolet ((frob (stream abort)    (macrolet ((frob (stream abort)
212                 `(when ,stream (close ,stream :abort ,abort))))                 `(when ,stream (close ,stream :abort ,abort))))
213      (frob (process-pty    proc)   t) ; Don't FLUSH-OUTPUT to dead process.      (frob (process-pty    proc)   t) ; Don't FLUSH-OUTPUT to dead process.
# Line 276  Line 281 
281                                             #o666)))                                             #o666)))
282              (when slave-fd              (when slave-fd
283                ; Maybe put a vhangup here?                ; Maybe put a vhangup here?
284                  #-glibc2
285                (alien:with-alien ((stuff (alien:struct unix:sgttyb)))                (alien:with-alien ((stuff (alien:struct unix:sgttyb)))
286                  (let ((sap (alien:alien-sap stuff)))                  (let ((sap (alien:alien-sap stuff)))
287                    (unix:unix-ioctl slave-fd unix:TIOCGETP sap)                    (unix:unix-ioctl slave-fd unix:TIOCGETP sap)
# Line 309  Line 315 
315             (slave-fd (unix:unix-open slave-name unix:o_rdwr #o666)))             (slave-fd (unix:unix-open slave-name unix:o_rdwr #o666)))
316        (when slave-fd        (when slave-fd
317          ; Maybe put a vhangup here?          ; Maybe put a vhangup here?
318            #-glibc2
319          (alien:with-alien ((stuff (alien:struct unix:sgttyb)))          (alien:with-alien ((stuff (alien:struct unix:sgttyb)))
320            (let ((sap (alien:alien-sap stuff)))            (let ((sap (alien:alien-sap stuff)))
321              (unix:unix-ioctl slave-fd unix:TIOCGETP sap)              (unix:unix-ioctl slave-fd unix:TIOCGETP sap)

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.22.2.2

  ViewVC Help
Powered by ViewVC 1.1.5