X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=f8a36a133bf6b0eced90a3e4c04435a98e08c523;hb=619189958917e80786d5bb2efa4dc38d908d2553;hp=df3e173e519ca84afc1bef6c82e66937d80ecef5;hpb=0e5d338cec4e90475ea88f6892c24c62a07ae579;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index df3e173..f8a36a1 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -154,7 +154,8 @@
 ;;; accesses it, that's why we need without-interrupts.
 (defmacro with-active-processes-lock (() &body body)
   #-win32
-  `(sb-thread::call-with-system-mutex (lambda () ,@body) *active-processes-lock*)
+  `(sb-thread::with-system-mutex (*active-processes-lock* :allow-with-interrupts t)
+     ,@body)
   #+win32
   `(progn ,@body))
 
@@ -248,7 +249,7 @@ PROCESS."
       (sb-sys:serve-all-events 1))
   process)
 
-#-(or hpux win32)
+#-win32
 ;;; Find the current foreground process group id.
 (defun find-current-foreground-process (proc)
   (with-alien ((result sb-alien:int))
@@ -273,18 +274,11 @@ PROCESS."
                ((:pid :process-group)
                 (process-pid process))
                (:pty-process-group
-                #-hpux
                 (find-current-foreground-process process)))))
     (multiple-value-bind
           (okay errno)
         (case whom
-          #+hpux
-          (:pty-process-group
-           (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty process))
-                               sb-unix:TIOCSIGSEND
-                               (sb-sys:int-sap
-                                signal)))
-          ((:process-group #-hpux :pty-process-group)
+          ((:process-group)
            (sb-unix:unix-killpg pid signal))
           (t
            (sb-unix:unix-kill pid signal)))
@@ -830,9 +824,11 @@ Users Manual for details about the PROCESS structure."#-win32"
                                          (ash 1 descriptor)
                                          0 0 0)
                   (cond ((null result)
-                         (error "~@<couldn't select on sub-process: ~
-                                           ~2I~_~A~:>"
-                                (strerror readable/errno)))
+                         (if (eql sb-unix:eintr readable/errno)
+                             (return)
+                             (error "~@<Couldn't select on sub-process: ~
+                                        ~2I~_~A~:>"
+                                    (strerror readable/errno))))
                         ((zerop result)
                          (return))))
                 (multiple-value-bind (count errno)