(defvar *active-processes* nil
"List of process structures for all active processes.")
+(defvar *active-processes-lock*
+ (sb-thread:make-mutex :name "Lock for active processes."))
+
+;;; *ACTIVE-PROCESSES* can be accessed from multiple threads so a
+;;; mutex is needed. More importantly the sigchld signal handler also
+;;; accesses it, that's why we need without-interrupts.
+(defmacro with-active-processes-lock (() &body body)
+ `(without-interrupts
+ (sb-thread:with-mutex (*active-processes-lock*)
+ ,@body)))
+
(defstruct (process (:copier nil))
pid ; PID of child process
%status ; either :RUNNING, :STOPPED, :EXITED, or :SIGNALED
(frob (process-input proc) t) ; .. 'cause it will generate SIGPIPE.
(frob (process-output proc) nil)
(frob (process-error proc) nil))
- (sb-sys:without-interrupts
+ (with-active-processes-lock ()
(setf *active-processes* (delete proc *active-processes*)))
proc)
(wait3 t t)
(unless pid
(return))
- (let ((proc (find pid *active-processes* :key #'process-pid)))
- (when proc
- (setf (process-%status proc) what)
- (setf (process-exit-code proc) code)
- (setf (process-core-dumped proc) core)
- (when (process-status-hook proc)
- (funcall (process-status-hook proc) proc))
- (when (position what #(:exited :signaled))
- (sb-sys:without-interrupts
- (setf *active-processes*
- (delete proc *active-processes*)))))))))
+ (let ((proc (with-active-processes-lock ()
+ (find pid *active-processes* :key #'process-pid))))
+ (when proc
+ (setf (process-%status proc) what)
+ (setf (process-exit-code proc) code)
+ (setf (process-core-dumped proc) core)
+ (when (process-status-hook proc)
+ (funcall (process-status-hook proc) proc))
+ (when (position what #(:exited :signaled))
+ (with-active-processes-lock ()
+ (setf *active-processes*
+ (delete proc *active-processes*)))))))))
\f
;;;; RUN-PROGRAM and close friends
(push new-fd *close-on-error*)
(copy-descriptor-to-stream new-fd pty cookie)))
(values name
- (sb-sys:make-fd-stream master :input t :output t)))))
+ (sb-sys:make-fd-stream master :input t :output t
+ :dual-channel-p t)))))
(defmacro round-bytes-to-words (n)
`(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
(declare (simple-string s))
(let ((n (length s)))
;; Blast the string into place.
- (sb-kernel:copy-to-system-area (the simple-base-string
- ;; FIXME
- (coerce s 'simple-base-string))
- (* sb-vm:vector-data-offset
- sb-vm:n-word-bits)
- string-sap 0
- (* (1+ n) sb-vm:n-byte-bits))
+ (sb-kernel:copy-ub8-to-system-area (the simple-base-string
+ ;; FIXME
+ (coerce s 'simple-base-string))
+ 0
+ string-sap 0
+ (1+ n))
;; Blast the pointer to the string into place.
(setf (sap-ref-sap vec-sap i) string-sap)
(setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
;; Make sure we are not notified about the child
;; death before we have installed the PROCESS
;; structure in *ACTIVE-PROCESSES*.
- (sb-sys:without-interrupts
+ (with-active-processes-lock ()
(with-c-strvec (args-vec simple-args)
(with-c-strvec (environment-vec environment)
(let ((child-pid
~2I~_~A~:>"
(strerror errno)))
(t
- (sb-kernel:copy-from-system-area
+ (sb-kernel:copy-ub8-from-system-area
(alien-sap buf) 0
- string (* sb-vm:vector-data-offset
- sb-vm:n-word-bits)
- (* count sb-vm:n-byte-bits))
+ string 0
+ count)
(write-string string stream
:end count)))))))))))