1.0.6.36: ALLOW-WITH-INTERRUPTS and interrupt safe WITH-MUTEX &co

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index cafb1de..5c4f9fc 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -154,9 +154,7 @@
 ;;; accesses it, that's why we need without-interrupts.
 (defmacro with-active-processes-lock (() &body body)
   #-win32
-  `(without-interrupts
-    (sb-thread:with-mutex (*active-processes-lock*)
-      ,@body))
+  `(sb-thread::call-with-system-mutex (lambda () ,@body) *active-processes-lock*)
   #+win32
   `(progn ,@body))
 
@@ -459,7 +457,9 @@ status slot."
                                      :dual-channel-p t)))))
 
 (defmacro round-bytes-to-words (n)
-  `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
+  (let ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)))
+    `(logandc2 (the fixnum (+ (the fixnum ,n)
+                              (1- ,bytes-per-word))) (1- ,bytes-per-word))))
 
 (defun string-list-to-c-strvec (string-list)
   ;; Make a pass over STRING-LIST to calculate the amount of memory
@@ -467,7 +467,7 @@ status slot."
   (let ((string-bytes 0)
         ;; We need an extra for the null, and an extra 'cause exect
         ;; clobbers argv[-1].
-        (vec-bytes (* #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)
+        (vec-bytes (* #.(/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)
                       (+ (length string-list) 2))))
     (declare (fixnum string-bytes vec-bytes))
     (dolist (s string-list)
@@ -477,7 +477,7 @@ status slot."
     (let* ((total-bytes (+ string-bytes vec-bytes))
            (vec-sap (sb-sys:allocate-system-memory total-bytes))
            (string-sap (sap+ vec-sap vec-bytes))
-           (i #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits)))
+           (i #.(/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)))
       (declare (type (and unsigned-byte fixnum) total-bytes i)
                (type sb-sys:system-area-pointer vec-sap string-sap))
       (dolist (s string-list)
@@ -493,11 +493,11 @@ status slot."
           ;; 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))))
-          (incf i #.(/ sb-vm::n-machine-word-bits sb-vm::n-byte-bits))))
+          (incf i #.(/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits))))
       ;; Blast in the last null pointer.
       (setf (sap-ref-sap vec-sap i) (int-sap 0))
-      (values vec-sap (sap+ vec-sap #.(/ sb-vm::n-machine-word-bits
-                                         sb-vm::n-byte-bits))
+      (values vec-sap (sap+ vec-sap #.(/ sb-vm:n-machine-word-bits
+                                         sb-vm:n-byte-bits))
               total-bytes))))
 
 (defmacro with-c-strvec ((var str-list) &body body)
@@ -845,12 +845,9 @@ Common Lisp Users Manual for details about the PROCESS structure.
               (coerce
                 ;; Apparently any spaces or double quotes in the arguments
                 ;; need to be escaped on win32.
-                #+win32
                 (if (position-if (lambda (c) (find c '(#\" #\Space))) x)
                     (write-to-string x)
                     x)
-                #-win32
-                x
                 'simple-string))
             args)))
     (unwind-protect
@@ -882,7 +879,7 @@ Common Lisp Users Manual for details about the PROCESS structure.
                                          (spawn pfile args-vec
                                                 stdin stdout stderr
                                                 (if wait 1 0)))))
-                            (when (< handle 0)
+                            (when (= handle -1)
                               (error "Couldn't spawn program: ~A" (strerror)))
                             (setf proc
                                   (if wait