X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Frun-program.lisp;h=5c4f9fc229ce023d87850aa1c5033fffc7849cb7;hb=abfd7c2c9d4882e05a2e9953baf87f8e02a6a1af;hp=805a92ac2e4424ccca69cbbb58a96852efda700e;hpb=33412e55c5926dbed87f8816d22fbf95b12f839a;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 805a92a..5c4f9fc 100644
--- 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)
@@ -531,7 +531,7 @@ status slot."
 
 ;;; Is UNIX-FILENAME the name of a file that we can execute?
 (defun unix-filename-is-executable-p (unix-filename)
-  (let ((filename (coerce unix-filename 'base-string)))
+  (let ((filename (coerce unix-filename 'string)))
     (values (and (eq (sb-unix:unix-file-kind filename) :file)
                  #-win32
                  (sb-unix:unix-access filename sb-unix:x_ok)))))
@@ -839,7 +839,17 @@ Common Lisp Users Manual for details about the PROCESS structure.
         proc
         ;; It's friendly to allow the caller to pass any string
         ;; designator, but internally we'd like SIMPLE-STRINGs.
-        (simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
+        (simple-args
+          (mapcar
+            (lambda (x)
+              (coerce
+                ;; Apparently any spaces or double quotes in the arguments
+                ;; need to be escaped on win32.
+                (if (position-if (lambda (c) (find c '(#\" #\Space))) x)
+                    (write-to-string x)
+                    x)
+                'simple-string))
+            args)))
     (unwind-protect
          (let ((pfile
                 (if search
@@ -869,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