X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=1a4b7e7c2116885c768c49cae47d5fdf2b054ef3;hb=7254da92a1ba1bf8bc5a2e78a29d993f272d526e;hp=e85e2cc259360393a7536e5f5136a8ea5b782806;hpb=5b96a0e6ff6390f3c85f90a72207cf052ea11bf6;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index e85e2cc..1a4b7e7 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -455,13 +455,19 @@ status slot."
           (copy-descriptor-to-stream new-fd pty cookie external-format)))
       (values name
               (sb-sys:make-fd-stream master :input t :output t
+                                     :external-format external-format
                                      :element-type :default
                                      :dual-channel-p t)))))
 
-(defmacro round-bytes-to-words (n)
+;; Null terminate strings only C-side: otherwise we can run into
+;; A-T-S-L even for simple encodings like ASCII.  Multibyte encodings
+;; may need more than a single byte of zeros; assume 4 byte is enough
+;; for everyone.
+(defmacro round-null-terminated-bytes-to-words (n)
   (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))))
+    `(logandc2 (the sb-vm:signed-word (+ (the fixnum ,n)
+                                         4 (1- ,bytes-per-word)))
+               (1- ,bytes-per-word))))
 
 (defun string-list-to-c-strvec (string-list)
   (let* ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits))
@@ -469,28 +475,33 @@ status slot."
          ;; clobbers argv[-1].
          (vec-bytes (* bytes-per-word (+ (length string-list) 2)))
          (octet-vector-list (mapcar (lambda (s)
-                                      (string-to-octets s :null-terminate t))
+                                      (string-to-octets s))
                                     string-list))
          (string-bytes (reduce #'+ octet-vector-list
                                :key (lambda (s)
-                                      (round-bytes-to-words (length s)))))
+                                      (round-null-terminated-bytes-to-words
+                                       (length s)))))
          (total-bytes (+ string-bytes vec-bytes))
          ;; Memory to hold the vector of pointers and all the strings.
          (vec-sap (sb-sys:allocate-system-memory total-bytes))
          (string-sap (sap+ vec-sap vec-bytes))
          ;; Index starts from [1]!
          (vec-index-offset bytes-per-word))
-    (declare (index string-bytes vec-bytes total-bytes)
+    (declare (sb-vm:signed-word vec-bytes)
+             (sb-vm:word string-bytes total-bytes)
              (sb-sys:system-area-pointer vec-sap string-sap))
     (dolist (octets octet-vector-list)
       (declare (type (simple-array (unsigned-byte 8) (*)) octets))
       (let ((size (length octets)))
         ;; Copy string.
         (sb-kernel:copy-ub8-to-system-area octets 0 string-sap 0 size)
+        ;; NULL-terminate it
+        (setf (sap-ref-32 string-sap size) 0)
         ;; Put the pointer in the vector.
         (setf (sap-ref-sap vec-sap vec-index-offset) string-sap)
         ;; Advance string-sap for the next string.
-        (setf string-sap (sap+ string-sap (round-bytes-to-words size)))
+        (setf string-sap (sap+ string-sap
+                               (round-null-terminated-bytes-to-words size)))
         (incf vec-index-offset bytes-per-word)))
     ;; Final null pointer.
     (setf (sap-ref-sap vec-sap vec-index-offset) (int-sap 0))
@@ -724,7 +735,7 @@ Users Manual for details about the PROCESS structure."#-win32"
                         #+win32 `(declare (ignore ,pty ,cookie))
                         #+win32 `(let (,pty-name ,pty-stream) ,@body)
                         #-win32 `(multiple-value-bind (,pty-name ,pty-stream)
-                                     (open-pty ,pty ,cookie)
+                                     (open-pty ,pty ,cookie :external-format external-format)
                                    ,@body))
                       (with-args-vec ((vec args) &body body)
                         `(with-c-strvec (,vec ,args)
@@ -938,7 +949,9 @@ Users Manual for details about the PROCESS structure."#-win32"
     (cond ((eq object t)
            ;; No new descriptor is needed.
            (values -1 nil))
-          ((eq object nil)
+          ((or (eq object nil)
+               (and (typep object 'broadcast-stream)
+                    (not (broadcast-stream-streams object))))
            ;; Use /dev/null.
            (multiple-value-bind
                  (fd errno)
@@ -1051,7 +1064,10 @@ Users Manual for details about the PROCESS structure."#-win32"
                          (loop with buf = (make-array 256 :element-type '(unsigned-byte 8))
                                for p = (read-sequence buf object)
                                until (zerop p)
-                               do (sb-unix:unix-write fd buf 0 p))))
+                               do (sb-unix:unix-write fd buf 0 p)))
+                        (t
+                         (error "Don't know how to copy from stream of element-type ~S"
+                                et)))
                   (sb-unix:unix-lseek fd 0 sb-unix:l_set)
                   (push fd *close-in-parent*)
                   (return (values fd nil)))))