X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=f8a36a133bf6b0eced90a3e4c04435a98e08c523;hb=9abfd1a2b22862570c15ffa5129b1196d0480290;hp=22fcfdb858a7f1f65838d488ca2044fb9e4c3ec0;hpb=77d46c398278c0bbe221722c21c01d47713cd878;p=sbcl.git diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 22fcfdb..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 "~@" - (strerror readable/errno))) + (if (eql sb-unix:eintr readable/errno) + (return) + (error "~@" + (strerror readable/errno)))) ((zerop result) (return)))) (multiple-value-bind (count errno) @@ -976,7 +972,11 @@ Users Manual for details about the PROCESS structure."#-win32" (error "Direction must be either :INPUT or :OUTPUT, not ~S." direction))))) ((or (pathnamep object) (stringp object)) - (with-open-stream (file (apply #'open object keys)) + ;; GET-DESCRIPTOR-FOR uses &allow-other-keys, so rather + ;; than munge the &rest list for OPEN, just disable keyword + ;; validation there. + (with-open-stream (file (apply #'open object :allow-other-keys t + keys)) (multiple-value-bind (fd errno) (sb-unix:unix-dup (sb-sys:fd-stream-fd file))