| ... |
... |
@@ -27,58 +27,12 @@ |
|
27
|
27
|
process-close process-pid process-p))
|
|
28
|
28
|
|
|
29
|
29
|
|
|
30
|
|
-;;;; Import WAIT3 from unix.
|
|
31
|
|
-
|
|
32
|
|
-(alien:def-alien-routine ("wait3" c-wait3) c-call:int
|
|
33
|
|
- (status c-call:int :out)
|
|
34
|
|
- (options c-call:int)
|
|
35
|
|
- (rusage c-call:int))
|
|
36
|
|
-
|
|
37
|
30
|
(alien:def-alien-routine ("prog_status" c-prog-status) c-call:void
|
|
38
|
31
|
(pid c-call:int :out)
|
|
39
|
32
|
(what c-call:int :out)
|
|
40
|
33
|
(code c-call:int :out)
|
|
41
|
34
|
(corep c-call:int :out))
|
|
42
|
35
|
|
|
43
|
|
-(eval-when (load eval compile)
|
|
44
|
|
- (defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
|
|
45
|
|
- (defconstant wait-wuntraced #-svr4 2 #+svr4 4)
|
|
46
|
|
- (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced))
|
|
47
|
|
-
|
|
48
|
|
-(defun wait3 (&optional do-not-hang check-for-stopped)
|
|
49
|
|
- "Return any available status information on child processed. "
|
|
50
|
|
- (multiple-value-bind (pid status)
|
|
51
|
|
- (c-wait3 (logior (if do-not-hang
|
|
52
|
|
- wait-wnohang
|
|
53
|
|
- 0)
|
|
54
|
|
- (if check-for-stopped
|
|
55
|
|
- wait-wuntraced
|
|
56
|
|
- 0))
|
|
57
|
|
- 0)
|
|
58
|
|
- (cond ((or (minusp pid)
|
|
59
|
|
- (zerop pid))
|
|
60
|
|
- nil)
|
|
61
|
|
- ((eql (ldb (byte 8 0) status)
|
|
62
|
|
- wait-wstopped)
|
|
63
|
|
- (values pid
|
|
64
|
|
- :stopped
|
|
65
|
|
- (ldb (byte 8 8) status)))
|
|
66
|
|
- ((zerop (ldb (byte 7 0) status))
|
|
67
|
|
- (values pid
|
|
68
|
|
- :exited
|
|
69
|
|
- (ldb (byte 8 8) status)))
|
|
70
|
|
- (t
|
|
71
|
|
- (let ((signal (ldb (byte 7 0) status)))
|
|
72
|
|
- (values pid
|
|
73
|
|
- (if (or (eql signal unix:sigstop)
|
|
74
|
|
- (eql signal unix:sigtstp)
|
|
75
|
|
- (eql signal unix:sigttin)
|
|
76
|
|
- (eql signal unix:sigttou))
|
|
77
|
|
- :stopped
|
|
78
|
|
- :signaled)
|
|
79
|
|
- signal
|
|
80
|
|
- (not (zerop (ldb (byte 1 7) status)))))))))
|
|
81
|
|
-
|
|
82
|
36
|
(defun prog-status ()
|
|
83
|
37
|
(multiple-value-bind (ret pid what code corep)
|
|
84
|
38
|
(c-prog-status)
|
| ... |
... |
@@ -89,7 +43,6 @@ |
|
89
|
43
|
code
|
|
90
|
44
|
(not (zerop corep))))))
|
|
91
|
45
|
|
|
92
|
|
-
|
|
93
|
46
|
|
|
94
|
47
|
;;;; Process control stuff.
|
|
95
|
48
|
|